000100 IDENTIFICATION DIVISION. 
000200 PROGRAM-ID.    PY300 IS INITIAL.
000300 AUTHOR.        MJD.
000400 ENVIRONMENT DIVISION.
000500 CONFIGURATION SECTION. 
           COPY "EXCEL.CS".
000600 SOURCE-COMPUTER. IBM-PC-XT.
000700 OBJECT-COMPUTER. IBM-PC-XT.
000800*REMARKS. 
000900***************************************************************** 
001000* 
001100* PY300 - Create G/L Entries, Print Payroll Journal 
001200* VERSION 4.02 - 07/16/1987 Fix BAD-ACCT-MSG. 
060889* UPDATE 06/02/89  SLR  - Added pause option & printer redirect *
112190* UPD KWS - ADDED LOGIC FOR MEDICARE                            *
TS0327*  UPD TNS - EXPANDED NUMBER OF DEDUCTIONS FROM 9 TO 10.        *
121791* FIX KWS - IF S125 RETURN, GL POSTING OFF BY THAT AMOUNT       *
090892* UPD BOB - EXPANDED NUMBER OF DEDUCTIONS FROM 10 TO 20.        *
101792* UPD KWS - ADD JOB COST LOGIC                                  *
122192* FIX KWS - EXPANDED ACCT-NUM/ACCT-TOT TO HOLD MORE THAN 50     *
033093* UPD BOB - NOT READY TO POST TEST                              *
101893* UPD KWS - STORE COMPLETE EMPL # IN JOBCOST FILE               *
101893* UPD KWS - STORE HOURS IN JCTN-QUANTITY FIELD                  *
032894* UPD KWS - CHANGED THE WAY GL-ACCT HANDLED FOR JOB COST        *
052694* MOD BOB - QUEST, SPLIT OUT NON-TAXABLE $ FROM NET-PAY         *
061594* UPD BOB - SAVE EMPL-NO IN J/C HISTORY                         *
041096* FIX KWS V2.4B- F4 NOT WORKING.                                *
070896* MOD BOB V2.4A- ARE YOU SURE QUES AFTER G/L PERIOD FOR IND MTLS*
071296* UPD KWS V2.5 - NO LONGER USING CNTL-PR-DATE, CNTL-DATE        *
122688* UPD KWS V2.7B- Y2K DATE CHANGES                                *
072999* UPD KWS V2.8A- VCA - APPEND LASTNAME TO DESC IF ROOM           *
080399* FIX KWS V2.8B- P106 CAUSING OUT OF BALANCE CONDITION           *
080399* FIX KWS V2.8B- P106 NOT WRITING GL ENTRY FOR REIMBURSEMENT     *
080399* UPD KWS V2.8B- WRITE A/P ENTRY FOR FIT, FICA, MED, & STATE     *
080499* UPD KWS V2.8B- WRITE A/P ENTRY FOR STATE TAXES                 *
081199* UPD KWS V2.8B- PY+ REIMBUR GL ENTRY NOT RIGHT                  *
081399* UPD KWS V2.8B- STATE TAXES DUE 15TH OF FOLLOWING MONTH         *
092499* UPD BOB V2.8B- PRINT PERIOD ENDING DATE                        *
121601* MOD  KWS - PIERCE - INIT NEW JCTN FIELD                       *
010502* UPD KWS V2.9A- REMOVE PY+/S106/P106 DEDUCTION TYPE             *
033106* MOD KWS V4.1 - SUNBELTO - WRITE ASCII FILE OF CHECK DETAIL     *
041306* MOD KWS V4.1 - SUNBELTO - MORE LOGIC FOR 033106                *
010709* FIX KWS V4.4.1- ADD CLOSE-LO                                   *
010111* UPD KWS V4.5.3- EMPLOYEE/EMPLOYER RATES ARE DIFFERETN FOR 2010 *
001400******************************************************************
001500 INPUT-OUTPUT SECTION.
001600 FILE-CONTROL.
001700     COPY "PYHDF.SL". 
001800     COPY "PYLNF.SL". 
003100     COPY "CNTLF.SL". 
003100     COPY "DEDCF.SL". 
002700     COPY "GLTNF.SL". 
002700     COPY "CHRTF.SL". 
002700     COPY "STATF.SL". 
003300     COPY "USERF.SL". 
101792     COPY "JCTNF.SL".                                             J550/A
080399     COPY "EMPLF.SL".
080399     COPY "APHDF.SL". 
080399     COPY "APLNF.SL". 
080399     COPY "VENDF.SL". 
002200
060889     COPY "LPFPRNTR.SL".
033106     COPY "ASCII.SL".
           COPY "STEST.SL".

003400
003500 DATA DIVISION. 
       BASED-STORAGE SECTION.
            COPY "STEST.BS".
003600 FILE SECTION.
003700     COPY "PYHDF.FD". 
003800     COPY "PYLNF.FD". 
005400     COPY "CNTLF.FD". 
005400     COPY "DEDCF.FD". 
004300     COPY "GLTNF.FD". 
004300     COPY "CHRTF.FD". 
004300     COPY "STATF.FD". 
005600     COPY "USERF.FD". 
101792     COPY "JCTNF.FD".                                             J550/A
080399     COPY "EMPLF.FD".
080399     COPY "APHDF.FD". 
080399     COPY "APLNF.FD". 
080399     COPY "VENDF.FD".
033106     COPY "ASCII.FD".
       01  ASCII-REC.
           05  ASCII-EMPL-NO       PIC X(8).
           05  ASCII-EMPL-NAME     PIC X(30).
           05  ASCII-CHK-DATE      PIC 9(6).
           05  ASCII-CHK-NO        PIC 9(6).
           05  ASCII-PPE-DATE      PIC 9(6).
           05  ASCII-AMT           PIC 9(7).99-  OCCURS  9 TIMES.
           05  ASCII-TOTAL-AMT     PIC 9(7).99-.
           05  ASCII-TAXABLE-AMT   PIC 9(7).99-.
           05  ASCII-NONTAX-AMT    PIC 9(7).99-.
101101     05  ASCII-TAX-AMT       PIC 9(7).99-  OCCURS  6 TIMES.
           05  ASCII-DED-AMT       PIC 9(5).99-  OCCURS 20 TIMES.
           05  ASCII-NET-PAY       PIC 9(7).99-.
           05  ASCII-TAX-CODE      PIC X(5)      OCCURS  5 TIMES.
           05  ASCII-FED-401K-DED  PIC 9(7).99-.
           05  ASCII-FED-S125-DED  PIC 9(7).99-.
           05  ASCII-ST-401K-DED   PIC 9(7).99-.
           05  ASCII-ST-S125-DED   PIC 9(7).99-.
041306     05  ASCII-EXP-ACCT      PIC 9(7).
041306     05  ASCII-DIRDEP-CD     PIC 9.
        
003500
003600*    PRNTR.FD   PRINT FILE DESCRIPTION. 
003700
070907     COPY "LPFPRNTR.FD".
070907*FD  LO 
070907*    LABEL RECORDS ARE OMITTED. 
004000
070907*01  PRINT-REC. 
070907*    03 SCREEN-REC       PIC X(80). 
070907*    03 FILLER           PIC X(52). 
           COPY "STEST.FD".
005700
005900 WORKING-STORAGE SECTION. 
CVT    01  PROG-NAME    PIC X(6) VALUE    "PY300".                      
007100
007200     COPY "CONSTANT.DTA". 
051503     COPY "WAIT.OPT".
007300     COPY "DATE.DTA". 
007400     COPY "ERROR.DTA".
007600     COPY "ERRORP.DTA". 
007500     COPY "SCREEN.DTA". 
007600     COPY "STATUS.DTA". 
007700     COPY "PYTYPE.OPT". 
060889     COPY "PFPRINT.DTA".
070907     COPY "PAUSE.DTA".
007800
008300 77  PYHDF-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".
008400 77  PYLNF-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".
008700 77  CNTLF-STATUS        PIC XX.
008700 77  DEDCF-STATUS        PIC XX.
008700 77  DEDCF-KEY           PIC 9(6)  VALUE 1. 
008900 77  USERF-STATUS        PIC XX.
006600 01  GLTNF-STATUS        PIC XX.
006600 01  CHRTF-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".
006600 01  STATF-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".
101792 01  JCTNF-STATUS        PIC XX.                                  J550/A
101792 01  JCTNF-NAME          PIC X(5) VALUE "JCTNF".                  J550/A
101792 01  EXT-TRN-FILE        PIC X(14).                               J550
080399 01  EMPLF-STATUS        PIC XX     VALUE SPACES.
080399 77  APHDF-STATUS        PIC XX.
080399 77  APLNF-STATUS        PIC XX.
080399 77  VENDF-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".
080399 01  APHDF-NAME          PIC X(5) VALUE "APHDF".
080399 01  APLNF-NAME          PIC X(5) VALUE "APLNF".
080399 01  EXT-HDR-FILE        PIC X(14).
080399 01  EXT-LIN-FILE        PIC X(14).
080399 77  AP-AMT              PIC S9(7)V99    COMP-3 VALUE ZERO.
080399 01  TERMS-DESC.
080399     05  T-PCT       PIC Z9.999.
080399     05  T-DAY1      PIC /ZZ9B.
080399     05  T-TYPE      PIC X(11).
080399 01  DAY-TYPE.
080399     05  FILLER  PIC X(4)  VALUE "Net".
080399     05  T-DAY2  PIC ZZ9.
080399 01  MONTH-TYPE.
080399     05  FILLER  PIC X(8)  VALUE "EOM Net".
080399     05  T-DAY3  PIC ZZ9.
006000 01  LO-STATUS           PIC XX.
005600 01  LINE-NO             PIC 9(2).
005700 01  PAGE-NO             PIC 9(4).
110802*01  PAGE-SIZE           PIC 99     VALUE 60. 
110802 01  PAGE-SIZE           PIC 9(2)   VALUE 55.
005900 01  SKIP                PIC 9      VALUE 1.
006300 01  INDEX-OCCURS        PIC 9(1).
006400 01  INDEX-PERFORM       PIC 9(1) VALUE 1.
006500 01  ESC-FLAG            PIC 9    VALUE ZERO. 
007100 01  GLTNF-KEY           PIC 9(6) VALUE 0.
101792 01  COST-CD             PIC X VALUE "C".                         J550/A
101792 01  NEXT-SEQ            PIC 9(4) VALUE 0.                        J550/A
009100
007400 01  EMPTY-BATCH-FLAG    PIC X  VALUE "Y".
007500     88  EMPTY-BATCH     VALUE "Y". 
007400 01  BATCH-OK-FLAG       PIC X  VALUE "Y".
007500     88  BATCH-OK        VALUE "Y". 
006900 01  DISPLAY-MESSAGES.
007000     03 PRINTING-REPORT  PIC X(16) VALUE "Printing Report.".
007800 01  UPDATEING           PIC X(19) VALUE "Update in Progress.". 
007900 01  PERIOD-QUES     PIC X(37)
008000     VALUE "Enter G/L Period to post entries to: ". 
008100 01  PERIOD-SPEC    PIC X(14) VALUE "1157D02020E   ". 
008200 01  PERIOD-HELP. 
008300     05  FILLER PIC X(093)   VALUE " Enter the period of your fisc
008400-    "al year that you want to post the General Ledger   entries t
008500-    "o.$". 
008600
008700 01  BAD-PER-MSG         PIC X(31)
008800     VALUE " Invalid Period, please retry. ". 
008900 01  EMPTY-MSG-1     PIC X(63) VALUE "There are no transactions to
009000-    "update with.  ".
009100 01  EMPTY-MSG-2 PIC X(62) VALUE "Please correct and try again.". 
009300 01  EMPTY-HELP    PIC X(52) VALUE " Check to make sure that trans
009400-    "actions exist.$". 
011600 77  GL-MAX-PERIOD       PIC 99.
011600 01  GL-PERIOD           PIC 99.
012100 01  STATE-TABLE. 
012200     05  STATE           PIC X(5)     OCCURS 50 TIMES.
012300     05  STATE-TOT       PIC S9(7)V99 OCCURS 50 TIMES.
012400 01  NUM-STATES          PIC 9(3)     VALUE ZERO. 
012100 01  ACCT-TABLE.
122192     05  ACCT-NUM        PIC 9(7)     OCCURS 150 TIMES.
122192     05  ACCT-TOT        PIC S9(7)V99 OCCURS 150 TIMES.
012400 01  NUM-ACCTS           PIC 9(3)     VALUE ZERO. 
012600 77  FIRST-FLAG  PIC X. 
012700     88  FIRST-ITEM   VALUE "Y".
012800     88  NOT-FIRST    VALUE "N".
015300 01  OK-FLAG                 PIC X. 
015400     88  OK           VALUE "Y".
017000
017500 01  HELP1         PIC X VALUE "$". 
017600*    COPY "PY300.HLP".
017700
018300 77  J                PIC 99. 
018300 77  K1               PIC 99. 
007100
008000 01  SYSTEM-TIME. 
008100     03 SYSTEM-HOUR          PIC 99.
008200     03 SYSTEM-MINUTE        PIC 99.
008300     03 SYSTEM-SECONDS       PIC 99.
008400     03 FILLER               PIC 99.
008500
008600 01  PR-HEADER1.
070907*    03 PR-CNDSE         PIC X(4).
008800     03 FILLER           PIC X(7)   VALUE "DATE - ".
122698     03 PR-DATE-11       PIC X(11).
009000     03 FILLER           PIC X(10)  VALUE "   TIME - ". 
009100     03 PR-HOUR          PIC 99.
009200     03 FILLER           PIC X      VALUE ":".
009300     03 PR-MINUTE        PIC 99.
009400     03 FILLER           PIC X      VALUE ":".
009500     03 PR-SECONDS       PIC 99.
122698     03 FILLER           PIC X(08)  VALUE SPACES. 
009700     03 PR-CONAME        PIC X(40)  VALUE SPACES. 
009800     03 FILLER           PIC X(34)  VALUE SPACES. 
009900     03 FILLER           PIC X(5)   VALUE "PAGE ".
010000     03 PR-PAGE-NO       PIC ZZZ9.
010100 01  PR-HEADER1A. 
010200     03 FILLER           PIC X(41) VALUE SPACES.
010300     03 PR-TITLE         PIC X(50). 
010100 01  PR-HEADER1B. 
010200     03 FILLER           PIC X(57) VALUE SPACES.
010300     03 GL-POST-MSG      PIC X(18). 
010400*    COPY "PY300.RW". 
010500
010600*    PY300.RW                     SALES JOURNA
010700
010800 01  REPORT-TITLE PIC X(50) 
010900     VALUE "                 PAYROLL JOURNAL".
011400
011500 01  PR-HEADER2.
011600     03 FILLER            PIC X(11) VALUE "ACCOUNT    ".
011700     03 FILLER            PIC X(11) VALUE "           ".
011800     03 FILLER            PIC X(11) VALUE "           ".
011900     03 FILLER            PIC X(11) VALUE "           ".
012000     03 FILLER            PIC X(11) VALUE "           ".
012100     03 FILLER            PIC X(11) VALUE " DEBIT     ".
012200     03 FILLER            PIC X(11) VALUE "  CREDIT   ".
012300 01  PR-HEADER3.
012400     03 FILLER            PIC X(11) VALUE " NUMBER DES".
012500     03 FILLER            PIC X(11) VALUE "CRIPTION   ".
012600     03 FILLER            PIC X(11) VALUE "           ".
012700     03 FILLER            PIC X(11) VALUE "         DA".
012800     03 FILLER            PIC X(11) VALUE "TE         ".
012900     03 FILLER            PIC X(11) VALUE "AMOUNT     ".
013000     03 FILLER            PIC X(11) VALUE "  AMOUNT  P".
013100     03 FILLER            PIC X(11) VALUE "ERIOD  SOUR".
013200     03 FILLER            PIC X(11) VALUE "CE      REF".
013300     03 FILLER            PIC X(11) VALUE "ERENCE  DES".
013400     03 FILLER            PIC X(11) VALUE "CRIPTION   ".
013500     03 FILLER            PIC X(11) VALUE "           ".
092499 01  PR-HEADER4.
092499     03 FILLER            PIC X(14) VALUE "PERIOD ENDING ".
092499     03 PR-H4-PE-DATE-11  PIC X(11) VALUE SPACES.
013600
013700 01  PR-DETAIL1.
013800     03 PR-GLTN-ACCT-NO                       PIC ZZZ9999       . 
013900     03 FILLER            PIC X               VALUE SPACES. 
014000     03 PR-CHRT-NAME      PIC X(30)           VALUE SPACES. 
014100     03 FILLER            PIC X               VALUE SPACES. 
122698     03 PR-GLTN-DATE-11                       PIC X(11).
014300     03 FILLER            PIC X               VALUE SPACES. 
014400     03 PR-DEBIT-AMT                          PIC Z,ZZZ,ZZZ.ZZ-.
014500     03 PR-CREDIT-AMT                         PIC Z,ZZZ,ZZZ.ZZ-.
014600     03 FILLER            PIC X(3)            VALUE SPACES. 
014700     03 PR-GLTN-PERIOD                        PIC Z9. 
014800     03 FILLER            PIC X(4)            VALUE SPACES. 
014900     03 PR-GLTN-SOURCE                        PIC X(10)         . 
015000     03 FILLER            PIC X               VALUE SPACES. 
015100     03 PR-GLTN-REF                           PIC XX            . 
015200     03 FILLER            PIC X               VALUE SPACES. 
015300     03 PR-GLTN-REF-NO                        PIC 999/9999      . 
015400     03 FILLER            PIC X               VALUE SPACES. 
015500     03 PR-GLTN-DESC                          PIC X(25)         . 
015600
015700 01  PR-TOTALS. 
100699     03 FILLER            PIC X(51)           VALUE SPACES. 
015900     03 TS-DEBIT-AMT                          PIC Z,ZZZ,ZZZ.99-.
016000     03 TS-CREDIT-AMT                         PIC Z,ZZZ,ZZZ.99-.
016100
016200 01  TOTALS VALUE ZERO. 
016300     03 TOTAL-LINE OCCURS 1 TIMES.
016400        05 TOT-DEBIT-AMT                      PIC S9(9)V9(2). 
016500        05 TOT-CREDIT-AMT                     PIC S9(9)V9(2). 
016600
016700 01  WORK-AREAS.
016800     03 DEBIT-AMT            PIC S9(9)V99.
016900     03 CREDIT-AMT           PIC S9(9)V99.
016900 01  CASH-TOTAL              PIC S9(9)V99 COMP-3 VALUE 0. 
052694 01  CASH-TOTAL-NONTAX       PIC S9(9)V99 COMP-3 VALUE 0. 
052694 01  CASH-TOTAL-THIS-EMPL    PIC S9(9)V99 COMP-3 VALUE 0. 
016900 01  FIT-TOTAL               PIC S9(9)V99 COMP-3 VALUE 0. 
016900 01  FICA-TOTAL              PIC S9(9)V99 COMP-3 VALUE 0. 
010111 01  EMPLR-FICA-TOTAL        PIC S9(9)V99 COMP-3 VALUE ZERO.
112190 01  MEDICARE-TOTAL          PIC S9(9)V99 COMP-3 VALUE 0. 
016900 01  STATE-TOTAL             PIC S9(9)V99 COMP-3 VALUE 0. 
016900 01  LOCAL-TOTAL             PIC S9(9)V99 COMP-3 VALUE 0. 
016900 01  DISUEM-TOTAL            PIC S9(9)V99 COMP-3 VALUE 0. 
016900 01  EIC-TOTAL               PIC S9(9)V99 COMP-3 VALUE 0. 
010502*01  S106-TOTAL              PIC S9(9)V99 COMP-3 VALUE 0. 
010502*01  S106-AMT                PIC S9(9)V99 COMP-3 VALUE 0. 
016900 01  DED-TOTALS.
090892     05  DED-TOTAL           PIC S9(9)V99 COMP-3 OCCURS 20 TIMES.
071687 77  BAD-ACCT-MSG1 PIC X(69) VALUE "There is an invalid General Le
071687-    "dger Account in your Control File or in". 
071687 77  BAD-ACCT-MSG2 PIC X(25) VALUE "the Employee Master File.". 
071687 77  BAD-ACCT-MSG3 PIC X(69) VALUE "Run Control File or Employee F
071687-    "ile Update to correct the Account No.  ". 
       77  PRESS-ENTER   PIC X(23) VALUE "Press ENTER when ready.". 
       01  BAD-ACCT-HELP  PIC X(120) VALUE " After returning to the menu
071687-    ", run appropriate update to correct all invalid      account
      -    "s. Then run this option.$". 
041096 01  WS-CUSTOMIZED-FLAG     PIC 9(5) VALUE ZERO.
033106     88 SUNBELTO            VALUE 00342.
092499 01  WS-PER-END-DATE PIC 9(6) VALUE 0.
CLNUP1 77  CNTLF--NAME    PIC X(15) VALUE "CONTROL.FIL" .
CLNUP1 77  CNTLF-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  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   GLTNF--NAME    PIC X(15) VALUE "GLTRAN.FIL" .
CLNUP1 77   GLTNF-FULLPATH PIC X(35) VALUE SPACES .
CLNUP1 77   CHRTF--NAME    PIC X(15) VALUE "CHART.FIL" .
CLNUP1 77   CHRTF-FULLPATH PIC X(35) VALUE SPACES .
CLNUP1 77   APHDF--NAME    PIC X(15) VALUE "APHDR.FIL" .
CLNUP1 77   APHDF-FULLPATH PIC X(35) VALUE SPACES .
CLNUP1 77   APLNF--NAME    PIC X(15) VALUE "APLINE.FIL" .
CLNUP1 77   APLNF-FULLPATH PIC X(35) VALUE SPACES .
CLNUP1 77   VENDF--NAME    PIC X(15) VALUE "VENDOR.FIL" .
CLNUP1 77   VENDF-FULLPATH PIC X(35) VALUE SPACES .
CLNUP1 77   JCTNF--NAME    PIC X(15) VALUE "JCTRAN.FIL" .
CLNUP1 77   JCTNF-FULLPATH PIC X(35) VALUE SPACES .
CLNUP1 77   EMPLF--NAME    PIC X(15) VALUE "EMPLOYEE.FIL" .
CLNUP1 77   EMPLF-FULLPATH PIC X(35) VALUE SPACES .
CLNUP1 77   DEDCF--NAME    PIC X(15) VALUE "DEDCNTL.FIL" .
CLNUP1 77   DEDCF-FULLPATH PIC X(35) VALUE SPACES .
CLNUP1 77   PYHDF--NAME    PIC X(15) VALUE "PYBATHDR.FIL" .
CLNUP1 77   PYHDF-FULLPATH PIC X(35) VALUE SPACES .
CLNUP1 77   STATF--NAME    PIC X(15) VALUE "STATE.FIL" .
CLNUP1 77   STATF-FULLPATH PIC X(35) VALUE SPACES .
CLNUP1 77   PYLNF--NAME    PIC X(15) VALUE "PYBATLIN.FIL" .
CLNUP1 77   PYLNF-FULLPATH PIC X(35) VALUE SPACES .
061301 77  ASCII-STATUS        PIC XX    VALUE SPACES.
       01  ASCII--NAME         PIC X(15)  VALUE "PYCHKREC.TXT"
       01  ASCII-FILENAME PIC X(15) REDEFINES ASCII--NAME.
       77  ASCII-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.
       01 DSPL--CONTROL  PIC X(100) IS EXTERNAL.

      */
       SCREEN SECTION.
CLNUP1     COPY "CONSTANT.SCR".
CLNUP1     COPY "SCRNINIT.SCR".
CLNUP1     COPY "ERRORFIL.SCR".
CLNUP1     COPY "PRINT.SCR".   
CLNUP1     COPY "WAIT.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-wait-sr-4-21 VALUE IS "Press         to Continue!" CONTROL
CLNUP1*      DSPL--CONTROL LINE 19 COLUMN 27.
CLNUP1*01 SCR-wait-sr-7-21 PIC IS X(78) FROM CLEAR-19 CONTROL 
CLNUP1*     DSPL--CONTROL LINE 19 COLUMN 2.
       01 SCR-py300-cbl-362-20 PIC IS X(16) FROM PRINTING-REPORT CONTROL
             DSPL--CONTROL LINE 13 COLUMN 32.
       01 SCR-py300-cbl-393-20 PIC IS X(37) FROM PERIOD-QUES CONTROL 
            DSPL--CONTROL LINE 11 COLUMN 20.
       01 SCR-py300-cbl-401-24 PIC IS X(31) FROM BAD-PER-MSG CONTROL 
            DSPL--CONTROL LINE 21 COLUMN 1 REVERSE-VIDEO.
       01 SCR-py300-cbl-404-23 VALUE IS "Are you sure?" CONTROL 
            DSPL--CONTROL LINE 17 COLUMN 20.
       01 SCR-py300-cbl-418-20 PIC IS X(63) FROM EMPTY-MSG-1 CONTROL 
            DSPL--CONTROL LINE 11 COLUMN 8.
       01 SCR-py300-cbl-419-20 PIC IS X(62) FROM EMPTY-MSG-2 CONTROL 
            DSPL--CONTROL LINE 12 COLUMN 8.
       01 SCR-py300-cbl-430-20 PIC IS X(69) FROM BAD-ACCT-MSG1 CONTROL 
            DSPL--CONTROL LINE 12 COLUMN 10.
       01 SCR-py300-cbl-431-20 PIC IS X(25) FROM BAD-ACCT-MSG2 CONTROL 
            DSPL--CONTROL LINE 13 COLUMN 10.
       01 SCR-py300-cbl-432-20 PIC IS X(69) FROM BAD-ACCT-MSG3 CONTROL 
            DSPL--CONTROL LINE 14 COLUMN 10.
       01 SCR-py300-cbl-433-20 PIC IS X(23) FROM PRESS-ENTER CONTROL 
            DSPL--CONTROL LINE 16 COLUMN 25.
       01 SCR-py300-cbl-782-12 VALUE IS "You must take the option 'Calcu
      -     "late Withholding Taxes'" CONTROL DSPL--CONTROL LINE 6 
            COLUMN 13.
       01 SCR-py300-cbl-785-12 VALUE IS "before this option will run." 
            CONTROL DSPL--CONTROL LINE 7 COLUMN 26.
       01 SCR-py300-cbl-788-12 VALUE IS "Press ENTER to exit this progra
      -     "m." CONTROL DSPL--CONTROL LINE 8 COLUMN 23.
019900
020000 PROCEDURE DIVISION.
020100 DECLARATIVES.
017600
017700 Z-PRNTR SECTION. 
017800     USE AFTER ERROR PROCEDURE ON LO. 
017900 Z-PRNTR-D. 
018000     COPY "ERRORPRT.SR".
018100     GO TO STATUS-EXIT. 
020200     COPY "CNTLF.DS". 
020200     COPY "DEDCF.DS". 
020400     COPY "USERF.DS". 
020700     COPY "PYHDF.DS". 
020800     COPY "PYLNF.DS". 
015500     COPY "GLTNF.DS". 
015500     COPY "CHRTF.DS". 
015500     COPY "STATF.DS". 
101792     COPY "JCTNF.DS".                                             J550/A
080399     COPY "EMPLF.DS".
080399     COPY "APHDF.DS". 
080399     COPY "APLNF.DS". 
080399     COPY "VENDF.DS". 
033106     COPY "ASCII.DS".
021900
022000     GO TO STATUS-EXIT. 
022100
022200     COPY "ERRORFIL.SR".
022300 STATUS-EXIT. EXIT. 
022400 END DECLARATIVES.
022500
022600 MAIN-PROG SECTION. 
022700 OPEN-FILES.
            PERFORM USERF-FILL-FULLPATH.
022800     PERFORM PGM-INIT.
033106     IF USER-SN = 00342
041096        MOVE USER-SN TO WS-CUSTOMIZED-FLAG.
041096     IF WS-CUSTOMIZED-FLAG > ZERO
041096        MOVE "PY300M" TO PROG-NAME.
033093     IF NOT PAYROLL-READY-TO-POST
033093         PERFORM NOT-READY-MSG
033093         GO TO EXIT-RUN.
022900     PERFORM OPEN-PYHDF.
023000     PERFORM OPEN-PYLNF.
048100     PERFORM OPEN-DEDCF.
070599     PERFORM READ-DEDCF.
101792     IF JC-YES                                                    J550/A
101792          PERFORM  OPEN-JCTNF.                                    J550/A
080399     PERFORM OPEN-EMPLF.
080399     PERFORM OPEN-APHDF.
080399     PERFORM OPEN-APLNF.
080399     PERFORM OPEN-VENDF.
033106     IF SUNBELTO
033106        PERFORM OPEN-ASCII.
018400     PERFORM SCREEN-INIT. 
023500 BEGIN-REPORT.
018100     IF GL-ACTIVE-PY
018200         PERFORM GET-GL-PERIOD
018300         IF FLAG = 4 GO TO EXIT-RUN.
041096     MOVE "1010000000" TO FKEYS.
060889     PERFORM PRINT-SELECT.
060889     IF FLAG = 3 GO TO BEGIN-REPORT.
060889     PERFORM PF-OPEN-LO.
018400     PERFORM SCREEN-INIT. 
020500     DISPLAY SCR-py300-cbl-362-20  . 
020300     MOVE 99 TO LINE-NO.
020400     MOVE 0 TO PAGE-NO. 
020600     IF ESC-FLAG = 1 MOVE "0010000000" TO FKEYS 
020700                ELSE MOVE "0000000000" TO FKEYS.
020800     MOVE 1 TO FLAG.
020900     CALL "KBDCHK" USING FLAG, FKEYS. 
021000     MOVE 0 TO FLAG.
021100     PERFORM PROCESS-REPORT.
021500
024700 END-REPORT.
024800     PERFORM CLOSE-FILES. 
019200     IF EMPTY-BATCH 
019300         PERFORM EMPTY-BATCH-SCREEN 
019300         GO TO EXIT-RUN.
056400     PERFORM WRITE-GL-ENTRIES.
021200     MOVE SPACES TO PRINT-REC.
070907     PERFORM PF-REC-CHECK.
021300     WRITE PFRPT BEFORE ADVANCING PAGE. 
010709     PERFORM CLOSE-LO.
019200     IF BATCH-OK
101792          IF NEXT-SEQ > 0                                         J550/A
101792               MOVE "JC080" TO NEXT-PROG                          J550/A
092499               MOVE WS-PER-END-DATE TO USER-POS-ORDER
092499               REWRITE USERF-REC
101792          ELSE  MOVE "PY310" TO NEXT-PROG
025100     ELSE PERFORM BAD-ACCT. 
024900 EXIT-RUN.
025200     COPY "FINISH.SR".
025300
024700 GET-GL-PERIOD SECTION. 
024800 GET-GL-PERIOD-START. 
024900     PERFORM SCREEN-INIT. 
025000     DISPLAY SCR-py300-cbl-393-20  . 
025300 ACCEPT-PERIOD. 
025400     MOVE "1001000000" TO FKEYS.
025500     MOVE 0 TO FLAG.
033106*    PERFORM STEST-py300-cbl-397
025600     CALL "SCRN01" USING FLAG, FKEYS, PERIOD-SPEC, PERIOD-HELP, 
025700         GL-PERIOD.
033106*    PERFORM STEST-AFTER-CALL. 
025800     IF FLAG = 4 GO TO GET-GL-PERIOD-EXIT.
025900     IF GL-PERIOD < 1 OR GL-PERIOD > GL-MAX-PERIOD
026000         DISPLAY SCR-py300-cbl-401-24    
026100         GO TO ACCEPT-PERIOD. 
070896     IF USER-SN = 00138
070896        DISPLAY SCR-py300-cbl-404-23  
070896        MOVE 0 TO FLAG
070896        MOVE "0001000000" TO FKEYS
070896        MOVE "1734O02032E   " TO YES-NO-SPEC
033106*       PERFORM STEST-py300-cbl-408
070896        CALL "SCRN01" USING FLAG, FKEYS, YES-NO-SPEC,
                    BAD-ACCT-HELP, YES-NO.
033106*       PERFORM STEST-AFTER-CALL
070896        IF FLAG NOT = 4
070896           IF OPTION OF YES-NO-SPEC = 2
070896              GO TO ACCEPT-PERIOD.
026200 GET-GL-PERIOD-EXIT. EXIT.
026300
026400 EMPTY-BATCH-SCREEN SECTION.
026500 EMPTY-BATCH-SCREEN-START.
026600     PERFORM SCREEN-INIT. 
026700     
            DISPLAY SCR-py300-cbl-418-20
            DISPLAY SCR-py300-cbl-419-20.
026900     MOVE "1001000000" TO FKEYS.
027000     MOVE 0 TO FLAG.
027100     MOVE "1272O02031IE" TO YES-NO-SPEC.
033106*    PERFORM STEST-py300-cbl-423
027200     CALL "SCRN01" USING FLAG, FKEYS, YES-NO-SPEC, EMPTY-HELP,
027300         YES-NO.
033106*    PERFORM STEST-AFTER-CALL.
027400 EMPTY-BATCH-SCREEN-EXIT. EXIT. 
045500
       BAD-ACCT SECTION.
       BAD-ACCT-START.
           PERFORM SCREEN-INIT. 
           
            DISPLAY SCR-py300-cbl-430-20
            DISPLAY SCR-py300-cbl-431-20
            DISPLAY SCR-py300-cbl-432-20
            DISPLAY SCR-py300-cbl-433-20. 
           MOVE "1001000000" TO FKEYS.
           MOVE 0 TO FLAG.
071687     MOVE "1672O02031IE" TO YES-NO-SPEC.
033106*    PERFORM STEST-py300-cbl-437
           CALL "SCRN01" USING FLAG, FKEYS, YES-NO-SPEC,
             BAD-ACCT-HELP, YES-NO.
033106*    PERFORM STEST-AFTER-CALL. 
           MOVE 4 TO FLAG.
  
       BAD-ACCT-EXIT. 
  
045500 PROCESS-REPORT SECTION.
045600 PROCESS-REPORT-BEGIN.
045700     PERFORM START-PYHDF. 
045800     IF NOT C-AT-END OF PYHDF-STATUS 
045900         PERFORM  READ-PYHDF-NEXT.
046000
046100 PROCESS-REPORT-NEXT. 
046200     IF C-AT-END OF PYHDF-STATUS 
046300         GO TO PROCESS-REPORT-EXIT. 
007400     MOVE "N" TO EMPTY-BATCH-FLAG.
046600     PERFORM PROCESS-PY-TRAN. 
046700 PROCESS-REPORT-READ. 
046800     IF ESC-FLAG = 1
046900         CALL "KBDCHK" USING FLAG, FKEYS
060889         IF FLAG = 3 
060889            PERFORM ACCEPT-PAUSE 
060889            IF OPTION OF PAUSE-SPEC(1) = 1 
060889               MOVE 3 TO FLAG 
060889               GO TO PROCESS-REPORT-EXIT.
047100     PERFORM  READ-PYHDF-NEXT.
047200     GO TO PROCESS-REPORT-NEXT. 
047300
047400 PROCESS-REPORT-EXIT. EXIT. 
047400
045500 PROCESS-BATCH SECTION. 
047700 PROCESS-PY-TRAN. 
048400     ADD PYHD-NET-PAY TO CASH-TOTAL.
048400     ADD PYHD-TAX(1) TO FIT-TOTAL.
048400     ADD PYHD-TAX(2) TO FICA-TOTAL. 
112190     ADD PYHD-TAX(3) TO MEDICARE-TOTAL. 
048400     ADD PYHD-EIC-AMT TO EIC-TOTAL. 
038000     PERFORM SEARCH-STATES
112190       VARYING I FROM 4 BY 1 UNTIL I > 6
048400     PERFORM ADD-DED-TOTALS 
090892       VARYING I FROM 1 BY 1 UNTIL I > 20. 
080399     MOVE PYHD-EMPL-NO TO PYLN-EMPL-NO, EMPLF-KEY.,
080399     PERFORM READ-EMPLF.
041306     IF SUNBELTO
041306        PERFORM SUNBELTO-ASCII.
048500     MOVE PYHD-CHECK-CD TO PYLN-CHECK-CD. 
048600     MOVE 0 TO PYLN-SEQ-NO. 
048700     PERFORM START-PYLNF-GREATER. 
048800     IF NOT C-AT-END OF PYLNF-STATUS 
048900         PERFORM READ-PYLNF-NEXT. 
049000     PERFORM PROCESS-DETAIL 
049100         UNTIL C-AT-END OF PYLNF-STATUS. 
049400
038000 SEARCH-STATES. 
112190     COMPUTE J = I - 3. 
038000     PERFORM SEARCH-STATES-LOOP 
038100       VARYING K1 FROM 1 BY 1
038200         UNTIL K1 > NUM-STATES OR STATE(K1) = PYHD-TAX-CODE(J). 
038300     IF K1 > NUM-STATES
038400         ADD 1 TO NUM-STATES
038500         MOVE NUM-STATES TO K1 
038600         MOVE PYHD-TAX-CODE(J) TO STATE(K1)
038700         MOVE 0 TO STATE-TOT(K1).
038800     ADD PYHD-TAX(I) TO STATE-TOT(K1). 
049400
049400 SEARCH-STATES-LOOP. EXIT.
049400
048400 ADD-DED-TOTALS.
080399     IF DEDC-METHOD-CD(I) < 9
048400        ADD PYHD-DED(I) TO DED-TOTAL(I). 
048400
060300 PROCESS-DETAIL.
038000     PERFORM SEARCH-ACCTS 
038100         VARYING I FROM 1 BY 1
038200             UNTIL I > NUM-ACCTS OR ACCT-NUM(I) = PYLN-ACCT-NO. 
038300     IF I > NUM-ACCTS 
038400         ADD 1 TO NUM-ACCTS 
038500         MOVE NUM-ACCTS TO I
038600         MOVE PYLN-ACCT-NO TO ACCT-NUM(I) 
038700         MOVE 0 TO ACCT-TOT(I). 
033106*    IF QUEST
033106*        IF CASH-TOTAL-THIS-EMPL > 0
033106*          IF PYLN-AMT > CASH-TOTAL-THIS-EMPL
033106*            COMPUTE PYLN-AMT = PYLN-AMT - CASH-TOTAL-THIS-EMPL
033106*            MOVE 0 TO CASH-TOTAL-THIS-EMPL.
038800     ADD PYLN-AMT TO ACCT-TOT(I). 
101792     IF JC-YES                                                    J550/A
101792          IF PYLN-JOBNO NOT = SPACES                              J550/A
101792               PERFORM JOB-INTERFACE.                             J550/A
061700     PERFORM READ-PYLNF-NEXT. 
038900
039000 SEARCH-ACCTS. EXIT.
056300
056400 WRITE-GL-ENTRIES SECTION.
056500 WRITE-GL-ENTRIES-START.
           CLOSE CNTLF. 
056600     OPEN I-O CNTLF.
056700     PERFORM WITH TEST AFTER UNTIL RECORD-LOCK NOT EQUAL 
CLNUP1      CNTLF-STATUS OR IO-WAIT-OFF 
           READ CNTLF
           END-READ END-PERFORM.
056800     IF CNTL-PY-REF = 999 
056900         MOVE 1 TO CNTL-PY-REF
057000     ELSE ADD 1 TO CNTL-PY-REF. 
057100     REWRITE CNTLF-REC. 
056700     PERFORM WITH TEST AFTER UNTIL RECORD-LOCK NOT EQUAL 
CLNUP1      CNTLF-STATUS OR IO-WAIT-OFF 
           READ CNTLF NO LOCK
           END-READ END-PERFORM.
063900     IF GL-ACTIVE-PY
057400         PERFORM OPEN-GLTNF 
057400         PERFORM OPEN-CHRTF.
057400     PERFORM OPEN-STATF.
057500     MOVE "PAYROLL" TO GLTN-SOURCE. 
057600     MOVE "PY" TO GLTN-REF. 
057700     MOVE TODAYS-DATE TO GLTN-DATE. 
057800     MOVE 2 TO GLTN-ADJ-CD. 
057900     MOVE GL-PERIOD TO GLTN-PERIOD. 
058000     COMPUTE GLTN-REF-NO = CNTL-PY-REF * 10000. 
062300* EXPENSE ENTRIES 
062400     MOVE "PAYROLL EXPENSE" TO GLTN-DESC. 
062500     PERFORM WRITE-EXPENSE-ENTRIES
062600         VARYING I FROM 1 BY 1 UNTIL I > NUM-ACCTS. 
033106*    IF QUEST
033106*        PERFORM WRITE-JDAF-ENTRIES. 
058100* CASH ENTRY
058200     IF CASH-TOTAL NOT = 0
058300         MOVE "PAYROLL CHECKS" TO GLTN-DESC 
058400         MOVE CNTL-GL-ACCT(19) TO GLTN-ACCT-NO
058500         COMPUTE GLTN-AMT = CASH-TOTAL * -1 
058600         PERFORM WRITE-GL-ENTRY.
058700* FIT WITHHELD ENTRY
058800     IF FIT-TOTAL NOT = 0 
058900         MOVE "FIT TAXES" TO GLTN-DESC
059000         MOVE CNTL-GL-ACCT(15) TO GLTN-ACCT-NO
059100         COMPUTE GLTN-AMT = FIT-TOTAL * -1
059200         PERFORM WRITE-GL-ENTRY
080399         MOVE "PYTAXES" TO VENDF-KEY
080399         MOVE FIT-TOTAL TO AP-AMT
080399         PERFORM PROCESS-AP-ENTRY.
058700* FICA WITHHELD ENTRY 
058800     IF FICA-TOTAL NOT = 0
058900         MOVE "FICA WITHHELD" TO GLTN-DESC
059000         MOVE CNTL-GL-ACCT(16) TO GLTN-ACCT-NO
059100         COMPUTE GLTN-AMT = FICA-TOTAL * -1 
059200         PERFORM WRITE-GL-ENTRY
080399         MOVE "PYTAXES" TO VENDF-KEY
080399         MOVE FICA-TOTAL TO AP-AMT
080399         PERFORM PROCESS-AP-ENTRY.
112190* MEDICARE WITHHELD ENTRY 
112190     IF MEDICARE-TOTAL NOT = 0
112190         MOVE "MEDICARE WHLD" TO GLTN-DESC
112190         MOVE CNTL-GL-ACCT(16) TO GLTN-ACCT-NO
112190         COMPUTE GLTN-AMT = MEDICARE-TOTAL * -1 
112190         PERFORM WRITE-GL-ENTRY
080399         MOVE "PYTAXES" TO VENDF-KEY
080399         MOVE MEDICARE-TOTAL TO AP-AMT
080399         PERFORM PROCESS-AP-ENTRY.
062300* STATE TAX ENTRIES 
062500     PERFORM WRITE-STATE-ENTRIES
062600         VARYING I FROM 1 BY 1 UNTIL I > NUM-STATES.
062300* DEDUCTION ENTRIES 
062500     PERFORM WRITE-DED-ENTRIES
090892       VARYING I FROM 1 BY 1 UNTIL I > 20. 
058700* EMPLOYER FICA ENTRIES 
058800     IF FICA-TOTAL NOT = 0
010111         PERFORM COMPUTE-EMPLOYER-FICA
058900         MOVE "FICA EXPENSE"      TO GLTN-DESC 
059000         MOVE CNTL-GL-ACCT(17)    TO GLTN-ACCT-NO
010111*         MOVE FICA-TOTAL          TO GLTN-AMT
010111         MOVE EMPLR-FICA-TOTAL    TO GLTN-AMT
059200         PERFORM WRITE-GL-ENTRY 
058900         MOVE "EMPLOYER FICA W/H" TO GLTN-DESC
059000         MOVE CNTL-GL-ACCT(18)    TO GLTN-ACCT-NO
010111*         COMPUTE GLTN-AMT = FICA-TOTAL * -1 
010111         COMPUTE GLTN-AMT = EMPLR-FICA-TOTAL * -1 
059200         PERFORM WRITE-GL-ENTRY
080399         MOVE "PYTAXES"           TO VENDF-KEY
010111*         MOVE FICA-TOTAL          TO AP-AMT
010111         MOVE EMPLR-FICA-TOTAL    TO AP-AMT
080399         PERFORM PROCESS-AP-ENTRY.
112190* EMPLOYER MEDICARE ENTRIES 
112190     IF MEDICARE-TOTAL NOT = 0
112190         MOVE "MEDICARE EXP" TO GLTN-DESC 
112190         MOVE CNTL-GL-ACCT(17) TO GLTN-ACCT-NO
112190         MOVE MEDICARE-TOTAL TO GLTN-AMT
112190         PERFORM WRITE-GL-ENTRY 
112190         MOVE "EMPLOYER MEDI W/H" TO GLTN-DESC
112190         MOVE CNTL-GL-ACCT(18) TO GLTN-ACCT-NO
112190         COMPUTE GLTN-AMT = MEDICARE-TOTAL * -1 
112190         PERFORM WRITE-GL-ENTRY
080399         MOVE "PYTAXES" TO VENDF-KEY
080399         MOVE MEDICARE-TOTAL TO AP-AMT
080399         PERFORM PROCESS-AP-ENTRY.
058700* ADVANCE EIC ENTRY 
058800     IF EIC-TOTAL NOT = 0 
058900         MOVE "ADVANCE EIC PAYMENT" TO GLTN-DESC
121791         MOVE CNTL-GL-ACCT(15) TO GLTN-ACCT-NO
059100         MOVE EIC-TOTAL TO GLTN-AMT 
059200         PERFORM WRITE-GL-ENTRY.

062700
031500     PERFORM MOVE-TOTALS. 
063900     IF GL-ACTIVE-PY
062800         PERFORM CLOSE-GLTNF
062800         PERFORM CLOSE-CHRTF. 
062800     PERFORM CLOSE-STATF. 
062900     GO TO WRITE-GL-ENTRIES-EXIT. 
063000
063100 WRITE-EXPENSE-ENTRIES. 
063200     IF ACCT-TOT(I) NOT = 0 
063300         MOVE ACCT-NUM(I) TO GLTN-ACCT-NO 
063400         MOVE ACCT-TOT(I) TO GLTN-AMT 
063500         PERFORM WRITE-GL-ENTRY.
063600
033106*WRITE-JDAF-ENTRIES. 
033106*    IF QUEST
033106*      IF CASH-TOTAL-NONTAX NOT = 0
033106*        MOVE "PAYROLL EXPENSE" TO GLTN-DESC 
033106*        MOVE 3350000 TO GLTN-ACCT-NO
033106*        COMPUTE GLTN-AMT = CASH-TOTAL-NONTAX * 1 
033106*        PERFORM WRITE-GL-ENTRY.
052694
063100 WRITE-STATE-ENTRIES. 
063200     IF STATE-TOT(I) NOT = 0
063300         MOVE STATE(I) TO STAT-CODE 
063300         PERFORM READ-STATF 
CLNUP1         IF C-RECORD-OK OF STATF-STATUS
063300             MOVE STAT-WH-TAX-ACCT TO GLTN-ACCT-NO
080499             MOVE STAT-VENDOR-NO TO VENDF-KEY
080499             MOVE STATE-TOT(I)   TO AP-AMT
080499             MOVE "WITHHOLDING TAXES" TO GLTN-DESC
080499             PERFORM PROCESS-AP-ENTRY
080499             MOVE SPACES TO STATF-KEY
063300         ELSE MOVE 0 TO GLTN-ACCT-NO. 
063200     IF STATE-TOT(I) NOT = 0
059100         MOVE STAT-NAME TO GLTN-DESC
059100         COMPUTE GLTN-AMT = STATE-TOT(I) * -1 
063500         PERFORM WRITE-GL-ENTRY.
062500
062500 WRITE-DED-ENTRIES. 
063200     IF DED-TOTAL(I) NOT = 0
063300         MOVE DEDC-NAME(I) TO GLTN-DESC 
063300         MOVE DEDC-ACCT(I) TO GLTN-ACCT-NO
063400         COMPUTE GLTN-AMT = DED-TOTAL(I) * -1 
063500         PERFORM WRITE-GL-ENTRY.
063600
063700 WRITE-GL-ENTRY.
063800     ADD 1 TO GLTN-REF-NO, GLTNF-KEY. 
063900     PERFORM MOVE-DETAIL. 
063900     IF GL-ACTIVE-PY
063900         PERFORM WRITE-GLTNF. 
064000
064100 WRITE-GL-ENTRIES-EXIT. EXIT. 
028200
044800     COPY "CONTROL.SR". 
044800     COPY "DATECVT.SR". 
080399     COPY "DATECHK.SR".
044900
101792 JOB-INTERFACE SECTION.                                           J550/A
101792 JOB-NEXT.                                                        J550/A
101792     ADD 1                TO NEXT-SEQ.                            J550/A
101792     MOVE NEXT-SEQ        TO JCTN-SEQNO.                          J550/A
101792     MOVE "C"             TO JCTN-REC-TYPE.                       J550/A
101792     MOVE PYLN-JOBNO      TO JCTN-JOBNO.                          J550/A
101792     MOVE PYLN-STAGENO    TO JCTN-STAGENO.                        J550/A
101792     MOVE PYLN-ACT-CD     TO JCTN-ACT-CD.                         J550/A
101792     MOVE "L"             TO JCTN-ACT-TYPE.                       J550/A
101792     MOVE ZEROES          TO JCTN-GL-CREDIT-AC.                   J550/A
032894     MOVE ZEROES          TO JCTN-GL-DEBIT-AC.                    J550/A
032894     MOVE ZEROES          TO JCTN-GL-PERIOD.                      J550/A
101792     MOVE PYLN-AMT        TO JCTN-AMOUNT.                         J550/A
101893     MOVE PYLN-HR         TO JCTN-QUANTITY.
061594     MOVE PYLN-EMPL-NO    TO JCTN-EMPL-NO.
121601     MOVE ZERO TO JCTN-PMW-AMT.
           MOVE SPACES TO JCTN-DESC.
101893     STRING "PY/" DELIMITED BY SIZE,
072999            PYLN-EMPL-NO DELIMITED BY " ",
072999            PYHD-LAST-NAME DELIMITED BY SIZE
101792            INTO JCTN-DESC.
101792     MOVE TODAYS-DATE     TO JCTN-DATE.                           J550/A
101792     PERFORM WRITE-JCTNF.                                         J550/A
101792                                                                  J550/A
101792 JOB-INTERFACE-EXIT.  EXIT.                                       J550/A
045000 SUBROUTINE SECTION.
045100
045200 PGM-INIT.
045300     PERFORM CONTROL-INIT.
122698     MOVE PGM-DATE-11 TO PR-DATE-11.
023000     ACCEPT SYSTEM-TIME FROM TIME.
023100     MOVE SYSTEM-HOUR TO PR-HOUR. 
023200     MOVE SYSTEM-MINUTE TO PR-MINUTE. 
023300     MOVE SYSTEM-SECONDS TO PR-SECONDS. 
023400     MOVE CNTL-CONAME TO PR-CONAME. 
023800     MOVE REPORT-TITLE TO PR-TITLE. 
024600*    0 = NO ESCAPE, 1 = ESCAPABLE 
024700     MOVE 1 TO ESC-FLAG.
023400     IF GL-ACTIVE-PY
023400         MOVE  "  POSTED TO G/L" TO GL-POST-MSG 
023400     ELSE MOVE "NOT POSTED TO G/L" TO GL-POST-MSG.
           IF 12-PERIODS
               MOVE 12 TO GL-MAX-PERIOD 
           ELSE MOVE 13 TO GL-MAX-PERIOD. 
071296     MOVE A-YEAR   TO I-YEAR.
071296     MOVE A-MONTH  TO I-MONTH.
071296     MOVE A-DAY    TO I-DAY.
           IF I-MONTH > CNTL-FISCAL-END 
               COMPUTE GL-PERIOD = I-MONTH - CNTL-FISCAL-END
           ELSE COMPUTE GL-PERIOD = 
               GL-MAX-PERIOD - CNTL-FISCAL-END + I-MONTH. 
           MOVE 0 TO DED-TOTAL(1), DED-TOTAL(2), DED-TOTAL(3),
             DED-TOTAL(4), DED-TOTAL(5), DED-TOTAL(6),
             DED-TOTAL(7), DED-TOTAL(8), DED-TOTAL(9), DED-TOTAL(10).
090892     MOVE 0 TO DED-TOTAL(11), DED-TOTAL(12), DED-TOTAL(13),
             DED-TOTAL(14), DED-TOTAL(15), DED-TOTAL(16),
             DED-TOTAL(17), DED-TOTAL(18), DED-TOTAL(19), DED-TOTAL(20).

101792     MOVE "JCAPTRAN.FIL" TO EXT-TRN-FILE.
101792     MOVE EXT-TRN-FILE   TO JCTNF--NAME.
           PERFORM JCTNF-FILL-FULLPATH.

080399     MOVE "APBATHDR.FIL" TO EXT-HDR-FILE.
080399     MOVE EXT-HDR-FILE   TO APHDF--NAME

           PERFORM APHDF-FILL-FULLPATH.
080399     MOVE "APBATLIN.FIL" TO EXT-LIN-FILE.

080399     MOVE EXT-LIN-FILE   TO APLNF--NAME
           PERFORM APLNF-FILL-FULLPATH.

080399     MOVE SPACES TO STATF-KEY. 
047300
PROFIT     COPY "SCRNINIT.SR".
051503     COPY "WAIT.SR".
053100
033093 NOT-READY-MSG.
033093     PERFORM SCREEN-INIT.
033093     DISPLAY
033093     SCR-py300-cbl-782-12
033093      
033093     DISPLAY
033093     SCR-py300-cbl-785-12
033093      
033093     DISPLAY
033093     SCR-py300-cbl-788-12
033093      .
033093     MOVE "0001000000" TO FKEYS.
           MOVE 0 TO FLAG.
071687     MOVE "1672O02031IE" TO YES-NO-SPEC.
033106*    PERFORM STEST-py300-cbl-793
           CALL "SCRN01" USING FLAG, FKEYS, YES-NO-SPEC,
             BAD-ACCT-HELP, YES-NO
033106*    PERFORM STEST-AFTER-CALL. 

080399 PROCESS-AP-ENTRY.
080399     PERFORM READ-VENDF
           IF C-FOUND OF VENDF-STATUS
080399        PERFORM FIND-APHD
080399        ADD AP-AMT TO APHD-GROSS-AMT
              PERFORM WRITE-APHDF
              PERFORM INIT-APLN
080399        MOVE GLTN-DESC TO APLN-DESC
              MOVE APHD-VEND-NO TO APLN-VEND-NO
              MOVE APHD-INV-NO  TO APLN-INV-NO
              MOVE GLTN-ACCT-NO TO APLN-EXP-ACCT
              MOVE AP-AMT       TO APLN-AMT
              ADD 128 TO APLN-SEQ-NO
              PERFORM WRITE-APLNF.

080399 FIND-APHD.
           MOVE VENDF-KEY          TO APHD-VEND-NO.
03699      MOVE PYHD-PERIOD-ENDING TO DATE-IN.
032699     PERFORM DATE-CONVERT THRU DATE-CONVERT-EXIT.
032699     STRING O-YEAR-4          DELIMITED BY SIZE,
                  I-MONTH           DELIMITED BY SIZE,
                  I-DAY             DELIMITED BY SIZE,
                  INTO APHD-INV-NO.
032398     PERFORM READ-APHDF.
032398     IF APHDF-STATUS = NOT-FOUND
032398        PERFORM INIT-APHD.

080399 INIT-APHD.
057100     MOVE VEND-NAME TO APHD-VEND-NAME.
057200     MOVE VEND-ADDR1 TO APHD-VEND-ADDR1.
057300     MOVE VEND-ADDR2 TO APHD-VEND-ADDR2.
057400     MOVE VEND-CITY TO APHD-VEND-CITY.
057500     MOVE VEND-STATE TO APHD-VEND-STATE.
057600     MOVE VEND-ZIP TO APHD-VEND-ZIP.
057700     MOVE VEND-DISC-DAYS TO APHD-DISC-DAYS, T-DAY1.
057800     MOVE VEND-DISC-PCT TO APHD-DISC-PCT, T-PCT.
057900     MOVE VEND-DUE-CD TO APHD-DUE-CD.
058000     MOVE VEND-DISC-CD TO APHD-DISC-CD.
058100     MOVE VEND-DUE-DAYS TO APHD-DUE-DAYS.
058200     IF VEND-DISC-CD = 1
058300         MOVE VEND-DUE-DAYS TO T-DAY2
058400         MOVE DAY-TYPE TO T-TYPE
058500     ELSE MOVE VEND-DUE-DAYS TO T-DAY3
058600         MOVE MONTH-TYPE TO T-TYPE.
058700     IF VEND-DISC-DAYS = 0 AND VEND-DISC-PCT = 0
058800         MOVE SPACES TO TERMS-DESC
058900         IF VEND-DUE-DAYS NOT = 0
059000             IF VEND-DISC-CD = 1
059100                 MOVE DAY-TYPE TO TERMS-DESC
059200             ELSE MOVE MONTH-TYPE TO TERMS-DESC.
059300     MOVE TERMS-DESC TO APHD-TERMS-DESC.
059400     MOVE 0 TO APHD-CHKNO, APHD-CHK-DATE,
059500       APHD-PO-NO, APHD-DUE-DATE, APHD-DISC-DATE,
059600       APHD-GROSS-AMT, APHD-DISC-AMT, APHD-PAID-AMT,
059700       APHD-PAID-DISC, APHD-AMT-PAY, APHD-DISC-PAY.
059800     MOVE 1 TO APHD-HALT-CD, APHD-TYPE-CD, APHD-PMT-CD.
059900     MOVE CNTL-GL-ACCT(1) TO APHD-CASH-ACCT.
060000     MOVE CNTL-GL-ACCT(11) TO APHD-AP-ACCT.
112696
032098     MOVE TODAYS-DATE TO APHD-INV-DATE.
080399     MOVE PYHD-PERIOD-ENDING TO DATE-IN.
080399     PERFORM CVT-TO-JULIAN THRU CVT-TO-JULIAN-EXIT.
080499     IF STATF-KEY = SPACES
080499        ADD 3 TO JULIAN-DAYS
080499     ELSE
081399        MOVE 15   TO I-DAY
              ADD 1 TO I-MONTH
              IF I-MONTH > 12
                 MOVE 1 TO I-MONTH
081399           ADD  1 TO I-YEAR.
080399     MOVE DATE-IN TO APHD-DUE-DATE.
032699     STRING "PY TAXES"    DELIMITED BY SIZE,
                  "/WE"         DELIMITED BY SIZE,
                  O-DAY-11      DELIMITED BY SIZE,
                  O-MONTH-11    DELIMITED BY SIZE,
                  O-YEAR-4      DELIMITED BY SIZE,
032699            INTO APHD-INV-DESC.
112696
060100
060200 INIT-APLN.
060300     MOVE SPACES TO APLN-DESC, APLN-REF, APLN-DISC-REF.
060400     MOVE 0 TO APLN-AMT, APLN-DISC-AMT, APLN-PAID-AMT,
060500       APLN-AMT-PAY, APLN-DISC-PAY, APLN-PAID-DISC,
060600       APLN-REFNO, APLN-DISC-REFNO.
060700     MOVE VEND-EXP-ACCT TO APLN-EXP-ACCT.
060700     MOVE CNTL-GL-ACCT(12) TO APLN-DISC-ACCT.
060800     MOVE APHD-DISC-PCT TO APLN-DISC-PCT.
060900     MOVE APHD-TYPE-CD TO APLN-TYPE-CD.
           MOVE SPACES TO APLN-ACTIV-CD, APLN-JOBNO, APLN-STAGENO.      J550/A
061594     MOVE 4 TO APLN-ACTIV-TYPE.                                   J550/A
080399     STRING "LINE DESC"       DELIMITED BY SIZE,
                  INTO APLN-DESC.

041306 SUNBELTO-ASCII.
041306     IF EMPL-ACCT-NUM NOT = SPACES AND 
041306        EMPL-DD-REC-DFI-ID NOT = 0
041306          MOVE 1 TO ASCII-DIRDEP-CD
041306     ELSE 
041306          MOVE 2 TO ASCII-DIRDEP-CD.
033106     MOVE PYHD-EMPL-NO    TO  ASCII-EMPL-NO.
033106     MOVE PYHD-EMPL-NAME  TO  ASCII-EMPL-NAME.
           MOVE PYHD-CHECK-DATE TO  ASCII-CHK-DATE.
           MOVE PYHD-CHECK-NO   TO  ASCII-CHK-NO.
           MOVE PYHD-PERIOD-ENDING TO ASCII-PPE-DATE.
           MOVE PYHD-AMT(1)        TO ASCII-AMT(1).           
           MOVE PYHD-AMT(2)        TO ASCII-AMT(2).           
           MOVE PYHD-AMT(3)        TO ASCII-AMT(3).           
           MOVE PYHD-AMT(4)        TO ASCII-AMT(4).           
           MOVE PYHD-AMT(5)        TO ASCII-AMT(5).           
           MOVE PYHD-AMT(6)        TO ASCII-AMT(6).           
           MOVE PYHD-AMT(7)        TO ASCII-AMT(7).           
           MOVE PYHD-AMT(8)        TO ASCII-AMT(8).           
           MOVE PYHD-AMT(9)        TO ASCII-AMT(9).
           MOVE PYHD-TOTAL-AMT     TO ASCII-TOTAL-AMT.
           MOVE PYHD-TAXABLE-AMT   TO ASCII-TAXABLE-AMT.
           MOVE PYHD-NONTAX-AMT    TO ASCII-NONTAX-AMT.
           MOVE PYHD-TAX(1)        TO ASCII-TAX-AMT(1).
           MOVE PYHD-TAX(2)        TO ASCII-TAX-AMT(2).
           MOVE PYHD-TAX(3)        TO ASCII-TAX-AMT(3).
           MOVE PYHD-TAX(4)        TO ASCII-TAX-AMT(4).
           MOVE PYHD-TAX(5)        TO ASCII-TAX-AMT(5).
           MOVE PYHD-TAX(6)        TO ASCII-TAX-AMT(6).
           MOVE PYHD-DED(1)        TO ASCII-DED-AMT(1).
           MOVE PYHD-DED(2)        TO ASCII-DED-AMT(2).
           MOVE PYHD-DED(3)        TO ASCII-DED-AMT(3).
           MOVE PYHD-DED(4)        TO ASCII-DED-AMT(4).
           MOVE PYHD-DED(5)        TO ASCII-DED-AMT(5).
           MOVE PYHD-DED(6)        TO ASCII-DED-AMT(6).
           MOVE PYHD-DED(7)        TO ASCII-DED-AMT(7).
           MOVE PYHD-DED(8)        TO ASCII-DED-AMT(8).
           MOVE PYHD-DED(9)        TO ASCII-DED-AMT(9).
           MOVE PYHD-DED(10)       TO ASCII-DED-AMT(10).
           MOVE PYHD-DED(11)       TO ASCII-DED-AMT(11).
           MOVE PYHD-DED(12)       TO ASCII-DED-AMT(12).
           MOVE PYHD-DED(13)       TO ASCII-DED-AMT(13).
           MOVE PYHD-DED(14)       TO ASCII-DED-AMT(14).
           MOVE PYHD-DED(15)       TO ASCII-DED-AMT(15).
           MOVE PYHD-DED(16)       TO ASCII-DED-AMT(16).
           MOVE PYHD-DED(17)       TO ASCII-DED-AMT(17).
           MOVE PYHD-DED(18)       TO ASCII-DED-AMT(18).
           MOVE PYHD-DED(19)       TO ASCII-DED-AMT(19).
           MOVE PYHD-DED(20)       TO ASCII-DED-AMT(20).
033106     MOVE PYHD-NET-PAY       TO ASCII-NET-PAY.
           MOVE PYHD-TAX-CODE(1)   TO ASCII-TAX-CODE(1).
           MOVE PYHD-TAX-CODE(2)   TO ASCII-TAX-CODE(2).
           MOVE PYHD-TAX-CODE(3)   TO ASCII-TAX-CODE(3).
052506     MOVE SPACES             TO ASCII-TAX-CODE(4).
052506     MOVE SPACES             TO ASCII-TAX-CODE(5).
           MOVE PYHD-FED-401K-DED  TO ASCII-FED-401K-DED.
           MOVE PYHD-FED-S125-DED  TO ASCII-FED-S125-DED.
           MOVE PYHD-ST-401K-DED   TO ASCII-ST-401K-DED.
           MOVE PYHD-ST-S125-DED   TO ASCII-ST-S125-DED.
           MOVE EMPL-EXP-ACCT      TO ASCII-EXP-ACCT.
           PERFORM WRITE-ASCII.

010111 COMPUTE-EMPLOYER-FICA.
010111     COMPUTE EMPLR-FICA-TOTAL ROUNDED =
010111       ((FICA-TOTAL / (CNTL-FICA-PCT / 100)) * .042).

071700 END-SUBROUTINE-EXIT. EXIT. 
027500
027500 PRINT-REPORT SECTION.
027600 PRINT-DETAIL.
027700     PERFORM PAGE-CHECK.
027800     PERFORM PRINT-REPORT-DETAIL. 
027900
028000 PRINT-TOTALS.
028100     PERFORM PAGE-CHECK.
028200     ADD 2 TO LINE-NO.
028300     MOVE PR-TOTALS TO PRINT-REC
070907               PERFORM PF-REC-CHECK
              WRITE PFRPT AFTER ADVANCING 2 LINES.
028400     MOVE SPACES TO PRINT-REC.
070907               PERFORM PF-REC-CHECK
028500     WRITE PFRPT. 
028600     ADD 1 TO LINE-NO.
028700
028800 PAGE-CHECK.
028900     IF LINE-NO > PAGE-SIZE AND PAGE-NO IS NOT = 0
029000         MOVE SPACES TO PRINT-REC 
070907               PERFORM PF-REC-CHECK
029100         WRITE PFRPT AFTER ADVANCING PAGE.
029200     IF LINE-NO > PAGE-SIZE 
029300         MOVE 0 TO LINE-NO
029400         ADD 1 TO PAGE-NO 
029500         MOVE PAGE-NO TO PR-PAGE-NO 
029600         MOVE PR-HEADER1 TO PRINT-REC
070907               PERFORM PF-REC-CHECK
              WRITE PFRPT
029700         MOVE PR-HEADER1A TO PRINT-REC
070907               PERFORM PF-REC-CHECK
              WRITE PFRPT 
029700         MOVE PR-HEADER1B TO PRINT-REC
070907               PERFORM PF-REC-CHECK
              WRITE PFRPT 
029800         ADD 3 TO LINE-NO 
029900         PERFORM PRINT-REPORT-HEADERS 
030000         MOVE SPACES TO PRINT-REC 
070907               PERFORM PF-REC-CHECK
030100         WRITE PFRPT
030200         ADD 2 TO LINE-NO.
030300
030400 PRINT-REPORT-EXIT. EXIT. 
030500
031000 PY300-REPORT SECTION.
031200
031700 MOVE-DETAIL. 
031800     MOVE GLTN-ACCT-NO TO PR-GLTN-ACCT-NO.
063900     IF GL-ACTIVE-PY
031800         MOVE GLTN-ACCT-NO TO CHRT-ACCT-NO
031800         PERFORM READ-CHRTF 
CLNUP1         IF C-RECORD-OK OF CHRTF-STATUS
032000             MOVE CHRT-NAME TO PR-CHRT-NAME 
032000         ELSE MOVE "*** INVALID ACCOUNT ***" TO PR-CHRT-NAME
051503        PERFORM WAIT-ENTER
032000             MOVE "N" TO BATCH-OK-FLAG. 
032200     MOVE GLTN-DATE TO DATE-IN. 
122698     PERFORM DATE-CONVERT THRU DATE-CONVERT-EXIT.
122698     MOVE DATE-OUT-11 TO PR-GLTN-DATE-11.
032500     MOVE 0 TO DEBIT-AMT, CREDIT-AMT. 
032600     IF GLTN-AMT < 0
032700         COMPUTE CREDIT-AMT = GLTN-AMT * -1 
032800     ELSE MOVE GLTN-AMT TO DEBIT-AMT. 
032900     MOVE DEBIT-AMT TO PR-DEBIT-AMT.
033100     MOVE CREDIT-AMT TO PR-CREDIT-AMT.
033300     MOVE GLTN-PERIOD TO PR-GLTN-PERIOD.
033500     MOVE GLTN-SOURCE TO PR-GLTN-SOURCE.
033700     MOVE GLTN-REF TO PR-GLTN-REF.
033900     MOVE GLTN-REF-NO TO PR-GLTN-REF-NO.
034100     MOVE GLTN-DESC TO PR-GLTN-DESC.
034300     PERFORM PRINT-DETAIL.
034400     PERFORM ADD-TOTALS.
034500
034600 ADD-TOTALS.
034700     MOVE 1 TO INDEX-OCCURS.
034800     PERFORM ADD-TOTAL 1 TIMES. 
034900 ADD-TOTAL. 
035000     ADD  DEBIT-AMT 
035100         TO TOT-DEBIT-AMT                     (INDEX-OCCURS). 
035200     ADD  CREDIT-AMT
035300         TO TOT-CREDIT-AMT                    (INDEX-OCCURS). 
035400     ADD 1 TO INDEX-OCCURS. 
035500
035600 MOVE-TOTALS. 
035700     MOVE 1 TO INDEX-OCCURS.
035800     PERFORM MOVE-TOTAL INDEX-PERFORM TIMES.
035900 MOVE-TOTAL.
036000     MOVE TOT-DEBIT-AMT                  (INDEX-OCCURS) 
036100         TO TS-DEBIT-AMT                     .
036200     MOVE 0  TO TOT-DEBIT-AMT            (INDEX-OCCURS).
036300     MOVE TOT-CREDIT-AMT                 (INDEX-OCCURS) 
036400         TO TS-CREDIT-AMT                    .
036500     MOVE 0  TO TOT-CREDIT-AMT           (INDEX-OCCURS).
036600     PERFORM PRINT-TOTALS.
036700     ADD  1 TO INDEX-OCCURS.
036800
036900 PRINT-REPORT-HEADERS.
092499     IF WS-PER-END-DATE = 0
092499        PERFORM GET-PER-END-DATE.
092499     MOVE PYHD-PERIOD-ENDING TO WS-PER-END-DATE.
092499     ADD 2 TO LINE-NO.
092499     MOVE PR-HEADER4 TO PRINT-REC
070907               PERFORM PF-REC-CHECK
              WRITE PFRPT AFTER ADVANCING 2 LINES.

037000     ADD 2 TO LINE-NO.
037100     MOVE PR-HEADER2 TO PRINT-REC
070907               PERFORM PF-REC-CHECK
              WRITE PFRPT AFTER ADVANCING 2 LINES. 
037200     ADD 1 TO LINE-NO.
037300     MOVE PR-HEADER3 TO PRINT-REC
070907               PERFORM PF-REC-CHECK
              WRITE PFRPT AFTER ADVANCING 1 LINE . 
037400
092499 GET-PER-END-DATE.
092499     IF PYHD-PERIOD-ENDING NOT = 0
092499        MOVE PYHD-PERIOD-ENDING TO DATE-IN
092499        PERFORM DATE-CONVERT THRU DATE-CONVERT-EXIT
092499        MOVE DATE-OUT-11 TO PR-H4-PE-DATE-11.

037500 PRINT-REPORT-DETAIL. 
037600     ADD SKIP TO LINE-NO. 
037700     MOVE PR-DETAIL1 TO PRINT-REC
070907               PERFORM PF-REC-CHECK
              WRITE PFRPT AFTER ADVANCING SKIP LINES.
037800
037900 PY300-REPORT-EXIT. EXIT. 
060889     COPY "PFPRINT.SR".
077600
099600 IN-OUT SECTION.
099800 OPEN-PYHDF.
099900     OPEN INPUT PYHDF.
100000 OPEN-PYLNF.
100100     OPEN INPUT PYLNF.
071500 OPEN-DEDCF.
071600     OPEN INPUT DEDCF.
065700 OPEN-GLTNF.
065800     OPEN OUTPUT GLTNF. 
065700 OPEN-CHRTF.
065800     OPEN INPUT CHRTF.
065700 OPEN-STATF.
065800     OPEN INPUT STATF.
101792 OPEN-JCTNF.                                                      J550/A
101792     OPEN OUTPUT JCTNF.                                           J550/A
080399 OPEN-EMPLF.
080399     OPEN INPUT EMPLF.
080399 OPEN-APHDF.
080399     OPEN I-O APHDF.
080399 OPEN-APLNF.
080399     OPEN I-O APLNF.
080399 OPEN-VENDF.
080399     OPEN INPUT VENDF.
033106 OPEN-ASCII.
033106     OPEN OUTPUT ASCII.
100800 START-PYHDF. 
100900     MOVE LOW-VALUES TO PYHDF-KEY.
100900     START PYHDF KEY NOT < PYHDF-KEY
101000         INVALID KEY MOVE AT-END TO PYHDF-STATUS. 
100800 START-PYLNF. 
100900     START PYLNF KEY NOT < PYLNF-KEY
101000         INVALID KEY MOVE AT-END TO PYLNF-STATUS. 
101100 START-PYLNF-GREATER. 
101200     START PYLNF KEY > PYLNF-KEY
101300         INVALID KEY MOVE AT-END TO PYLNF-STATUS. 
102000 READ-PYHDF-NEXT. 
102100     PERFORM WITH TEST AFTER UNTIL RECORD-LOCK NOT EQUAL 
CLNUP1      PYHDF-STATUS OR IO-WAIT-OFF 
           READ PYHDF NEXT
102200         AT END MOVE AT-END TO PYHDF-STATUS
           END-READ END-PERFORM.
104600 READ-PYLNF.
104700     PERFORM WITH TEST AFTER UNTIL RECORD-LOCK NOT EQUAL 
CLNUP1      PYLNF-STATUS OR IO-WAIT-OFF 
           READ PYLNF INVALID KEY 
104800         MOVE NOT-FOUND TO PYLNF-STATUS
           END-READ END-PERFORM.
072200 READ-DEDCF.
072300     PERFORM WITH TEST AFTER UNTIL RECORD-LOCK NOT EQUAL 
CLNUP1      DEDCF-STATUS OR IO-WAIT-OFF 
           READ DEDCF
           END-READ END-PERFORM.
104900 READ-PYLNF-NEXT. 
105000     PERFORM WITH TEST AFTER UNTIL RECORD-LOCK NOT EQUAL 
CLNUP1      PYLNF-STATUS OR IO-WAIT-OFF 
           READ PYLNF NEXT
105100         AT END MOVE AT-END TO PYLNF-STATUS
           END-READ END-PERFORM.
105200     IF NOT C-AT-END OF PYLNF-STATUS 
105300         AND (PYLN-EMPL-NO NOT = PYHD-EMPL-NO OR
105400              PYLN-CHECK-CD NOT = PYHD-CHECK-CD)
105500             MOVE AT-END TO PYLNF-STATUS. 
       READ-CHRTF.
           PERFORM WITH TEST AFTER UNTIL RECORD-LOCK NOT EQUAL 
CLNUP1      CHRTF-STATUS OR IO-WAIT-OFF 
           READ CHRTF INVALID KEY 
               MOVE NOT-FOUND TO CHRTF-STATUS
           END-READ END-PERFORM.
CLNUP1     IF C-RECORD-OK OF CHRTF-STATUS AND
             (CHRT-KIND-CD = 1 OR CHRT-KIND-CD = 3) 
               IF (I NOT = 22 AND I NOT = 23) 
                   MOVE NOT-FOUND TO CHRTF-STATUS.
080399 READ-EMPLF.
080399     PERFORM WITH TEST AFTER UNTIL RECORD-LOCK NOT EQUAL 
CLNUP1      EMPLF-STATUS OR IO-WAIT-OFF 
           READ EMPLF INVALID KEY 
080399         MOVE NOT-FOUND TO EMPLF-STATUS
           END-READ END-PERFORM.
104600 READ-STATF.
104700     PERFORM WITH TEST AFTER UNTIL RECORD-LOCK NOT EQUAL 
CLNUP1      STATF-STATUS OR IO-WAIT-OFF 
           READ STATF INVALID KEY 
104800         MOVE NOT-FOUND TO STATF-STATUS
           END-READ END-PERFORM.
080399 READ-VENDF.
080399     PERFORM WITH TEST AFTER UNTIL RECORD-LOCK NOT EQUAL 
CLNUP1      VENDF-STATUS OR IO-WAIT-OFF 
           READ VENDF INVALID KEY 
080399         MOVE NOT-FOUND TO VENDF-STATUS
           END-READ END-PERFORM.
071600 WRITE-GLTNF. 
071700     WRITE GLTNF-REC. 
101792 WRITE-JCTNF.                                                     J550/A
101792     WRITE JCTNF-REC.                                             J550/A
033106 WRITE-ASCII.
033106     WRITE ASCII-REC.
080399 READ-APHDF.
080399     PERFORM WITH TEST AFTER UNTIL RECORD-LOCK NOT EQUAL 
CLNUP1      APHDF-STATUS OR IO-WAIT-OFF 
           READ APHDF INVALID KEY
080399        MOVE NOT-FOUND TO APHDF-STATUS
           END-READ END-PERFORM.

080399 WRITE-APHDF. 
032098     WRITE APHDF-REC INVALID KEY
032098        MOVE APHDF-STATUS TO APHDF-STATUS.
032398     IF APHDF-STATUS = DUPLICATE-RECORD
032398        PERFORM REWRITE-APHDF.
032398 REWRITE-APHDF.
032398     REWRITE APHDF-REC INVALID KEY
032398        MOVE APHDF-STATUS TO APHDF-STATUS.
032098 WRITE-APLNF. 
032098     WRITE APLNF-REC INVALID KEY
032098        MOVE APLNF-STATUS TO APLNF-STATUS.
032398     IF APLNF-STATUS = DUPLICATE-RECORD
032398        ADD 128 TO APLN-SEQ-NO
080399        GO TO WRITE-APLNF.
107000
107100 CLOSE-FILES. 
107200     CLOSE PYHDF. 
107300     CLOSE PYLNF. 
073200     CLOSE DEDCF. 
101792     IF JC-YES                                                    J550/A
101792          CLOSE JCTNF.                                            J550/A
033106     IF SUNBELTO    
033106          CLOSE ASCII.
073100 CLOSE-GLTNF. 
073200     CLOSE GLTNF. 
073100 CLOSE-CHRTF. 
073200     CLOSE CHRTF. 
073100 CLOSE-STATF. 
073200     CLOSE STATF. 
108000 IN-OUT-EXIT. EXIT. 
       FILENAMES SECTION.
       FILL-PATHS.
            MOVE SPACES TO TEMP-SUB-DIR.
            STRING SUB-DIR DELIMITED BY LOW-VALUES INTO TEMP-SUB-DIR.
            PERFORM CNTLF-FILL-FULLPATH.
            PERFORM GLTNF-FILL-FULLPATH.
            PERFORM CHRTF-FILL-FULLPATH.
            PERFORM APHDF-FILL-FULLPATH.
            PERFORM APLNF-FILL-FULLPATH.
            PERFORM VENDF-FILL-FULLPATH.
            PERFORM JCTNF-FILL-FULLPATH.
            PERFORM EMPLF-FILL-FULLPATH.
            PERFORM DEDCF-FILL-FULLPATH.
            PERFORM PYHDF-FILL-FULLPATH.
            PERFORM STATF-FILL-FULLPATH.
            PERFORM PYLNF-FILL-FULLPATH.
033106      PERFORM ASCII-FILL-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.
       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.
       GLTNF-FILL-FULLPATH.
            MOVE SPACES TO TEMP-MASTER-DIR.
            STRING MASTER-DIR DELIMITED BY LOW-VALUES INTO 
            TEMP-MASTER-DIR.
            MOVE SPACES TO GLTNF-FULLPATH.
            STRING TEMP-MASTER-DIR "\" TEMP-SUB-DIR "\" GLTNF--NAME 
            DELIMITED BY SPACES INTO GLTNF-FULLPATH.
       CHRTF-FILL-FULLPATH.
            MOVE SPACES TO TEMP-MASTER-DIR.
            STRING MASTER-DIR DELIMITED BY LOW-VALUES INTO 
            TEMP-MASTER-DIR.
            MOVE SPACES TO CHRTF-FULLPATH.
            STRING TEMP-MASTER-DIR "\" TEMP-SUB-DIR "\" CHRTF--NAME 
            DELIMITED BY SPACES INTO CHRTF-FULLPATH.
       APHDF-FILL-FULLPATH.
            MOVE SPACES TO TEMP-MASTER-DIR.
            STRING MASTER-DIR DELIMITED BY LOW-VALUES INTO 
            TEMP-MASTER-DIR.
            MOVE SPACES TO APHDF-FULLPATH.
            STRING TEMP-MASTER-DIR "\" TEMP-SUB-DIR "\" APHDF--NAME 
            DELIMITED BY SPACES INTO APHDF-FULLPATH.
       APLNF-FILL-FULLPATH.
            MOVE SPACES TO TEMP-MASTER-DIR.
            STRING MASTER-DIR DELIMITED BY LOW-VALUES INTO 
            TEMP-MASTER-DIR.
            MOVE SPACES TO APLNF-FULLPATH.
            STRING TEMP-MASTER-DIR "\" TEMP-SUB-DIR "\" APLNF--NAME 
            DELIMITED BY SPACES INTO APLNF-FULLPATH.
       VENDF-FILL-FULLPATH.
            MOVE SPACES TO TEMP-MASTER-DIR.
            STRING MASTER-DIR DELIMITED BY LOW-VALUES INTO 
            TEMP-MASTER-DIR.
            MOVE SPACES TO VENDF-FULLPATH.
            STRING TEMP-MASTER-DIR "\" TEMP-SUB-DIR "\" VENDF--NAME 
            DELIMITED BY SPACES INTO VENDF-FULLPATH.
       JCTNF-FILL-FULLPATH.
            MOVE SPACES TO TEMP-MASTER-DIR.
            STRING MASTER-DIR DELIMITED BY LOW-VALUES INTO 
            TEMP-MASTER-DIR.
            MOVE SPACES TO JCTNF-FULLPATH.
            STRING TEMP-MASTER-DIR "\" TEMP-SUB-DIR "\" JCTNF--NAME 
            DELIMITED BY SPACES INTO JCTNF-FULLPATH.
       EMPLF-FILL-FULLPATH.
            MOVE SPACES TO TEMP-MASTER-DIR.
            STRING MASTER-DIR DELIMITED BY LOW-VALUES INTO 
            TEMP-MASTER-DIR.
            MOVE SPACES TO EMPLF-FULLPATH.
            STRING TEMP-MASTER-DIR "\" TEMP-SUB-DIR "\" EMPLF--NAME 
            DELIMITED BY SPACES INTO EMPLF-FULLPATH.
       DEDCF-FILL-FULLPATH.
            MOVE SPACES TO TEMP-MASTER-DIR.
            STRING MASTER-DIR DELIMITED BY LOW-VALUES INTO 
            TEMP-MASTER-DIR.
            MOVE SPACES TO DEDCF-FULLPATH.
            STRING TEMP-MASTER-DIR "\" TEMP-SUB-DIR "\" DEDCF--NAME 
            DELIMITED BY SPACES INTO DEDCF-FULLPATH.
       PYHDF-FILL-FULLPATH.
            MOVE SPACES TO TEMP-MASTER-DIR.
            STRING MASTER-DIR DELIMITED BY LOW-VALUES INTO 
            TEMP-MASTER-DIR.
            MOVE SPACES TO PYHDF-FULLPATH.
            STRING TEMP-MASTER-DIR "\" TEMP-SUB-DIR "\" PYHDF--NAME 
            DELIMITED BY SPACES INTO PYHDF-FULLPATH.
       STATF-FILL-FULLPATH.
            MOVE SPACES TO TEMP-MASTER-DIR.
            STRING MASTER-DIR DELIMITED BY LOW-VALUES INTO 
            TEMP-MASTER-DIR.
            MOVE SPACES TO STATF-FULLPATH.
            STRING TEMP-MASTER-DIR "\" TEMP-SUB-DIR "\" STATF--NAME 
            DELIMITED BY SPACES INTO STATF-FULLPATH.
       PYLNF-FILL-FULLPATH.
            MOVE SPACES TO TEMP-MASTER-DIR.
            STRING MASTER-DIR DELIMITED BY LOW-VALUES INTO 
            TEMP-MASTER-DIR.
            MOVE SPACES TO PYLNF-FULLPATH.
            STRING TEMP-MASTER-DIR "\" TEMP-SUB-DIR "\" PYLNF--NAME 
            DELIMITED BY SPACES INTO PYLNF-FULLPATH.
033106 ASCII-FILL-FULLPATH.
            MOVE SPACES TO TEMP-MASTER-DIR.
            STRING MASTER-DIR DELIMITED BY LOW-VALUES INTO 
            TEMP-MASTER-DIR.
            MOVE SPACES TO ASCII-FULLPATH.
            STRING TEMP-MASTER-DIR "\" TEMP-SUB-DIR "\" ASCII--NAME 
            DELIMITED BY SPACES INTO ASCII-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==.

       SCRN-TEST SECTION.
            COPY "STEST.SR".
CLNUP1*STEST-errorfil-sr-46.
CLNUP1*     MOVE "   py300.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 "   py300.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.
CLNUP1*STEST-wait-sr-5.
CLNUP1*     MOVE "   py300.cbl      wait.sr    5" TO STEST-KEY.
CLNUP1*     MOVE WAIT-SPECS TO STEST-SCRN-SPECS.
CLNUP1*     MOVE FUNCTION ADDR(WAIT-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 (WAIT-SPECS).
CLNUP1*     MOVE 14 TO STEST-PARAM-W-SIZE OF 
CLNUP1*     STEST-PARAMS (STEST-PARAM-NUM).
CLNUP1*     MOVE "WAIT-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 (ENTER-QUESTION).
CLNUP1*     MOVE FLEN OF STEST-SPECS (1) TO STEST-PARAM-W-SIZE OF 
CLNUP1*     STEST-PARAMS (STEST-PARAM-NUM).
CLNUP1*     MOVE "ENTER-QUESTION" TO STEST-PARAM-NAME OF 
CLNUP1*     STEST-PARAMS (STEST-PARAM-NUM).
CLNUP1*     PERFORM STEST-PARAM-CHECK.
CLNUP1*     PERFORM STEST-FINAL.
033106*STEST-py300-cbl-397.
033106*     MOVE "   py300.cbl               397" TO STEST-KEY.
033106*     MOVE PERIOD-SPEC TO STEST-SCRN-SPECS.
033106*     MOVE FUNCTION ADDR(PERIOD-SPEC) TO STEST-PTR.
033106*     PERFORM STEST-BEGIN.
033106*     COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
033106*     = FUNCTION LENG (FLAG).
033106*     MOVE 4 TO STEST-PARAM-W-SIZE OF 
033106*     STEST-PARAMS (STEST-PARAM-NUM).
033106*     MOVE "FLAG" TO STEST-PARAM-NAME OF 
033106*     STEST-PARAMS (STEST-PARAM-NUM).
033106*     PERFORM STEST-PARAM-CHECK.
033106*     COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
033106*     = FUNCTION LENG (FKEYS).
033106*     MOVE 10 TO STEST-PARAM-W-SIZE OF 
033106*     STEST-PARAMS (STEST-PARAM-NUM).
033106*     MOVE "FKEYS" TO STEST-PARAM-NAME OF 
033106*     STEST-PARAMS (STEST-PARAM-NUM).
033106*     PERFORM STEST-PARAM-CHECK.
033106*     COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
033106*     = FUNCTION LENG (PERIOD-SPEC).
033106*     MOVE 14 TO STEST-PARAM-W-SIZE OF 
033106*     STEST-PARAMS (STEST-PARAM-NUM).
033106*     MOVE "PERIOD-SPEC" TO STEST-PARAM-NAME OF 
033106*     STEST-PARAMS (STEST-PARAM-NUM).
033106*     PERFORM STEST-PARAM-CHECK.
033106*     PERFORM STEST-SKIP.
033106*     COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
033106*     = FUNCTION LENG (GL-PERIOD).
033106*     MOVE FLEN OF STEST-SPECS (1) TO STEST-PARAM-W-SIZE OF 
033106*     STEST-PARAMS (STEST-PARAM-NUM).
033106*     MOVE "GL-PERIOD" TO STEST-PARAM-NAME OF 
033106*     STEST-PARAMS (STEST-PARAM-NUM).
033106*     PERFORM STEST-PARAM-CHECK.
033106*     PERFORM STEST-FINAL.
033106*       STEST-py300-cbl-408.
033106*            MOVE "   py300.cbl               408" TO STEST-KEY.
033106*            MOVE YES-NO-SPEC TO STEST-SCRN-SPECS.
033106*            MOVE FUNCTION ADDR(YES-NO-SPEC) TO STEST-PTR.
033106*     PERFORM STEST-BEGIN.
033106*     COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
033106*     = FUNCTION LENG (FLAG).
033106*     MOVE 4 TO STEST-PARAM-W-SIZE OF 
033106*     STEST-PARAMS (STEST-PARAM-NUM).
033106*     MOVE "FLAG" TO STEST-PARAM-NAME OF 
033106*     STEST-PARAMS (STEST-PARAM-NUM).
033106*     PERFORM STEST-PARAM-CHECK.
033106*     COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
033106*     = FUNCTION LENG (FKEYS).
033106*     MOVE 10 TO STEST-PARAM-W-SIZE OF 
033106*     STEST-PARAMS (STEST-PARAM-NUM).
033106*     MOVE "FKEYS" TO STEST-PARAM-NAME OF 
033106*     STEST-PARAMS (STEST-PARAM-NUM).
033106*     PERFORM STEST-PARAM-CHECK.
033106*     COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
033106*     = FUNCTION LENG (YES-NO-SPEC).
033106*     MOVE 14 TO STEST-PARAM-W-SIZE OF 
033106*     STEST-PARAMS (STEST-PARAM-NUM).
033106*     MOVE "YES-NO-SPEC" TO STEST-PARAM-NAME OF 
033106*     STEST-PARAMS (STEST-PARAM-NUM).
033106*     PERFORM STEST-PARAM-CHECK.
033106*     PERFORM STEST-SKIP.
033106*     COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
033106*     = FUNCTION LENG (YES-NO).
033106*     MOVE FLEN OF STEST-SPECS (1) TO STEST-PARAM-W-SIZE OF 
033106*     STEST-PARAMS (STEST-PARAM-NUM).
033106*     MOVE "YES-NO" TO STEST-PARAM-NAME OF 
033106*     STEST-PARAMS (STEST-PARAM-NUM).
033106*     PERFORM STEST-PARAM-CHECK.
033106*     PERFORM STEST-FINAL.
033106*STEST-py300-cbl-423.
033106*     MOVE "   py300.cbl               423" TO STEST-KEY.
033106*     MOVE YES-NO-SPEC TO STEST-SCRN-SPECS.
033106*     MOVE FUNCTION ADDR(YES-NO-SPEC) TO STEST-PTR.
033106*     PERFORM STEST-BEGIN.
033106*     COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
033106*     = FUNCTION LENG (FLAG).
033106*     MOVE 4 TO STEST-PARAM-W-SIZE OF 
033106*     STEST-PARAMS (STEST-PARAM-NUM).
033106*     MOVE "FLAG" TO STEST-PARAM-NAME OF 
033106*     STEST-PARAMS (STEST-PARAM-NUM).
033106*     PERFORM STEST-PARAM-CHECK.
033106*     COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
033106*     = FUNCTION LENG (FKEYS).
033106*     MOVE 10 TO STEST-PARAM-W-SIZE OF 
033106*     STEST-PARAMS (STEST-PARAM-NUM).
033106*     MOVE "FKEYS" TO STEST-PARAM-NAME OF 
033106*     STEST-PARAMS (STEST-PARAM-NUM).
033106*     PERFORM STEST-PARAM-CHECK.
033106*     COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
033106*     = FUNCTION LENG (YES-NO-SPEC).
033106*     MOVE 14 TO STEST-PARAM-W-SIZE OF 
033106*     STEST-PARAMS (STEST-PARAM-NUM).
033106*     MOVE "YES-NO-SPEC" TO STEST-PARAM-NAME OF 
033106*     STEST-PARAMS (STEST-PARAM-NUM).
033106*     PERFORM STEST-PARAM-CHECK.
033106*     PERFORM STEST-SKIP.
033106*     COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
033106*     = FUNCTION LENG (YES-NO).
033106*     MOVE FLEN OF STEST-SPECS (1) TO STEST-PARAM-W-SIZE OF 
033106*     STEST-PARAMS (STEST-PARAM-NUM).
033106*     MOVE "YES-NO" TO STEST-PARAM-NAME OF 
033106*     STEST-PARAMS (STEST-PARAM-NUM).
033106*     PERFORM STEST-PARAM-CHECK.
033106*     PERFORM STEST-FINAL.
033106*STEST-py300-cbl-437.
033106*     MOVE "   py300.cbl               437" TO STEST-KEY.
033106*     MOVE YES-NO-SPEC TO STEST-SCRN-SPECS.
033106*     MOVE FUNCTION ADDR(YES-NO-SPEC) TO STEST-PTR.
033106*     PERFORM STEST-BEGIN.
033106*     COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
033106*     = FUNCTION LENG (FLAG).
033106*     MOVE 4 TO STEST-PARAM-W-SIZE OF 
033106*     STEST-PARAMS (STEST-PARAM-NUM).
033106*     MOVE "FLAG" TO STEST-PARAM-NAME OF 
033106*     STEST-PARAMS (STEST-PARAM-NUM).
033106*     PERFORM STEST-PARAM-CHECK.
033106*     COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
033106*     = FUNCTION LENG (FKEYS).
033106*     MOVE 10 TO STEST-PARAM-W-SIZE OF 
033106*     STEST-PARAMS (STEST-PARAM-NUM).
033106*     MOVE "FKEYS" TO STEST-PARAM-NAME OF 
033106*     STEST-PARAMS (STEST-PARAM-NUM).
033106*     PERFORM STEST-PARAM-CHECK.
033106*     COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
033106*     = FUNCTION LENG (YES-NO-SPEC).
033106*     MOVE 14 TO STEST-PARAM-W-SIZE OF 
033106*     STEST-PARAMS (STEST-PARAM-NUM).
033106*     MOVE "YES-NO-SPEC" TO STEST-PARAM-NAME OF 
033106*     STEST-PARAMS (STEST-PARAM-NUM).
033106*     PERFORM STEST-PARAM-CHECK.
033106*     PERFORM STEST-SKIP.
033106*     COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
033106*     = FUNCTION LENG (YES-NO).
033106*     MOVE FLEN OF STEST-SPECS (1) TO STEST-PARAM-W-SIZE OF 
033106*     STEST-PARAMS (STEST-PARAM-NUM).
033106*     MOVE "YES-NO" TO STEST-PARAM-NAME OF 
033106*     STEST-PARAMS (STEST-PARAM-NUM).
033106*     PERFORM STEST-PARAM-CHECK.
033106*     PERFORM STEST-FINAL.
033106*STEST-py300-cbl-793.
033106*     MOVE "   py300.cbl               793" TO STEST-KEY.
033106*     MOVE YES-NO-SPEC TO STEST-SCRN-SPECS.
033106*     MOVE FUNCTION ADDR(YES-NO-SPEC) TO STEST-PTR.
033106*     PERFORM STEST-BEGIN.
033106*     COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
033106*     = FUNCTION LENG (FLAG).
033106*     MOVE 4 TO STEST-PARAM-W-SIZE OF 
033106*     STEST-PARAMS (STEST-PARAM-NUM).
033106*     MOVE "FLAG" TO STEST-PARAM-NAME OF 
033106*     STEST-PARAMS (STEST-PARAM-NUM).
033106*     PERFORM STEST-PARAM-CHECK.
033106*     COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
033106*     = FUNCTION LENG (FKEYS).
033106*     MOVE 10 TO STEST-PARAM-W-SIZE OF 
033106*     STEST-PARAMS (STEST-PARAM-NUM).
033106*     MOVE "FKEYS" TO STEST-PARAM-NAME OF 
033106*     STEST-PARAMS (STEST-PARAM-NUM).
033106*     PERFORM STEST-PARAM-CHECK.
033106*     COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
033106*     = FUNCTION LENG (YES-NO-SPEC).
033106*     MOVE 14 TO STEST-PARAM-W-SIZE OF 
033106*     STEST-PARAMS (STEST-PARAM-NUM).
033106*     MOVE "YES-NO-SPEC" TO STEST-PARAM-NAME OF 
033106*     STEST-PARAMS (STEST-PARAM-NUM).
033106*     PERFORM STEST-PARAM-CHECK.
033106*     PERFORM STEST-SKIP.
033106*     COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
033106*     = FUNCTION LENG (YES-NO).
033106*     MOVE FLEN OF STEST-SPECS (1) TO STEST-PARAM-W-SIZE OF 
033106*     STEST-PARAMS (STEST-PARAM-NUM).
033106*     MOVE "YES-NO" TO STEST-PARAM-NAME OF 
033106*     STEST-PARAMS (STEST-PARAM-NUM).
033106*     PERFORM STEST-PARAM-CHECK.
033106*     PERFORM STEST-FINAL.
108100*END-OF-FILE* 
