000100 IDENTIFICATION DIVISION.
000200 PROGRAM-ID.    A0530XHP IS INITIAL.
000300 AUTHOR.        MJD.
000400 ENVIRONMENT DIVISION.
000500 CONFIGURATION SECTION.
000600 SOURCE-COMPUTER. IBM-PC-XT.
000700 OBJECT-COMPUTER. IBM-PC-XT.
100308 Repository.
100308 Class COM AS "*COM".
000800*REMARKS.
000900*******************************************************************
001000*                                                                 *
001100* A0530XHP - LASER Statements V2.4B                               *
001300*                                                                 *
040496* FIX KWS V2.4B- FIRST INV OK, THEN ALL PULL FROM BOTTOM TRAY     *
040496* FIX KWS V2.4B- BOTTOM LINE OF FORM NOT PRINTING                 *
070596* UPD KWS V2.5 - MADE LASRFORM.DTA FOR ALL FORMS TO USE           *
100996* UPD BOB V2.5B- INDEXED ARITEM                                   *
121696* UPD KWS V2.6 - WRONG MONTH PRINTING ON STATEMENTS               *
012397* UPD KWS V2.6B- ALLOW CALL FROM A0300 TO PRINT ONE STATEMENT     *
012797* UPD KWS V2.6B- IF CHAINED FROM A0300, FORCE YES TO STMT-CD      *
031597* UPD KWS V2.6C- ALLOW HARD-COPY WHEN FAXING                     *
050400* UPD KWS V2.8D- DETAIL SPACING ADJUSTMENTS                      *
062401* UPD KWS V2.9 - CONVERT TO FAXWARE                              *
122301* MOD KWS V2.9A- DIAZO - VERTICAL ALIGN FOR PREPRINTED FORM      *
122801* MOD KWS V2.9A- DIAZO - REMOVE 'FUTURE DUE' MSG                 *
020302* FIX KWS V2.9A- ALLOW PRINTING TO LOCAL PRINTERS, NOT JUST LPT2 *
021102* UPD KWS V2.9A- CHANGE ALIGN FOR BETTER FIT IN ENVELOPES        *
022102* MOD KWS V2.9A- DIAZO - DO NOT PRINT REMIT INFO OR 'STATEMENT'  *
060702* FIX KWS V2.9A- MULTI-PAGE FAXED STATEMENT CUT TO ONE PAGE      *
110402* UPD KWS V2.9A- FORCE FIRST TRAY TO COPY 1 OF LFCT              *
040403* MOD KWS V3.0 - PCS - DO NOT PRINT LOGO                         *
062603* UPD KWS V3.0 - CONVERT TO NEW LASER FORM LOGIC                 *
073003* UPD      KWS - PROBLEM WITH AGING TOTALS AT BOTTOM OF FORM     *
080503* FIX      KWS - MULTIPAGE FAX EACH PAGE LAYED ON TOP OF PREVIOUS*
010204* FIX KWS  KWS - CONFLICT, SPECS-4 NEEDED IN COPYFIL2.SR         *
121803* MOD KWS V3.0 - PCS - PUT LOGO IN MACRO FILE                    *
121903* UPD KWS V3.0 - ADD LOGIC FOR PDF COPY                          *
050104* MOD KWS V3.0 - DIAZO - MOVE PAGE NO LINE UP A LITTLE           *
050104* MOD KWS V3.0 - DIAZO - HEADER FONT NOT ALWAYS CORRECT          *
050104* FIX KWS V3.0 - DIAZO - SOMETIMES ONLY PRINTS HALF PAGE OF DETAL*
071704* FIX KWS V3.1 - MISSING PDF-YES PDF-NO                          *
100404* FIX KWS      - PDF NOT WORKING                                 *
102504* MOD KWS      - MEI - SIMILAR TO DIAZO PRE-PRINTED FORM         *
032405* UPD KWS V4.0 - REPLACE CGTIMES WITH TIMESNEWROMAN 4110>1690    *

102406* MOD KWS V4.1 - RESA - REMOVE WORD STATEMENT                    *
113006* MOD KWS V4.2 - PACA - HARDCODE REMIT TO ADDRESS                *
020207* UPD KWS V4.2 - PREVENT ERROR 48 ON PRINTER                     *
020607* UPD SKI V4.2 - ADD 2 AR BUCKETS                                *
031607* FIX KWS V4.2 - IF LOGO, DO NOT PRINT TEXT ON STUB EITHER       *
111907* UPD SKI V4.2 - POWERFORM                                       *
070308* UPD KWS V4.4 - TEMP CHANGE UNTIL LFPR FINISHED                 *
071808* UPD KWS V4.4 - DUMMY PARAGRAPH NEEDED FOR LFPR FORM PRINTING   *
100308* UPD KWS V4.4 - LOGIC FOR PDFCREATOR                            *
110608* FIX SKI V4.4 - NUMBER OF DETAIL LINES PER PAGE                 *
110608* UPD KWS V4.4 - ADD LOGIC TO AUTOMATICALLY SEND PDF VIA EMAIL   *
111908* UPD KWS V4.4.1- ZIP CUT OFF IF LONG CITY NAME                  *
022609* FIX SKI V4.4 -  CLOSE-LO                                       *
050109* MOD KWS V4.4.2 - PACA - FORCE CHICAGO ADDRESS                  *
062809* FIX KWS V4.5   - NOT SHOWING FULL CUST# IN EMAIL SUBJECT       *
062809* FIX KWS V4.5   - WRONG ATTACHMENTS ON EMAILS (CONSTANT.DTA)    *
080309* FIX KWS V4.5   - NOT SHOW NEG SIGN ON TEAR STRIP               *
080309* UPD KWS V4.5   - ADD CUST CONTACT/VOICE/FAX INFO BELOW ADDR    *
090909* FIX KWS V4.5   - NOT CLEARING TOTALS ON MULTIPAGE STATEMENTS   *
120109* FIX KWS V4.5   - 090909 FIX CAUSED ZEROS AT BOTTOM OF STATEMENT*
011210* UPD KWS V4.5   - NEW PAST-DUE MSG IN TAIL OF FORM              *
011810* UPD SKI V4.5   - SUNBELTS REMOVE "REMIT TO" AND COMPANY DATA   *
021710* UPD SKI V4.5.1 - ADD TAG, ADD EXCLUDE PAID OFF INVOICES        *
030210* MOD KWS V4.5.1 - MEI - REMOVE PAST-DUE, CHANGE BODY HEADINGS   *
030610* MOD KWS V4.5.1 - JEREMIE - SAME AS 030210                      *
031510* FIX KWS V4.5.1 - ERR 41 ON MULTI STMTS, ERR 35 ON EMAIL STMT   *
032910* UPD KWS V4.5.1 - USE CONTACT-2 EMAIL FOR STATEMENTS            *
060810* MOD KWS V4.5.1 - SUNBELTS - SAME AS 030210                     *
062810* MOD KWS V4.5.1 - PACA - CHANGE PAYMENT ADDRESS                 *
072310* UPD KWS V4.5.1 - USE EMAIL1 IF EMAIL2 = SPACES                 *
090310* UPD KWS V4.5.2 - REMOVE CHANGES 011210 USE OLD FORMAT INSTEAD  *
01400*******************************************************************
001500 INPUT-OUTPUT SECTION.
001600 FILE-CONTROL.
001700
001800     COPY "ARITF.SL".
002000     COPY "CUSTF.SL".
003000     COPY "CNTLF.SL".
003100     COPY "EXCNF.SL".
003200     COPY "USERF.SL".
021710     COPY "TAGKF.SL".
111907*    COPY "PRNTR.SL".
111907     COPY "PFPRNTR.SL".
103108     COPY "EMALF.SL".
           COPY "STEST.SL".
003300/
003400 DATA DIVISION.
       BASED-STORAGE SECTION.
           COPY "STEST.BS".
003500 FILE SECTION.
003600
003800
111907*FD  LO
111907*    LABEL RECORDS ARE OMITTED.
004100
111907*01  PRINT-REC           PIC X(140).
111907     COPY "PFPRNTR.FD".
111907     COPY STMFRM OF XMDLIB.
           
004300
004400     COPY "ARITF.FD".
004500     COPY "CUSTF.FD".
004600     COPY "CNTLF.FD".
111907*    COPY "LFCTF.FD". 
004700     COPY "EXCNF.FD".
004800     COPY "USERF.FD".
103108     COPY "EMALF.FD".
           COPY "STEST.FD".
021710     COPY "TAGMF.FD".
021710 01  TAGMF-REC.
021710   03 TAGMF-KEY.
021710       05 TAG-INVNO PIC 9(6).
021710   03 TAG-DATA.
021710       05 TAG-INV-AMOUNT PIC S9(7)V9(2) COMP.
004900/
005000 WORKING-STORAGE SECTION.
CVT    01  PROG-NAME    PIC X(9) VALUE    "A0530XHP".
005100
111907*01  PR-CNDSE            PIC X(4).
005200 01  ARITF-STATUS        PIC XX.
CLNUP1     88 C-RECORD-OK VALUES "00", "02".
CLNUP1     88 C-FOUND VALUES "00", "02".
CLNUP1     88 C-AT-END VALUES "10", "14".
CLNUP1     88 C-END-OF-FILE VALUES "10", "14".
100996*01  ARITF-KEY           PIC 9(6).
005400 01  CUSTF-STATUS        PIC XX.
CLNUP1     88 C-RECORD-OK VALUES "00", "02".
CLNUP1     88 C-FOUND VALUES "00", "02".
CLNUP1     88 C-AT-END VALUES "10", "14".
CLNUP1     88 C-END-OF-FILE VALUES "10", "14".
005500 01  LINE-NO             PIC 9(2).
005600 01  PAGE-NO             PIC 9(3).
005900 01  LO-STATUS           PIC XX.
006000 01  CNTLF-STATUS        PIC XX.
CLNUP1     88 C-RECORD-OK VALUES "00", "02".
CLNUP1     88 C-FOUND VALUES "00", "02".
CLNUP1     88 C-AT-END VALUES "10", "14".
CLNUP1     88 C-END-OF-FILE VALUES "10", "14".
006100 01  EXCNF-STATUS        PIC XX.
006200 01  USERF-STATUS        PIC XX.
021710 01  TAGMF-STATUS        PIC XX.
021710     COPY "FSTATUS88.DTA".
006300 01  INDEX-OCCURS        PIC 9(1).
006500 01  ESC-FLAG            PIC 9    VALUE ZERO.
006600 01  LOW-KEY             PIC 9(6) VALUE 1.
006700 01  HIGH-KEY            PIC 9(6) VALUE 1.
006800 77  LOW-CUST            PIC X(8) VALUE LOW-VALUES.
006900 77  HIGH-CUST           PIC X(8) VALUE HIGH-VALUES.
100404 77  WS-CUST-NO          PIC X(08) VALUE SPACES.
007000 77  DOL-LIMIT           PIC S9(7)V99 VALUE ZERO COMP-3.
022896 77  LOW-SLSMN           PIC 999  VALUE 1.
022896 77  HIGH-SLSMN          PIC 999  VALUE 999.
007200
032190
007300 01  INPUT-SPECS-3.
007400     05  FILLER      PIC X(9)   VALUE "1133O0638".
007500     05  OPTION      PIC 9      VALUE 1.
007600     05  FILLER      PIC X(4)   VALUE "E   ".
010204*01  INPUT-SPECS-4.
010204 01  INPUT-SPECS-4A.
007800     05  FILLER      PIC X(14)  VALUE "1346P06102E   ".
007900 01  INPUT-SPECS-5.
008000     05  FILLER      PIC X(9)   VALUE "1340O0322".
008100     05  OPTION      PIC 9      VALUE 1.
008200     05  FILLER      PIC X(4)   VALUE "E   ".
009000 01  INPUT-SPECS-6.
022896     05  FILLER      PIC X(14)  VALUE "1355D03030    ".
022896     05  FILLER      PIC X(14)  VALUE "1455D03030    ".
008500 01  RANGE-CODES.
008600     05  FILLER      PIC X(38) VALUE "All Customers".
008700     05  FILLER      PIC X(38) VALUE "A Range of Customers".
008800     05  FILLER      PIC X(38)
008900         VALUE "Customers with Balances over X Dollars".
009000     05  FILLER      PIC X(38)
009100         VALUE "Customers with Balances over X Days".
010500     05  FILLER      PIC X(38)
010600         VALUE "Customers with Particular Salesmen".
009400     05  FILLER      PIC X(38)
009500         VALUE "Customers over their Credit Limit".
009600 77  RANGE-TYPE-1    PIC X.
009700     88  ALL-CUST    VALUE "Y".
009800 77  RANGE-TYPE-2    PIC X.
009900     88  BY-RANGE    VALUE "Y".
010000 77  RANGE-TYPE-3    PIC X.
010100     88  BY-BAL      VALUE "Y".
010200 77  RANGE-TYPE-4    PIC X.
010300     88  BY-AGE      VALUE "Y".
010400 77  RANGE-TYPE-5    PIC X.
010500     88  BY-SLSMN    VALUE "Y".
010600 77  RANGE-TYPE-6    PIC X.
010700     88  BY-LIMIT    VALUE "Y".
010800 01  BAL-TYPES.
010900     05  FILLER      PIC X(22) VALUE "Balances over XXX Days".
011000     05  FILLER      PIC X(22) VALUE "Balances over XXX Days".
011100     05  FILLER      PIC X(22) VALUE "Balances over XXX Days".
020607     05  FILLER      PIC X(22) VALUE "Balances over XXX Days".
011200 01  BAL-TYPE-TABLE REDEFINES BAL-TYPES.
020607*    05  BAL-TYPE-ENTRY OCCURS 3 TIMES.
020607     05  BAL-TYPE-ENTRY OCCURS 4 TIMES.
011400         10  FILLER   PIC X(14).
011500         10  BAL-DAYS PIC ZZ9.
011600         10  FILLER   PIC X(5).
011700 77  AGE-CODE         PIC 9.
011800 01  DISPLAY-MESSAGES.
011900     05  DOLLAR-QUES    PIC X(55)  VALUE
012000     "Print Customers with Balances Over            Dollars.".
012100     05  BAL-QUES       PIC X(21)
012200         VALUE "Print Customers with:".
013800     05  SLSMN-LOW-QUES  PIC X(34)
013900         VALUE "Print Customers with Low Salesman:".
013800     05  SLSMN-HIGH-QUES PIC X(15)
013900         VALUE "High Salesman:".
012500     05  NEXT-QUES       PIC X(38)
012600         VALUE "Do you wish to add further selections?".
           05  ZERO-QUES  PIC X(51) VALUE "Do you want to print customer
      -    "'s with zero balances?".
012700 01  CONT-HELP  PIC X(120) VALUE " To add more selections, select 
012800-    "Yes, otherwise select No.   Remember that all    selection c
012900-    "riteria must be met for the ".
013000 01  FILLER     PIC X(024) VALUE "customer to be printed.$".
013100
121803 01  BOX-VARIABLES.
121803     05  POS-X           PIC 9(4)  VALUE ZERO.
121803     05  POS-Y           PIC 9(4)  VALUE ZERO.
121803     05  SIZE-X          PIC 9(4)  VALUE ZERO.
121803     05  SIZE-Y          PIC 9(4)  VALUE ZERO.
121803 01  HP-BOX.
121803     05  FILLER          PIC X(03) VALUE X"1B2661".
121803     05  HP-BOX-PX       PIC 9(04) VALUE ZERO.
121803     05  FILLER          PIC X     VALUE "h".
121803     05  HP-BOX-PY       PIC 9(04) VALUE ZERO.
121803     05  FILLER          PIC X(04) VALUE X"561B2A63".
121803     05  HP-BOX-SX       PIC 9(04) VALUE ZERO.
121803     05  FILLER          PIC X     VALUE "a".
121803     05  HP-BOX-SY       PIC 9(04) VALUE ZERO.
121803     05  FILLER          PIC X(04) VALUE X"421B2A63".
121803     05  HP-BOX-FILL     PIC 9(03) VALUE 0.
121803     05  FILLER          PIC X(01) VALUE "P".
006100
013200 01  RANGE-DATA.
013300     05  SELECT-MSG     PIC X(21) VALUE "Do you want to print?".
013400     05  RANGE-LOW-MSG  PIC X(16) VALUE "First to print -".
013500     05  RANGE-HIGH-MSG PIC X(16) VALUE "Last  to print -".
013600     05  RANGE-SPECS-2.
013700         10  FILLER     PIC X(14) VALUE "1338X08080    ".
013800         10  FILLER     PIC X(14) VALUE "1438X08080    ".
013900     05  RANGE-ERR-1    PIC X(47) VALUE
014000         " That is an invalid range, please try another. ".
014100     05  RANGE-ERR-2    PIC X(51) VALUE
014200         " There are none in this range, please try another. ".
014300
073003 01  BREAK-CONTROL.
073003*    03 BREAK-ARIT-CUST-NO                    PIC X(8).
073003     03 BREAK-ARIT-INVNO                      PIC 9(6).

014700 77  AGE-TOTAL                PIC S9(9)V99 COMP-3.
014800 77  AR-TOTAL                 PIC S9(9)V99 COMP-3.
003200 01  PR-PAGE-NO          PIC Z(2)  VALUE ZERO.
014900 77  SKIP-FLAG       PIC X.
015000     88  SKIPPING    VALUE "Y".
015100     88  NO-SKIP     VALUE "N".
071203*77  FIRST-INVOICE-FLAG   PIC X.
071203 77  FIRST-INVOICE-FLAG   PIC X  VALUE "Y".
031000     88  FIRST-INVOICE    VALUE "Y".
015200 01  MSG-SPECS.
015300     05  FILLER          PIC X(14) VALUE "1139X35350    ".
015400     05  FILLER          PIC X(14) VALUE "1239X35350    ".
015500 01  MSG-MSG PIC X(31)   VALUE "Message to print on statements:".
015600 77  MSG-LINE-1          PIC X(35) VALUE SPACES.
015700 77  MSG-LINE-2          PIC X(35) VALUE SPACES.
015800
015900 01  FIRST-FLAG          PIC X.
016000     88  FIRST-TIME      VALUE "Y".
016100     88  NOT-FIRST       VALUE "N".
       01  ZERO-BAL-FLAG               PIC 9.
           88  SKIP-ZERO-STMTS         VALUE 2.
016200 01  INPUT-SPECS-1.
016300     05  FILLER      PIC X(14)  VALUE "1363O01011IE  ".
016400 77  INVIS-OPTION    PIC X(1)   VALUE "X".
016500 01  DISPLAY-MESSAGES.
017000     05 PRINTING-REPORT  PIC X(20) VALUE "Printing Statements.".
017100
017200     COPY "CONSTANT.DTA".
017300     COPY "SCREEN.DTA".
017400     COPY "STATUS.DTA".
017500     COPY "ERROR.DTA".
017600     COPY "ERRORP.DTA".
017700     COPY "DATE.DTA".
017800     COPY "ARTYPE.OPT".
017900     COPY "A0530.HLP".
018000     COPY "A0500.HLP".
062603*    COPY "PRINT.DTA".
111907*    COPY "PRINT2.DTA".
111907     COPY "LFPRF.DTA".
111907     COPY "PRINT.DTA".
111907     COPY "PAUSE.DTA".
013850     COPY "CENTER.DTA". 
062401*    COPY "EZFAX.DTA".
062401     COPY "FAX.DTA".
103108     COPY "EMALF.DTA".
103108     COPY "SENDMAIL.DTA".
040609     COPY "MSGBOX.DTA".
021710     COPY "TAG.DTA".

010204 01  WS-ORDER-NO.
010204     05 ORDH-ORDER-NO          PIC X(6) VALUE SPACES.
010204     05 ORDH-SUB-ORDER-NO      PIC X(02) VALUE SPACES.
062603  
062603 01  WS-PRINT-COPY-CODES.
062603     05  WS-PRINT-COPY-CD          PIC 9 OCCURS 10 TIMES.
062603      
062603 01  WS-PRINT-ENVELOPE-CD PIC 9    VALUE 2.
062603     88 PRINT-ENVELOPE-YES         VALUE 1.
062603         
062603 01  HELP8.
062603     05  FILLER PIC X(080)   VALUE " Select [Accept Defaults] to p
062603-    "rint the copies set to YES above.  If you want to ".
062603     05  FILLER PIC X(080)   VALUE " change what copies will print
062603-    " press ESC or the Spacebar and Ctrl-Enter        $".
062603     05  FILLER PIC X(080)   VALUE " Select [Yes] if you want to f
062603-    "ax a copy of this form in addition to printing    ".
062603     05  FILLER PIC X(080)   VALUE " whatever copies are set to [Y
062603-    "es].  You will be prompted for the Phone Number. $".
062603          
062603 01  SPECS-8.
062603     05  FILLER      PIC X(14)  VALUE "2032O02151    ".
062603     05  FILLER      PIC X(14)  VALUE "1672O02031    ".
062603 01  SPECS-8-REDEF REDEFINES SPECS-8.
062603     05  SPEC-8    OCCURS 11 TIMES.
062603          15  FILLER     PIC X(9).
062603          15  OPTION     PIC 9   .
062603          15  ATTR1      PIC X(2).
062603          15  ATTR2      PIC X(2).
062603 
062603 01  ACCEPT-OPTS.
062603     05  FILLER          PIC X(15)   VALUE "Accept Defaults".
062603     05  FILLER          PIC X(15)   VALUE "Change Defaults".

082000 77  NEXT-PROG2          PIC    X(20)           VALUE SPACES.
121903 01  YES-NO-PDF.
           05  FILLER              PIC X(3)           VALUE "Yes".
           05  FILLER              PIC X(3)           VALUE "No ".
           05  FILLER              PIC X(3)           VALUE "PDF".
071704 01  WS-PDF-CD                  PIC 9 VALUE 2.
071704     88  PDF-YES    VALUE 1.
071704     88  PDF-NO     VALUE 2.
060797     COPY "CHAINR.DTA".
018200 01  SYSTEM-TIME.
018300     03 SYSTEM-HOUR          PIC 99.
018400     03 SYSTEM-MINUTE        PIC 99.
018500     03 SYSTEM-SECONDS       PIC 99.
018600     03 FILLER               PIC 99.
018700/
018800*    COPY "A0530.RW".
018900
019000*    A0530.RW   STATEMENTS
020900 01  PR-HEADER5.
032190     03 FILLER            PIC X(05) VALUE SPACES.
021100     03 PR-ATTN           PIC X(7).
021300     03 PR-CUST-AR-CONTACT PIC X(25).
021600
      *-- HP CONTROL CODES FOR MACRO PRINTING OF FORMS --*
111907*01  HP-CTRL-CODES. 
111907*    05 HP-RESET         PIC X(02) VALUE X"1B45". 
062603*016550*-- FOLLOWING LINES ADDED TO ALLOW DOWNLOAD OF MACRO TO PRINTER --
062603*    05 HP-DEFINE-MACRO.
062603*       10  FILLER       PIC X(03) VALUE X"1B2666". 
062603*       10  MACRO-NUMBER PIC 9(5)  VALUE 00501. 
062603*       10  FILLER       PIC X(3)  VALUE X"793058". 
062603*
062603*    05 HP-STOP-DEFINE   PIC X(05) VALUE X"1B26663158". 
070596     COPY "LASRFORM.DTA". 
016900
060797     03 PR-DATE                PIC X(11) VALUE SPACES. 

080503*77  MAX-LINES                 COMP-1    VALUE 36.
110608*77  MAX-LINES                 COMP-1    VALUE 45.
110608 77  MAX-LINES                 COMP-1    VALUE 35.
062603 01  DETAIL-LINE. 
111907         05  FILLER              PIC X(05).
023500         05  PR-ARIT-INVNO-1     PIC 9(06). 
050400         05  FILLER              PIC X(05).
060797         05  PR-ARIT-DATE-1      PIC X(11).
111907         05  FILLER              PIC X(03).
               05  PR-ARIT-REF.
                   10 PR-ARIT-PAST-DUE PIC X(10).
                   10 PR-ARIT-PO-NUM   PIC X(10).
111907         05  FILLER              PIC X(04).
023950         05  PR-ARIT-AMT-1       PIC Z,ZZZ,ZZZ.99-
024000                                       BLANK ZERO.
080309*        05  FILLER              PIC X(03).
080309         05  FILLER              PIC X(02).
023500         05  PR-ARIT-INVNO-2     PIC 9(06). 
               05  FILLER              PIC X(02).
023950         05  PR-ARIT-AMT-2       PIC Z,ZZZ,ZZZ.99-
024000                                       BLANK ZERO.
024800 01  TOTALS VALUE ZERO.
024900     03 TOTAL-LINE OCCURS 1 TIMES.
025000        05 TOT-ARIT-AMT                       PIC S9(9)V9(2).
025100        05 TOT-FUTURE                         PIC S9(9)V9(2).
025200        05 TOT-CURRENT                        PIC S9(9)V9(2).
025300        05 TOT-OVER30                         PIC S9(9)V9(2).
025400        05 TOT-OVER60                         PIC S9(9)V9(2).
025500        05 TOT-OVER90                         PIC S9(9)V9(2).

023100 01  PR-TOTALS.
032190     03 TS-CURRENT                            PIC ZZZ,ZZZ.99-.
032190     03 TS-OVER30                             PIC ZZZ,ZZZ.99-.
032190     03 TS-OVER60                             PIC ZZZ,ZZZ.99-.
032190     03 TS-OVER90                             PIC ZZZ,ZZZ.99-.
032190     03 TS-ARIT-AMT                           PIC ZZZZ,ZZZ.99-.
032190     03 TS-FUTURE-AMT                         PIC ZZZZ,ZZZ.99-.
025600
025700 01  WORK-AREAS.
025800     05  FUTURE-AMT              PIC S9(9)V99 COMP.
025900     05  CURRENT-AMT             PIC S9(9)V99 COMP.
026000     05  OVER30-AMT              PIC S9(9)V99 COMP.
026100     05  OVER60-AMT              PIC S9(9)V99 COMP.
026200     05  OVER90-AMT              PIC S9(9)V99 COMP.
026300 01  DAYS-OVERDUE                PIC S9(5).
026400 01  PER1-DAYS                   PIC 999.
026500 01  PER2-DAYS                   PIC 999.
026600 01  PER3-DAYS                   PIC 999.
020607 01  PER4-DAYS                   PIC 999.
026700 01  FUTURE-MSG-1    PIC X(20)   VALUE "DUE AT A FUTURE DATE".
012397 01  CHAINED-FROM-CD             PIC X(5).
012397     88 CHAINED-FROM-A0300       VALUE "A0300".

122301 01  WS-CUSTOMIZED-FLAG     PIC 9(5) VALUE ZERO.
122301     88 DIAZO               VALUE 00191.
040403     88 PCS                 VALUE 00003.
030610     88 JEREMIE             VALUE 00112.
102504     88 MEI                 VALUE 00152.
102406     88 GRIFFINRESA         VALUE 00355.
113006     88 PROTECTI            VALUE 00196.
011810     88 SUNBELTS            VALUE 00010, 00011.
CLNUP1 77  CUSTF--NAME PIC X(15) VALUE "CUSTOMER.FIL" .
CLNUP1 77  CUSTF-FULLPATH PIC X(35) VALUE SPACES .
CLNUP1 77  TEMP-MASTER-DIR PIC X(14) VALUE SPACES .
CLNUP1 77  TEMP-SUB-DIR PIC X(14) VALUE SPACES .
CLNUP1 77  CNTLF--NAME PIC X(15) VALUE "CONTROL.FIL" .
CLNUP1 77  CNTLF-FULLPATH PIC X(35) VALUE SPACES .
CLNUP1 77  EXCNF--NAME PIC X(15) VALUE "CONTROL2.FIL" .
CLNUP1 77  EXCNF-FULLPATH PIC X(35) VALUE SPACES .
CLNUP1 77  USERF--NAME PIC X(15) VALUE "USER.FIL" .
CLNUP1 77  USERF-FULLPATH PIC X(35) VALUE SPACES .
CLNUP1 01  IO-WAIT-CD  PIC X VALUE "1"                                  
CLNUP1     88 IO-WAIT-ON VALUE IS "1".
CLNUP1     88 IO-WAIT-OFF VALUE IS "0".
            COPY "STEST.DTA".
CLNUP1 77  ARITF--NAME PIC X(15) VALUE "ARITEM.FIL" .
CLNUP1 77  ARITF-FULLPATH PIC X(35) VALUE SPACES .
CLNUP1 01  CHAIN-PARAM-LEN PIC S9(4) COMP-5.
CLNUP1 01  CHAIN-NAME-LEN PIC S9(4) COMP-5.
CLNUP1 01  DSPL--CONTROL PIC X(100) IS EXTERNAL.
021710 01  EXCLUDE-PAID-ITEMS-CD PIC 9.
            88 EXCLUDE-PAID-ITEMS VALUE 1.
            88 INCLUDE-PAID-ITEMS VALUE 2.
021710 01  EXCL-PAID-HELP PIC X(80) VALUE "Exclude paid items.$".
       SCREEN SECTION.
CLNUP1     COPY "CONSTANT.SCR".
CLNUP1     COPY "SCRNINIT.SCR".
CLNUP1     COPY "ERRORFIL.SCR".
111907*    COPY "PRINT.SCR".   
CLNUP1     COPY "CHAINR.SCR".  
111907     COPY "PAUSE.SCR".
103108     COPY "SENDMAIL.SCR".  
CLNUP1                         
CLNUP1*01 SCR-errorfil-sr-14-20 PIC IS X(51) FROM BOX-TOP CONTROL 
CLNUP1*     DSPL--CONTROL LINE 08 COLUMN 14 REVERSE-VIDEO.
CLNUP1*01 SCR-errorfil-sr-15-20 PIC IS X(51) FROM BOX-MIDDLE CONTROL 
CLNUP1*     DSPL--CONTROL LINE 09 COLUMN 14 REVERSE-VIDEO.
CLNUP1*01 SCR-errorfil-sr-16-20 PIC IS X(51) FROM BOX-MIDDLE CONTROL 
CLNUP1*     DSPL--CONTROL LINE 10 COLUMN 14 REVERSE-VIDEO.
CLNUP1*01 SCR-errorfil-sr-17-20 PIC IS X(51) FROM BOX-MIDDLE CONTROL 
CLNUP1*     DSPL--CONTROL LINE 11 COLUMN 14 REVERSE-VIDEO.
CLNUP1*01 SCR-errorfil-sr-18-20 PIC IS X(51) FROM BOX-MIDDLE CONTROL 
CLNUP1*     DSPL--CONTROL LINE 12 COLUMN 14 REVERSE-VIDEO.
CLNUP1*01 SCR-errorfil-sr-19-20 PIC IS X(51) FROM BOX-MIDDLE CONTROL 
CLNUP1*     DSPL--CONTROL LINE 13 COLUMN 14 REVERSE-VIDEO.
CLNUP1*01 SCR-errorfil-sr-20-20 PIC IS X(51) FROM BOX-MIDDLE CONTROL 
CLNUP1*     DSPL--CONTROL LINE 14 COLUMN 14 REVERSE-VIDEO.
CLNUP1*01 SCR-errorfil-sr-21-20 PIC IS X(51) FROM BOX-BOTTOM CONTROL 
CLNUP1*     DSPL--CONTROL LINE 15 COLUMN 14 REVERSE-VIDEO.
CLNUP1*01 SCR-errorfil-sr-35-20 PIC IS X(40) FROM ERROR-MSG CONTROL 
CLNUP1*     DSPL--CONTROL LINE 10 COLUMN 17 REVERSE-VIDEO.
CLNUP1*01 SCR-errorfil-sr-36-20 PIC IS X(35) FROM ERROR-LINE-1 CONTROL 
CLNUP1*     DSPL--CONTROL LINE 11 COLUMN 17 REVERSE-VIDEO.
CLNUP1*01 SCR-errorfil-sr-37-20 PIC IS X(41) FROM ERROR-LINE-2 CONTROL 
CLNUP1*     DSPL--CONTROL LINE 12 COLUMN 17 REVERSE-VIDEO.
CLNUP1*01 SCR-errorfil-sr-38-20 PIC IS X(40) FROM ERROR-CONTACT CONTROL 
CLNUP1*     DSPL--CONTROL LINE 13 COLUMN 17 REVERSE-VIDEO.
CLNUP1*01 SCR-errorfil-sr-39-20 PIC IS X(40) FROM ERROR-RESUME CONTROL 
CLNUP1*     DSPL--CONTROL LINE 14 COLUMN 17 REVERSE-VIDEO.
CLNUP1*01 SCR-errorfil-sr-40-20 VALUE IS "Program Name = " CONTROL 
CLNUP1*     DSPL--CONTROL LINE 09 COLUMN 17 REVERSE-VIDEO.
CLNUP1*01 SCR-errorfil-sr-41-20 PIC IS X(6) FROM PROG-NAME CONTROL 
CLNUP1*     DSPL--CONTROL LINE 09 COLUMN 32 REVERSE-VIDEO.
CLNUP1*01 SCR-datechk-sr-35-23 PIC IS X(29) FROM DATE-ERROR CONTROL 
CLNUP1*     DSPL--CONTROL LINE 21 COLUMN 1 REVERSE-VIDEO.
CLNUP1*01 SCR-scrninit-sr-13-20 PIC IS X(80) FROM SCRN-TITLE-1 CONTROL 
CLNUP1*     DSPL--CONTROL LINE 01 COLUMN 01.
CLNUP1*01 SCR-scrninit-sr-14-20 PIC IS X(80) FROM SCRN-TITLE-2 CONTROL 
CLNUP1*     DSPL--CONTROL LINE 02 COLUMN 01.
CLNUP1*01 SCR-scrninit-sr-15-20 VALUE IS " PGM=" CONTROL DSPL--CONTROL 
CLNUP1*     LINE 02 COLUMN 04.
CLNUP1*01 SCR-scrninit-sr-16-20 PIC IS X(6) FROM PROG-NAME CONTROL 
CLNUP1*     DSPL--CONTROL LINE 02 COLUMN 09.
CLNUP1*01 SCR-scrninit-sr-17-20 VALUE IS " Station " CONTROL 
CLNUP1*     DSPL--CONTROL LINE 02 COLUMN 19.
CLNUP1*01 SCR-scrninit-sr-18-20 PIC IS X(2) FROM USER-TERMID CONTROL 
CLNUP1*     DSPL--CONTROL LINE 02 COLUMN 28.
CLNUP1*01 SCR-scrninit-sr-21-20 VALUE IS " " CONTROL DSPL--CONTROL LINE 
CLNUP1*     TIMER-CNT COLUMN 1 SIZE IS 80.
CLNUP1*01 SCR-print-sr-100-20 PIC IS X(6) FROM PROG-NAME CONTROL 
CLNUP1*     DSPL--CONTROL LINE 2 COLUMN 9.
CLNUP1*01 SCR-print-sr-114-20 PIC IS X(78) FROM CLEAR-19 CONTROL 
CLNUP1*     DSPL--CONTROL LINE CNT COLUMN 2.
CLNUP1*01 SCR-print-sr-145-20 PIC IS X(80) FROM PAUSE-SCRN-2 CONTROL 
CLNUP1*     DSPL--CONTROL LINE 19 COLUMN 1.
CLNUP1*01 SCR-chainr-sr-15-20 VALUE IS " " CONTROL DSPL--CONTROL LINE 21
CLNUP1*      COLUMN 1.
CLNUP1*01 SCR-chainr-sr-28-23 PIC IS X(2) FROM DOS-RET-CODE CONTROL 
CLNUP1*     DSPL--CONTROL LINE 21 COLUMN 1 REVERSE-VIDEO.
CLNUP1*01 SCR-chainr-sr-29-23 VALUE IS " COULD NOT LOAD COMMAND.COM OR P
CLNUP1*01 SCR-chainr-sr-29-23 VALUE IS " COULD NOT LOAD COMMA
CLNUP1*     REVERSE-VIDEO.
CLNUP1*01 SCR-chainr-sr-31-23 CONTROL DSPL--CONTROL LOWLIGHT.
CLNUP1*01 SCR-chainr-sr-31-23 CONTROL DSPL--CONTROL LOWLIG
CLNUP1* 02 PIC X(80) FROM DOS-CALL-81-160 LINE 23 COLUMN 1 .
CLNUP1*01 SCR-chainr-sr-34-23 VALUE IS " E3 - INSUFFICIENT MEMORY " 
CLNUP1*     CONTROL DSPL--CONTROL LINE 21 COLUMN 1 REVERSE-VIDEO.
CLNUP1*01 SCR-chainr-sr-38-23 VALUE IS "COPY FAILED - " CONTROL 
CLNUP1*     DSPL--CONTROL LINE 21 COLUMN 1 REVERSE-VIDEO.
CLNUP1*01 SCR-chainr-sr-39-26 PIC IS X(2) FROM DOS-RET-CODE CONTROL 
CLNUP1*     DSPL--CONTROL LINE 21 COLUMN 15.
       01 SCR-a0530xhp-cbl-501-20 PIC IS X(20) FROM PRINTING-REPORT 
            CONTROL DSPL--CONTROL LINE 12 COLUMN 30.
       01 SCR-a0530xhp-cbl-627-20 PIC IS X(21) FROM SELECT-MSG CONTROL 
            DSPL--CONTROL LINE 11 COLUMN 11.
       01 SCR-a0530xhp-cbl-657-20 VALUE IS " " CONTROL DSPL--CONTROL 
            LINE 13 COLUMN 1 SIZE IS 80.
       01 SCR-a0530xhp-cbl-658-20 VALUE IS " " CONTROL DSPL--CONTROL 
            LINE 14 COLUMN 1 SIZE IS 80.
       01 SCR-a0530xhp-cbl-659-20 PIC IS X(38) FROM NEXT-QUES CONTROL 
            DSPL--CONTROL LINE 13 COLUMN 18.
       01 SCR-a0530xhp-cbl-669-24 VALUE IS " " CONTROL DSPL--CONTROL 
            LINE 13 COLUMN 1 SIZE IS 80.
       01 SCR-a0530xhp-cbl-674-20 PIC IS X(16) FROM RANGE-LOW-MSG 
            CONTROL DSPL--CONTROL LINE 13 COLUMN 21.
       01 SCR-a0530xhp-cbl-675-20 PIC IS X(16) FROM RANGE-HIGH-MSG 
            CONTROL DSPL--CONTROL LINE 14 COLUMN 21.
       01 SCR-a0530xhp-cbl-682-24 PIC IS X(47) FROM RANGE-ERR-1 CONTROL 
            DSPL--CONTROL LINE 21 COLUMN 1 REVERSE-VIDEO.
       01 SCR-a0530xhp-cbl-686-20 PIC IS X(55) FROM DOLLAR-QUES CONTROL 
            DSPL--CONTROL LINE 13 COLUMN 11.
       01 SCR-a0530xhp-cbl-695-20 PIC IS X(21) FROM BAL-QUES CONTROL 
            DSPL--CONTROL LINE 13 COLUMN 18.
       01 SCR-a0530xhp-cbl-705-20 PIC IS X(34) FROM SLSMN-LOW-QUES 
            CONTROL DSPL--CONTROL LINE 13 COLUMN 20.
       01 SCR-a0530xhp-cbl-706-20 PIC IS X(15) FROM SLSMN-HIGH-QUES 
            CONTROL DSPL--CONTROL LINE 14 COLUMN 40.
       01 SCR-a0530xhp-cbl-726-20 PIC IS X(51) FROM ZERO-QUES CONTROL 
            DSPL--CONTROL LINE 12 COLUMN 12.
       01 SCR-a0530xhp-cbl-742-20 PIC IS X(31) FROM MSG-MSG CONTROL 
            DSPL--CONTROL LINE 11 COLUMN 6.
021710 01 SCR-EXCL-PAID-ITEMS SIZE IS 31 VALUE "Exclude Paid Items"
021710      CONTROL DSPL--CONTROL LINE 11 COLUMN 6.
       01 SCR-a0530xhp-cbl-813-23 VALUE IS "Printing Customer #: " 
            CONTROL DSPL--CONTROL LINE 13 COLUMN 25.
       01 SCR-a0530xhp-cbl-814-23 PIC IS X(8) FROM CUST-NUMBER CONTROL 
            DSPL--CONTROL LINE 13 COLUMN 46.
111907*01 SCR-a0530xhp-cbl-995-20 PIC IS X(69) FROM DSP-HEADER CONTROL 
111907*     DSPL--CONTROL LINE 5 COLUMN 8.
111907*01 SCR-a0530xhp-cbl-996-20 PIC IS X(73) FROM DSP-HEADER2 CONTROL 
111907*     DSPL--CONTROL LINE 6 COLUMN 5.
111907*01 SCR-a0530xhp-cbl-1006-20 PIC IS X(64) FROM DSP-LINE CONTROL 
111907*     DSPL--CONTROL LINE 17 COLUMN 5.
       01 SCR-a0530xhp-cbl-1020-20 PIC IS X(80) FROM CLEAR-21 CONTROL 
            DSPL--CONTROL LINE 20 COLUMN 1.
       01 SCR-a0530xhp-cbl-1027-23 PIC IS X(80) FROM CLEAR-21 CONTROL 
            DSPL--CONTROL LINE 20 COLUMN 1.
       01 SCR-a0530xhp-cbl-1049-23 VALUE IS " No Copies have been select
      -     "ed to print! " CONTROL DSPL--CONTROL LINE 20 COLUMN 20 
            REVERSE-VIDEO.
111907*01 SCR-a0530xhp-cbl-1067-20 PIC IS X(64) FROM DSP-LINE CONTROL 
111907*     DSPL--CONTROL LINE CNT2 COLUMN 5.
       01 SCR-a0530xhp-cbl-1606-20 PIC IS X(9) FROM PROG-NAME CONTROL 
            DSPL--CONTROL LINE 2 COLUMN 9.
       01 SCR-a0530xhp-cbl-1656-20 VALUE IS "Checking Customer # " 
            CONTROL DSPL--CONTROL LINE 12 COLUMN 25.
       01 SCR-a0530xhp-cbl-1657-20 PIC IS X(8) FROM ARIT-CUST-NO CONTROL
             DSPL--CONTROL LINE 12 COLUMN 46.
       01 SCR-a0530xhp-cbl-1680-24 VALUE IS " CONTROL FILE IS IN USE, WA
      -     "ITING... " CONTROL DSPL--CONTROL LINE 23 COLUMN 1 
            REVERSE-VIDEO.
026900/
027000 PROCEDURE DIVISION.
027100 DECLARATIVES.
027200
021710     COPY "TAGMF.DS".
027300
027400*    PRNTR.DS   PRINTER DECLARATIVES PROCEDURE.
027500
027600 Z-PRNTR SECTION.
027700     USE AFTER ERROR PROCEDURE ON LO.
027800 Z-PRNTR-D.
027900     COPY "ERRORPRT.SR".
028000     GO TO STATUS-EXIT.
028100     COPY "ARITF.DS".
028300     COPY "CUSTF.DS".
103108     COPY "EMALF.DS".
028500     COPY "CNTLF.DS".
028600     COPY "EXCNF.DS".
028700     COPY "USERF.DS".
070808     COPY "LFPRF.DS".
028800     GO TO STATUS-EXIT.
028900
029000     COPY "ERRORFIL.SR".
029100
029200 STATUS-EXIT. EXIT.
029300
029400 END DECLARATIVES.
029500/
031996******************************************************************
029600 MAIN-PROG SECTION.
031996******************************************************************
029700 OPEN-FILES.
            PERFORM USERF-FILL-FULLPATH.
029800     PERFORM PGM-INIT.
021710     MOVE TERM-ID TO TAG-NO.
011810*    IF USER-SN = 00191 OR 00003 OR 00152 OR 00355 OR 00196 
011810     IF USER-SN = 00191 OR 00003 OR 00152 OR 00355 OR 00196 OR 
011810                  00010 OR 00011 OR 00112
122301        MOVE USER-SN TO WS-CUSTOMIZED-FLAG.
122301     IF WS-CUSTOMIZED-FLAG > ZERO
122301        MOVE "A0530XHM" TO PROG-NAME.
           PERFORM GETCP-CUSTF-KEY.
012397     IF CUSTF-KEY NOT = SPACES
012397        MOVE "A0300" TO CHAINED-FROM-CD.
029900     PERFORM  OPEN-ARITF.
030000     PERFORM  OPEN-CUSTF.
032190     PERFORM SCREEN-INIT.
103108     PERFORM  GET-EMAIL-SETTINGS.

062603*-- INSERT LOGIC TO ASK Y/N FOR EACH COPY --*
111907     PERFORM LFPRF-INIT.
111907     MOVE "STATEMENT" TO LFPR-FORM-TO-PRINT.
062603     PERFORM ASK-COPIES THRU ASK-COPIES-EXIT.
080309     IF FLAG = 3
080309        GO TO EXIT-RUN.   
030200 BEGIN-REPORT.
080309*    IF FLAG = 4 GO TO EXIT-RUN.
030300     PERFORM OPTION-SELECTION THRU OPTION-SELECTION-EXIT.
080309     IF FLAG = 4 GO TO EXIT-RUN.
030500     PERFORM ZERO-STMT-CHECK THRU ZERO-STMT-CHECK-EXIT.
030600     IF FLAG = 3 GO TO BEGIN-REPORT.
030500     PERFORM GET-MESSAGE THRU GET-MESSAGE-EXIT.
030600     IF FLAG = 3
012397        IF CHAINED-FROM-A0300
                 EXIT PROGRAM
              ELSE
                 GO TO BEGIN-REPORT.
021710     PERFORM GET-PRINT-PAID-OFF.
062603*    PERFORM SCREEN-INIT.
073003     MOVE 1  TO WS-WHAT-NUMBER-CD, WS-WHAT-CONTACT-CD.
031100     MOVE 0 TO PAGE-NO.
031200     DISPLAY SCR-a0530xhp-cbl-501-20  .
031300     IF ESC-FLAG = 1 MOVE "0010000000" TO FKEYS
031400                ELSE MOVE "0000000000" TO FKEYS.
031500     MOVE 1 TO FLAG.
031600     CALL "KBDCHK" USING FLAG, FKEYS.
031700     MOVE 0 TO FLAG.
021910     IF DIAZO
021910        PERFORM BOLD-CUST-ADDR-BLOCK.
031800     PERFORM PROCESS-REPORT THRU PROCESS-REPORT-EXIT.
032200
032300 END-REPORT.
032400     PERFORM CLOSE-FILES.
032500
032600 EXIT-RUN.
062401     PERFORM CLR-CHN-USERF THRU CLR-CHN-USERF-EXIT.
032700     COPY "FINISH.SR".
032800/
032900     COPY "CONTROL.SR".
033000     COPY "DATECVT.SR".
060797*    COPY "DAYCVT.SR".
060797     COPY "DATECHK.SR".
090591     COPY "CLRUSERF.SR".
033250     COPY "CENTER.SR".
033200
031996******************************************************************
033300 SUBROUTINE SECTION.
031996******************************************************************
033400 PGM-INIT.
033500     PERFORM CONTROL-INIT.
           MOVE "N" TO FORM-STOCK-FLAG.
052695     MOVE "STATEMENT" TO QUEUE-DEFAULT-NAME.
033600     OPEN INPUT EXCNF.
033700     READ EXCNF.
033800     CLOSE EXCNF.
034000     MOVE TODAYS-DATE TO DATE-IN.
           PERFORM DATE-CONVERT THRU DATE-CONVERT-EXIT.
060797     MOVE DATE-OUT-11 TO PR-DATE. 
060797*    PERFORM DAY-CONVERT THRU DAY-CONVERT-EXIT.
060797*    MOVE DAY-OUT TO TODAYS-DAYS.
060797     PERFORM CVT-TO-JULIAN THRU CVT-TO-JULIAN-EXIT.
060797     MOVE JULIAN-DAYS TO TODAYS-DAYS.
034300*    0 = NO ESCAPE, 1 = ESCAPABLE
034400     MOVE 1 TO ESC-FLAG.
062603*    MOVE SPACES  TO ON-SCREEN. 
062401*****MOVE "EZFAX" TO EZFAX. 
062603*    MOVE "FaxWare" TO EZFAX.
012997*****MOVE "P " TO ATTR1 OF PRNT-1(2). 
012997*****MOVE "E " TO ATTR1 OF PRNT-1(1).
062603*    MOVE 4    TO WS-DEFAULT-CODES. 

033650     MOVE 40 TO SOURCE-LEN.
033700     MOVE CNTL-CONAME TO SOURCE-FIELD.
033750     PERFORM LEFT-JUST-FIELD THRU LEFT-JUST-FIELD-EXIT.
033800     MOVE DEST-FIELD TO PR-CONAME-LEFT.

036650*- Read Form Control Record --* 
111907*    MOVE 15 TO CNTLF-KEY.
111907*    PERFORM READ-LASER-CNTLF-REC.
111907*    CLOSE CNTLF. 
111907*    OPEN I-O CNTLF.
111907     MOVE 1 TO CNTLF-KEY. 
111907     PERFORM READ-CNTLF.
039600
PROFIT     COPY "SCRNINIT.SR".
062401     COPY "STRGFAX.SR".
103108     COPY "SENDMAIL.SR".
040609     COPY "MSGBOX.SR".

062603*    COPY "COPYFILE.SR".
062603     COPY "COPYFIL2.SR".
062603 
062603 PREPARE-PRINT-FILE.
111907     PERFORM LFPR-PREPARE-PRINT-NEXT.
111907     IF NOT LFPR-NO-MORE-COPY
111907        IF LFPR-DONTPRINT-THIS-COPY
062603           GO TO PREPARE-PRINT-FILE.
111907     IF NOT LFPR-NO-MORE-COPY
062603        MOVE 9 TO USER-PTR-CHN
103108        PERFORM CHECK-ELECTRONIC-FORMAT
062603        PERFORM OPEN-LO-LASER
062603 SETUP-FOR-DETAIL-LINES.

111907*    MOVE SPACES TO PRINT-REC
111907*    STRING HP-VERT-POSITION  DELIMITED BY SIZE
111907*           HP-HORZ-POSITION DELIMITED BY SIZE,
111907*           HP-SYMBOL-SET    DELIMITED BY SIZE,
111907*           HP-FONT          DELIMITED BY SIZE,
111907*           HP-UPRIGHT       DELIMITED BY SIZE,
111907*           HP-FIXED         DELIMITED BY SIZE,
111907*           HP-PITCH-SIZE    DELIMITED BY SIZE
111907*           HP-POINT-SIZE    DELIMITED BY SIZE
111907*           HP-MEDIUM        DELIMITED BY SIZE
111907*           HP-8-LPI         DELIMITED BY SIZE
111907*           INTO PRINT-REC
111907*    WRITE PRINT-REC BEFORE 1.

111907*DIAZO-INCREASE.
122301*    IF DIAZO
122301*       COMPUTE VERT-POS = VERT-POS - 375.   

103108 CHECK-ELECTRONIC-FORMAT.   
103108     IF LFPR-CURR-COPYSEQ = 2
032910*          IF PDF-INVOICE-YES
032910           IF PDF-INVOICE-YES AND
032910              CUST-CONTACT-2-EMAIL NOT = SPACES
103108              SET EMAIL-PDF-YES    TO TRUE
032910*             MOVE CUST-CONTACT-1-EMAIL TO WS-TO-ADDR 
072310*             MOVE CUST-CONTACT-2-EMAIL TO WS-TO-ADDR 
072310              IF CUST-CONTACT-2-EMAIL NOT = SPACES
072310                 MOVE CUST-CONTACT-2-EMAIL TO WS-TO-ADDR
072310              ELSE
072310                 MOVE CUST-CONTACT-1-EMAIL TO WS-TO-ADDR
072310              END-IF
103108           ELSE
103108              SET EMAIL-PDF-NO     TO TRUE
103108              MOVE SPACES          TO WS-TO-ADDR.


021910 BOLD-CUST-ADDR-BLOCK.
021910     MOVE "O" TO EDIT-OPTION OF PR-CUST-NAME,
021910                 EDIT-OPTION OF PR-CUST-ADDR1
021910                 EDIT-OPTION OF PR-CUST-ADDR2
021910                 EDIT-OPTION OF PR-CUST-CSZ.
035100 SUBROUTINE-EXIT. EXIT.
035200
031996******************************************************************
035300 OPTION-SELECTION SECTION.
031996******************************************************************
035400 SETUP-DAYS.
035500     COMPUTE PER1-DAYS = CNTL-AR-DAYS + 1.
035600     COMPUTE PER2-DAYS = CNTL-AR-DAYS * 2 + 1.
035700     COMPUTE PER3-DAYS = CNTL-AR-DAYS * 3 + 1.
020607     COMPUTE PER4-DAYS = CNTL-AR-DAYS * 4 + 1.
035800     SUBTRACT 1 FROM PER1-DAYS GIVING BAL-DAYS(1).
035900     SUBTRACT 1 FROM PER2-DAYS GIVING BAL-DAYS(2).
036000     SUBTRACT 1 FROM PER3-DAYS GIVING BAL-DAYS(3).
020607     SUBTRACT 1 FROM PER4-DAYS GIVING BAL-DAYS(4).
036100*
032190     MOVE 1 TO FLAG.
036200 OPTION-START.
036300     MOVE 1 TO OPTION OF INPUT-SPECS-3.
036400     MOVE "N" TO RANGE-TYPE-1, RANGE-TYPE-2, RANGE-TYPE-3,
036500         RANGE-TYPE-4, RANGE-TYPE-5, RANGE-TYPE-6.
036600     MOVE LOW-VALUES TO LOW-CUST.
036700     MOVE HIGH-VALUES TO HIGH-CUST.
036800     PERFORM SCREEN-INIT.
032190     MOVE 1 TO FLAG.
036900 OPTION-SELECT-AGAIN.
037000     DISPLAY SCR-a0530xhp-cbl-627-20  .
032190     MOVE "1011000000" TO FKEYS.
037200     MOVE 0 TO FLAG.
012397     IF CHAINED-FROM-A0300
012397        MOVE 2 TO OPTION OF INPUT-SPECS-3
012397        MOVE CUSTF-KEY TO LOW-CUST, HIGH-CUST
012397        GO TO OPTION-SELECTION-DONE
012397     ELSE
              PERFORM STEST-a0530xhp-cbl-635
037300        CALL "SCRN01" USING FLAG, FKEYS, STEST-SCRN-SPECS, HELP3,
037400             RANGE-CODES
              PERFORM STEST-AFTER-CALL.
037500     IF FLAG = 4 GO TO OPTION-SELECTION-EXIT.
037600     IF OPTION OF INPUT-SPECS-3 = 1
037700         MOVE "Y" TO RANGE-TYPE-1
037800         GO TO OPTION-SELECTION-DONE.
037900     IF OPTION OF INPUT-SPECS-3 = 2
038000         MOVE "Y" TO RANGE-TYPE-2
038100         PERFORM OPTION-RANGE-SELECT.
038200     IF OPTION OF INPUT-SPECS-3 = 3
038300         MOVE "Y" TO RANGE-TYPE-3
038400         PERFORM OPTION-DOLLAR-SELECT.
038500     IF OPTION OF INPUT-SPECS-3 = 4
038600         MOVE "Y" TO RANGE-TYPE-4
038700         PERFORM OPTION-BALANCE-SELECT.
038800     IF OPTION OF INPUT-SPECS-3 = 5
038900         MOVE "Y" TO RANGE-TYPE-5
039000         PERFORM OPTION-SLSMN-SELECT.
039100     IF OPTION OF INPUT-SPECS-3 = 6
039200         MOVE "Y" TO RANGE-TYPE-6.
039300*
039400 OPTION-SELECT-NEXT.
039500     
            DISPLAY SCR-a0530xhp-cbl-657-20
            DISPLAY SCR-a0530xhp-cbl-658-20
            DISPLAY SCR-a0530xhp-cbl-659-20.
039800     MOVE 13 TO ROW OF YES-NO-SPEC.
039900     MOVE 58 TO COL OF YES-NO-SPEC.
040000     MOVE 2 TO OPTION OF YES-NO-SPEC.
040100     MOVE "1010000000" TO FKEYS.
040200     MOVE ZERO TO FLAG.
           PERFORM STEST-a0530xhp-cbl-665
040300     CALL "SCRN01" USING FLAG, FKEYS, STEST-SCRN-SPECS, CONT-HELP,
040400         YES-NO
           PERFORM STEST-AFTER-CALL.
040500     IF FLAG = 3 GO TO OPTION-START.
040600     IF OPTION OF YES-NO-SPEC = 1
040700         DISPLAY SCR-a0530xhp-cbl-669-24   
040800         GO TO OPTION-SELECT-AGAIN
040900     ELSE GO TO OPTION-SELECTION-DONE.
041000*
041100 OPTION-RANGE-SELECT.
041200     
            DISPLAY SCR-a0530xhp-cbl-674-20
            DISPLAY SCR-a0530xhp-cbl-675-20.
041400     MOVE "1010000000" TO FKEYS.
041500     MOVE ZERO TO FLAG.
           PERFORM STEST-a0530xhp-cbl-678
041600     CALL "SCRN02" USING FLAG, FKEYS, STEST-SCRN-SPECS,
041700         STMT-RANGE-HELP, LOW-CUST, HIGH-CUST
           PERFORM STEST-AFTER-CALL.
041800     IF FLAG = 3 GO TO OPTION-START.
041900     IF LOW-CUST > HIGH-CUST
042000         DISPLAY SCR-a0530xhp-cbl-682-24   
042100         GO TO OPTION-RANGE-SELECT.

042700 OPTION-DOLLAR-SELECT.
042800     DISPLAY SCR-a0530xhp-cbl-686-20  .
042900     MOVE "1010000000" TO FKEYS.
043000     MOVE ZERO TO FLAG.
010204*    CALL "SCRN01" USING FLAG, FKEYS, INPUT-SPECS-4, HELP4,
           PERFORM STEST-a0530xhp-cbl-690
010204     CALL "SCRN01" USING FLAG, FKEYS, STEST-SCRN-SPECS, HELP4,
043200         DOL-LIMIT
           PERFORM STEST-AFTER-CALL.
043300     IF FLAG = 3 GO TO OPTION-START.
043400*
043500 OPTION-BALANCE-SELECT.
043600     DISPLAY SCR-a0530xhp-cbl-695-20  .
043700     MOVE 1 TO OPTION OF INPUT-SPECS-5.
043800     MOVE "1010000000" TO FKEYS.
043900     MOVE ZERO TO FLAG.
           PERFORM STEST-a0530xhp-cbl-699
044000     CALL "SCRN01" USING FLAG, FKEYS, STEST-SCRN-SPECS, HELP5,
044100         BAL-TYPES
           PERFORM STEST-AFTER-CALL.
044200     IF FLAG = 3 GO TO OPTION-START.
044300     MOVE OPTION OF INPUT-SPECS-5 TO AGE-CODE.
044400*
051700 OPTION-SLSMN-SELECT.
051800     
            DISPLAY SCR-a0530xhp-cbl-705-20
            DISPLAY SCR-a0530xhp-cbl-706-20.
051900     MOVE "1010000000" TO FKEYS.
052000     MOVE 0 TO FLAG.
           PERFORM STEST-a0530xhp-cbl-709
052100     CALL "SCRN02" USING FLAG, FKEYS, STEST-SCRN-SPECS, HELP6,
052200         LOW-SLSMN, HIGH-SLSMN
           PERFORM STEST-AFTER-CALL.
052300     IF FLAG = 3 GO TO OPTION-START.
045200
045300 OPTION-SELECTION-DONE.
045400     PERFORM SCREEN-INIT.

045500 OPTION-SELECTION-EXIT. EXIT.
045600
031996******************************************************************
       ZERO-STMT-CHECK SECTION.
031996******************************************************************
       ZERO-STMT-CHECK-START.
012397     IF CHAINED-FROM-A0300
012397        MOVE 2 TO ZERO-BAL-FLAG
012397        GO TO ZERO-STMT-CHECK-EXIT.
           PERFORM SCREEN-INIT.
           DISPLAY SCR-a0530xhp-cbl-726-20  .
           MOVE 12 TO ROW OF YES-NO-SPECS.
           MOVE 65 TO COL OF YES-NO-SPECS.
           MOVE 1 TO OPTION OF YES-NO-SPECS.
           MOVE "1010000000" TO FKEYS.
           MOVE 0 TO FLAG.
           PERFORM STEST-a0530xhp-cbl-732
           CALL "SCRN01" USING FLAG, FKEYS, STEST-SCRN-SPECS, ZERO-HELP,
               YES-NO
           PERFORM STEST-AFTER-CALL.
           MOVE OPTION OF YES-NO-SPECS TO ZERO-BAL-FLAG.
       ZERO-STMT-CHECK-EXIT. EXIT.
045700
031996******************************************************************
045700 GET-MESSAGE SECTION.
031996******************************************************************
045800 GET-MESSAGE-START.
045900     PERFORM SCREEN-INIT.
046000     DISPLAY SCR-a0530xhp-cbl-742-20  .
046100     MOVE "1010000000" TO FKEYS.
046200     MOVE 0 TO FLAG.
           PERFORM STEST-a0530xhp-cbl-745
046300     CALL "SCRN02" USING FLAG, FKEYS, STEST-SCRN-SPECS, MSG-HELP,
046400         MSG-LINE-1, MSG-LINE-2
           PERFORM STEST-AFTER-CALL.
046700 GET-MESSAGE-EXIT. EXIT.

021710 GET-PRINT-PAID-OFF SECTION.
           PERFORM SCREEN-INIT.
           DISPLAY SCR-EXCL-PAID-ITEMS.
           MOVE 11 TO ROW OF YES-NO-SPEC.
           MOVE 27 TO COL OF YES-NO-SPEC.
           MOVE 2 TO OPTION OF YES-NO-SPEC.
           MOVE "1000000000" TO FKEYS.
           MOVE ZERO TO FLAG.
           CALL "SCRN01" USING FLAG, FKEYS, YES-NO-SPECS, 
              EXCL-PAID-HELP, YES-NO.
           MOVE OPTION OF YES-NO-SPEC TO EXCLUDE-PAID-ITEMS-CD.

062603******************************************************************
062603 PROCESS-REPORT SECTION.
062603******************************************************************
062603 PROCESS-REPORT-BEGIN.
062603     PERFORM SCREEN-INIT.
062603     IF NOT ALL-CUST
062603        MOVE LOW-CUST TO CUSTF-KEY.
062603     PERFORM START-CUSTF.
062603     IF C-AT-END OF CUSTF-STATUS
062603         GO TO PROCESS-REPORT-EXIT.
062603     PERFORM READ-CUSTF-NEXT.
031510*    PERFORM CREATE-ARIT-TAG.

062603 PROCESS-REPORT-NEXT.
062603     IF C-AT-END OF CUSTF-STATUS
062603        GO TO PROCESS-REPORT-EXIT.
031510     PERFORM CREATE-ARIT-TAG.
062603
062603     PERFORM SELECTION-CHECK THRU SELECTION-CHECK-EXIT.
           IF SKIP-FLAG = "Y"
              GO TO PROCESS-REPORT-READ.
062603 
062603     MOVE 1         TO PAGE-NO.
062603     MOVE SPACES TO DETAIL-LINE.
           MOVE LOW-VALUES  TO ARITF-KEY.
062603     MOVE CUST-NUMBER TO ARIT-CUST-NO.
010204     MOVE CUST-NUMBER TO WS-ORDER-NO.
021710*    PERFORM START-ARITF-GREATER.
021710     PERFORM START-ARIT-TAG.
062603     IF NOT C-AT-END OF ARITF-STATUS
021710*       PERFORM READ-ARITF-NEXT.
021710        PERFORM READ-ARITF-TAG-NEXT.
062603
110608*062603     IF FAX-A-COPY-YES
110608*       IF CHAINED-FROM-A0300
110608*          MOVE 1 TO WS-FAX-ASK-CD     
110608*          MOVE 2 TO PRINT-TYPE-FLAG
110608*          PERFORM GET-FAX-INFO THRU GET-FAX-INFO-EXIT
110608*          IF RETURN-FLAG = 3
110608*             MOVE 3 TO FLAG
110608*             GO TO PROCESS-REPORT-READ.
       
111907     PERFORM LFPR-START-COPY-4-FORM.
111907     MOVE SPACES TO PF-DOCU-ID.
111907     STRING 
                "STMT" DELIMITED BY SIZE
                CUST-NUMBER DELIMITED BY SIZE
                INTO PF-DOCU-ID.
062603     PERFORM PREPARE-PRINT-FILE.
111907     IF LFPR-NO-MORE-COPY
111907        GO TO PROCESS-REPORT-EXIT
111907     END-IF.
062603          
062603 DETAIL-LOOP.
062603     IF NOT CHAINED-FROM-A0300
062603        DISPLAY SCR-a0530xhp-cbl-813-23  
              DISPLAY SCR-a0530xhp-cbl-814-23              .
111907*    IF FAX-A-COPY-YES AND COPIES-PRINTED = 10
111907*      IF PDF-NO
111907*       IF NEED-FAX-COVER-YES
111907*          PERFORM COVER-SHEET THRU COVER-SHEET-EXIT
111907*          MOVE SPACES TO PRINT-REC
111907*          WRITE PRINT-REC BEFORE ADVANCING PAGE.
062603     PERFORM PRINT-FORM-AND-HEADER THRU 
062603             PRINT-FORM-AND-HEADER-EXIT.
062603     PERFORM SETUP-FOR-DETAIL-LINES.
062603     PERFORM MOVE-DETAIL THRU MOVE-DETAIL-EXIT.
062603     PERFORM PRINT-THE-PAGE THRU PRINT-THE-PAGE-EXIT
100404*-- Used in CopyFil2.SR for PDF filename --*
111907*    MOVE SPACES      TO PCL-FILENAME.
111907*    MOVE CUST-NUMBER TO WS-CUST-NO.
111907*    INSPECT WS-CUST-NO REPLACING ALL " " BY "_".
111907*    STRING WS-CUST-NO    DELIMITED BY SIZE 
111907*           ".PCL"        DELIMITED BY SIZE
111907*           INTO PCL-FILENAME.
062603
062603*-- Done Printing an entire Copy, Send to Print Device --*
062603     PERFORM COPY-FILE.
050104     MOVE ZERO TO LINE-NO.
103108     IF LFPR-CURR-COPYSEQ = 2 AND EMAIL-PDF-YES
103108        MOVE PDFCR-FULLPATH TO SENDMAIL-ATTACHMENT
103108        COMPUTE I = FUNCTION STORED-CHAR-LENGTH(CNTL-CONAME) 
103108        MOVE SPACES               TO SENDMAIL-SUBJECT
103108        MOVE CNTL-CONAME(1:I)     TO SENDMAIL-SUBJECT
103108        MOVE " - "                TO SENDMAIL-SUBJECT(I + 1:3)
062809*       MOVE PDFCR-FILENAME(1:8)  TO SENDMAIL-SUBJECT(I + 4:8)
062809        MOVE PDFCR-FILENAME(5:8)  TO SENDMAIL-SUBJECT(I + 4:8)
103108        MOVE EMAL-STMT-HTML-MSG-FILE TO WS-HTML-MSG-FILE
103108        MOVE EMAL-STMT-TEXT-MSG-FILE TO WS-TEXT-MSG-FILE
103108        MOVE EMAL-STMT-CC-ADDR    TO WS-CC-ADDR
103108        MOVE EMAL-STMT-BCC-ADDR   TO WS-BCC-ADDR
103108        MOVE EMAL-STMT-FROM-ADDR  TO WS-FROM-ADDR
103108        PERFORM SEND-EMAIL
103108        SET EMAIL-PDF-NO TO TRUE.
062603         
11190      IF NOT LFPR-NO-MORE-COPY
              MOVE LOW-VALUES  TO ARITF-KEY
062603        MOVE CUST-NUMBER TO ARIT-CUST-NO
062603        MOVE 1         TO PAGE-NO
021710*       PERFORM START-ARITF-GREATER
021710        PERFORM START-ARIT-TAG
              IF C-AT-END OF ARITF-STATUS
                 GO TO PROCESS-REPORT-READ
              ELSE
021710*          PERFORM READ-ARITF-NEXT
021710           PERFORM READ-ARITF-TAG-NEXT
062603           PERFORM PREPARE-PRINT-FILE
111907           IF NOT LFPR-NO-MORE-COPY
062603              GO TO DETAIL-LOOP.
062603         
062603 PROCESS-REPORT-READ.
031510     IF TAGMF-OPEN
031510        CLOSE TAGMF
031510        SET TAGMF-CLOSED TO TRUE.
062603     IF CHAINED-FROM-A0300
062603        GO TO PROCESS-REPORT-EXIT.
062603
062603     PERFORM READ-CUSTF-NEXT.
062603     IF ESC-FLAG = 1
062603        CALL "KBDCHK" USING FLAG, FKEYS.
062603     IF FLAG = 3
062603        PERFORM ACCEPT-PAUSE
062603        IF OPTION OF PAUSE-SPEC(1) = 1
062603           MOVE 3 TO FLAG
062603           GO TO PROCESS-REPORT-EXIT.
           IF CUST-NUMBER > HIGH-CUST
              MOVE AT-END TO CUSTF-STATUS
              GO TO PROCESS-REPORT-EXIT.
062603
062603     GO TO PROCESS-REPORT-NEXT.
062603
062603 PROCESS-REPORT-EXIT. EXIT.
062603
062603 PRINT-FORM-AND-HEADER SECTION.
062603 PRINT-FORM-AND-HDR-BEGIN.
062603*-- EXECUTE OVERLAY --*
111907*    MOVE WS-FORM-ID TO FORM-NUMBER.
111907*    IF FORM-NUMBER = ZERO
111907*       MOVE 00501 TO FORM-NUMBER.
111907*    MOVE SPACES TO PRINT-REC.
111907*    STRING HP-FORM-MACRO DELIMITED BY SIZE,
111907*           INTO PRINT-REC.
111907*    WRITE PRINT-REC BEFORE ZERO.
062603
111907*    MOVE 320  TO VERT-POS.
111907*    MOVE 090  TO HORZ-POS.
062603     IF WS-LOGO-ID NOT = ZERO OR WS-LOGO-FILENAME NOT = SPACES
070308*       NEXT SENTENCE
070308        MOVE WS-LOGO-FILENAME TO PR-COMPANY-LOGO OF STMFRM
070308        MOVE WS-LOGO-IMAGE-TYPE TO 
                   EDIT-MODE OF PR-COMPANY-LOGO OF STMFRM
062603     ELSE
              MOVE "X" TO EDIT-MODE OF PR-COMPANY-LOGO OF STMFRM 
062603        PERFORM PRINT-COMPANY-INFO.
070308     IF WS-WMARK-FILENAME NOT = SPACES
070308        MOVE WS-WMARK-FILENAME TO PR-WATERMARK   OF STMFRM
070308        MOVE WS-WMARK-IMAGE-TYPE TO
                   EDIT-MODE OF PR-WATERMARK    OF STMFRM 
           ELSE
              MOVE "X" TO EDIT-MODE OF PR-WATERMARK OF STMFRM.
062603     PERFORM PRINT-HEADER-INFO.
111907*    IF PCS
111907*       IF COPIES-PRINTED = 1 AND OPTION OF SPEC-4(1) = 1   
111907*           MOVE 0001     TO POS-X,  HP-BOX-PX
111907*           MOVE 0001     TO POS-Y,  HP-BOX-PY
111907*           MOVE 0900     TO SIZE-X, HP-BOX-SX
111907*           MOVE 0400     TO SIZE-Y, HP-BOX-SY
111907*           MOVE 1        TO HP-BOX-FILL
111907*           WRITE PRINT-REC FROM HP-BOX BEFORE ADVANCING 1.
       PRINT-FORM-AND-HEADER-EXIT. EXIT.
062603         
062603******************************************************************
062603 MOVE-DETAIL SECTION.
062603******************************************************************
062603 MOVE-DETAIL-START.
062603     IF C-AT-END OF ARITF-STATUS
062603        GO TO MOVE-DETAIL-EXIT.
062603     MOVE ARIT-INVNO      TO PR-ARIT-INVNO-1
062603                             PR-ARIT-INVNO-2.
062603     MOVE ARIT-TRAN-DATE  TO DATE-IN.
062603     PERFORM DATE-CONVERT THRU DATE-CONVERT-EXIT.
062603     MOVE DATE-OUT-11     TO PR-ARIT-DATE-1.
062603     MOVE ARTYPE-OPTS(ARIT-TYPE) TO PR-ARIT-REF.
062603     IF ARIT-TYPE = 1 AND ARIT-AMT < 0
062603         MOVE "Credit Memo" TO PR-ARIT-REF.
062603     IF ARIT-REF NOT = SPACES
062603         MOVE ARIT-REF TO PR-ARIT-REF.
062603     IF ARIT-PO-NUM NOT = SPACES AND ARIT-PAST-DUE = SPACES
062603         MOVE "Pur Ord # " TO PR-ARIT-PAST-DUE.
062603     PERFORM INVOICE-AGE.
062603     MOVE ARIT-AMT         TO PR-ARIT-AMT-1,
062603                              PR-ARIT-AMT-2.
062603     PERFORM ADD-TOTALS.
062603
111907*    WRITE PRINT-REC FROM DETAIL-LINE BEFORE ADVANCING 1 LINES.
090310*    IF CURRENT-AMT > ZERO OR
090310*       OVER30-AMT  > ZERO OR
090310*       OVER60-AMT  > ZERO OR
090310*       OVER90-AMT  > ZERO 
090310*          MOVE "R"  TO EDIT-COLOR OF PR-DETAIL-LINE
090310*    ELSE
090310*          MOVE "X"  TO EDIT-COLOR OF PR-DETAIL-LINE.
 
090310*    IF MEI OR JEREMIE OR SUNBELTS
090310*       MOVE "X"  TO EDIT-COLOR OF PR-DETAIL-LINE.

111907     MOVE DETAIL-LINE TO PR-DETAIL-LINE.
111907     MOVE "ITEM" TO PFRPT-GROUP.
111907     WRITE STMFRM.
062603     ADD 1 TO LINE-NO.
062603 
062603 MOVE-DETAIL-END.
062603  
021710*    PERFORM READ-ARITF-NEXT .
021710     PERFORM READ-ARITF-TAG-NEXT.
073003     IF ARIT-INVNO NOT = BREAK-ARIT-INVNO
073003         MOVE ARIT-INVNO TO BREAK-ARIT-INVNO
073003         MOVE "Y" TO FIRST-INVOICE-FLAG.
062603     IF C-AT-END OF ARITF-STATUS
062603        GO TO MOVE-DETAIL-EXIT.
062603     IF LINE-NO < MAX-LINES
062603        GO TO MOVE-DETAIL-START
062603     ELSE
062603        PERFORM PRINT-THE-PAGE THRU PRINT-THE-PAGE-EXIT
062603        PERFORM PRINT-FORM-AND-HEADER THRU 
062603                PRINT-FORM-AND-HEADER-EXIT
062603        MOVE ZERO TO LINE-NO
062603        PERFORM SETUP-FOR-DETAIL-LINES
062603        GO TO MOVE-DETAIL-START.
062603
062603 MOVE-DETAIL-EXIT. EXIT.
062603 
062603******************************************************************
062603 PRINT-THE-PAGE SECTION.
062603******************************************************************
062603 PRINT-THE-PAGE-START.
062603     IF C-AT-END OF ARITF-STATUS
062603        PERFORM PRINT-TOTALS.
062603  
062603*-- PRINT COPY-MSG LINE --*
111907*    MOVE 7260 TO VERT-POS.
111907*    IF DIAZO
111907*       MOVE 7200 TO VERT-POS.
111907*    MOVE 2380 TO HORZ-POS.
111907*    MOVE 08   TO POINT-SIZE
111907*    MOVE 1690 TO FONT-NUMBER.
111907*    MOVE SPACES TO PRINT-REC.
111907*    STRING HP-VERT-POSITION DELIMITED BY SIZE,
111907*           HP-HORZ-POSITION DELIMITED BY SIZE,
111907*           HP-SYMBOL-SET    DELIMITED BY SIZE,
111907*           HP-FONT          DELIMITED BY SIZE,
111907*           HP-UPRIGHT       DELIMITED BY SIZE,
111907*           HP-MEDIUM        DELIMITED BY SIZE,
111907*           HP-PORPORTIONAL  DELIMITED BY SIZE,
111907*           HP-POINT-SIZE    DELIMITED BY SIZE,
111907*           COPY-MSG(COPIES-PRINTED)  DELIMITED BY SIZE,
111907*           INTO PRINT-REC.
111907*    WRITE PRINT-REC BEFORE 0.
111907     MOVE LFPR-COPY-TO-PRINT TO PR-COPY-MSG.
062603
062603     MOVE PAGE-NO TO PR-PAGE-NO.
111907*    MOVE 0400 TO HORZ-POS.
111907*    IF MEI 
111907*       SUBTRACT 100 FROM HORZ-POS.
111907*    MOVE 10   TO POINT-SIZE
111907*    MOVE SPACES TO PRINT-REC.
111907*    STRING HP-VERT-POSITION DELIMITED BY SIZE,
111907*           HP-HORZ-POSITION DELIMITED BY SIZE,
111907*           HP-POINT-SIZE    DELIMITED BY SIZE,
111907     STRING 
111907            "Page No. "      DELIMITED BY SIZE,
111907            PR-PAGE-NO       DELIMITED BY SIZE
111907*           INTO PRINT-REC.
111907            INTO PR-PAGE.
080503*    WRITE PRINT-REC BEFORE 0.
111907*    WRITE PRINT-REC BEFORE ADVANCING PAGE.
062603     ADD 1 TO PAGE-NO.
111907     MOVE "TAIL" TO PFRPT-GROUP.
111907     WRITE STMFRM.
021510*     MOVE ZERO  TO PR-CURRENT, PR-OVER30, PR-OVER60, PR-OVER90
021510*                  PR-TOTAL1, PR-TOTAL2.
021510      MOVE SPACES TO PR-CURRENT, PR-OVER30, PR-OVER60, PR-OVER90
021510                     PR-TOTAL1, PR-TOTAL2.
062603
062603 PRINT-THE-PAGE-EXIT. EXIT.
062603
111907*ASK-COPIES SECTION.
111907*ASK-COPIES-BEGIN.
111907*    PERFORM SCREEN-INIT.
111907*    DISPLAY SCR-a0530xhp-cbl-995-20  .
111907*    DISPLAY SCR-a0530xhp-cbl-996-20  .
111907*    PERFORM DISPLAY-INFO VARYING CNT FROM 1 BY 1 UNTIL CNT > 10.
111907*    MOVE ZERO               TO DSP-CNT.
111907*    MOVE "Envelope"         TO DSP-COPY-MSG.
111907*    MOVE WS-ENVELOPE-TRAY   TO DSP-TRAY.
111907*    MOVE WS-ENV-DEVICE      TO DSP-DEVICE-NAME.
111907*    IF RETURN-ADDR-YES
111907*       MOVE "Yes"           TO DSP-KNOCKOUT
111907*    ELSE
111907*       MOVE "No "             TO DSP-KNOCKOUT.
111907*    DISPLAY SCR-a0530xhp-cbl-1006-20  .
062603*-- Force Display of Data-7 without stopping --*
111907*    MOVE 1 TO FLAG.
111907* 
111907*    PERFORM SET-PROTECT-CD VARYING CNT FROM 1 BY 1 
111907*         UNTIL CNT > 10.
062603*    IF FROM-B0750
010204*       MOVE B0750-PRINT-ENVELOPE-CD TO OPTION OF SPEC-4(11).
111907*ACCEPT-YN.
111907*    PERFORM ACCEPT-DATA-4.
111907*    IF FLAG = 4
111907*       GO TO END-REPORT.
111907* 
111907*ACCEPT-8.
111907*    DISPLAY SCR-a0530xhp-cbl-1020-20  .
111907*    MOVE 1 TO OPTION OF SPEC-8(1).
111907*    MOVE OPTION OF SPEC-4(10) TO OPTION OF SPEC-8(2).
111907*    PERFORM ACCEPT-DATA-8.
111907*    IF OPTION OF SPEC-8(1) = 2
111907*       MOVE 3 TO FLAG.
111907*    IF FLAG = 3
111907*       DISPLAY SCR-a0530xhp-cbl-1027-23  
111907*       GO TO ACCEPT-YN.
111907* 
111907*    MOVE OPTION OF SPEC-8(2) TO OPTION OF SPEC-4(10).
111907*    MOVE OPTION OF SPEC-4(1) TO WS-PRINT-COPY-CD(01).
111907*    MOVE OPTION OF SPEC-4(2) TO WS-PRINT-COPY-CD(02).
111907*    MOVE OPTION OF SPEC-4(3) TO WS-PRINT-COPY-CD(03).
111907*    MOVE OPTION OF SPEC-4(4) TO WS-PRINT-COPY-CD(04).
111907*    MOVE OPTION OF SPEC-4(5) TO WS-PRINT-COPY-CD(05).
111907*    MOVE OPTION OF SPEC-4(6) TO WS-PRINT-COPY-CD(06).
111907*    MOVE OPTION OF SPEC-4(7) TO WS-PRINT-COPY-CD(07).
111907*    MOVE OPTION OF SPEC-4(8) TO WS-PRINT-COPY-CD(08).
111907*    MOVE OPTION OF SPEC-4(9) TO WS-PRINT-COPY-CD(09).
111907*    MOVE OPTION OF SPEC-4(10) TO WS-PRINT-COPY-CD(10).
111907*    MOVE OPTION OF SPEC-4(11) TO WS-PRINT-ENVELOPE-CD. 
111907*    
111907*    IF OPTION OF SPEC-4(1) = 3
111907*       MOVE 1 TO WS-PDF-CD
111907*       MOVE 2 TO WS-PRINT-COPY-CD(01)
111907*       MOVE 1 TO WS-PRINT-COPY-CD(10).

111907*    IF WS-PRINT-COPY-CODES = "2222222222"
111907*       DISPLAY SCR-a0530xhp-cbl-1049-23
111907*             
111907*       GO TO ACCEPT-YN.
062603
111907*    IF WS-PDF-CD NOT = 1
111907*       MOVE WS-PRINT-COPY-CD(10) TO FAX-COPY-CD.
111907*    GO TO ASK-COPIES-EXIT.
111907*     
111907*DISPLAY-INFO.
111907*    MOVE CNT                 TO DSP-CNT.
111907*    MOVE COPY-MSG-LEFT(CNT)  TO DSP-COPY-MSG.
111907*    MOVE WS-TRAY(CNT)        TO DSP-TRAY.
111907*    MOVE WS-DEVICE-NAME(CNT) TO DSP-DEVICE-NAME.
111907*    IF WS-KNOCKOUT-CD(CNT) = 1
111907*       MOVE "Yes" TO DSP-KNOCKOUT
111907*    ELSE
111907*       MOVE "No " TO DSP-KNOCKOUT.
111907*    COMPUTE CNT2 = CNT + 6.
111907*    DISPLAY SCR-a0530xhp-cbl-1067-20  .
111907*
111907*SET-PROTECT-CD.
111907*    IF CNT NOT > COPIES-TO-PRINT
111907*       MOVE NORM-ATTR TO ATTR1 OF SPEC-4(CNT)
111907*       MOVE 1         TO OPTION OF SPEC-4(CNT)
062603*       IF FROM-B0750
062603*          MOVE B0750-PRINT-COPY-CD(CNT) TO OPTION OF SPEC-4(CNT)
062603*       ELSE
062603*          NEXT SENTENCE
111907*    ELSE 
111907*       MOVE 2         TO OPTION OF SPEC-4(CNT)
111907*       MOVE "P "      TO ATTR1 OF SPEC-4(CNT).
062603*       IF FROM-B0750
062603*          MOVE B0750-PRINT-COPY-CD(CNT) TO OPTION OF SPEC-7(CNT).
111907*
111907*ASK-COPIES-EXIT. EXIT.
111907     COPY "ASKCOPY.SR".
111907*    COPY "LFPRF.SR".

031996******************************************************************
055000 PRINT-REPORT SECTION.
031996******************************************************************
           COPY "LASRHDR.SR" REPLACING LASER-IO-FORM BY STMFRM.

048100 PRINT-HEADER-INFO. 
062603*-- SET CAP (CURRENT ACTIVE POSITION) TO 0,0 --*
111907*    WRITE PRINT-REC FROM HP-SET-MARGIN BEFORE ZERO.
111907*    IF COPIES-PRINTED = 10
111907*     IF PDF-NO
111907*       PERFORM STRING-FAX-TAG-LINE
111907*       WRITE PRINT-REC BEFORE ADVANCING 1. 
111907*    IF FAX-A-COPY-YES AND NEED-HARD-COPY-YES AND
111907*       COPIES-PRINTED = 10
111907*         MOVE "@@PROTOCOL 1@@" TO PRINT-REC
111907*         WRITE PRINT-REC BEFORE ZERO.

      *-- Print Company Name/Address on Stub Section --*
050109     IF PROTECTI
050109        MOVE "PACA BODY ARMOR" TO PR-CNTL-CONAME
050109     ELSE
111907        MOVE PR-CONAME-LEFT TO PR-CNTL-CONAME.
045250
050109     IF PROTECTI
062810*       MOVE "5021 PAYSPHERE CIRCLE" TO PR-CNTL-ADDR1
062810        MOVE "DEPT 0691       " TO PR-CNTL-ADDR1
050109     ELSE
111907        MOVE CNTL-ADDR1 TO PR-CNTL-ADDR1.
045700
050109     IF PROTECTI
062810*       MOVE "CHICAGO  IL   60674" TO PR-CNTL-ADDR2
062810        MOVE "PO BOX 850001 "      TO PR-CNTL-ADDR2
050109     ELSE
111907        MOVE CNTL-ADDR2 TO PR-CNTL-ADDR2.
046050
111907     STRING  
046200            CNTL-CITY        DELIMITED BY "  ", 
111908            ", "           DELIMITED BY SIZE, 
046300            CNTL-STATE       DELIMITED BY SIZE, 
111908            "  "           DELIMITED BY SIZE, 
046400            CNTL-ZIP         DELIMITED BY SIZE, 
111907            INTO PR-CNTL-CSZ. 
050109     IF PROTECTI
062810*       MOVE SPACES TO PR-CNTL-CSZ.
062810        MOVE "Orlando  FL   32885-0691" TO PR-CNTL-CSZ

046650     MOVE CNTL-PHONE-NUMBER TO TEMP-PHONE.
046700     MOVE TEMP-AREA TO F-AREA.
046750     MOVE TEMP-EXCHG TO F-EXCHG.
046800     MOVE TEMP-NUM TO F-NUM.
046850     IF CNTL-PHONE-NUMBER NOT = ZEROES
046900        MOVE FORMATTED-PHONE TO PR-PHONE
046950     ELSE 
047450        MOVE SPACES TO PR-VOICE-MSG 
047000        MOVE SPACES TO PR-PHONE.
047050
047100     MOVE CNTL-FAX-NUMBER TO TEMP-PHONE.
047150     MOVE TEMP-AREA TO F-AREA.
047200     MOVE TEMP-EXCHG TO F-EXCHG.
047250     MOVE TEMP-NUM TO F-NUM.
047300     IF CNTL-FAX-NUMBER NOT = ZEROES
047350        MOVE FORMATTED-PHONE TO PR-FAX
047400     ELSE 
047450        MOVE SPACES TO PR-FAX-MSG 
047500        MOVE SPACES TO PR-FAX.
111907*    MOVE SPACES TO PRINT-REC.
111907*    STRING HP-HORZ-POSITION DELIMITED BY SIZE, 
111907     STRING  
111907*           HP-POINT-SIZE    DELIMITED BY SIZE, 
                  PR-VOICE-MSG DELIMITED BY SPACE,
047850            "  "       DELIMITED BY SIZE, 
047700            PR-PHONE   DELIMITED BY SIZE, 
047750            "     "    DELIMITED BY SIZE, 
047800            PR-FAX-MSG DELIMITED BY SIZE, 
047850            "  "       DELIMITED BY SIZE, 
047900            PR-FAX     DELIMITED BY SIZE, 
111907*           HP-6-LPI   DELIMITED BY SIZE
111907*           INTO PRINT-REC. 
111907            INTO PR-CNTL-VPF.
048200
048450*-- Print Date & Customer No. --*

111907     MOVE PR-DATE TO PR-HEAD-DATE1.

111907     MOVE PR-DATE TO PR-HEAD-DATE2.
049000
111907     MOVE CUST-NUMBER TO PR-HEAD-CUST-NUMBER1.

111907     MOVE CUST-NUMBER TO PR-HEAD-CUST-NUMBER2.
050600
111907     MOVE MSG-LINE-1 TO PR-HEAD-MSG1.

111907     MOVE MSG-LINE-2 TO PR-HEAD-MSG2.
052300
      *-- Print Sold To/Ship To Address LInes --* 

111907     MOVE CUST-NAME TO PR-CUST-NAME.
053200
           IF CUST-AR-CONTACT = SPACES
              MOVE "Accounts Payable" TO CUST-AR-CONTACT.
111907     STRING  
                  "ATTN: "         DELIMITED BY SIZE
052750            CUST-AR-CONTACT  DELIMITED BY SIZE, 
111907            INTO PR-CUST-CONTACT.
053850
111907     MOVE CUST-ADDR1 TO PR-CUST-ADDR1.
053850
111907     MOVE CUST-ADDR2 TO PR-CUST-ADDR2.
054500
111907     STRING  
054700            CUST-CITY        DELIMITED BY "  ", 
111908            ", "           DELIMITED BY SIZE, 
054800            CUST-STATE       DELIMITED BY SIZE, 
111908            "  "          DELIMITED BY SIZE, 
054900            CUST-ZIP         DELIMITED BY SIZE
111907*           INTO PRINT-REC. 
111907            INTO PR-CUST-CSZ.

080309     MOVE SPACES TO PR-CUST-VOICE-FAX.
080309     STRING "Contact: "
                  CUST-AR-CONTACT    DELIMITED BY "  "
                  " - Voice: ("         
                  CUST-AR-PHONE(1:3)
                  ")"
                  CUST-AR-PHONE(4:3)
                  "-"
                  CUST-AR-PHONE(7:4)
                  "  FAX: ("
                  CUST-FAX2(1:3)
                  ")"
                  CUST-FAX2(4:3)
                  "-"
                  CUST-FAX2(7:4)  DELIMITED BY SIZE
                  INTO PR-CUST-VOICE-FAX.
111907*    WRITE PRINT-REC BEFORE 1.
011810     IF SUNBELTS 
011810       MOVE SPACES TO PR-HEAD-REMITTO
011810       MOVE SPACES TO PR-CNTL-CONAME, PR-CNTL-ADDR1, 
011810             PR-CNTL-ADDR2, PR-CNTL-CSZ, PR-CNTL-VPF
011810     ELSE
011810       MOVE "REMIT TO:" TO PR-HEAD-REMITTO
011810     END-IF.
090310*    IF MEI OR JEREMIE OR SUNBELTS
030210        MOVE "INV. DATE" TO PR-DATE-BODY-HDR
090310*    ELSE
090310*       MOVE "DUE DATE"  TO PR-DATE-BODY-HDR.
111907     MOVE "HEAD" TO PFRPT-GROUP.
111907     WRITE STMFRM.
055650
       PRINT-TOTALS.
062603     MOVE 1 TO INDEX-OCCURS.
062603     PERFORM MOVE-TOTALS.
111907     MOVE TS-CURRENT TO PR-CURRENT.
111907     MOVE TS-OVER30  TO PR-OVER30 .
111907     MOVE TS-OVER60  TO PR-OVER60 .
111907     MOVE TS-OVER90  TO PR-OVER90 .
111907     MOVE TS-ARIT-AMT TO PR-TOTAL1 .
111907     MOVE TS-ARIT-AMT TO PR-TOTAL2 .

090310*    IF TOT-CURRENT(1) > ZERO OR
090310*       TOT-OVER30(1)  > ZERO OR
090310*       TOT-OVER60(1)  > ZERO OR
090310*       TOT-OVER90(1)  > ZERO 
090310*         MOVE "Account PAST DUE please pay immediately!"
090310*              TO PR-TAIL-PAST-DUE-MSG
090310*    ELSE
090310*       MOVE SPACES TO PR-TAIL-PAST-DUE-MSG.

090310*    IF MEI OR JEREMIE OR DIAZO OR SUNBELTS
090310*       MOVE SPACES TO PR-TAIL-PAST-DUE-MSG.

122801     IF DIAZO
122801        NEXT SENTENCE
122801     ELSE
067400     IF TOT-FUTURE(1) NOT = 0
111907        MOVE SPACES TO PR-FUTURE-MSG
111907        STRING  
                     FUTURE-MSG-1   DELIMITED BY SIZE,
                     "    "         DELIMITED BY SIZE,
063900               TS-FUTURE-AMT  DELIMITED BY SIZE,
111907               INTO PR-FUTURE-MSG
111907        END-IF.
063650
067300     MOVE 0 TO TOT-ARIT-AMT(1).
068100     MOVE 0 TO TOT-CURRENT(1).
068300     MOVE 0 TO TOT-OVER30(1).
068500     MOVE 0 TO TOT-OVER60(1).
068700     MOVE 0 TO TOT-OVER90(1).
067800     MOVE 0 TO TOT-FUTURE(1).
120109*    MOVE ZERO  TO PR-CURRENT, PR-OVER30, PR-OVER60, PR-OVER90
120109*                  PR-TOTAL1, PR-TOTAL2.

057000 PRINT-REPORT-EXIT. EXIT.
057100/
031996******************************************************************
057600 A0530-REPORT SECTION.
031996******************************************************************
057800 AT-END-CHECK.
057900     IF C-AT-END OF ARITF-STATUS AND NOT SKIPPING
               PERFORM PRINT-THE-PAGE THRU PRINT-THE-PAGE-EXIT.
058200
           
       MOVE-TOTALS.
           MOVE TOT-CURRENT(INDEX-OCCURS) TO TS-CURRENT.
           MOVE TOT-OVER30(INDEX-OCCURS)  TO TS-OVER30.
           MOVE TOT-OVER60(INDEX-OCCURS)  TO TS-OVER60.
           MOVE TOT-OVER90(INDEX-OCCURS)  TO TS-OVER90.
           MOVE TOT-ARIT-AMT(INDEX-OCCURS) TO TS-ARIT-AMT.
           MOVE TOT-FUTURE(INDEX-OCCURS)   TO TS-FUTURE-AMT.


061200 INVOICE-AGE.
061300* MAKE PMTS AND DISCS NEG
061400     IF ARIT-TYPE = 4 OR ARIT-TYPE = 5
061500         COMPUTE ARIT-AMT = ARIT-AMT * -1.
061600     MOVE 0 TO FUTURE-AMT, CURRENT-AMT, OVER30-AMT,
061700       OVER60-AMT, OVER90-AMT.
061800* AGE FIRST INVOICE, LATE CHARGES, AND UNAPPLIED CASH
061900* OTHERWISE USE PREVIOUS AGING
062000     IF (ARIT-TYPE = 1 AND FIRST-INVOICE)
062100       OR (ARIT-TYPE = 3 AND ARIT-INVNO = 999991)
062200       OR (ARIT-TYPE = 4 AND ARIT-INVNO = 999990)
065800         MOVE "N" TO FIRST-INVOICE-FLAG
062300         MOVE ARIT-TRAN-DATE TO DATE-IN
060797*        PERFORM DAY-CONVERT
060797*        SUBTRACT DAY-OUT FROM TODAYS-DAYS GIVING DAYS-OVERDUE.
060797         PERFORM CVT-TO-JULIAN THRU CVT-TO-JULIAN-EXIT
060797         SUBTRACT JULIAN-DAYS FROM TODAYS-DAYS 
060797                  GIVING DAYS-OVERDUE.
062600     IF CUST-AR-CD = 1 OR ARIT-INVNO = 999991
062700         PERFORM OPN-ITM-AGE
062800     ELSE PERFORM BAL-FWD-AGE.
062900
063000 BAL-FWD-AGE.
063100     IF ARIT-INVNO < 999997
063200         IF DAYS-OVERDUE < 0
063300             MOVE ARIT-AMT TO FUTURE-AMT
063400         ELSE MOVE ARIT-AMT TO CURRENT-AMT.
063500     IF ARIT-INVNO = 999997
063600         MOVE ARIT-AMT TO OVER30-AMT.
063700     IF ARIT-INVNO = 999998
063800         MOVE ARIT-AMT TO OVER60-AMT.
063900     IF ARIT-INVNO = 999999
064000         MOVE ARIT-AMT TO OVER90-AMT.
064100
064200 OPN-ITM-AGE.
064300     IF DAYS-OVERDUE < 0
064400         MOVE ARIT-AMT TO FUTURE-AMT
064500     ELSE IF DAYS-OVERDUE < PER1-DAYS
064600         MOVE ARIT-AMT TO CURRENT-AMT
064700     ELSE IF DAYS-OVERDUE < PER2-DAYS
064800         MOVE ARIT-AMT TO OVER30-AMT
064900     ELSE IF DAYS-OVERDUE < PER3-DAYS
065000         MOVE ARIT-AMT TO OVER60-AMT
065100     ELSE MOVE ARIT-AMT TO OVER90-AMT.
020607* IF LATER NEED SHOW MORE90 and less120, then add code here.
065200
065300 ADD-TOTALS.
065400     MOVE 1 TO INDEX-OCCURS.
065500     PERFORM ADD-TOTAL 1 TIMES.
065600 ADD-TOTAL.
065700     IF FUTURE-AMT = 0
065800         ADD  ARIT-AMT TO TOT-ARIT-AMT(INDEX-OCCURS)
065900     ELSE ADD  FUTURE-AMT  TO TOT-FUTURE(INDEX-OCCURS).
066000     ADD  CURRENT-AMT TO TOT-CURRENT(INDEX-OCCURS).
066100     ADD  OVER30-AMT  TO TOT-OVER30(INDEX-OCCURS).
066200     ADD  OVER60-AMT  TO TOT-OVER60(INDEX-OCCURS).
066300     ADD  OVER90-AMT  TO TOT-OVER90(INDEX-OCCURS).
066400     ADD 1 TO INDEX-OCCURS.
71200
071300 A0530-REPORT-EXIT. EXIT.
071400
031996******************************************************************
071500 SELECTION-CHECK SECTION.
031996******************************************************************
071600 SELECTION-CHECK-START.
071700     MOVE "Y" TO SKIP-FLAG.
071800     COMPUTE AR-TOTAL =
020607*      CUST-AR(1) + CUST-AR(2) + CUST-AR(3) + CUST-AR(4).
020607       CUST-AR(1) + CUST-AR(2) + CUST-AR(3) + CUST-AR(4) +
020607       CUST-AR(5).
072000     IF CUST-STMT-CD = 2
072100         GO TO SELECTION-CHECK-EXIT.
072200     IF BY-BAL AND AR-TOTAL < DOL-LIMIT
072300         GO TO SELECTION-CHECK-EXIT.
072400     IF BY-AGE
072500         PERFORM CALC-AGED-TOTAL
072600         IF AGE-TOTAL NOT > 0
072700             GO TO SELECTION-CHECK-EXIT.
078500     IF BY-SLSMN AND
078500       (CUST-SLSMN < LOW-SLSMN OR CUST-SLSMN > HIGH-SLSMN)
078600         GO TO SELECTION-CHECK-EXIT.
020895     IF BY-LIMIT AND AR-TOTAL < CUST-CREDIT-LIMIT
073100         GO TO SELECTION-CHECK-EXIT.
073100     IF SKIP-ZERO-STMTS AND AR-TOTAL = 0
073100         GO TO SELECTION-CHECK-EXIT.
073200     MOVE "N" TO SKIP-FLAG.
073300     GO TO SELECTION-CHECK-EXIT.
073400
073500 CALC-AGED-TOTAL.
020607*    MOVE CUST-AR(4) TO AGE-TOTAL.
020607     MOVE CUST-AR(5) TO AGE-TOTAL.
020607     IF AGE-CODE = 1 OR AGE-CODE = 2 OR AGE-CODE = 3
020607         ADD CUST-AR(4) TO AGE-TOTAL.
073700     IF AGE-CODE = 1 OR AGE-CODE = 2
073800         ADD CUST-AR(3) TO AGE-TOTAL.
073900     IF AGE-CODE = 1
074000         ADD CUST-AR(2) TO AGE-TOTAL.
074100
074200 SELECTION-CHECK-EXIT. EXIT.

062401*    COPY "FAXCOVER.SR".
062401******************************************************************
062401*CALL-CHAINR SECTION. 
062401******************************************************************
062401*CALL-CHAINR-START. 
062401*
062401*    DISPLAY " " LINE 12 POSITION 29
062401*    CALL "CHAINR" USING DOS-CALL, PARM-BLK, DOS-RET-CODE.
062401*    PERFORM DOS-ERROR-CHECK THRU DOS-ERROR-CHECK-EXIT. 
062401*
062401*CALL-CHAINR-EXIT. EXIT.
062401*
062401******************************************************************
062401*DOS-ERROR-CHECK SECTION. 
062401******************************************************************
062401*DOS-ERROR-CHECK-START. 
062401*    IF DOS-RET-CODE = "E1" OR DOS-RET-CODE = "E2"
062401*       DISPLAY DOS-RET-CODE LINE 21 POSITION 1 REVERSE 
062401*       DISPLAY " COULD NOT LOAD COMMAND.COM OR PROGRAM " 
062401*          LINE 21 POSITION 3 REVERSE 
062401*       DISPLAY COMMAND-COM LINE 22 POSITION 1 LOW
062401*       ACCEPT CNT LINE 21 POSITION 70
062401*    ELSE 
062401*    IF DOS-RET-CODE = "E3" 
062401*       DISPLAY " E3 - INSUFFICIENT MEMORY " LINE 21
062401*           POSITION 1 REVERSE
062401*       ACCEPT CNT LINE 21 POSITION 70. 
062401*DOS-ERROR-CHECK-EXIT. EXIT.
       
           COPY "PRINT.SR".
062401*    COPY "EZFAX.SR". 
062401     COPY "CHAINR.SR".
111907     COPY "PAUSE.SR".
062603     COPY "FAXMSG.SR".

*******  Merge into Program where EZFAX.SR was.  Change per Program *******
082000******************************************************************
082000 GET-FAX-INFO SECTION.
082000******************************************************************
082000 GET-FAX-INFO-START.
062603     PERFORM SCREEN-INIT.    
090298     MOVE ZERO TO FLAG.
082000     MOVE "\PROFITS\FAXINFO" TO NEXT-PROG2.
082000     REWRITE USERF-REC.
062603*    CLOSE USERF, CNTLF, CLOSE LO.
062603     CLOSE USERF, CNTLF.
082000     MOVE 1                  TO CHAINED-FLAG.
082000     MOVE CUST-NUMBER        TO WS-RECORD-KEY.
090298     PERFORM CHNR-NEXT-PROG2-WS-FAX-SHARED.
081297     OPEN I-O USERF.
081297     OPEN I-O CNTLF.
062603*    MOVE 1  TO USER-PTR-CHN.
062603*    IF RETURN-FLAG = 0
062603*       PERFORM OPEN-LO-LASER.
081297     MOVE "PMENU" TO NEXT-PROG.
090498     DISPLAY SCR-a0530xhp-cbl-1606-20  .
           MOVE SPACES TO WS-FAX-SUBJECT.
082000     STRING "Statement for "  DELIMITED BY SIZE
082000            CUST-NUMBER       DELIMITED BY SIZE
                  INTO WS-FAX-SUBJECT.
062603*    IF RETURN-FLAG = 0
062603*       PERFORM STRING-FAX-TAG-LINE
062603*       WRITE PRINT-REC BEFORE ADVANCING 1. 
082000 GET-FAX-INFO-EXIT. EXIT.

111907*SCREEN-ACCEPT SECTION.
111907*ACCEPT-DATA-4.
111907*    MOVE "1001000000" TO FKEYS.
111907*    PERFORM STEST-a0530xhp-cbl-1619
111907*    CALL "SCRN11" USING FLAG, FKEYS, STEST-SCRN-SPECS, HELP4,
121903*         YES-NO, YES-NO, YES-NO, YES-NO, YES-NO,
111907*         YES-NO-PDF, YES-NO, YES-NO, YES-NO, YES-NO,
111907*         YES-NO, YES-NO, YES-NO, YES-NO, YES-NO,
111907*         YES-NO
111907*    PERFORM STEST-AFTER-CALL.
111907*    
111907*ACCEPT-DATA-8.
111907*    MOVE ZERO TO FLAG.
111907*    MOVE "1010000000" TO FKEYS.
111907*    PERFORM STEST-a0530xhp-cbl-1628
111907*    CALL "SCRN02" USING FLAG, FKEYS, STEST-SCRN-SPECS, HELP8,
111907*         ACCEPT-OPTS, YES-NO
111907*    PERFORM STEST-AFTER-CALL.
111907*    
111907*SCREEN-ACCEPT-EXIT. EXIT.
102900
074300/
074500 IN-OUT SECTION.
074600 OPEN-ARITF.
074700     OPEN INPUT  ARITF.
074800 OPEN-CUSTF.
074900     OPEN INPUT  CUSTF.
075000
062603 START-CUSTF.
062603     START CUSTF KEY NOT < CUSTF-KEY
062603         INVALID KEY MOVE AT-END TO CUSTF-STATUS.
075300 START-ARITF-GREATER.
075400     START ARITF KEY NOT < ARITF-KEY
075500         INVALID KEY MOVE AT-END TO ARITF-STATUS.
075600 READ-ARITF-NEXT.
075700     PERFORM WITH TEST AFTER UNTIL RECORD-LOCK NOT EQUAL 
CLNUP1      ARITF-STATUS OR IO-WAIT-OFF 
           READ ARITF NEXT
075800         AT END MOVE AT-END TO ARITF-STATUS
           END-READ END-PERFORM.
075900     IF NOT C-AT-END OF ARITF-STATUS
076000         IF ARIT-CUST-NO NOT = CUST-NUMBER
076300            MOVE AT-END TO ARITF-STATUS.

062603 READ-CUSTF-NEXT.
062303     PERFORM WITH TEST AFTER UNTIL RECORD-LOCK NOT EQUAL 
CLNUP1      CUSTF-STATUS OR IO-WAIT-OFF 
           READ CUSTF NEXT
                AT END MOVE CUSTF-STATUS TO CUSTF-STATUS
           END-READ END-PERFORM.
           DISPLAY SCR-a0530xhp-cbl-1656-20  
           DISPLAY SCR-a0530xhp-cbl-1657-20            .

062603*READ-CUSTF.
062603*    MOVE ARIT-CUST-NO    TO CUST-NUMBER.
062603*    READ CUSTF INVALID KEY
062603*        MOVE SPACES TO CUSTF-DATA1
062603*        MOVE "*** INVALID CUSTOMER ***" TO CUST-NAME
062603*        MOVE ZERO TO CUST-CREDIT-LIMIT.
062603*    IF CUSTF-STATUS = RECORD-LOCK
062603*        GO TO READ-CUSTF.
077500 CLOSE-FILES.
077600     CLOSE ARITF.
077700     CLOSE CUSTF.
111907     PERFORM LFPRF-CLOSE.
022609*CLOSE-LO.
022609*    PERFORM PDFCR-BEFORE-CLOSE.
022609*    CLOSE LO.
022609*     CALL "PRNTFILECLOSED" USING PRNT-FILENAME
022609*    PERFORM PDFCR-AFTER-CLOSE.
032190 OPEN-CNTLF.
032190     OPEN INPUT CNTLF.
032190 OPEN-IO-CNTLF.
032190     OPEN I-O CNTLF.
032190 READ-CNTLF.
CLNUP1     SET IO-WAIT-OFF TO TRUE.
032190     PERFORM WITH TEST AFTER UNTIL RECORD-LOCK NOT EQUAL 
CLNUP1      CNTLF-STATUS OR IO-WAIT-OFF 
           READ CNTLF
           END-READ END-PERFORM.
CLNUP1     IF NOT C-RECORD-OK OF CNTLF-STATUS
032190         DISPLAY SCR-a0530xhp-cbl-1680-24
032190               .
CLNUP1     SET IO-WAIT-ON TO TRUE.
CLNUP1     IF NOT C-RECORD-OK OF CNTLF-STATUS
032190         CALL "KBDCHK" USING FLAG, FKEYS
032190         IF FLAG = 3 GO TO END-REPORT
032190         ELSE GO TO READ-CNTLF.
032190 READ-CNTLF-NOLOCK.
032190     PERFORM WITH TEST AFTER UNTIL RECORD-LOCK NOT EQUAL 
CLNUP1      CNTLF-STATUS OR IO-WAIT-OFF 
           READ CNTLF NO LOCK
           END-READ END-PERFORM.
032190 REWRITE-CNTLF.
032190     REWRITE CNTLF-REC.
032190
026600 CLOSE-CNTLF.
026700     CLOSE CNTLF.

021710 CREATE-ARIT-TAG.
           OPEN OUTPUT TAGMF.
031510     IF C-FOUND OF TAGMF-STATUS
031510        SET TAGMF-OPEN TO TRUE.
           CLOSE TAGMF.
031510     IF C-FOUND OF TAGMF-STATUS
031510        SET TAGMF-CLOSED TO TRUE.
           OPEN I-O TAGMF.
031510     IF C-FOUND OF TAGMF-STATUS
031510        SET TAGMF-OPEN TO TRUE.
021710     MOVE LOW-VALUES  TO ARITF-KEY.
021710     MOVE CUST-NUMBER TO ARIT-CUST-NO.
021710     MOVE CUST-NUMBER TO WS-ORDER-NO.
021710     PERFORM START-ARITF-GREATER.
           IF NOT C-AT-END OF ARITF-STATUS
               PERFORM TAG-SCAN-INVOICES.
           PERFORM TAG-SELECT.
           CLOSE TAGMF.
031510     IF C-FOUND OF TAGMF-STATUS
031510        SET TAGMF-CLOSED TO TRUE.
021710 TAG-SELECT.
           START TAGMF FIRST
031610        INVALID KEY MOVE AT-END TO TAGMF-STATUS.
           PERFORM UNTIL C-AT-END OF TAGMF-STATUS
              READ TAGMF NEXT
              AT END MOVE TAGMF-STATUS TO TAGMF-STATUS
              NOT AT END
                   IF TAG-INV-AMOUNT = 0 AND EXCLUDE-PAID-ITEMS
                       DELETE TAGMF
                   END-IF
              END-READ
           END-PERFORM. 
021710 TAG-CHECK.
           MOVE ARIT-INVNO TO TAG-INVNO.
           READ TAGMF
           INVALID KEY MOVE AT-END TO ARITF-STATUS
           END-READ. 
021710 TAG-SCAN-INVOICES.
           PERFORM READ-ARITF-NEXT.
           IF C-FOUND OF ARITF-STATUS
               MOVE ARIT-INVNO TO TAG-INVNO
               READ TAGMF
               INVALID KEY
                  MOVE 0 TO TAG-INV-AMOUNT
                  WRITE TAGMF-REC
                  END-WRITE
               END-READ
               IF  ARIT-TYPE = 4 OR ARIT-TYPE = 5
                  COMPUTE TAG-INV-AMOUNT = TAG-INV-AMOUNT - ARIT-AMT 
               ELSE
                  ADD ARIT-AMT TO TAG-INV-AMOUNT 
               END-IF
               REWRITE TAGMF-REC
               GO TO TAG-SCAN-INVOICES
           END-IF.

021710 START-ARIT-TAG.
           OPEN INPUT TAGMF.
031510     IF C-FOUND OF TAGMF-STATUS
031510        SET TAGMF-OPEN TO TRUE.
           READ TAGMF NEXT
           AT END 
             MOVE AT-END TO ARITF-STATUS
             CLOSE TAGMF
031510       SET TAGMF-CLOSED TO TRUE
           NOT AT END
             PERFORM START-ARITF-GREATER
           END-READ.

021710 READ-ARITF-TAG-NEXT.
           PERFORM READ-ARITF-NEXT.
           IF NOT C-AT-END OF ARITF-STATUS
               PERFORM TAG-CHECK
               IF C-AT-END OF ARITF-STATUS
                   GO TO READ-ARITF-TAG-NEXT
               END-IF
           ELSE
               CLOSE TAGMF
031510         SET TAGMF-OPEN TO TRUE
           END-IF

077900 IN-OUT-EXIT. EXIT.

       LOAD-LFPR-DATA.

       FILENAMES SECTION.
       FILL-PATHS.
            MOVE SPACES TO TEMP-SUB-DIR.
            STRING SUB-DIR DELIMITED BY LOW-VALUES INTO TEMP-SUB-DIR.
            PERFORM CUSTF-FILL-FULLPATH.
            PERFORM CNTLF-FILL-FULLPATH.
            PERFORM EXCNF-FILL-FULLPATH.
            PERFORM ARITF-FILL-FULLPATH.
103108      PERFORM EMALF-FILL-FULLPATH.
       CUSTF-FILL-FULLPATH.
            MOVE SPACES TO TEMP-MASTER-DIR.
            STRING MASTER-DIR DELIMITED BY LOW-VALUES INTO 
            TEMP-MASTER-DIR.
            MOVE SPACES TO CUSTF-FULLPATH.
            STRING TEMP-MASTER-DIR "\" TEMP-SUB-DIR "\" CUSTF--NAME 
            DELIMITED BY SPACES INTO CUSTF-FULLPATH.
       CNTLF-FILL-FULLPATH.
            MOVE SPACES TO TEMP-MASTER-DIR.
            STRING MASTER-DIR DELIMITED BY LOW-VALUES INTO 
            TEMP-MASTER-DIR.
            MOVE SPACES TO CNTLF-FULLPATH.
            STRING TEMP-MASTER-DIR "\" TEMP-SUB-DIR "\" CNTLF--NAME 
            DELIMITED BY SPACES INTO CNTLF-FULLPATH.
       EXCNF-FILL-FULLPATH.
            MOVE SPACES TO TEMP-MASTER-DIR.
            STRING MASTER-DIR DELIMITED BY LOW-VALUES INTO 
            TEMP-MASTER-DIR.
            MOVE SPACES TO EXCNF-FULLPATH.
            STRING TEMP-MASTER-DIR "\" TEMP-SUB-DIR "\" EXCNF--NAME 
            DELIMITED BY SPACES INTO EXCNF-FULLPATH.
       USERF-FILL-FULLPATH.
            MOVE SPACES TO TEMP-MASTER-DIR.
            STRING MASTER-DIR DELIMITED BY LOW-VALUES INTO 
            TEMP-MASTER-DIR.
            MOVE SPACES TO USERF-FULLPATH.
            STRING TEMP-MASTER-DIR "\" USERF--NAME DELIMITED BY SPACES 
            INTO USERF-FULLPATH.
       ARITF-FILL-FULLPATH.
            MOVE SPACES TO TEMP-MASTER-DIR.
            STRING MASTER-DIR DELIMITED BY LOW-VALUES INTO 
            TEMP-MASTER-DIR.
            MOVE SPACES TO ARITF-FULLPATH.
            STRING TEMP-MASTER-DIR "\" TEMP-SUB-DIR "\" ARITF--NAME 
            DELIMITED BY SPACES INTO ARITF-FULLPATH.
103108 EMALF-FILL-FULLPATH.
103108      MOVE "EMAIL.FIL"  TO EMALF--NAME.
103108      MOVE SPACES TO TEMP-MASTER-DIR.
103108      STRING MASTER-DIR DELIMITED BY LOW-VALUES INTO 
103108      TEMP-MASTER-DIR.
103108      MOVE SPACES TO EMALF-FULLPATH.
103108      STRING TEMP-MASTER-DIR "\" TEMP-SUB-DIR "\" EMALF--NAME 
103108      DELIMITED BY SPACES INTO EMALF-FULLPATH.
       CHAINCALLS SECTION.
       CHN--PARM-BLOCK.
            COPY "CHAIN.CBL" REPLACING ==PARAM-BLOCK== BY ==PARM-BLOCK==
            .

       CHN--PARM-BLK.
            COPY "CHAIN.CBL" REPLACING ==PARAM-BLOCK== BY ==PARM-BLK==.

       CHNR--WS-PASSED.
            COPY "CHAINR.CBL" REPLACING ==PARAM-BLOCK== BY ==WS-PASSED==
            .

       CHNR-DOS-CALL-PARAM-BLOCK-DOS.
            COPY "CHAINR.CBL" REPLACING ==NEXT-PROG== BY ==DOS-CALL== 
            ==RETURN-CD== BY ==DOS-RET-CODE==.

       CHNR-NEXT-PROG2-WS-FAX-SHARED.
            COPY "CHAINR.CBL" REPLACING ==NEXT-PROG== BY ==NEXT-PROG2== 
            ==PARAM-BLOCK== BY ==WS-FAX-SHARED==.

       GETCP-CUSTF-KEY.
            COPY "GETCP.CBL" REPLACING ==PARAM-BLOCK== BY ==CUSTF-KEY==.

       SCRN-TEST SECTION.
            COPY "STEST.SR".
CLNUP1*STEST-errorfil-sr-46.
CLNUP1*     MOVE "a0530xhp.cbl  errorfil.sr   46" TO STEST-KEY.
CLNUP1*     MOVE ERROR-FIELD TO STEST-SCRN-SPECS.
CLNUP1*     MOVE FUNCTION ADDR(ERROR-FIELD) TO STEST-PTR.
CLNUP1*     PERFORM STEST-BEGIN.
CLNUP1*     COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
CLNUP1*     = FUNCTION LENG (FLAG).
CLNUP1*     MOVE 4 TO STEST-PARAM-W-SIZE OF 
CLNUP1*     STEST-PARAMS (STEST-PARAM-NUM).
CLNUP1*     MOVE "FLAG" TO STEST-PARAM-NAME OF 
CLNUP1*     STEST-PARAMS (STEST-PARAM-NUM).
CLNUP1*     PERFORM STEST-PARAM-CHECK.
CLNUP1*     COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
CLNUP1*     = FUNCTION LENG (FKEYS).
CLNUP1*     MOVE 10 TO STEST-PARAM-W-SIZE OF 
CLNUP1*     STEST-PARAMS (STEST-PARAM-NUM).
CLNUP1*     MOVE "FKEYS" TO STEST-PARAM-NAME OF 
CLNUP1*     STEST-PARAMS (STEST-PARAM-NUM).
CLNUP1*     PERFORM STEST-PARAM-CHECK.
CLNUP1*     COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
CLNUP1*     = FUNCTION LENG (ERROR-FIELD).
CLNUP1*     MOVE 14 TO STEST-PARAM-W-SIZE OF 
CLNUP1*     STEST-PARAMS (STEST-PARAM-NUM).
CLNUP1*     MOVE "ERROR-FIELD" TO STEST-PARAM-NAME OF 
CLNUP1*     STEST-PARAMS (STEST-PARAM-NUM).
CLNUP1*     PERFORM STEST-PARAM-CHECK.
CLNUP1*     PERFORM STEST-SKIP.
CLNUP1*     COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
CLNUP1*     = FUNCTION LENG (ERROR-ANSWER).
CLNUP1*     MOVE FLEN OF STEST-SPECS (1) TO STEST-PARAM-W-SIZE OF 
CLNUP1*     STEST-PARAMS (STEST-PARAM-NUM).
CLNUP1*     MOVE "ERROR-ANSWER" TO STEST-PARAM-NAME OF 
CLNUP1*     STEST-PARAMS (STEST-PARAM-NUM).
CLNUP1*     PERFORM STEST-PARAM-CHECK.
CLNUP1*     PERFORM STEST-FINAL.
CLNUP1*STEST-print-sr-148.
CLNUP1*     MOVE "a0530xhp.cbl     print.sr  148" TO STEST-KEY.
CLNUP1*     MOVE PAUSE-SPECS TO STEST-SCRN-SPECS.
CLNUP1*     MOVE FUNCTION ADDR(PAUSE-SPECS) TO STEST-PTR.
CLNUP1*     PERFORM STEST-BEGIN.
CLNUP1*     COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
CLNUP1*     = FUNCTION LENG (FLAG).
CLNUP1*     MOVE 4 TO STEST-PARAM-W-SIZE OF 
CLNUP1*     STEST-PARAMS (STEST-PARAM-NUM).
CLNUP1*     MOVE "FLAG" TO STEST-PARAM-NAME OF 
CLNUP1*     STEST-PARAMS (STEST-PARAM-NUM).
CLNUP1*     PERFORM STEST-PARAM-CHECK.
CLNUP1*     COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
CLNUP1*     = FUNCTION LENG (FKEYS).
CLNUP1*     MOVE 10 TO STEST-PARAM-W-SIZE OF 
CLNUP1*     STEST-PARAMS (STEST-PARAM-NUM).
CLNUP1*     MOVE "FKEYS" TO STEST-PARAM-NAME OF 
CLNUP1*     STEST-PARAMS (STEST-PARAM-NUM).
CLNUP1*     PERFORM STEST-PARAM-CHECK.
CLNUP1*     COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
CLNUP1*     = FUNCTION LENG (PAUSE-SPECS).
CLNUP1*     MOVE 14 TO STEST-PARAM-W-SIZE OF 
CLNUP1*     STEST-PARAMS (STEST-PARAM-NUM).
CLNUP1*     MOVE "PAUSE-SPECS" TO STEST-PARAM-NAME OF 
CLNUP1*     STEST-PARAMS (STEST-PARAM-NUM).
CLNUP1*     PERFORM STEST-PARAM-CHECK.
CLNUP1*     PERFORM STEST-SKIP.
CLNUP1*     COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
CLNUP1*     = FUNCTION LENG (ABORT-CONTINUE).
CLNUP1*     MOVE FLEN OF STEST-SPECS (1) TO STEST-PARAM-W-SIZE OF 
CLNUP1*     STEST-PARAMS (STEST-PARAM-NUM).
CLNUP1*     MOVE "ABORT-CONTINUE" TO STEST-PARAM-NAME OF 
CLNUP1*     STEST-PARAMS (STEST-PARAM-NUM).
CLNUP1*     PERFORM STEST-PARAM-CHECK.
CLNUP1*     PERFORM STEST-FINAL.
       STEST-a0530xhp-cbl-635.
            MOVE "a0530xhp.cbl               635" TO STEST-KEY.
            MOVE INPUT-SPECS-3 TO STEST-SCRN-SPECS.
            MOVE FUNCTION ADDR(INPUT-SPECS-3) TO STEST-PTR.
            PERFORM STEST-BEGIN.
            COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
            = FUNCTION LENG (FLAG).
            MOVE 4 TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "FLAG" TO STEST-PARAM-NAME OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            PERFORM STEST-PARAM-CHECK.
            COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
            = FUNCTION LENG (FKEYS).
            MOVE 10 TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "FKEYS" TO STEST-PARAM-NAME OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            PERFORM STEST-PARAM-CHECK.
            COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
            = FUNCTION LENG (INPUT-SPECS-3).
            MOVE 14 TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "INPUT-SPECS-3" TO STEST-PARAM-NAME OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            PERFORM STEST-PARAM-CHECK.
            PERFORM STEST-SKIP.
            COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
            = FUNCTION LENG (RANGE-CODES).
            MOVE FLEN OF STEST-SPECS (1) TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "RANGE-CODES" TO STEST-PARAM-NAME OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            PERFORM STEST-PARAM-CHECK.
            PERFORM STEST-FINAL.
       STEST-a0530xhp-cbl-665.
            MOVE "a0530xhp.cbl               665" TO STEST-KEY.
            MOVE YES-NO-SPEC TO STEST-SCRN-SPECS.
            MOVE FUNCTION ADDR(YES-NO-SPEC) TO STEST-PTR.
            PERFORM STEST-BEGIN.
            COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
            = FUNCTION LENG (FLAG).
            MOVE 4 TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "FLAG" TO STEST-PARAM-NAME OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            PERFORM STEST-PARAM-CHECK.
            COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
            = FUNCTION LENG (FKEYS).
            MOVE 10 TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "FKEYS" TO STEST-PARAM-NAME OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            PERFORM STEST-PARAM-CHECK.
            COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
            = FUNCTION LENG (YES-NO-SPEC).
            MOVE 14 TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "YES-NO-SPEC" TO STEST-PARAM-NAME OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            PERFORM STEST-PARAM-CHECK.
            PERFORM STEST-SKIP.
            COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
            = FUNCTION LENG (YES-NO).
            MOVE FLEN OF STEST-SPECS (1) TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "YES-NO" TO STEST-PARAM-NAME OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            PERFORM STEST-PARAM-CHECK.
            PERFORM STEST-FINAL.
       STEST-a0530xhp-cbl-678.
            MOVE "a0530xhp.cbl               678" TO STEST-KEY.
            MOVE RANGE-SPECS-2 TO STEST-SCRN-SPECS.
            MOVE FUNCTION ADDR(RANGE-SPECS-2) TO STEST-PTR.
            PERFORM STEST-BEGIN.
            COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
            = FUNCTION LENG (FLAG).
            MOVE 4 TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "FLAG" TO STEST-PARAM-NAME OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            PERFORM STEST-PARAM-CHECK.
            COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
            = FUNCTION LENG (FKEYS).
            MOVE 10 TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "FKEYS" TO STEST-PARAM-NAME OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            PERFORM STEST-PARAM-CHECK.
            COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
            = FUNCTION LENG (RANGE-SPECS-2).
            MOVE 28 TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "RANGE-SPECS-2" TO STEST-PARAM-NAME OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            PERFORM STEST-PARAM-CHECK.
            PERFORM STEST-SKIP.
            COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
            = FUNCTION LENG (LOW-CUST).
            MOVE FLEN OF STEST-SPECS (1) TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "LOW-CUST" TO STEST-PARAM-NAME OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            PERFORM STEST-PARAM-CHECK.
            COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
            = FUNCTION LENG (HIGH-CUST).
            MOVE FLEN OF STEST-SPECS (2) TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "HIGH-CUST" TO STEST-PARAM-NAME OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            PERFORM STEST-PARAM-CHECK.
            PERFORM STEST-FINAL.
       STEST-a0530xhp-cbl-690.
            MOVE "a0530xhp.cbl               690" TO STEST-KEY.
            MOVE INPUT-SPECS-4A TO STEST-SCRN-SPECS.
            MOVE FUNCTION ADDR(INPUT-SPECS-4A) TO STEST-PTR.
            PERFORM STEST-BEGIN.
            COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
            = FUNCTION LENG (FLAG).
            MOVE 4 TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "FLAG" TO STEST-PARAM-NAME OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            PERFORM STEST-PARAM-CHECK.
            COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
            = FUNCTION LENG (FKEYS).
            MOVE 10 TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "FKEYS" TO STEST-PARAM-NAME OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            PERFORM STEST-PARAM-CHECK.
            COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
            = FUNCTION LENG (INPUT-SPECS-4A).
            MOVE 14 TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "INPUT-SPECS-4A" TO STEST-PARAM-NAME OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            PERFORM STEST-PARAM-CHECK.
            PERFORM STEST-SKIP.
            COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
            = FUNCTION LENG (DOL-LIMIT).
            MOVE FLEN OF STEST-SPECS (1) TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "DOL-LIMIT" TO STEST-PARAM-NAME OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            PERFORM STEST-PARAM-CHECK.
            PERFORM STEST-FINAL.
       STEST-a0530xhp-cbl-699.
            MOVE "a0530xhp.cbl               699" TO STEST-KEY.
            MOVE INPUT-SPECS-5 TO STEST-SCRN-SPECS.
            MOVE FUNCTION ADDR(INPUT-SPECS-5) TO STEST-PTR.
            PERFORM STEST-BEGIN.
            COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
            = FUNCTION LENG (FLAG).
            MOVE 4 TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "FLAG" TO STEST-PARAM-NAME OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            PERFORM STEST-PARAM-CHECK.
            COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
            = FUNCTION LENG (FKEYS).
            MOVE 10 TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "FKEYS" TO STEST-PARAM-NAME OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            PERFORM STEST-PARAM-CHECK.
            COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
            = FUNCTION LENG (INPUT-SPECS-5).
            MOVE 14 TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "INPUT-SPECS-5" TO STEST-PARAM-NAME OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            PERFORM STEST-PARAM-CHECK.
            PERFORM STEST-SKIP.
            COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
            = FUNCTION LENG (BAL-TYPES).
            MOVE FLEN OF STEST-SPECS (1) TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "BAL-TYPES" TO STEST-PARAM-NAME OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            PERFORM STEST-PARAM-CHECK.
            PERFORM STEST-FINAL.
       STEST-a0530xhp-cbl-709.
            MOVE "a0530xhp.cbl               709" TO STEST-KEY.
            MOVE INPUT-SPECS-6 TO STEST-SCRN-SPECS.
            MOVE FUNCTION ADDR(INPUT-SPECS-6) TO STEST-PTR.
            PERFORM STEST-BEGIN.
            COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
            = FUNCTION LENG (FLAG).
            MOVE 4 TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "FLAG" TO STEST-PARAM-NAME OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            PERFORM STEST-PARAM-CHECK.
            COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
            = FUNCTION LENG (FKEYS).
            MOVE 10 TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "FKEYS" TO STEST-PARAM-NAME OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            PERFORM STEST-PARAM-CHECK.
            COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
            = FUNCTION LENG (INPUT-SPECS-6).
            MOVE 28 TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "INPUT-SPECS-6" TO STEST-PARAM-NAME OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            PERFORM STEST-PARAM-CHECK.
            PERFORM STEST-SKIP.
            COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
            = FUNCTION LENG (LOW-SLSMN).
            MOVE FLEN OF STEST-SPECS (1) TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "LOW-SLSMN" TO STEST-PARAM-NAME OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            PERFORM STEST-PARAM-CHECK.
            COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
            = FUNCTION LENG (HIGH-SLSMN).
            MOVE FLEN OF STEST-SPECS (2) TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "HIGH-SLSMN" TO STEST-PARAM-NAME OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            PERFORM STEST-PARAM-CHECK.
            PERFORM STEST-FINAL.
       STEST-a0530xhp-cbl-732.
            MOVE "a0530xhp.cbl               732" TO STEST-KEY.
            MOVE YES-NO-SPECS TO STEST-SCRN-SPECS.
            MOVE FUNCTION ADDR(YES-NO-SPECS) TO STEST-PTR.
            PERFORM STEST-BEGIN.
            COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
            = FUNCTION LENG (FLAG).
            MOVE 4 TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "FLAG" TO STEST-PARAM-NAME OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            PERFORM STEST-PARAM-CHECK.
            COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
            = FUNCTION LENG (FKEYS).
            MOVE 10 TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "FKEYS" TO STEST-PARAM-NAME OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            PERFORM STEST-PARAM-CHECK.
            COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
            = FUNCTION LENG (YES-NO-SPECS).
            MOVE 14 TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "YES-NO-SPECS" TO STEST-PARAM-NAME OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            PERFORM STEST-PARAM-CHECK.
            PERFORM STEST-SKIP.
            COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
            = FUNCTION LENG (YES-NO).
            MOVE FLEN OF STEST-SPECS (1) TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "YES-NO" TO STEST-PARAM-NAME OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            PERFORM STEST-PARAM-CHECK.
            PERFORM STEST-FINAL.
       STEST-a0530xhp-cbl-745.
            MOVE "a0530xhp.cbl               745" TO STEST-KEY.
            MOVE MSG-SPECS TO STEST-SCRN-SPECS.
            MOVE FUNCTION ADDR(MSG-SPECS) TO STEST-PTR.
            PERFORM STEST-BEGIN.
            COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
            = FUNCTION LENG (FLAG).
            MOVE 4 TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "FLAG" TO STEST-PARAM-NAME OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            PERFORM STEST-PARAM-CHECK.
            COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
            = FUNCTION LENG (FKEYS).
            MOVE 10 TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "FKEYS" TO STEST-PARAM-NAME OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            PERFORM STEST-PARAM-CHECK.
            COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
            = FUNCTION LENG (MSG-SPECS).
            MOVE 28 TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "MSG-SPECS" TO STEST-PARAM-NAME OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            PERFORM STEST-PARAM-CHECK.
            PERFORM STEST-SKIP.
            COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
            = FUNCTION LENG (MSG-LINE-1).
            MOVE FLEN OF STEST-SPECS (1) TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "MSG-LINE-1" TO STEST-PARAM-NAME OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            PERFORM STEST-PARAM-CHECK.
            COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
            = FUNCTION LENG (MSG-LINE-2).
            MOVE FLEN OF STEST-SPECS (2) TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "MSG-LINE-2" TO STEST-PARAM-NAME OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            PERFORM STEST-PARAM-CHECK.
            PERFORM STEST-FINAL.
111907*STEST-a0530xhp-cbl-1619.
111907*     MOVE "a0530xhp.cbl              1619" TO STEST-KEY.
111907*     MOVE SPECS-4 TO STEST-SCRN-SPECS.
111907*     MOVE FUNCTION ADDR(SPECS-4) TO STEST-PTR.
111907*     PERFORM STEST-BEGIN.
111907*     COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
111907*     = FUNCTION LENG (FLAG).
111907*     MOVE 4 TO STEST-PARAM-W-SIZE OF 
111907*     STEST-PARAMS (STEST-PARAM-NUM).
111907*     MOVE "FLAG" TO STEST-PARAM-NAME OF 
111907*     STEST-PARAMS (STEST-PARAM-NUM).
111907*     PERFORM STEST-PARAM-CHECK.
111907*     COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
111907*     = FUNCTION LENG (FKEYS).
111907*     MOVE 10 TO STEST-PARAM-W-SIZE OF 
111907*     STEST-PARAMS (STEST-PARAM-NUM).
111907*     MOVE "FKEYS" TO STEST-PARAM-NAME OF 
111907*     STEST-PARAMS (STEST-PARAM-NUM).
111907*     PERFORM STEST-PARAM-CHECK.
111907*     COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
111907*     = FUNCTION LENG (SPECS-4).
111907*     MOVE 154 TO STEST-PARAM-W-SIZE OF 
111907*     STEST-PARAMS (STEST-PARAM-NUM).
111907*     MOVE "SPECS-4" TO STEST-PARAM-NAME OF 
111907*     STEST-PARAMS (STEST-PARAM-NUM).
111907*     PERFORM STEST-PARAM-CHECK.
111907*     PERFORM STEST-SKIP.
111907*     COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
111907*     = FUNCTION LENG (YES-NO-PDF).
111907*     MOVE FLEN OF STEST-SPECS (1) TO STEST-PARAM-W-SIZE OF 
111907*     STEST-PARAMS (STEST-PARAM-NUM).
111907*     MOVE "YES-NO-PDF" TO STEST-PARAM-NAME OF 
111907*     STEST-PARAMS (STEST-PARAM-NUM).
111907*     PERFORM STEST-PARAM-CHECK.
111907*     COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
111907*     = FUNCTION LENG (YES-NO).
111907*     MOVE FLEN OF STEST-SPECS (2) TO STEST-PARAM-W-SIZE OF 
111907*     STEST-PARAMS (STEST-PARAM-NUM).
111907*     MOVE "YES-NO" TO STEST-PARAM-NAME OF 
111907*     STEST-PARAMS (STEST-PARAM-NUM).
111907*     PERFORM STEST-PARAM-CHECK.
111907*     COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
111907*     = FUNCTION LENG (YES-NO).
111907*     MOVE FLEN OF STEST-SPECS (3) TO STEST-PARAM-W-SIZE OF 
111907*     STEST-PARAMS (STEST-PARAM-NUM).
111907*     MOVE "YES-NO" TO STEST-PARAM-NAME OF 
111907*     STEST-PARAMS (STEST-PARAM-NUM).
111907*     PERFORM STEST-PARAM-CHECK.
111907*     COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
111907*     = FUNCTION LENG (YES-NO).
111907*     MOVE FLEN OF STEST-SPECS (4) TO STEST-PARAM-W-SIZE OF 
111907*     STEST-PARAMS (STEST-PARAM-NUM).
111907*     MOVE "YES-NO" TO STEST-PARAM-NAME OF 
111907*     STEST-PARAMS (STEST-PARAM-NUM).
111907*     PERFORM STEST-PARAM-CHECK.
111907*     COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
111907*     = FUNCTION LENG (YES-NO).
111907*     MOVE FLEN OF STEST-SPECS (5) TO STEST-PARAM-W-SIZE OF 
111907*     STEST-PARAMS (STEST-PARAM-NUM).
111907*     MOVE "YES-NO" TO STEST-PARAM-NAME OF 
111907*     STEST-PARAMS (STEST-PARAM-NUM).
111907*     PERFORM STEST-PARAM-CHECK.
111907*     COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
111907*     = FUNCTION LENG (YES-NO).
111907*     MOVE FLEN OF STEST-SPECS (6) TO STEST-PARAM-W-SIZE OF 
111907*     STEST-PARAMS (STEST-PARAM-NUM).
111907*     MOVE "YES-NO" TO STEST-PARAM-NAME OF 
111907*     STEST-PARAMS (STEST-PARAM-NUM).
111907*     PERFORM STEST-PARAM-CHECK.
111907*     COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
111907*     = FUNCTION LENG (YES-NO).
111907*     MOVE FLEN OF STEST-SPECS (7) TO STEST-PARAM-W-SIZE OF 
111907*     STEST-PARAMS (STEST-PARAM-NUM).
111907*     MOVE "YES-NO" TO STEST-PARAM-NAME OF 
111907*     STEST-PARAMS (STEST-PARAM-NUM).
111907*     PERFORM STEST-PARAM-CHECK.
111907*     COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
111907*     = FUNCTION LENG (YES-NO).
111907*     MOVE FLEN OF STEST-SPECS (8) TO STEST-PARAM-W-SIZE OF 
111907*     STEST-PARAMS (STEST-PARAM-NUM).
111907*     MOVE "YES-NO" TO STEST-PARAM-NAME OF 
111907*     STEST-PARAMS (STEST-PARAM-NUM).
111907*     PERFORM STEST-PARAM-CHECK.
111907*     COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
111907*     = FUNCTION LENG (YES-NO).
111907*     MOVE FLEN OF STEST-SPECS (9) TO STEST-PARAM-W-SIZE OF 
111907*     STEST-PARAMS (STEST-PARAM-NUM).
111907*     MOVE "YES-NO" TO STEST-PARAM-NAME OF 
111907*     STEST-PARAMS (STEST-PARAM-NUM).
111907*     PERFORM STEST-PARAM-CHECK.
111907*     COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
111907*     = FUNCTION LENG (YES-NO).
111907*     MOVE FLEN OF STEST-SPECS (10) TO STEST-PARAM-W-SIZE OF 
111907*     STEST-PARAMS (STEST-PARAM-NUM).
111907*     MOVE "YES-NO" TO STEST-PARAM-NAME OF 
111907*     STEST-PARAMS (STEST-PARAM-NUM).
111907*     PERFORM STEST-PARAM-CHECK.
111907*     COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
111907*     = FUNCTION LENG (YES-NO).
111907*     MOVE FLEN OF STEST-SPECS (11) TO STEST-PARAM-W-SIZE OF 
111907*     STEST-PARAMS (STEST-PARAM-NUM).
111907*     MOVE "YES-NO" TO STEST-PARAM-NAME OF 
111907*     STEST-PARAMS (STEST-PARAM-NUM).
111907*     PERFORM STEST-PARAM-CHECK.
111907*     PERFORM STEST-FINAL.
111907*STEST-a0530xhp-cbl-1628.
111907*     MOVE "a0530xhp.cbl              1628" TO STEST-KEY.
111907*     MOVE SPECS-8 TO STEST-SCRN-SPECS.
111907*     MOVE FUNCTION ADDR(SPECS-8) TO STEST-PTR.
111907*     PERFORM STEST-BEGIN.
111907*     COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
111907*     = FUNCTION LENG (FLAG).
111907*     MOVE 4 TO STEST-PARAM-W-SIZE OF 
111907*     STEST-PARAMS (STEST-PARAM-NUM).
111907*     MOVE "FLAG" TO STEST-PARAM-NAME OF 
111907*     STEST-PARAMS (STEST-PARAM-NUM).
111907*     PERFORM STEST-PARAM-CHECK.
111907*     COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
111907*     = FUNCTION LENG (FKEYS).
111907*     MOVE 10 TO STEST-PARAM-W-SIZE OF 
111907*     STEST-PARAMS (STEST-PARAM-NUM).
111907*     MOVE "FKEYS" TO STEST-PARAM-NAME OF 
111907*     STEST-PARAMS (STEST-PARAM-NUM).
111907*     PERFORM STEST-PARAM-CHECK.
111907*     COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
111907*     = FUNCTION LENG (SPECS-8).
111907*     MOVE 28 TO STEST-PARAM-W-SIZE OF 
111907*     STEST-PARAMS (STEST-PARAM-NUM).
111907*     MOVE "SPECS-8" TO STEST-PARAM-NAME OF 
111907*     STEST-PARAMS (STEST-PARAM-NUM).
111907*     PERFORM STEST-PARAM-CHECK.
111907*     PERFORM STEST-SKIP.
111907*     COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
111907*     = FUNCTION LENG (ACCEPT-OPTS).
111907*     MOVE FLEN OF STEST-SPECS (1) TO STEST-PARAM-W-SIZE OF 
111907*     STEST-PARAMS (STEST-PARAM-NUM).
111907*     MOVE "ACCEPT-OPTS" TO STEST-PARAM-NAME OF 
111907*     STEST-PARAMS (STEST-PARAM-NUM).
111907*     PERFORM STEST-PARAM-CHECK.
111907*     COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
111907*     = FUNCTION LENG (YES-NO).
111907*     MOVE FLEN OF STEST-SPECS (2) TO STEST-PARAM-W-SIZE OF 
111907*     STEST-PARAMS (STEST-PARAM-NUM).
111907*     MOVE "YES-NO" TO STEST-PARAM-NAME OF 
111907*     STEST-PARAMS (STEST-PARAM-NUM).
111907*     PERFORM STEST-PARAM-CHECK.
111907*     PERFORM STEST-FINAL.
