I-46
********************************************************************************
IDENTIFICATION DIVISION.
********************************************************************************
PROGRAM-ID. CBCIST IS INITIAL PROGRAM.
AUTHOR. USPS - NYPDC.
DATE-WRITTEN.MAY-1992.
DATE-COMPILED.
********************************************************************
*REMARKS: On an accounting period (AP) basis, create a sequential flat file
* which contains a summary of pieces, weight, postage for all classes of mail.
* (Note: usually run on the third day of each AP analyzing data for the
* previous AP.)
* AP to be analyzed is calculated from the USPS_YYYYAPMM system logical.
* The begin and end dates for the AP are set from the CALENDAR file.
* For Second-Class the begin and end dates are formatted into julian dates.
*
* Permit reads records within a date range using the master file, and "account
* number/processing date" alternate key.
* Permit transactions contain a vipcode field.
*
* Second-Class reads records within a date range using the time-stamp primary
* key.
* Only the transaction file is read (the SCmaster.FIL file is not read).
* Records are written to the sort work file so that they may be sorted into
* account number and processing category order.
* Second-Class transactions do NOT contain a vipcode field... the vipcode must
* be derived in this program.
*
* The following is an example of the symbols that are set in the procedure
* before running this program:
* dcl_ap_key= "1994AP04"!note: USPS_YYYYAPMM was "19940503"
* dcl_node_no= "SMC077"
* dcl_run_sw= "0" or " "
* When dcl_run_sw = "0", build an empty file CBCIS:CBCIS_'node'_'yyaa'_T.FIL
* and end the program. That is done in the procedure once for that VAX site.
* That symbol is then set to " " in the procedure to signal that records are
* to be added to the existing file for each finance number.
* dcl_flag_t= " "!will be set to "1" each time the program ends
* successfully. If that field is still blank after program end, a
* transaction process failure routine is executed by the calling procedure.
*
*Disk files:
*COMMON_TABLES:CALENDAR.FIL (AP begin/end dates)
*PITRANS.HIS (Permit Imprint trans file)
*PSTRANS.HIS (PRECANCELED STAMP trans file)
*MSTRANS.HIS (METER STAMP trans file)
*SECOND.HIS (SECOND CLASS trans file):
*SCMRATE.FIL (SECOND CLASS Rate file):
* BUSREPLY.HIS (Business Reply tranaction file)
*
*2) Copy files
* a) PITSEL (Permit Imprint record description)
* c) PITREC (Permit Imprint record description)
* d) PSTSEL (PRECANCELED STAMP select clause)
* f) PSTREC (PRECANCELED STAMP record description)
* g) MSTSEL (METER STAMP select clause)
* i) MSTREC (METER STAMP record description)
* j) SCTSEL (SECOND CLASS TRANS SELECT CLAUSE)
* k) SCTREC (SECOND CLASS TRANS RECORD DESCRIPTION)
* r) EXTERN (External variable for next module)
* s) STATVAR (File Status for all files)
*
* Calls: lib$get_symbol, lib$stop, lib$wait.
*
*CHANGE LOG:
*11-SEP-1992- Changes to allow display for generating reports to be
*standardized on line 23 column 1 with reverse video and blink.
*
*20-OCT-1992- tighten screening for verification records
* -Changes to header and trailer records
* -second class pending differentiated
*
*8/92 JCL- Modified for Second class rate case changes for FY93
* - Added in First class surcharge revenue
*
*1/93 JCL- COMMENT OUR MESSAGE MAILED TO NEW YORK.
*
*04-Apr-1993- Changed the program to Batch mode.
*
*26-OCT-1993- Changed the HEADER/TRAILER. THE TRAILER WOULD
* NOW HAVE TOTAL-REVENUE INSTEAD TOTAL-WEIGHT.
**02-AUG-1994
* Now, read 2C trans within begin/end julian date range using the primary
* SCT-TRANSACTION-DATE. Write to the temporary sort work file, then sort into
* the desired final order.
* Extensive debugging displays were added to help understand the flow of the
* program logic for Second-Class.
*
*09-AUG-1994 - move spaces to account number area of sort-work recor.
* Note: Output file CBCIST writes pending before approved ("PS" < "SC" in sort).
*10-aug-1994 - PSA94-08 extend the weight field by 2 decimals.
*17-aug-1994 - CPP process category fix, init # of sort records
*18-aug-1994 - Delay 63 char output until Acctg Period 01/95.
*15-sep-1994 - 63 char output ok now.
*01-DEC-1994 - EXTEND THE REVENUE FIELD BY 2 CHAR.
*07-FEB-1994 - PROVIDE FOR BY/FOR FIELD FOR SALE PARTNER DATA.
*04-May-1995- Include new VIP codes for new Mexico Int'l mailings.
*01-SEP-1995 - CAN48 BRM SEQUENCE CHANGE FROM 2 TO 3 DIGITS
*19-Jan-1996 - 1.CAN49 Terminal dues file creation.
* 2.International VIPCODE changes.
********************************************************************************
********************************************************************************
Environment Division.
********************************************************************************
Configuration Section.
SPECIAL-NAMES.
SWITCH 1 ON is W-DEBUG-SWITCH .
*DCL $DEFINE COB$SWITCHES "1"
SOURCE-COMPUTER.VAX.
OBJECT-COMPUTER.VAX.
Input-Output Section.
File-Control.
* Input File(s)
COPY PITSEL IN "LIB:DATAPERMIT.TLB".
COPY MSTSEL IN "LIB:DATAPERMIT.TLB".
COPY PSTSEL IN "LIB:DATAPERMIT.TLB".
COPY BRTSEL IN "LIB:DATAPERMIT.TLB".
COPY CALSEL IN "LIB:DATAPERMIT.TLB".
COPY POSEL IN "LIB:DATAPERMIT.TLB".
COPY ISTSEL IN "LIB:DATAPERMIT.TLB".
* Input-Output File(s)
SELECT SORT-SRT-FILE Assign to "SYS$DISK:SORT.TMP".
* Output File(s)
SELECT TCIS-FILE Assign TO "CBCIS:".
SELECT ISTCIS-FILE Assign TO "CBCIS:".
I-O-CONTROL.
APPLY LOCK-HOLDING ON IMPRINT-TRANS-FILE
METER-TRANS-FILE
PRECANCELED-TRANS-FILE
BUSINESS-REPLY-TRANS-FILE
ISO-TRANS-FILE
POST-OFFICE-FILE
CALENDAR-FILE.
*********************************************
DATA DIVISION.
*********************************************
File Section.
COPY PITREC IN "LIB:DATAPERMIT.TLB".
COPY MSTREC IN "LIB:DATAPERMIT.TLB".
COPY PSTREC IN "LIB:DATAPERMIT.TLB".
COPY BRTREC IN "LIB:DATAPERMIT.TLB".
COPY POREC IN "LIB:DATAPERMIT.TLB".
COPY CALREC IN "LIB:DATAPERMIT.TLB".
COPY ISTREC IN "LIB:DATAPERMIT.TLB".
FD TCIS-FILE
RECORD CONTAINS 80 CHARACTERS
VALUE OF ID IS TCIS-FILE-NAME.
01 TCIS-HEADER-RECORD.
03 TCIS-HEADER-FINANCE-NO PIC X(6).
03 TCIS-HEADER-FISCAL-AP PIC 99.
03 TCIS-HEADER-FISCAL-YYYY PIC 9(4).
03 TCIS-HEADER-ORIG-SYSTEM PIC X VALUE "P".
03 TCIS-HEADER-FILE-TYPE PIC X VALUE "T".
03 TCIS-HEADER-RECORD-TYPE PIC X VALUE "H".
***03 FILLER PIC X(46).
***03 FILLER PIC X(48).
03 FILLER PIC X(65) .
01 TCIS-RECORD.
03 TCIS-TRANS-FINANCE-NO PIC X(6).
03 TCIS-TRANS-PERMIT-NUMBER.
05 TCIS-PERMIT-NO PIC 9(5).
05 FILLER PIC X(3).
03 TCIS-TRANS-BRM-NUMBER REDEFINES TCIS-TRANS-PERMIT-NUMBER.
05 TCIS-BRM-NO PIC 9(5).
05 TCIS-BRM-SEQ-NO PIC 9(3).
03 TCIS-TRANS-SCM-NUMBER REDEFINES TCIS-TRANS-PERMIT-NUMBER.
05 TCIS-SCM-NO PIC 9(6).
05 FILLER PIC XX.
03 TCIS-TRANS-PERMIT-TYPE PIC XX.
88 TCIS-IMPRINT VALUE "PI".
*** 88 TCIS-METER VALUE "ML".
88 TCIS-METER VALUE "MT".
*** 88 TCIS-PRECANCEL VALUE "PP".
88 TCIS-PRECANCEL VALUE "PC".
88 TCIS-BUSINESS-REPLY VALUE "BR".
88 TCIS-SECOND-CLASS VALUE "SC".
88 TCIS-SECOND-CLASS-PENDING VALUE "PS".
03 TCIS-MAIL-PROC-CAT PIC X.
03 TCIS-VIPCODE PIC X(5).
03 TCIS-BF-PERMIT-NUMBER.
05 TCIS-BF-PERMIT-NO PIC 9(5).
05 FILLER PIC X(3).
03 TCIS-BF-PERMIT-TYPE PIC XX.
03 TCIS-BF-IND PIC X.
03 FILLER PIC X(3).
03 TCIS-QUANTITY.
05 TCIS-TRANS-REVENUE PIC S9(10)V99.
05 TCIS-TRANS-VOLUME PIC S9(10).
05 TCIS-TRANS-WEIGHT PIC S9(10)V99.
05 TCIS-TRANS-COPIES PIC S9(10).
01 TCIS-TRAILER-RECORD.
03 TCIS-TRAILER-FINANCE-NO PIC X(6).
03 TCIS-TRAILER-FISCAL-AP PIC 99.
03 TCIS-TRAILER-FISCAL-YYYY PIC 9(4).
03 TCIS-TRAILER-ORIG-SYSTEM PIC X VALUE "P".
03 TCIS-TRAILER-FILE-TYPE PIC X VALUE "T".
03 TCIS-TRAILER-RECORD-TYPE PIC X VALUE "H".
03 FILLER PIC X(11).
03 TCIS-TRAILER-RECORD-COUNT PIC 9(10).
03 TCIS-TRAILER-REVENUE PIC S9(10)V99.
03 TCIS-TRAILER-VOLUME PIC S9(10).
03 TCIS-TRAILER-WEIGHT PIC S9(10)V99.
03 TCIS-TRAILER-COPIES PIC S9(10).
FD ISTCIS-FILE
RECORD CONTAINS 59 CHARACTERS
VALUE OF ID IS ISTCIS-FILE-NAME.
01 ISTCIS-HEADER-RECORD.
03 ISTCIS-HEADER-FINANCE-NO PIC X(6).
03 ISTCIS-HEADER-FISCAL-AP PIC 99.
03 ISTCIS-HEADER-FISCAL-YYYY PIC 9(4).
03 ISTCIS-HEADER-ORIG-SYSTEM PIC X VALUE "P".
03 ISTCIS-HEADER-FILE-TYPE PIC X VALUE "I".
03 ISTCIS-HEADER-RECORD-TYPE PIC X VALUE "H".
03 FILLER PIC X(44).
01 ISTCIS-RECORD.
03 ISTCIS-TRANS-FINANCE-NOPIC X(6).
03 ISTCIS-TRANS-ORIG-SYSTEMPIC X.
03 ISTCIS-TRANS-PERMIT-NUMBER.
05 ISTCIS-PERMIT-NOPIC 9(5).
05 FILLER PIC X(3).
03 ISTCIS-TRANS-BRM-NUMBER REDEFINES ISTCIS-TRANS-PERMIT-NUMBER.
05 ISTCIS-BRM-NOPIC 9(5).
05 ISTCIS-BRM-SEQ-NOPIC 9(3).
03 ISTCIS-TRANS-SCM-NUMBER REDEFINES ISTCIS-TRANS-PERMIT-NUMBER.
05 ISTCIS-SCM-NOPIC 9(6).
05 FILLERPIC XX.
03 ISTCIS-TRANS-PERMIT-TYPE PIC XX.
88 ISTCIS-IMPRINT VALUE "PI".
88 ISTCIS-METER VALUE "MT".
88 ISTCIS-PRECANCEL VALUE "PC".
88 ISTCIS-BUSINESS-REPLY VALUE "BR".
88 ISTCIS-SECOND-CLASS VALUE "SC".
88 ISTCIS-SECOND-CLASS-PENDING VALUE "PS".
03 ISTCIS-MAIL-PROCESS-DATEPIC X(8).
03 ISTCIS-COUNTRY-CODEPIC XX.
03 ISTCIS-PRODUCT-IDPIC XX.
03 ISTCIS-TRANS-VOLUMEPIC S9(10).
03 ISTCIS-TRANS-WEIGHTPIC S9(10)V99.
03 ISTCIS-TRANS-REFPIC X(8).
01 ISTCIS-TRAILER-RECORD.
03 ISTCIS-TRAILER-FINANCE-NOPIC X(6).
03 ISTCIS-TRAILER-FISCAL-APPIC 99.
03 ISTCIS-TRAILER-FISCAL-YYYYPIC 9(4).
03 ISTCIS-TRAILER-ORIG-SYSTEMPIC X VALUE "P".
03 ISTCIS-TRAILER-FILE-TYPEPIC X VALUE "I".
03 ISTCIS-TRAILER-RECORD-TYPEPIC X VALUE "T".
03 FILLERPIC X(2).
03 ISTCIS-TRAILER-RECORD-COUNTPIC 9(8).
03 FILLERPIC X(4).
03 ISTCIS-TRAILER-VOLUMEPIC S9(10).
03 ISTCIS-TRAILER-WEIGHTPIC S9(10)V99.
03 FILLERPIC X(8).
SD SORT-SRT-FILE.
01 SORT-SRT-RECORD.
03 SRT-KEY.
05 SRT-PERMIT-TYPE-ORDERPIC 9.
* 1=Permit, 2=Metered, 3=Precancalled, 4=Bus Reply, 5=Second_Class
05 SRT-PERMIT-TYPEPIC XX.
05 SRT-PERMIT-NUMBER.
10 SRT-PERMIT-NOPIC 9(5).
10 FILLERPIC X(3).
05 SRT-BRM-NUMBER REDEFINES SRT-PERMIT-NUMBER.
10 SRT-BRM-NOPIC 9(5).
10 SRT-BRM-SEQ-NOPIC 9(3).
05 SRT-SCM-NUMBER REDEFINES SRT-PERMIT-NUMBER.
10 SRT-SCM-NOPIC 9(6).
10 FILLERPIC XX.
05 SRT-PROC-CATPIC X.
05 SRT-VIPCODE-NPIC 9(5).
05 SRT-VIPCODE REDEFINES SRT-VIPCODE-N.
10 SRT-VIPCODE13PIC 9(3).
10 SRT-VIPCODE13-REDEF REDEFINES SRT-VIPCODE13.
15 SRT-VIPCODE12PIC 9(2).
15 SRT-VIPCODE12-REDEF REDEFINES SRT-VIPCODE12.
20 SRT-VIPCODE1PIC 9.
20 SRT-VIPCODE2PIC 9.
88 SRT-VIP-4TH-CLASSVALUE 4.
15 SRT-VIPCODE3PIC 9.
10 SRT-VIPCODE4PIC 9.
10 SRT-VIPCODE5PIC 9.
05 SRT-BF-PERMIT-TYPEPIC XX.
05 SRT-BF-PERMIT-NUMBER.
10 SRT-BF-PERMIT-NOPIC 9(5).
10 FILLERPIC X(3).
05 SRT-BF-INDPIC X.
03 SRT-QUANTITY.
05 SRT-REVENUEPIC S9(10)V9999 COMP.
05 SRT-PIECESPIC S9(10) COMP.
05 SRT-POUNDSPIC S9(10)V9(4) COMP.
05 SRT-COPIESPIC S9(10) COMP.
*debug write transaction identifier for debugging purposes
** 03 SRT-TRANPIC X(15).
*******************************************************************************
WORKING-STORAGE SECTION.
*******************************************************************************
COPY STATVAR IN "LIB:WSPERMIT.TLB".
COPY EXTERN IN "LIB:WSPERMIT.TLB".
COPY MESSAGES IN "LIB:WSPERMIT.TLB".
*******************************************************************************
*SWITCHES
*******************************************************************************
01W-PRE-REFORM-FLAGPIC X.
88 W-PRE-REFORMVALUE "Y".
88 W-REFORM-FORMATVALUE "#".
88 W-REFORMVALUE "*".
01WS01-SWITCHESCOMP.
05 WS01-SORT-RETURN-DONE-SWPIC S9VALUE 0.
88 WS01-SORT-RETURN-DONEVALUE 1.
05 WS-END-OF-TRANS-SWPIC S9 VALUE 0.
88 WS-END-OF-TRANSVALUE 1.
01 IST-STATPIC XX EXTERNAL.
01 IST-LENGTH PIC 9(4) EXTERNAL.
01 WS02-SORT-RECS-RETURNEDPIC S9(5)VALUE 0.
01 WS-PREVIOUS-KEY.
05 WS-PREVIOUS-TYPE-ORDERPIC 9.
05 WS-PREVIOUS-TYPEPIC XX.
05 WS-PREVIOUS-NUMBER.
10 WS-PREVIOUS-NOPIC 9(5).
10 FILLERPIC X(3).
05 WS-PREVIOUS-PROC-CATPIC X.
05 WS-PREVIOUS-VIPCODEPIC X(5).
05 WS-PREVIOUS-BF-PERMIT-TYPEPIC XX.
05 WS-PREVIOUS-BF-PERMIT-NUMBER.
10 WS-PREVIOUS-BF-PERMIT-NOPIC 9(5).
10 FILLERPIC X(3).
05 WS-PREVIOUS-BF-INDPIC X.
01 TCIS-FILE-NAME.
02 FILLERPIC X(6) VALUE "CBCIS_".
02 TCIS-FILE-NAME-NODE PIC X(6).
02 FILLERPIC X(1) VALUE "_".
02 TCIS-FILE-NAME-YY PIC X(2).
02 TCIS-FILE-NAME-AP PIC X(2).
02 FILLERPIC X(6) VALUE "_T.FIL".
01 ISTCIS-FILE-NAME.
02 FILLERPIC X(6) VALUE "CBCIS_".
02 ISTCIS-FILE-NAME-NODE PIC X(6).
02 FILLERPIC X(1) VALUE "_".
02 ISTCIS-FILE-NAME-YY PIC X(2).
02 ISTCIS-FILE-NAME-AP PIC X(2).
02 FILLERPIC X(6) VALUE "_I.FIL".
01 WS-TRANS-FOUND-SW PIC S9 VALUE 0.
88 WS-TRANS-FOUND VALUE 0.
88 WS-TRANS-NOT-FOUND VALUE 1.
*******************************************************************************
*ACCUMULATORS
*******************************************************************************
01 WS01-TRAILER-TOTALS.
03 WS01-TRAILER-VOLUMEPIC S9(10) COMP VALUE 0.
03 WS01-TRAILER-REVENUEPIC S9(10)V9(4) COMP VALUE 0.
03 WS01-TRAILER-WEIGHTPIC S9(10)V9(4) COMP VALUE 0.
03 WS01-TRAILER-COPIESPIC S9(10) COMP VALUE 0.
03 WS01-TRAILER-REC-COUNTPIC 9(6) COMP VALUE 0.
03 WS01-I-TRAILER-VOLUMEPIC S9(10)V9(4) COMP VALUE 0.
03 WS01-I-TRAILER-WEIGHTPIC S9(10)V9(4) COMP VALUE 0.
03 WS01-I-TRAILER-REC-COUNTPIC 9(6) COMP VALUE 0.
01 WS01-RECORD-TOTALS.
03 WS01-RECORD-REVENUEPIC S9(10)V9(4)COMP.
03 WS01-RECORD-PIECESPIC S9(10)COMP.
03 WS01-RECORD-POUNDSPIC S9(10)V9(4) COMP.
03 WS01-RECORD-COPIESPIC S9(10)COMP.
01 WS01-SUB-TOTALS-MATRIX.
02 WS01-SUB-TOTALS OCCURS 18 TIMES.
03 WS01-SUBTOTAL-REVENUEPIC S9(10)V9(4)COMP.
03 WS01-SUBTOTAL-PIECESPIC S9(10)COMP.
03 WS01-SUBTOTAL-POUNDSPIC S9(10)V9(4) COMP.
03 WS01-SUBTOTAL-COPIESPIC S9(10)COMP.
01 FIRST-CLASS-SURCHARGES.
05 W-PRESORT-SURCHARGE PIC 9V9(2) VALUE 0.05.
05 W-NONPRESORT-SURCHARGE PIC 9V9(2) VALUE 0.11.
01 STUFF.
05 SS PIC 9(4).
05 SS1 PIC 9(4).
05 SS2 PIC 9(4).
05 WX-TRANSACTION-TYPE PIC XX.
88 WX-PERMIT-REVERSALVALUE "0R" "1R" "2R" "3R" "4R"
"5R" "6R" "7R" "8R" "9R".
88 WX-PERMIT-DOMESTICVALUE "M0" "M1" "M2" "M3" "M9"
"N0" "N1" "N2" "N3"
"0R" "1R" "2R" "3R" "9R".
88 WX-PERMIT-3650VALUE "M4" "4R".
88 WX-PERMIT-3651VALUE "M5" "5R".
88 WX-PERMIT-3652VALUE "M6" "6R".
88 WX-PERMIT-3653VALUE "M7" "7R".
88 WX-PERMIT-3651CVALUE "M8" "8R".
01 WX-PRESRT-FLAGPIC X(1).
88 WX-PRESRT-USEDVALUE "Y".
01 WX-TRANS-ITEMS.
05 WX-PIECE-WEIGHTPIC 9(3)V9(4).
05 WX-LINE-ITEM-INFO.
10 WX-RPW-CODEPIC 9(5).
10 WX-RPW-CODE-X REDEFINES WX-RPW-CODE.
15 WX-RPW-CODE-1PIC X(1).
88 WX-RPW-REFORM-3CB-PPIVALUE "3".
15 WX-RPW-CODE-2PIC X(1).
88 WX-RPW-OLD-3CBVALUE "3" "8".
88 WX-RPW-REFORM-3CBVALUE "3" "5" "8" "9".
88 WX-RPW-4CP VALUE "4".
15 WX-RPW-CODE-3PIC X(1).
88 WX-RPW-4CP-PC-RATEVALUE "3" "7".
88 WX-RPW-4CP-LB-RATEVALUE "8" "9".
88 WX-RPW-REFORM-3CB-PC-LB-RATEVALUE "5" "6" "7" "8".
15 WX-RPW-CODE-4PIC X(1).
15 WX-RPW-CODE-5PIC X(1).
88 WX-RPW-OLD-3CB-PC-RATEVALUE "4" "8".
88 WX-RPW-OLD-3CB-LB-RATEVALUE "5" "9".
88 WX-RPW-OLD-3CB-PPIVALUE "6".
88 WX-RPW-REFORM-3CB-PC-RATEVALUE "1" "2" "3" "4".
88 WX-RPW-REFORM-3CB-LB-RATEVALUE "6" "7" "9".
10 WX-PIECESPIC S9(11).
10 WX-POUNDPIC S9(7)V9(4).
10 WX-REVENUEPIC S9(10)V9(4).
01 W-DOMESTIC-ITEM-INFO.
15 W-LINE-NOPIC 9(4) COMP-3.
15 W-VIP-CODEPIC 9(5) COMP-3.
15 W-LINE-AMTS.
20 W-LINE-RATEPIC S99V999 COMP-3.
20 W-LINE-PIECEPIC S9(11) COMP-3.
20 W-LINE-POUND REDEFINES W-LINE-PIECE
PIC S9(7)V9(4) COMP-3.
20 W-LINE-POSTPIC S9(10)V9(7) COMP-3.
*******************************************************************************
*LITERALS
*******************************************************************************
01 WS-NODE-SYMBOLPIC X(11) VALUE "DCL_NODE_NO".
01 WS-AP-SYMBOLPIC X(10) VALUE "DCL_AP_KEY".
01 WS-RUN-SW-SYMBOLPIC X(10) VALUE "DCL_RUN_SW".
01 WS-RUN-FLAG-SYMBOL PIC X(10) VALUE "DCL_FLAG_T".
01 WS-RUN-SWPIC X.
01 WS-AP-KEY.
05 WS-AP-CCPIC XX.
05 WS-AP-YYPIC XX.
05 WS-AP-TYPE PIC XX VALUE "AP".
05 WS-AP-NUMBERPIC XX.
01 WS-MISC.
05 WS-BEGINNING-DATE.
10 YYPIC 99.
10 MMPIC 99.
10 DDPIC 99.
05 WS-ENDING-DATE.
10 YYPIC 99.
10 MMPIC 99.
10 DDPIC 99.
05 WS-FINANCE-NUMBERPIC X(6).
* Range fields are used for the transaction time stamp.
05 WS-BEGIN-RANGEPIC X(15).
05 WS-END-RANGEPIC X(15).
05 WS-END-RANGE-DATEPIC X(8).
05 WS-LINK-DATES.
10 WS-GREGORIAN-DATE.
20 MMPIC 99.
20 DDPIC 99.
20 YYPIC 99.
10 WS-JULIAN-DATE.
20 YYPIC 99.
20 DDDPIC 999.
*******************************************************************************
PROCEDURE DIVISION.
*******************************************************************************
*DECLARATIVE SECTION
*******************************************************************************
DECLARATIVES.
D100-PITRANS SECTION.
USE AFTER EXCEPTION PROCEDURE ON IMPRINT-TRANS-FILE.
D199-EXIT. EXIT.
D200-PSTRANS SECTION.
USE AFTER EXCEPTION PROCEDURE ON PRECANCELED-TRANS-FILE.
D299-EXIT. EXIT.
D300-MSTRANS SECTION.
USE AFTER EXCEPTION PROCEDURE ON METER-TRANS-FILE.
D399-EXIT. EXIT.
D400-BRTRANS SECTION.
USE AFTER EXCEPTION PROCEDURE ON BUSINESS-REPLY-TRANS-FILE.
D499-EXIT. EXIT.
D500-ISTRANS SECTION.
USE AFTER EXCEPTION PROCEDURE ON ISO-TRANS-FILE.
D499-EXIT. EXIT.
END DECLARATIVES.
*******************************************************************************
1000-MAIN SECTION.
1010-DRIVER.
PERFORM 1020-INITIALIZATION.
PERFORM 2000-RPW-PROCESS-CONTROL.
PERFORM 9000-SUBTOTALS.
PERFORM 9999-TERMINATION.
EXIT PROGRAM.
1010-EXIT. EXIT.
*******************************************************************************
*INITIALIZATION.
*******************************************************************************
1020-OPENING SECTION.
1020-INITIALIZATION.
CALL "LIB$GET-SYMBOL" USING BY DESCRIPTOR WS-AP-SYMBOL
BY DESCRIPTOR WS-AP-KEY.
CALL "LIB$GET-SYMBOL" USING BY DESCRIPTOR WS-RUN-SW-SYMBOL
BY DESCRIPTOR WS-RUN-SW.
CALL "LIB$GET-SYMBOL" USING BY DESCRIPTOR WS-NODE-SYMBOL
BY DESCRIPTOR TCIS-FILE-NAME-NODE.
MOVE WS-AP-KEY(3:2) TO TCIS-FILE-NAME-YY.
MOVE WS-AP-KEY(7:2) TO TCIS-FILE-NAME-AP.
MOVE TCIS-FILE-NAME-NODE TO ISTCIS-FILE-NAME-NODE.
MOVE TCIS-FILE-NAME-YY TO ISTCIS-FILE-NAME-YY.
MOVE TCIS-FILE-NAME-AP TO ISTCIS-FILE-NAME-AP.
IF WS-RUN-SW = "0"
OPEN OUTPUT TCIS-FILE
ISTCIS-FILE
CLOSE TCIS-FILE
ISTCIS-FILE
STOP RUN.
* If this program was called to just create the output file, then the program
* has been stopped.
OPEN INPUT CALENDAR-FILE ALLOWING ALL,
POST-OFFICE-FILE ALLOWING ALL
MOVE WS-AP-KEY TO CA-CALENDAR-KEY.
READ CALENDAR-FILE
REGARDLESS OF LOCK
KEY IS CA-CALENDAR-KEY
INVALID KEY DISPLAY "**Invalid AP date**Job Aborted**"
CLOSE CALENDAR-FILE
POST-OFFICE-FILE
STOP RUN.
MOVE CA-BEGINNING-DATE TO WS-BEGINNING-DATE.
MOVE CA-ENDING-DATE TO WS-ENDING-DATE.
*Set begin/end "julian" range for the Accounting Period.
INITIALIZE WS-LINK-DATES
MOVE ZEROES TO WS-BEGIN-RANGE
MOVE CORRESPONDING WS-BEGINNING-DATE TO WS-GREGORIAN-DATE
CALL "JULIAN" USING WS-LINK-DATES
MOVE "19"TO WS-BEGIN-RANGE(1:2)
MOVE WS-JULIAN-DATETO WS-BEGIN-RANGE(3:5)
INITIALIZE WS-LINK-DATES WS-END-RANGE
MOVE CORRESPONDING WS-ENDING-DATE TO WS-GREGORIAN-DATE
CALL "JULIAN" USING WS-LINK-DATES
MOVE "19"TO WS-END-RANGE(1:2)
MOVE WS-JULIAN-DATETO WS-END-RANGE(3:5)
MOVE HIGH-VALUESTO WS-END-RANGE(8:8)
* stop if finance number is missing or zeros *
MOVE 106 TO PO-ID-NUMBER.
READ POST-OFFICE-FILE
REGARDLESS OF LOCK
INVALID KEY DISPLAY "Fin # missing in P.O. file - aborting run "
MOVE ZEROS TO PO-TEXT(1:6).
MOVE PO-TEXT(1:6) TO WS-FINANCE-NUMBER.
IF WS-FINANCE-NUMBER = "000000"
DISPLAY "Fin # not numeric, bad P.O. file - aborting run ."
CLOSE CALENDAR-FILE
POST-OFFICE-FILE
MOVE "1" TO WS-RUN-SW
CALL "LIB$SET_SYMBOL" USING BY DESCRIPTOR WS-RUN-FLAG-SYMBOL
BY DESCRIPTOR WS-RUN-SW
STOP RUN.
CLOSE CALENDAR-FILE
POST-OFFICE-FILE.
OPEN INPUTIMPRINT-TRANS-FILE ALLOWING ALL
METER-TRANS-FILE ALLOWING ALL
PRECANCELED-TRANS-FILE ALLOWING ALL
BUSINESS-REPLY-TRANS-FILE ALLOWING ALL
ISO-TRANS-FILE ALLOWING ALL
EXTENDTCIS-FILE
ISTCIS-FILE.
MOVE 0 TO WS01-TRAILER-REC-COUNT.
MOVE SPACES TO TCIS-RECORD.
MOVE WS-FINANCE-NUMBER TO TCIS-HEADER-FINANCE-NO
MOVE WS-AP-KEY(7:2) TO TCIS-HEADER-FISCAL-AP.
MOVE WS-AP-KEY(1:4) TO TCIS-HEADER-FISCAL-YYYY.
MOVE "P" TO TCIS-HEADER-ORIG-SYSTEM.
MOVE "T" TO TCIS-HEADER-FILE-TYPE.
MOVE "H" TO TCIS-HEADER-RECORD-TYPE.
WRITE TCIS-HEADER-RECORD.
ADD 1 TO WS01-TRAILER-REC-COUNT.
MOVE SPACES TO TCIS-HEADER-RECORD.
MOVE 0 TO WS01-I-TRAILER-REC-COUNT.
MOVE SPACES TO ISTCIS-RECORD.
MOVE WS-FINANCE-NUMBER TO ISTCIS-HEADER-FINANCE-NO
MOVE WS-AP-KEY(7:2) TO ISTCIS-HEADER-FISCAL-AP.
MOVE WS-AP-KEY(1:4) TO ISTCIS-HEADER-FISCAL-YYYY.
MOVE "P" TO ISTCIS-HEADER-ORIG-SYSTEM.
MOVE "I" TO ISTCIS-HEADER-FILE-TYPE.
MOVE "H" TO ISTCIS-HEADER-RECORD-TYPE.
WRITE ISTCIS-HEADER-RECORD.
ADD 1 TO WS01-I-TRAILER-REC-COUNT.
MOVE SPACES TO ISTCIS-HEADER-RECORD.
INITIALIZE WS01-SUB-TOTALS-MATRIX.
1020-EXIT. EXIT.
*******************************************************************************
*MAIN PROCESS CONTROL
*******************************************************************************
2000-PROCESS SECTION.
2000-RPW-PROCESS-CONTROL.
SORT SORT-SRT-FILE ASCENDING KEY SRT-KEY
INPUT PROCEDURE 2000-SORT-PROCESS
OUTPUT PROCEDURE 2500-RELEASE-OUTPUT.
PERFORM 6500-TERMINAL-DUE.
2000-SORT-PROCESS SECTION.
2000-MAIN-DRIVER.
INITIALIZE SORT-SRT-RECORD.
MOVE SPACES TO SRT-PERMIT-NUMBER.
MOVE 0 TO WS-END-OF-TRANS-SW.
PERFORM 7110-START-IMPRINT.
PERFORM 2100-PROCESS-IMPRINT UNTIL WS-END-OF-TRANS.
INITIALIZE SORT-SRT-RECORD.
MOVE SPACES TO SRT-PERMIT-NUMBER.
MOVE 0 TO WS-END-OF-TRANS-SW.
PERFORM 7210-START-METER.
PERFORM 2200-PROCESS-METER UNTIL WS-END-OF-TRANS.
INITIALIZE SORT-SRT-RECORD.
MOVE SPACES TO SRT-PERMIT-NUMBER.
MOVE 0 TO WS-END-OF-TRANS-SW.
PERFORM 7310-START-PRECANCEL.
PERFORM 2300-PROCESS-PRECANCEL UNTIL WS-END-OF-TRANS.
INITIALIZE SORT-SRT-RECORD
MOVE SPACES TO SRT-PERMIT-NUMBER.
MOVE 0 TO WS-END-OF-TRANS-SW.
PERFORM 7410-START-BRM-TRANS.
PERFORM 2400-PROCESS-BR UNTIL WS-END-OF-TRANS.
GO TO 4999-EXIT.
2100-PROCESS-IMPRINT.
PERFORM 7100-READ-IMPRINT-TRANS-FILE.
IF (WS-END-OF-TRANS OR PIT-PERMIT-NUMBER(1:1) = "G")
NEXT SENTENCE
ELSE
IF (PIT-MAIL-ALL OR PIT-REVERSED-MAIL)
PERFORM 2120-PIT-PROCESS.
2120-PIT-PROCESS.
MOVE "PI" TO SRT-PERMIT-TYPE.
MOVE 1 TO SRT-PERMIT-TYPE-ORDER.
MOVE PIT-PERMIT-NUMBER TO SRT-PERMIT-NO.
MOVE SPACES TO SRT-BF-PERMIT-NUMBER