000100 IDENTIFICATION DIVISION.
000200 PROGRAM-ID.          PPMGR210.
000300*AUTHOR.             DDS TEAM.
000400*          CENTERS FOR MEDICARE AND MEDICAID SERVICES
000500******************************************************************
000600*REMARKS.
000700*   EFFECTIVE JAN 1, 2006  CONVERTED SOFTWARE TO CICS FORMAT.
000800*
000900*   FOR TESTING PRICER COBOL
001000*            >  EXECUTE PPMGR___,PPOPN___,PPDRV___,PPCAL___
001100*
001200*   FOR CICS PRICER PROCESS
001300*            >  YOU MUST HAVE YOUR OWN OPEN AND CLOSE PROGRAMS
001400*            >  CAN NOT RUN PPMGR___ OR PPOPN___
001500*            >  CICS DOES NOT ALLOW ANY OPEN OR CLOSE ECT...
001600*            >  YOU NEED TO SET UP YOUR OWN INTERFACE FOR TESTING
001700*
001800*            THIS PROGRAM HAS BEEN CONVERTED TO COBOL II
001900* MILLENNIUM STANDARDS
002000*****        *******        ********        *******         ******
002100*     THIS CHANGE  MUST BE DONE FOR VS/COBOL II
002200*
002300*  VS/COBOL II -
002400*               TO COMPILE USING VS/COBOL II -
002500*  1. BLOCK CONTAINS 133 RECORDS -  IN BOTH
002600*               PRTOPER AND PRTCAPI FD'S
002700*  2. CHANGE THE WRITE STATEMENTS TO AFTER ADVANCING
002800*  3. CHANGE TO ADVANCING PAGE FROM ADVANCING 0
002900*****        *******        ********        *******         ******
003000*
003100*     THIS CHANGE MUST BE DONE FOR VS/COBOL
003200*
003300*  VS/COBOL -
003400*             TO COMPILE USING VS/COBOL -
003500*  1. BLOCK CONTAINS 0 RECORDS -  IN BOTH
003600*               PRTOPER AND PRTCAPI FD'S
003700*  2. CHANGE THE WRITE STATEMENTS TO AFTER POSITIONING
003800*  3. CHANGE TO POSITIONING 0 FROM POSITIONING PAGE
003900******************************************************************
004000*  FY 2021.0 PRICER
004100*  PPMGR210, PPOPN210, PPDRV210, PPCAL210 EFFECTIVE 10/01/2020
004200******************************************************************
004300 DATE-COMPILED.
004400 ENVIRONMENT                     DIVISION.
004500
004600 CONFIGURATION                   SECTION.
004700 SOURCE-COMPUTER.                IBM-370.
004800 OBJECT-COMPUTER.                IBM-370.
004900
005000 INPUT-OUTPUT SECTION.
005100 FILE-CONTROL.
005200
005300     SELECT BILLFILE   ASSIGN TO UT-S-SYSUT1
005400         FILE STATUS IS UT1-STAT.
005500     SELECT PPSOUT     ASSIGN TO UT-S-SYSUT2
005600         FILE STATUS IS UT2-STAT.
005700     SELECT PRTOPER    ASSIGN TO UT-S-PRTOPER
005800         FILE STATUS IS OPR-STAT.
005900     SELECT PRTCAPI    ASSIGN TO UT-S-PRTCAPI
006000         FILE STATUS IS CAP-STAT.
006100
006200 DATA DIVISION.
006300 FILE SECTION.
006400 FD  BILLFILE
006500     LABEL RECORDS ARE STANDARD
006600     RECORDING MODE IS F
006700     BLOCK CONTAINS 0 RECORDS.
006800 01  PPS-REC                     PIC X(500).
006900
007000 FD  PPSOUT
007100     LABEL RECORDS ARE STANDARD
007200     RECORDING MODE IS F
007300     BLOCK CONTAINS 0 RECORDS.
007400 01  OUT-REC                     PIC X(1897).
007500
007600 FD  PRTOPER
007700     RECORDING MODE IS F
007800     BLOCK CONTAINS 133 RECORDS
007900     LABEL RECORDS ARE STANDARD.
008000 01  PRTOPER-LINE                PIC X(133).
008100
008200 FD  PRTCAPI
008300     RECORDING MODE IS F
008400     BLOCK CONTAINS 133 RECORDS
008500     LABEL RECORDS ARE STANDARD.
008600 01  PRTCAPI-LINE                PIC X(133).
008700
008800 WORKING-STORAGE SECTION.
008900 77  W-STORAGE-REF               PIC X(49)  VALUE
009000     'P P M A N A G E R - W O R K I N G   S T O R A G E'.
009100
009200 01  PPMGR-VERSION               PIC X(05)  VALUE 'M21.0'.
009300 01  PPOPN-VERSION               PIC X(05)  VALUE 'O21.0'.
009400 01  PPDRV-VERSION               PIC X(05)  VALUE 'D21.0'.
009500 01  PPOPN210                    PIC X(08)  VALUE 'PPOPN210'.
009600 01  EOF-SW                      PIC 9(01)  VALUE 0.
009700 01  X1                          PIC 9(05)  COMP SYNC VALUE 0.
009800 01  X2                          PIC 9(05)  COMP SYNC VALUE 0.
009900 01  X3                          PIC 9(05)  COMP SYNC VALUE 0.
010000 01  X4                          PIC 9(05)  COMP SYNC VALUE 0.
010100
010200 01  OPERLINE-CTR                PIC 9(02)  VALUE 65.
010300 01  CAPILINE-CTR                PIC 9(02)  VALUE 65.
010400 01  BILLFILE-CTR                PIC 9(09)  VALUE 0.
010500 01  PPSOUT-CTR                  PIC 9(09)  VALUE 0.
010600
010700 01  UT1-STAT.
010800     05  UT1-STAT1               PIC X.
010900     05  UT1-STAT2               PIC X.
011000
011100 01  UT2-STAT.
011200     05  UT2-STAT1               PIC X.
011300     05  UT2-STAT2               PIC X.
011400
011500 01  OPR-STAT.
011600     05  OPR-STAT1               PIC X.
011700     05  OPR-STAT2               PIC X.
011800
011900 01  CAP-STAT.
012000     05  CAP-STAT1               PIC X.
012100     05  CAP-STAT2               PIC X.
012200
012300************************************************************************
012400* BILL RECORD FORMAT                                                   *
012500*                                                                      *
012600* BILL-CHARGES-CLAIMED = TOTAL COVERED CHARGES ON THE 0001 (TOTALS     *
012700* LINE) MINUS BLOOD CLOT COST, KIDNEY COSTS, ACQUISITION COSTS, AND    *
012800* TECHNICAL PROVIDER CHARGES.                                          *
012900************************************************************************
013000 01  BILL-WORK.
013100     05  BILL-INPUT-DATA.
013200         10  BILL-NPI-NUMBER.
013300             15  BILL-NPI            PIC X(08).
013400             15  BILL-NPI-FILLER     PIC X(02).
013500         10  BILL-PROVIDER-NO        PIC X(06).
013600         10  BILL-HI-CLAIM-NO        PIC X(12).
013700         10  BILL-REVIEW-CODE        PIC 9(02).
013800         10  BILL-DRG                PIC 9(03).
013900         10  BILL-LOS                PIC 9(03).
014000         10  BILL-COVERED-DAYS       PIC 9(03).
014100         10  BILL-LTR-DAYS           PIC 9(02).
014200         10  BILL-DISCHARGE-DATE.
014300             15  D-CC                PIC 9(02).
014400             15  D-YY                PIC 9(02).
014500             15  D-MM                PIC 9(02).
014600             15  D-DD                PIC 9(02).
014700         10  BILL-CHARGES-CLAIMED    PIC 9(07)V9(02).
014800         10  BILL-PRIN-PROC-CODE     PIC X(07).
014900         10  BILL-OTHER-PROC-CODE1   PIC X(07).
015000         10  BILL-OTHER-PROC-CODE2   PIC X(07).
015100         10  BILL-OTHER-PROC-CODE3   PIC X(07).
015200         10  BILL-OTHER-PROC-CODE4   PIC X(07).
015300         10  BILL-OTHER-PROC-CODE5   PIC X(07).
015400         10  BILL-OTHER-PROC-CODE6   PIC X(07).
015500         10  BILL-OTHER-PROC-CODE7   PIC X(07).
015600         10  BILL-OTHER-PROC-CODE8   PIC X(07).
015700         10  BILL-OTHER-PROC-CODE9   PIC X(07).
015800         10  BILL-OTHER-PROC-CODE10  PIC X(07).
015900         10  BILL-OTHER-PROC-CODE11  PIC X(07).
016000         10  BILL-OTHER-PROC-CODE12  PIC X(07).
016100         10  BILL-OTHER-PROC-CODE13  PIC X(07).
016200         10  BILL-OTHER-PROC-CODE14  PIC X(07).
016300         10  BILL-OTHER-PROC-CODE15  PIC X(07).
016400         10  BILL-OTHER-PROC-CODE16  PIC X(07).
016500         10  BILL-OTHER-PROC-CODE17  PIC X(07).
016600         10  BILL-OTHER-PROC-CODE18  PIC X(07).
016700         10  BILL-OTHER-PROC-CODE19  PIC X(07).
016800         10  BILL-OTHER-PROC-CODE20  PIC X(07).
016900         10  BILL-OTHER-PROC-CODE21  PIC X(07).
017000         10  BILL-OTHER-PROC-CODE22  PIC X(07).
017100         10  BILL-OTHER-PROC-CODE23  PIC X(07).
017200         10  BILL-OTHER-PROC-CODE24  PIC X(07).
017300         10  BILL-OTHER-DIAG-CODE1  PIC X(07).
017400         10  BILL-OTHER-DIAG-CODE2  PIC X(07).
017500         10  BILL-OTHER-DIAG-CODE3  PIC X(07).
017600         10  BILL-OTHER-DIAG-CODE4  PIC X(07).
017700         10  BILL-OTHER-DIAG-CODE5  PIC X(07).
017800         10  BILL-OTHER-DIAG-CODE6  PIC X(07).
017900         10  BILL-OTHER-DIAG-CODE7  PIC X(07).
018000         10  BILL-OTHER-DIAG-CODE8  PIC X(07).
018100         10  BILL-OTHER-DIAG-CODE9  PIC X(07).
018200         10  BILL-OTHER-DIAG-CODE10 PIC X(07).
018300         10  BILL-OTHER-DIAG-CODE11 PIC X(07).
018400         10  BILL-OTHER-DIAG-CODE12 PIC X(07).
018500         10  BILL-OTHER-DIAG-CODE13 PIC X(07).
018600         10  BILL-OTHER-DIAG-CODE14 PIC X(07).
018700         10  BILL-OTHER-DIAG-CODE15 PIC X(07).
018800         10  BILL-OTHER-DIAG-CODE16 PIC X(07).
018900         10  BILL-OTHER-DIAG-CODE17 PIC X(07).
019000         10  BILL-OTHER-DIAG-CODE18 PIC X(07).
019100         10  BILL-OTHER-DIAG-CODE19 PIC X(07).
019200         10  BILL-OTHER-DIAG-CODE20 PIC X(07).
019300         10  BILL-OTHER-DIAG-CODE21 PIC X(07).
019400         10  BILL-OTHER-DIAG-CODE22 PIC X(07).
019500         10  BILL-OTHER-DIAG-CODE23 PIC X(07).
019600         10  BILL-OTHER-DIAG-CODE24 PIC X(07).
019700         10  BILL-OTHER-DIAG-CODE25 PIC X(07).
019800         10  BILL-DEMO-DATA.
019900             15  BILL-DEMO-CODE1        PIC X(02).
020000             15  BILL-DEMO-CODE2        PIC X(02).
020100             15  BILL-DEMO-CODE3        PIC X(02).
020200             15  BILL-DEMO-CODE4        PIC X(02).
020300         10  BILL-NDC-DATA.
020400             15  BILL-NDC-NUMBER        PIC X(11).
020500         10  BILL-COND-DATA.
020600             15  BILL-COND-CODE1        PIC X(02).
020700             15  BILL-COND-CODE2        PIC X(02).
020800             15  BILL-COND-CODE3        PIC X(02).
020900             15  BILL-COND-CODE4        PIC X(02).
021000             15  BILL-COND-CODE5        PIC X(02).
021100         10  FILLER                     PIC X(63).
021200*************************************************************
021300*******************************************************
021400*    RETURNED BY PPOPN___                             *
021500*******************************************************
021600     05  PPS-DATA.
021700         10  PPS-RTC               PIC 9(02).
021800         10  PPS-WAGE-INDX         PIC 9(02)V9(04).
021900         10  PPS-OUTLIER-DAYS      PIC 9(03).
022000         10  PPS-AVG-LOS           PIC 9(02)V9(01).
022100         10  PPS-DAYS-CUTOFF       PIC 9(02)V9(01).
022200         10  PPS-OPER-IME-ADJ      PIC 9(06)V9(02).
022300         10  PPS-TOTAL-PAYMENT     PIC 9(07)V9(02).
022400         10  PPS-OPER-HSP-PART     PIC 9(06)V9(02).
022500         10  PPS-OPER-FSP-PART     PIC 9(06)V9(02).
022600         10  PPS-OPER-OUTLIER-PART PIC 9(07)V9(02).
022700         10  PPS-REG-DAYS-USED     PIC 9(03).
022800         10  PPS-LTR-DAYS-USED     PIC 9(02).
022900         10  PPS-OPER-DSH-ADJ      PIC 9(06)V9(02).
023000         10  PPS-CALC-VERS         PIC X(05).
023100     05  FILLER                    PIC X(02).
023200     05  PPS-ADDITIONAL-VARIABLES.
023300         10  PPS-HSP-PCT                PIC 9(01)V9(02).
023400         10  PPS-FSP-PCT                PIC 9(01)V9(02).
023500         10  PPS-NAT-PCT                PIC 9(01)V9(02).
023600         10  PPS-REG-PCT                PIC 9(01)V9(02).
023700         10  PPS-CMI-ADJ-CPD            PIC 9(05)V9(02).
023800         10  PPS-UPDATE-FACTOR          PIC 9(01)V9(05).
023900         10  PPS-DRG-WT                 PIC 9(02)V9(04).
024000         10  PPS-NAT-LABOR              PIC 9(05)V9(02).
024100         10  PPS-NAT-NLABOR             PIC 9(05)V9(02).
024200         10  PPS-REG-LABOR              PIC 9(05)V9(02).
024300         10  PPS-REG-NLABOR             PIC 9(05)V9(02).
024400         10  PPS-OPER-COLA              PIC 9(01)V9(03).
024500         10  PPS-INTERN-RATIO           PIC 9(01)V9(04).
024600         10  PPS-OPER-COST-OUTLIER      PIC 9(07)V9(09).
024700         10  PPS-OPER-BILL-COSTS        PIC 9(07)V9(09).
024800         10  PPS-OPER-DOLLAR-THRESHOLD  PIC 9(07)V9(09).
024900         10  PPS-DSCHG-FRCTN            PIC 9(1)V9999.
025000         10  PPS-DRG-WT-FRCTN           PIC 9(2)V9999.
025100         10  PPS-CAPITAL-VARIABLES.
025200             15  PPS-CAPI-TOTAL-PAY         PIC 9(07)V9(02).
025300             15  PPS-CAPI-HSP               PIC 9(07)V9(02).
025400             15  PPS-CAPI-FSP               PIC 9(07)V9(02).
025500             15  PPS-CAPI-OUTLIER           PIC 9(07)V9(02).
025600             15  PPS-CAPI-OLD-HARM          PIC 9(07)V9(02).
025700             15  PPS-CAPI-DSH-ADJ           PIC 9(07)V9(02).
025800             15  PPS-CAPI-IME-ADJ           PIC 9(07)V9(02).
025900             15  PPS-CAPI-EXCEPTIONS        PIC 9(07)V9(02).
026000         10  PPS-CAPITAL2-VARIABLES.
026100             15  PPS-CAPI2-PAY-CODE         PIC X(1).
026200             15  PPS-CAPI2-B-FSP            PIC 9(07)V9(02).
026300             15  PPS-CAPI2-B-OUTLIER        PIC 9(07)V9(02).
026400         10  PPS-OTHER-VARIABLES.
026500             15  PPS-NON-TEMP-RELIEF-PAYMENT PIC 9(07)V9(02).
026600             15  PPS-NEW-TECH-PAY-ADD-ON     PIC 9(07)V9(02).
026700             15  PPS-ISLET-ISOL-PAY-ADD-ON   PIC 9(07)V9(02).
026800             15  PPS-LOW-VOL-PAYMENT         PIC 9(07)V9(02).
026900         10  PPS-HVBP-HRR-DATA.
027000             15  PPS-VAL-BASED-PURCH-PARTIPNT PIC X.
027100             15  PPS-VAL-BASED-PURCH-ADJUST   PIC 9V9(11).
027200             15  PPS-HOSP-READMISS-REDUCTN    PIC X.
027300             15  PPS-HOSP-HRR-ADJUSTMT        PIC 9V9(4).
027400         10  PPS-OPERATNG-DATA.
027500             15  PPS-MODEL1-BUNDLE-DISPRCNT  PIC V999.
027600             15  PPS-OPER-BASE-DRG-PAY       PIC 9(08)V99.
027700             15  PPS-OPER-HSP-AMT            PIC 9(08)V99.
027800         10  PPS-PC-VARIABLES.
027900             15  PPS-OPER-DSH                PIC 9(01)V9(04).
028000             15  PPS-CAPI-DSH                PIC 9(01)V9(04).
028100             15  PPS-CAPI-HSP-PCT            PIC 9(01)V9(02).
028200             15  PPS-CAPI-FSP-PCT            PIC 9(01)V9(04).
028300             15  PPS-ARITH-ALOS              PIC 9(02)V9(01).
028400             15  PPS-PR-WAGE-INDEX           PIC 9(02)V9(04).
028500             15  PPS-TRANSFER-ADJ            PIC 9(01)V9(04).
028600             15  PPS-PC-HMO-FLAG             PIC X(01).
028700             15  PPS-PC-COT-FLAG             PIC X(01).
028800             15  PPS-OPER-HSP-PART2          PIC 9(07)V9(02).
028900             15  PPS-BUNDLE-ADJUST-AMT       PIC S9(07)V99.
029000         10  PPS-ADDITIONAL-PAY-INFO-DATA.
029100             15  PPS-UNCOMP-CARE-AMOUNT         PIC S9(07)V9(02).
029200             15  PPS-BUNDLE-ADJUST-AMT          PIC S9(07)V9(02).
029300             15  PPS-VAL-BASED-PURCH-ADJUST-AMT PIC S9(07)V9(02).
029400             15  PPS-READMIS-ADJUST-AMT         PIC S9(07)V9(02).
029500         10  PPS-ADDITIONAL-PAY-INFO-DATA2.
029600             15  PPS-HAC-PROG-REDUC-IND      PIC X.
029700             15  PPS-EHR-PROG-REDUC-IND      PIC X.
029800             15  PPS-EHR-ADJUST-AMT          PIC S9(07)V9(02).
029900             15  PPS-STNDRD-VALUE            PIC S9(07)V9(02).
030000             15  PPS-HAC-PAYMENT-AMT         PIC S9(07)V9(02).
030100             15  PPS-FLX7-PAYMENT            PIC S9(07)V9(02).
030200         10  PPS-FILLER                      PIC X(0897).
030300*************************************************************
030400
030500*******************************************************
030600* RETURNED BY PPOPN___                                *
030700*******************************************************
030800 COPY PPHOLDAR.
030900
031000************************************************************************
031100* PASSED TO PPOPN___                                                   *
031200*                                                                      *
031300* B-CHARGES-CLAIMED = TOTAL COVERED CHARGES ON THE 0001 (TOTALS        *
031400* LINE) MINUS BLOOD CLOT COST, KIDNEY COSTS, ACQUISITION COSTS, AND    *
031500* TECHNICAL PROVIDER CHARGES.                                          *
031600************************************************************************
031700 01  BILL-DATA.
031800     05  B-NPI-NUMBER.
031900         10  B-NPI               PIC X(08).
032000         10  B-NPI-FILLER        PIC X(02).
032100     05  B-PROVIDER-NO.
032200         10 B-PROVIDER-STATE     PIC X(02).
032300         10 FILLER               PIC X(04).
032400     05  B-REVIEW-CODE           PIC 9(02).
032500     05  B-DRG                   PIC 9(03).
032600     05  B-LOS                   PIC 9(03).
032700     05  B-COVERED-DAYS          PIC 9(03).
032800     05  B-LTR-DAYS              PIC 9(02).
032900     05  B-DISCHARGE-DATE.
033000         10  B-DISCHG-CC         PIC 9(02).
033100         10  B-DISCHG-YY         PIC 9(02).
033200         10  B-DISCHG-MM         PIC 9(02).
033300         10  B-DISCHG-DD         PIC 9(02).
033400     05  B-CHARGES-CLAIMED       PIC 9(07)V9(02).
033500     05  B-PRIN-PROC-CODE        PIC X(07).
033600     05  B-OTHER-PROC-CODE1      PIC X(07).
033700     05  B-OTHER-PROC-CODE2      PIC X(07).
033800     05  B-OTHER-PROC-CODE3      PIC X(07).
033900     05  B-OTHER-PROC-CODE4      PIC X(07).
034000     05  B-OTHER-PROC-CODE5      PIC X(07).
034100     05  B-OTHER-PROC-CODE6      PIC X(07).
034200     05  B-OTHER-PROC-CODE7      PIC X(07).
034300     05  B-OTHER-PROC-CODE8      PIC X(07).
034400     05  B-OTHER-PROC-CODE9      PIC X(07).
034500     05  B-OTHER-PROC-CODE10     PIC X(07).
034600     05  B-OTHER-PROC-CODE11     PIC X(07).
034700     05  B-OTHER-PROC-CODE12     PIC X(07).
034800     05  B-OTHER-PROC-CODE13     PIC X(07).
034900     05  B-OTHER-PROC-CODE14     PIC X(07).
035000     05  B-OTHER-PROC-CODE15     PIC X(07).
035100     05  B-OTHER-PROC-CODE16     PIC X(07).
035200     05  B-OTHER-PROC-CODE17     PIC X(07).
035300     05  B-OTHER-PROC-CODE18     PIC X(07).
035400     05  B-OTHER-PROC-CODE19     PIC X(07).
035500     05  B-OTHER-PROC-CODE20     PIC X(07).
035600     05  B-OTHER-PROC-CODE21     PIC X(07).
035700     05  B-OTHER-PROC-CODE22     PIC X(07).
035800     05  B-OTHER-PROC-CODE23     PIC X(07).
035900     05  B-OTHER-PROC-CODE24     PIC X(07).
036000     05  B-OTHER-DIAG-CODE1        PIC X(07).
036100     05  B-OTHER-DIAG-CODE2        PIC X(07).
036200     05  B-OTHER-DIAG-CODE3        PIC X(07).
036300     05  B-OTHER-DIAG-CODE4        PIC X(07).
036400     05  B-OTHER-DIAG-CODE5        PIC X(07).
036500     05  B-OTHER-DIAG-CODE6        PIC X(07).
036600     05  B-OTHER-DIAG-CODE7        PIC X(07).
036700     05  B-OTHER-DIAG-CODE8        PIC X(07).
036800     05  B-OTHER-DIAG-CODE9        PIC X(07).
036900     05  B-OTHER-DIAG-CODE10       PIC X(07).
037000     05  B-OTHER-DIAG-CODE11       PIC X(07).
037100     05  B-OTHER-DIAG-CODE12       PIC X(07).
037200     05  B-OTHER-DIAG-CODE13       PIC X(07).
037300     05  B-OTHER-DIAG-CODE14       PIC X(07).
037400     05  B-OTHER-DIAG-CODE15       PIC X(07).
037500     05  B-OTHER-DIAG-CODE16       PIC X(07).
037600     05  B-OTHER-DIAG-CODE17       PIC X(07).
037700     05  B-OTHER-DIAG-CODE18       PIC X(07).
037800     05  B-OTHER-DIAG-CODE19       PIC X(07).
037900     05  B-OTHER-DIAG-CODE20       PIC X(07).
038000     05  B-OTHER-DIAG-CODE21       PIC X(07).
038100     05  B-OTHER-DIAG-CODE22       PIC X(07).
038200     05  B-OTHER-DIAG-CODE23       PIC X(07).
038300     05  B-OTHER-DIAG-CODE24       PIC X(07).
038400     05  B-OTHER-DIAG-CODE25       PIC X(07).
038500     05  B-DEMO-DATA.
038600         10  B-DEMO-CODE1           PIC X(02).
038700         10  B-DEMO-CODE2           PIC X(02).
038800         10  B-DEMO-CODE3           PIC X(02).
038900         10  B-DEMO-CODE4           PIC X(02).
039000     05  B-NDC-DATA.
039100         10  B-NDC-NUMBER           PIC X(11).
039200     05  B-COND-DATA.
039300         10  B-COND-CODE1           PIC X(02).
039400         10  B-COND-CODE2           PIC X(02).
039500         10  B-COND-CODE3           PIC X(02).
039600         10  B-COND-CODE4           PIC X(02).
039700         10  B-COND-CODE5           PIC X(02).
039800     05  FILLER                     PIC X(63).
039900*************************************************************
040000
040100
040200*******************************************************
040300*    PASSED TO PPOPN___                               *
040400*******************************************************
040500 01  PRICER-OPT-VERS-SW.
040600     02  PRICER-OPTION-SW        PIC X.
040700*    02  PPS-VERSIONS.
040800*        10  PPOPN-VERSION       PIC X(05) VALUE 'O13.1'.
040900
041000*******************************************************
041100*    CAN BE PASSED TO PPOPN___                        *
041200*******************************************************
041300 01  PROV-RECORD-FROM-USER       PIC X(310).
041400
041500*******************************************************
041600*    CAN BE PASSED TO PPOPN___   4 POSITION MSA       *
041700*******************************************************
041800 01  MSAX-TABLE-FROM-USER.
041900     05  FILLER                  PIC X(32000).
042000     05  FILLER                  PIC X(30000).
042100     05  FILLER                  PIC X(30000).
042200
042300*******************************************************
042400*    CAN BE PASSED TO PPOPN___   5 POSITION CBSA      *
042500*******************************************************
042600 01  CBSA-TABLE-FROM-USER.
042700     05  FILLER                  PIC X(32000).
042800     05  FILLER                  PIC X(30000).
042900     05  FILLER                  PIC X(30000).
043000
043100*******************************************************
043200*    PROSPECTIVE PAYMENT REPORT COMPONENTS            *
043300*******************************************************
043400 01  PPS-DETAIL-LINE-OPER.
043500     05  FILLER                  PIC X(01)  VALUE SPACES.
043600     05  PRT-HIC                 PIC X(12).
043700     05  FILLER                  PIC X(01)  VALUE SPACES.
043800     05  PRT-PROV                PIC X(06).
043900     05  FILLER                  PIC X(01)  VALUE SPACES.
044000     05  PRT-WAGE-INDX           PIC 9.9999.
044100     05  FILLER                  PIC X(01)  VALUE SPACES.
044200     05  PRT-GRP-DRG             PIC 9(03).
044300     05  FILLER                  PIC X(01)  VALUE SPACES.
044400     05  PRT-ALOS                PIC Z9.9.
044500     05  FILLER                  PIC X(01)  VALUE SPACES.
044600     05  PRT-DAY-CUT             PIC Z9.
044700     05  FILLER                  PIC X(01)  VALUE SPACES.
044800     05  PRT-DISCHG-DATE         PIC 9(08).
044900**   05  PRT-SLASH1              PIC X(01)  VALUE '/'.
045000**   05  PRT-DISCHG-DD           PIC 9(02).
045100**   05  PRT-SLASH2              PIC X(01)  VALUE '/'.
045200**   05  PRT-DISCHG-YY           PIC 9(02).
045300     05  FILLER                  PIC X(01)  VALUE SPACES.
045400     05  PRT-TOT-PAY             PIC Z,ZZZ,ZZZ.99.
045500     05  FILLER                  PIC X(01)  VALUE SPACES.
045600     05  PRT-FSP-PART            PIC ZZZ,ZZZ.99.
045700     05  FILLER                  PIC X(01)  VALUE SPACES.
045800     05  PRT-HSP-PART            PIC ZZZ,ZZZ.99.
045900     05  FILLER                  PIC X(01)  VALUE SPACES.
046000     05  PRT-OUTLIER-PART        PIC Z,ZZZ,ZZZ.99.
046100     05  PRT-DSH-ADJ             PIC ZZ,ZZZ.99.
046200     05  PRT-INDTCH-ADJ          PIC ZZ,ZZZ.99.
046300     05  FILLER                  PIC X(01)  VALUE SPACES.
046400     05  PRT-LOS                 PIC ZZ9.
046500     05  FILLER                  PIC X(02)  VALUE SPACES.
046600     05  PRT-OUTLIER-DAYS        PIC ZZ9.
046700     05  FILLER                  PIC X(02)  VALUE SPACES.
046800     05  PRT-REV-CODE            PIC 99.
046900     05  FILLER                  PIC X(03)  VALUE SPACES.
047000     05  PRT-PPS-RTC             PIC 99.
047100     05  FILLER                  PIC X(01)  VALUE SPACES.
047200
047300 01  PPS-HEAD1.
047400     05  FILLER                  PIC X(01)  VALUE SPACES.
047500     05  FILLER                  PIC X(44)  VALUE
047600        '  C M S ,                                   '.
047700     05  FILLER                  PIC X(44)  VALUE
047800        '                                            '.
047900     05  FILLER                  PIC X(44)  VALUE
048000        '                                            '.
048100
048200 01  PPS-HEAD2-OPER.
048300     05  FILLER                  PIC X(01)  VALUE SPACES.
048400     05  FILLER                  PIC X(44)  VALUE
048500        '  C M S     PRICER OPERATING  P R O S P E C '.
048600     05  FILLER                  PIC X(44)  VALUE
048700        'T I V E   P A Y M E N T   T E S T   D A T A '.
048800     05  FILLER                  PIC X(44)  VALUE
048900        '  R E P O R T  OPER210                      '.
049000
049100 01  PPS-HEAD3-OPER.
049200     05  FILLER                  PIC X(01)  VALUE SPACES.
049300     05  FILLER                  PIC X(44)  VALUE
049400        ' HI CLAIM   PROVIDER WAGE  DRG GMN DRG DIS-D'.
049500     05  FILLER                  PIC X(44)  VALUE
049600        'ATE TOT OPERATING  FEDERAL     HOSPITAL     '.
049700     05  FILLER                  PIC X(44)  VALUE
049800        'OUTLIER  DISPROP   IMETCH     OUTL REV  PPS '.
049900
050000 01  PPS-HEAD4-OPER.
050100     05  FILLER                  PIC X(01)  VALUE SPACES.
050200     05  FILLER                  PIC X(44)  VALUE
050300        '    NO         NO    INDEX  NO LOS CUT CCYYM'.
050400     05  FILLER                  PIC X(44)  VALUE
050500        'MDD & CAPITAL PAY  PORTION     PORTION      '.
050600     05  FILLER                  PIC X(44)  VALUE
050700        'PORTION   SHARE    ADJUST LOS DAYS  CD  RTC '.
050800
050900 01  PPS-HEAD2-CAPI.
051000     05  FILLER                  PIC X(01)  VALUE SPACES.
051100     05  FILLER                  PIC X(44)  VALUE
051200        '  C M S     PRICER  CAPITAL   P R O S P E C '.
051300     05  FILLER                  PIC X(44)  VALUE
051400        'T I V E   P A Y M E N T   T E S T   D A T A '.
051500     05  FILLER                  PIC X(44)  VALUE
051600        '  R E P O R T  CAPI210                      '.
051700
051800 01  PPS-HEAD3-CAPI.
051900     05  FILLER                  PIC X(01)  VALUE SPACES.
052000     05  FILLER                  PIC X(44)  VALUE
052100        ' HI CLAIM  PROVIDER /CAPITAL PAY/      HSP  '.
052200     05  FILLER                  PIC X(44)  VALUE
052300        '  /     FSP     /   OUTLIER   /  OLD-HARM   '.
052400     05  FILLER                  PIC X(44)  VALUE
052500        '/   DSH-ADJ   /   IME-ADJ   /  EXCEPTIONS  /'.
052600
052700*******************************************************
052800*    CAPIITAL PROSPECTIVE PAYMENT REPORT COMPONENTS           *
052900*******************************************************
053000 01  PPS-DETAIL-LINE-CAPI.
053100     05  FILLER                  PIC X(01)  VALUE SPACES.
053200     05  PRT-CAPI-HIC            PIC X(12).
053300     05  FILLER                  PIC X(01)  VALUE SPACES.
053400     05  PRT-CAPI-PROV           PIC X(06).
053500     05  FILLER                  PIC X(01)  VALUE SPACES.
053600     05  PRT-CAPI-TOT-PAY        PIC Z,ZZZ,ZZZ.99.
053700     05  FILLER                  PIC X(02)  VALUE SPACES.
053800     05  PRT-CAPI-HSP            PIC Z,ZZZ,ZZZ.99.
053900     05  FILLER                  PIC X(02)  VALUE SPACES.
054000     05  PRT-CAPI-FSP            PIC Z,ZZZ,ZZZ.99.
054100     05  FILLER                  PIC X(02)  VALUE SPACES.
054200     05  PRT-CAPI-OUTLIER        PIC Z,ZZZ,ZZZ.99.
054300     05  FILLER                  PIC X(02)  VALUE SPACES.
054400     05  PRT-CAPI-OLD-HARM       PIC Z,ZZZ,ZZZ.99.
054500     05  FILLER                  PIC X(02)  VALUE SPACES.
054600     05  PRT-CAPI-DSH-ADJ        PIC Z,ZZZ,ZZZ.99.
054700     05  FILLER                  PIC X(02)  VALUE SPACES.
054800     05  PRT-CAPI-IME-ADJ        PIC Z,ZZZ,ZZZ.99.
054900     05  FILLER                  PIC X(02)  VALUE SPACES.
055000     05  PRT-CAPI-EXCEPTIONS     PIC Z,ZZZ,ZZZ.99.
055100     05  FILLER                  PIC X(03)  VALUE SPACES.
055200
055300*******************************************************
055400*    GROUPER TABLE COMPONENTS                         *
055500*******************************************************
055600 01  DRG-COUNTERS.
055700     03  FILLER                  OCCURS 9.
055800         05  FILLER                  OCCURS 580.
055900             10  DRG-CNT             PIC 9(09) COMP.
056000
056100 01  MDC-COUNTERS.
056200     03  FILLER                  OCCURS 9.
056300         05  FILLER                  OCCURS 32.
056400             10  MDC-CNT             PIC 9(09) COMP.
056500
056600 01  RTC-COUNTERS.
056700     03  FILLER                  OCCURS 9.
056800         05  FILLER                  OCCURS 10.
056900             10  RTC-CNT             PIC 9(09) COMP.
057000
057100 01  TOTAL-COUNTERS.
057200     03  FILLER                  OCCURS 37.
057300         05  COUNT-TOTAL             PIC 9(09) COMP.
057400
057500 01  PRT-LINE.
057600     05  FILLER                  PIC X(01)  VALUE SPACES.
057700     05  PRT-LNE                 OCCURS 9.
057800         10  PRT-XXX             PIC X(02).
057900         10  PRT-DRG             PIC 9(03).
058000         10  PRT-CNT             PIC Z(08)9B.
058100         10  PRT-COL             PIC X(01).
058200
058300 01  PRT-HDG-OLD.
058400     05  FILLER                  PIC X(01)  VALUE SPACES.
058500     05  FILLER                  PIC X(44)  VALUE
058600         '   ****** A L L   R E C O R D S ******      '.
058700     05  FILLER                  PIC X(44)  VALUE
058800         '    DISCHARGES OLDER THEN 5 YEARS           '.
058900     05  FILLER                  PIC X(35)  VALUE
059000        '                C M S ,            '.
059100
059200 01  PRT-HDG-V150.
059300     05  FILLER                  PIC X(01)  VALUE SPACES.
059400     05  FILLER                  PIC X(44)  VALUE
059500         'G R O U P E R  V15.0  COUNTS BY   D R G     '.
059600     05  FILLER                  PIC X(44)  VALUE
059700         'FOR DISCHARGES ON OR AFTER 10/01/97         '.
059800     05  FILLER                  PIC X(35)  VALUE
059900        '                C M S ,            '.
060000
060100 01  PRT-HDG-V160.
060200     05  FILLER                  PIC X(01)  VALUE SPACES.
060300     05  FILLER                  PIC X(44)  VALUE
060400         'G R O U P E R  V16.0  COUNTS BY   D R G     '.
060500     05  FILLER                  PIC X(44)  VALUE
060600         'FOR DISCHARGES ON OR AFTER 10/01/98         '.
060700     05  FILLER                  PIC X(35)  VALUE
060800        '                C M S ,            '.
060900
061000 01  PRT-HDG-V170.
061100     05  FILLER                  PIC X(01)  VALUE SPACES.
061200     05  FILLER                  PIC X(44)  VALUE
061300         'G R O U P E R  V17.0  COUNTS BY   D R G     '.
061400     05  FILLER                  PIC X(44)  VALUE
061500         'FOR DISCHARGES ON OR AFTER 10/01/99         '.
061600     05  FILLER                  PIC X(35)  VALUE
061700        '                C M S ,            '.
061800
061900 01  PRT-HDG-V180.
062000     05  FILLER                  PIC X(01)  VALUE SPACES.
062100     05  FILLER                  PIC X(44)  VALUE
062200         'G R O U P E R  V18.0  COUNTS BY   D R G     '.
062300     05  FILLER                  PIC X(44)  VALUE
062400         'FOR DISCHARGES ON OR AFTER 10/01/2000       '.
062500     05  FILLER                  PIC X(35)  VALUE
062600        '                C M S ,            '.
062700
062800
062900 01  PRT-HDG-V190.
063000     05  FILLER                  PIC X(01)  VALUE SPACES.
063100     05  FILLER                  PIC X(44)  VALUE
063200         'G R O U P E R  V19.0  COUNTS BY   D R G     '.
063300     05  FILLER                  PIC X(44)  VALUE
063400         'FOR DISCHARGES ON OR AFTER 10/01/2001       '.
063500     05  FILLER                  PIC X(35)  VALUE
063600        '                C M S ,            '.
063700
063800
063900 01  PRT-HDG-V200.
064000     05  FILLER                  PIC X(01)  VALUE SPACES.
064100     05  FILLER                  PIC X(44)  VALUE
064200         'G R O U P E R  V20.0  COUNTS BY   D R G     '.
064300     05  FILLER                  PIC X(44)  VALUE
064400         'FOR DISCHARGES ON OR AFTER 10/01/2002       '.
064500     05  FILLER                  PIC X(35)  VALUE
064600        '                C M S ,            '.
064700
064800 01  PRT-HDG-V210.
064900     05  FILLER                  PIC X(01)  VALUE SPACES.
065000     05  FILLER                  PIC X(44)  VALUE
065100         'G R O U P E R  V21.0  COUNTS BY   D R G     '.
065200     05  FILLER                  PIC X(44)  VALUE
065300         'FOR DISCHARGES ON OR AFTER 10/01/2003       '.
065400     05  FILLER                  PIC X(35)  VALUE
065500        '                C M S ,            '.
065600
065700 01  PRT-HDG-V220.
065800     05  FILLER                  PIC X(01)  VALUE SPACES.
065900     05  FILLER                  PIC X(44)  VALUE
066000         'G R O U P E R  V22.0  COUNTS BY   D R G     '.
066100     05  FILLER                  PIC X(44)  VALUE
066200         'FOR DISCHARGES ON OR AFTER 10/01/2004       '.
066300     05  FILLER                  PIC X(35)  VALUE
066400        '                C M S ,            '.
066500
066600 01  PRT-HDG-V230.
066700     05  FILLER                  PIC X(01)  VALUE SPACES.
066800     05  FILLER                  PIC X(44)  VALUE
066900         'G R O U P E R  V23.0  COUNTS BY   D R G     '.
067000     05  FILLER                  PIC X(44)  VALUE
067100         'FOR DISCHARGES ON OR AFTER 10/01/2005       '.
067200     05  FILLER                  PIC X(35)  VALUE
067300        '                C M S ,            '.
067400
067500 01  PRT-HDG-V240.
067600     05  FILLER                  PIC X(01)  VALUE SPACES.
067700     05  FILLER                  PIC X(44)  VALUE
067800         'G R O U P E R  V24.0  COUNTS BY   D R G     '.
067900     05  FILLER                  PIC X(44)  VALUE
068000         'FOR DISCHARGES ON OR AFTER 10/01/2006       '.
068100     05  FILLER                  PIC X(35)  VALUE
068200        '                C M S ,            '.
068300
068400 01  PRT-HDG-V250.
068500     05  FILLER                  PIC X(01)  VALUE SPACES.
068600     05  FILLER                  PIC X(44)  VALUE
068700         'G R O U P E R  V24.0  COUNTS BY   D R G     '.
068800     05  FILLER                  PIC X(44)  VALUE
068900         'FOR DISCHARGES ON OR AFTER 10/01/2007       '.
069000     05  FILLER                  PIC X(35)  VALUE
069100        '                C M S ,            '.
069200
069300 01  PRT-HDG-V260.
069400     05  FILLER                  PIC X(01)  VALUE SPACES.
069500     05  FILLER                  PIC X(44)  VALUE
069600         'G R O U P E R  V24.0  COUNTS BY   D R G     '.
069700     05  FILLER                  PIC X(44)  VALUE
069800         'FOR DISCHARGES ON OR AFTER 10/01/2008       '.
069900     05  FILLER                  PIC X(35)  VALUE
070000        '                C M S ,            '.
070100
070200 01  PRT-HDG-V270.
070300     05  FILLER                  PIC X(01)  VALUE SPACES.
070400     05  FILLER                  PIC X(44)  VALUE
070500         'G R O U P E R  V24.0  COUNTS BY   D R G     '.
070600     05  FILLER                  PIC X(44)  VALUE
070700         'FOR DISCHARGES ON OR AFTER 10/01/2011       '.
070800     05  FILLER                  PIC X(35)  VALUE
070900        '                C M S ,            '.
071000
071100
071200 01  PRT-HDG                     PIC X(132).
071300
071400 PROCEDURE DIVISION.
071500
071600 0000-MAINLINE  SECTION.
071700     OPEN INPUT  BILLFILE.
071800
071900     OPEN OUTPUT PPSOUT.
072000     OPEN OUTPUT PRTOPER.
072100     OPEN OUTPUT PRTCAPI.
072200
072300     MOVE LOW-VALUES  TO DRG-COUNTERS.
072400     MOVE LOW-VALUES  TO MDC-COUNTERS.
072500     MOVE LOW-VALUES  TO RTC-COUNTERS.
072600     MOVE LOW-VALUES  TO TOTAL-COUNTERS.
072700*    MOVE ALL '0'     TO PPS-VERSIONS.
072800
072900     PERFORM 0100-PROCESS-RECORDS THRU 0100-EXIT UNTIL EOF-SW = 1.
073000
073100     DISPLAY '-- PROGRAM PPMGR___  VERSION ==> ' PPMGR-VERSION.
073200     DISPLAY '-- PROGRAM PPOPN___  VERSION ==> ' PPOPN-VERSION.
073300     DISPLAY '-- PROGRAM PPDRV___  VERSION ==> ' PPDRV-VERSION.
073400
073500     DISPLAY ' '.
073600     IF COUNT-TOTAL (2) > 0
073700       DISPLAY '-- PROGRAM PPCAL___  VERSION ==> C87.1 '.
073800     IF COUNT-TOTAL (3) > 0
073900       DISPLAY '-- PROGRAM PPCAL___  VERSION ==> C88.4 '.
074000     IF COUNT-TOTAL (4) > 0
074100       DISPLAY '-- PROGRAM PPCAL___  VERSION ==> C89.4 '.
074200     IF COUNT-TOTAL (5) > 0
074300       DISPLAY '-- PROGRAM PPCAL___  VERSION ==> C90.5 '.
074400     IF COUNT-TOTAL (6) > 0
074500       DISPLAY '-- PROGRAM PPCAL___  VERSION ==> C91.5 '.
074600     IF COUNT-TOTAL (7) > 0
074700       DISPLAY '-- PROGRAM PPCAL___  VERSION ==> C92.6 '.
074800     IF COUNT-TOTAL (8) > 0
074900       DISPLAY '-- PROGRAM PPCAL___  VERSION ==> C93.5 '.
075000     IF COUNT-TOTAL (9) > 0
075100       DISPLAY '-- PROGRAM PPCAL___  VERSION ==> C94.4 '.
075200     IF COUNT-TOTAL (10) > 0
075300       DISPLAY '-- PROGRAM PPCAL___  VERSION ==> C95.4 '.
075400     IF COUNT-TOTAL (11) > 0
075500       DISPLAY '-- PROGRAM PPCAL___  VERSION ==> C96.4 '.
075600     IF COUNT-TOTAL (12) > 0
075700       DISPLAY '-- PROGRAM PPCAL___  VERSION ==> C97.4 '.
075800     IF COUNT-TOTAL (13) > 0
075900       DISPLAY '-- PROGRAM PPCAL___  VERSION ==> C98.7 '.
076000     IF COUNT-TOTAL (14) > 0
076100       DISPLAY '-- PROGRAM PPCAL___  VERSION ==> C99.8 '.
076200     IF COUNT-TOTAL (15) > 0
076300       DISPLAY '-- PROGRAM PPCAL___  VERSION ==> C00.6 '.
076400     IF COUNT-TOTAL (16) > 0
076500       DISPLAY '-- PROGRAM PPCAL___  VERSION ==> C01.7 '.
076600     IF COUNT-TOTAL (17) > 0
076700       DISPLAY '-- PROGRAM PPCAL___  VERSION ==> C02.6 '.
076800     IF COUNT-TOTAL (18) > 0
076900       DISPLAY '-- PROGRAM PPCAL___  VERSION ==> C03.8 '.
077000     IF COUNT-TOTAL (19) > 0
077100       DISPLAY '-- PROGRAM PPCAL___  VERSION ==> C04.D '.
077200     IF COUNT-TOTAL (20) > 0
077300       DISPLAY '-- PROGRAM PPCAL___  VERSION ==> C05.8 '.
077400     IF COUNT-TOTAL (21) > 0
077500       DISPLAY '-- PROGRAM PPCAL___  VERSION ==> C06.9 '.
077600     IF COUNT-TOTAL (22) > 0
077700       DISPLAY '-- PROGRAM PPCAL___  VERSION ==> C07.B '.
077800     IF COUNT-TOTAL (23) > 0
077900       DISPLAY '-- PROGRAM PPCAL___  VERSION ==> C08.D '.
078000     IF COUNT-TOTAL (24) > 0
078100       DISPLAY '-- PROGRAM PPCAL___  VERSION ==> C09.D '.
078200     IF COUNT-TOTAL (25) > 0
078300       DISPLAY '-- PROGRAM PPCAL___  VERSION ==> C10.O '.
078400     IF COUNT-TOTAL (26) > 0
078500       DISPLAY '-- PROGRAM PPCAL___  VERSION ==> C10.P '.
078600     IF COUNT-TOTAL (27) > 0
078700       DISPLAY '-- PROGRAM PPCAL___  VERSION ==> C11.9 '.
078800     IF COUNT-TOTAL (28) > 0
078900       DISPLAY '-- PROGRAM PPCAL___  VERSION ==> C12.5 '.
079000     IF COUNT-TOTAL (29) > 0
079100       DISPLAY '-- PROGRAM PPCAL___  VERSION ==> C13.5 '.
079200     IF COUNT-TOTAL (30) > 0
079300       DISPLAY '-- PROGRAM PPCAL___  VERSION ==> C14.B '.
079400     IF COUNT-TOTAL (31) > 0
079500       DISPLAY '-- PROGRAM PPCAL___  VERSION ==> C15.6 '.
079600     IF COUNT-TOTAL (32) > 0
079700       DISPLAY '-- PROGRAM PPCAL___  VERSION ==> C16.3 '.
079800     IF COUNT-TOTAL (33) > 0
079900       DISPLAY '-- PROGRAM PPCAL___  VERSION ==> C17.1 '.
080000     IF COUNT-TOTAL (34) > 0
080100       DISPLAY '-- PROGRAM PPCAL___  VERSION ==> C18.2 '.
080200     IF COUNT-TOTAL (35) > 0
080300       DISPLAY '-- PROGRAM PPCAL___  VERSION ==> C19.2 '.
080400     IF COUNT-TOTAL (36) > 0
080500       DISPLAY '-- PROGRAM PPCAL___  VERSION ==> C20.3 '.
080600     IF COUNT-TOTAL (37) > 0
080700       DISPLAY '-- PROGRAM PPCAL___  VERSION ==> C21.0 '.
080800
080900     DISPLAY ' '.
081000     IF COUNT-TOTAL (1) > 0
081100     DISPLAY '--   TOTAL OLD RECORDS   ====> ' COUNT-TOTAL (1).
081200     IF COUNT-TOTAL (3) > 0
081300     DISPLAY '-- FY 1988 RECORD COUNTS ====> ' COUNT-TOTAL (3).
081400     IF COUNT-TOTAL (4) > 0
081500     DISPLAY '-- FY 1989 RECORD COUNTS ====> ' COUNT-TOTAL (4).
081600     IF COUNT-TOTAL (5) > 0
081700     DISPLAY '-- FY 1990 RECORD COUNTS ====> ' COUNT-TOTAL (5).
081800     IF COUNT-TOTAL (6) > 0
081900     DISPLAY '-- FY 1991 RECORD COUNTS ====> ' COUNT-TOTAL (6).
082000     IF COUNT-TOTAL (7) > 0
082100     DISPLAY '-- FY 1992 RECORD COUNTS ====> ' COUNT-TOTAL (7).
082200     IF COUNT-TOTAL (8) > 0
082300     DISPLAY '-- FY 1993 RECORD COUNTS ====> ' COUNT-TOTAL (8).
082400     IF COUNT-TOTAL (9) > 0
082500     DISPLAY '-- FY 1994 RECORD COUNTS ====> ' COUNT-TOTAL (9).
082600     IF COUNT-TOTAL (10) > 0
082700     DISPLAY '-- FY 1995 RECORD COUNTS ====> ' COUNT-TOTAL (10).
082800     IF COUNT-TOTAL (11) > 0
082900     DISPLAY '-- FY 1996 RECORD COUNTS ====> ' COUNT-TOTAL (11).
083000     IF COUNT-TOTAL (12) > 0
083100     DISPLAY '-- FY 1997 RECORD COUNTS ====> ' COUNT-TOTAL (12).
083200     IF COUNT-TOTAL (13) > 0
083300     DISPLAY '-- FY 1998 RECORD COUNTS ====> ' COUNT-TOTAL (13).
083400     IF COUNT-TOTAL (14) > 0
083500     DISPLAY '-- FY 1999 RECORD COUNTS ====> ' COUNT-TOTAL (14).
083600     IF COUNT-TOTAL (15) > 0
083700     DISPLAY '-- FY 2000 RECORD COUNTS ====> ' COUNT-TOTAL (15).
083800     IF COUNT-TOTAL (16) > 0
083900     DISPLAY '-- FY 2001 RECORD COUNTS ====> ' COUNT-TOTAL (16).
084000     IF COUNT-TOTAL (17) > 0
084100     DISPLAY '-- FY 2002 RECORD COUNTS ====> ' COUNT-TOTAL (17).
084200     IF COUNT-TOTAL (18) > 0
084300     DISPLAY '-- FY 2003 RECORD COUNTS ====> ' COUNT-TOTAL (18).
084400     IF COUNT-TOTAL (19) > 0
084500     DISPLAY '-- FY 2004 RECORD COUNTS ====> ' COUNT-TOTAL (19).
084600     IF COUNT-TOTAL (20) > 0
084700     DISPLAY '-- FY 2005 RECORD COUNTS ====> ' COUNT-TOTAL (20).
084800     IF COUNT-TOTAL (21) > 0
084900     DISPLAY '-- FY 2006 RECORD COUNTS ====> ' COUNT-TOTAL (21).
085000     IF COUNT-TOTAL (22) > 0
085100     DISPLAY '-- FY 2007 RECORD COUNTS ====> ' COUNT-TOTAL (22).
085200     IF COUNT-TOTAL (23) > 0
085300     DISPLAY '-- FY 2008 RECORD COUNTS ====> ' COUNT-TOTAL (23).
085400     IF COUNT-TOTAL (24) > 0
085500     DISPLAY '-- FY 2009 RECORD COUNTS ====> ' COUNT-TOTAL (24).
085600     IF COUNT-TOTAL (25) > 0
085700     DISPLAY '-- FY 2010.O RECORD COUNTS ==> ' COUNT-TOTAL (25).
085800     IF COUNT-TOTAL (26) > 0
085900     DISPLAY '-- FY 2010.P RECORD COUNTS ==> ' COUNT-TOTAL (26).
086000     IF COUNT-TOTAL (27) > 0
086100     DISPLAY '-- FY 2011.9 RECORD COUNTS ==> ' COUNT-TOTAL (27).
086200     IF COUNT-TOTAL (28) > 0
086300     DISPLAY '-- FY 2012.5 RECORD COUNTS ==> ' COUNT-TOTAL (28).
086400     IF COUNT-TOTAL (29) > 0
086500     DISPLAY '-- FY 2013.5 RECORD COUNTS ==> ' COUNT-TOTAL (29).
086600     IF COUNT-TOTAL (30) > 0
086700     DISPLAY '-- FY 2014.B RECORD COUNTS ==> ' COUNT-TOTAL (30).
086800     IF COUNT-TOTAL (31) > 0
086900     DISPLAY '-- FY 2015.6 RECORD COUNTS ==> ' COUNT-TOTAL (31).
087000     IF COUNT-TOTAL (32) > 0
087100     DISPLAY '-- FY 2016.3 RECORD COUNTS ==> ' COUNT-TOTAL (32).
087200     IF COUNT-TOTAL (33) > 0
087300     DISPLAY '-- FY 2017.1 RECORD COUNTS ==> ' COUNT-TOTAL (33).
087400     IF COUNT-TOTAL (34) > 0
087500     DISPLAY '-- FY 2018.2 RECORD COUNTS ==> ' COUNT-TOTAL (34).
087600     IF COUNT-TOTAL (35) > 0
087700     DISPLAY '-- FY 2019.2 RECORD COUNTS ==> ' COUNT-TOTAL (35).
087800     IF COUNT-TOTAL (36) > 0
087900     DISPLAY '-- FY 2020.3 RECORD COUNTS ==> ' COUNT-TOTAL (36).
088000     IF COUNT-TOTAL (37) > 0
088100     DISPLAY '-- FY 2021.0 RECORD COUNTS ==> ' COUNT-TOTAL (37).
088200
088300     DISPLAY '                                 -----------'.
088400
088500     DISPLAY '-- INPUT  COUNTS FOR SYSUT1 ===> ' BILLFILE-CTR.
088600     DISPLAY '-- OUTPUT COUNTS FOR SYSUT2 ===> ' PPSOUT-CTR.
088700
088800     CLOSE BILLFILE.
088900     CLOSE PPSOUT.
089000
089100     CLOSE PRTOPER PRTCAPI.
089200     STOP RUN.
089300
089400 0100-PROCESS-RECORDS.
089500     READ BILLFILE INTO BILL-WORK
089600         AT END
089700             MOVE 1 TO EOF-SW.
089800
089900     MOVE BILL-PROVIDER-NO      TO B-PROVIDER-NO.
090000     MOVE BILL-REVIEW-CODE      TO B-REVIEW-CODE.
090100     MOVE BILL-DRG              TO B-DRG.
090200     MOVE BILL-LOS              TO B-LOS.
090300     MOVE BILL-COVERED-DAYS     TO B-COVERED-DAYS.
090400     MOVE BILL-LTR-DAYS         TO B-LTR-DAYS.
090500     MOVE BILL-DISCHARGE-DATE   TO B-DISCHARGE-DATE.
090600     MOVE BILL-CHARGES-CLAIMED  TO B-CHARGES-CLAIMED.
090700     MOVE BILL-PRIN-PROC-CODE   TO B-PRIN-PROC-CODE.
090800     MOVE BILL-OTHER-PROC-CODE1 TO B-OTHER-PROC-CODE1.
090900     MOVE BILL-OTHER-PROC-CODE2 TO B-OTHER-PROC-CODE2.
091000     MOVE BILL-OTHER-PROC-CODE3 TO B-OTHER-PROC-CODE3.
091100     MOVE BILL-OTHER-PROC-CODE4 TO B-OTHER-PROC-CODE4.
091200     MOVE BILL-OTHER-PROC-CODE5 TO B-OTHER-PROC-CODE5.
091300     MOVE BILL-OTHER-PROC-CODE6 TO B-OTHER-PROC-CODE6.
091400     MOVE BILL-OTHER-PROC-CODE7 TO B-OTHER-PROC-CODE7.
091500     MOVE BILL-OTHER-PROC-CODE8 TO B-OTHER-PROC-CODE8.
091600     MOVE BILL-OTHER-PROC-CODE9 TO B-OTHER-PROC-CODE9.
091700     MOVE BILL-OTHER-PROC-CODE11 TO B-OTHER-PROC-CODE11.
091800     MOVE BILL-OTHER-PROC-CODE12 TO B-OTHER-PROC-CODE12.
091900     MOVE BILL-OTHER-PROC-CODE13 TO B-OTHER-PROC-CODE13.
092000     MOVE BILL-OTHER-PROC-CODE14 TO B-OTHER-PROC-CODE14.
092100     MOVE BILL-OTHER-PROC-CODE15 TO B-OTHER-PROC-CODE15.
092200     MOVE BILL-OTHER-PROC-CODE16 TO B-OTHER-PROC-CODE16.
092300     MOVE BILL-OTHER-PROC-CODE17 TO B-OTHER-PROC-CODE17.
092400     MOVE BILL-OTHER-PROC-CODE18 TO B-OTHER-PROC-CODE18.
092500     MOVE BILL-OTHER-PROC-CODE19 TO B-OTHER-PROC-CODE19.
092600     MOVE BILL-OTHER-PROC-CODE20 TO B-OTHER-PROC-CODE20.
092700     MOVE BILL-OTHER-PROC-CODE21 TO B-OTHER-PROC-CODE21.
092800     MOVE BILL-OTHER-PROC-CODE22 TO B-OTHER-PROC-CODE22.
092900     MOVE BILL-OTHER-PROC-CODE23 TO B-OTHER-PROC-CODE23.
093000     MOVE BILL-OTHER-PROC-CODE24 TO B-OTHER-PROC-CODE24.
093100     MOVE BILL-OTHER-DIAG-CODE1 TO B-OTHER-DIAG-CODE1.
093200     MOVE BILL-OTHER-DIAG-CODE2 TO B-OTHER-DIAG-CODE2.
093300     MOVE BILL-OTHER-DIAG-CODE3 TO B-OTHER-DIAG-CODE3.
093400     MOVE BILL-OTHER-DIAG-CODE4 TO B-OTHER-DIAG-CODE4.
093500     MOVE BILL-OTHER-DIAG-CODE5 TO B-OTHER-DIAG-CODE5.
093600     MOVE BILL-OTHER-DIAG-CODE6 TO B-OTHER-DIAG-CODE6.
093700     MOVE BILL-OTHER-DIAG-CODE7 TO B-OTHER-DIAG-CODE7.
093800     MOVE BILL-OTHER-DIAG-CODE8 TO B-OTHER-DIAG-CODE8.
093900     MOVE BILL-OTHER-DIAG-CODE9 TO B-OTHER-DIAG-CODE9.
094000     MOVE BILL-OTHER-DIAG-CODE10 TO B-OTHER-DIAG-CODE10.
094100     MOVE BILL-OTHER-DIAG-CODE11 TO B-OTHER-DIAG-CODE11.
094200     MOVE BILL-OTHER-DIAG-CODE12 TO B-OTHER-DIAG-CODE12.
094300     MOVE BILL-OTHER-DIAG-CODE13 TO B-OTHER-DIAG-CODE13.
094400     MOVE BILL-OTHER-DIAG-CODE14 TO B-OTHER-DIAG-CODE14.
094500     MOVE BILL-OTHER-DIAG-CODE15 TO B-OTHER-DIAG-CODE15.
094600     MOVE BILL-OTHER-DIAG-CODE16 TO B-OTHER-DIAG-CODE16.
094700     MOVE BILL-OTHER-DIAG-CODE17 TO B-OTHER-DIAG-CODE17.
094800     MOVE BILL-OTHER-DIAG-CODE18 TO B-OTHER-DIAG-CODE18.
094900     MOVE BILL-OTHER-DIAG-CODE19 TO B-OTHER-DIAG-CODE19.
095000     MOVE BILL-OTHER-DIAG-CODE20 TO B-OTHER-DIAG-CODE20.
095100     MOVE BILL-OTHER-DIAG-CODE21 TO B-OTHER-DIAG-CODE21.
095200     MOVE BILL-OTHER-DIAG-CODE22 TO B-OTHER-DIAG-CODE22.
095300     MOVE BILL-OTHER-DIAG-CODE23 TO B-OTHER-DIAG-CODE23.
095400     MOVE BILL-OTHER-DIAG-CODE24 TO B-OTHER-DIAG-CODE24.
095500     MOVE BILL-OTHER-DIAG-CODE25 TO B-OTHER-DIAG-CODE25.
095600     MOVE BILL-DEMO-CODE1        TO B-DEMO-CODE1.
095700     MOVE BILL-DEMO-CODE2        TO B-DEMO-CODE2.
095800     MOVE BILL-DEMO-CODE3        TO B-DEMO-CODE3.
095900     MOVE BILL-DEMO-CODE4        TO B-DEMO-CODE4.
096000     MOVE BILL-NDC-NUMBER        TO B-NDC-NUMBER.
096100     MOVE BILL-COND-CODE1        TO B-COND-CODE1.
096200     MOVE BILL-COND-CODE2        TO B-COND-CODE2.
096300     MOVE BILL-COND-CODE3        TO B-COND-CODE3.
096400     MOVE BILL-COND-CODE4        TO B-COND-CODE4.
096500     MOVE BILL-COND-CODE5        TO B-COND-CODE5.
096600
096700     IF  EOF-SW = 0
096800         ADD 1 TO BILLFILE-CTR
096900
097000*    DISPLAY '-- INPUT  COUNTS FOR SYSUT1 ===> ' BILLFILE-CTR
097100*    DISPLAY '-- BILL PROVIDER NO         ===> ' BILL-PROVIDER-NO
097200
097300         PERFORM 0200-APPLY-DRG THRU 0200-EXIT
097400         PERFORM 1000-CALC-PAYMENT THRU 1000-EXIT
097500         PERFORM 1100-WRITE-SYSUT2 THRU 1100-EXIT.
097600
097700 0100-EXIT.  EXIT.
097800
097900 0200-APPLY-DRG.
098000***********************************************************
098100*   THIS PROGRAM NO LONGER CALLS THE GROUPERS             *
098200*   TO RETRIEVE THE DRGS. THE TEST BILL DATA HAS BEEN     *
098300*   CHANGED TO CARRY THE DRGS. IF YOU WERE TO CALL        *
098400*   HSI GROUPER SUBROUTINES -- USE                        *
098500* PPCAL993  -                                             *
098600*   DISCHARGE DATES AFTER 09/30/98 USE  GROUPER VERS 16.0 *
098700* PPCAL001  -                                             *
098800*   DISCHARGE DATES AFTER 09/30/99 USE  GROUPER VERS 17.0 *
098900* PPCAL012  -                                             *
099000*   DISCHARGE DATES AFTER 09/30/00 USE  GROUPER VERS 18.0 *
099100*      WITH APR 1, 2001 CHANGES FOR BIPA                  *
099200* PPCAL020  -                                             *
099300*   DISCHARGE DATES AFTER 09/30/01 USE  GROUPER VERS 19.0 *
099400* PPCAL033  -                                             *
099500*   DISCHARGE DATES AFTER 09/30/02 USE  GROUPER VERS 20.0 *
099600* PPCAL048  -                                             *
099700*   DISCHARGE DATES AFTER 09/30/03 USE  GROUPER VERS 21.0 *
099800* PPCAL052  -                                             *
099900*   DISCHARGE DATES AFTER 09/30/04 USE  GROUPER VERS 22.0 *
100000* PPCAL063  -                                             *
100100*   DISCHARGE DATES AFTER 09/30/05 USE  GROUPER VERS 23.0 *
100200* PPCAL063  - CORRECTED DRG 233                           *
100300*   DISCHARGE DATES AFTER 09/30/05 USE  GROUPER VERS 23.0 *
100400* PPCAL063  -  CONVERTED TO CICS ON 01/01/2006            *
100500*           NO LOGIC  CHANGES OTHER THEN CICS CONVERSION  *
100600*   DISCHARGE DATES AFTER 09/30/05 USE  GROUPER VERS 23.0 *
100700* PPCAL063  -                                             *
100800*           LOGIC CHANGES TO DSH AND 401 HOSPITAL 150051  *
100900*   DISCHARGE DATES AFTER 09/30/05 USE  GROUPER VERS 23.0 *
101000* PPCAL074  -                                             *
101100*   DISCHARGE DATES AFTER 09/30/06 USE  GROUPER VERS 24.0 *
101200***********************************************************
101300*******************************************************
101400****  OLD RECORDS
101500****       FY - -PPCAL870
101600*******************************************************
101700     IF BILL-DISCHARGE-DATE < 19871001
101800        MOVE 2 TO X4
101900        ADD 1             TO COUNT-TOTAL (X4)
102000     ELSE
102100
102200*******************************************************
102300****  AFTER 09/30/88 - GROUPER 20.0 IS FOR ALL VERSIONS
102400****       FY - -PPCAL880
102500*******************************************************
102600     IF BILL-DISCHARGE-DATE < 19881001
102700        MOVE 3 TO X4
102800        ADD 1             TO COUNT-TOTAL (X4)
102900     ELSE
103000
103100*******************************************************
103200****  AFTER 09/30/89 - GROUPER 20.0 IS FOR ALL VERSIONS
103300****       FY - -PPCAL891
103400*******************************************************
103500     IF BILL-DISCHARGE-DATE < 19891001
103600        MOVE 4 TO X4
103700        ADD 1             TO COUNT-TOTAL (X4)
103800     ELSE
103900
104000*******************************************************
104100****       FY - -PPCAL900
104200*******************************************************
104300     IF BILL-DISCHARGE-DATE < 19901001
104400        MOVE 5 TO X4
104500        ADD 1             TO COUNT-TOTAL (X4)
104600     ELSE
104700
104800*******************************************************
104900****       FY - -PPCA0910
105000*******************************************************
105100     IF BILL-DISCHARGE-DATE < 19911001
105200        MOVE 6 TO X4
105300        ADD 1             TO COUNT-TOTAL (X4)
105400     ELSE
105500
105600*******************************************************
105700****       FY - -PPCAL920
105800*******************************************************
105900     IF BILL-DISCHARGE-DATE < 19921001
106000        MOVE 7 TO X4
106100        ADD 1             TO COUNT-TOTAL (X4)
106200     ELSE
106300
106400*******************************************************
106500****       FY - -PPCAL930
106600*******************************************************
106700     IF BILL-DISCHARGE-DATE < 19931001
106800        MOVE 8 TO X4
106900        ADD 1             TO COUNT-TOTAL (X4)
107000     ELSE
107100
107200*******************************************************
107300****       FY - -PPCAL940
107400*******************************************************
107500     IF BILL-DISCHARGE-DATE < 19941001
107600        MOVE 9 TO X4
107700        ADD 1             TO COUNT-TOTAL (X4)
107800     ELSE
107900
108000*******************************************************
108100****       FY - -PPCAL950
108200*******************************************************
108300     IF BILL-DISCHARGE-DATE < 19951001
108400        MOVE 10 TO X4
108500        ADD 1             TO COUNT-TOTAL (X4)
108600     ELSE
108700
108800*******************************************************
108900****       FY - -PPCAL960
109000*******************************************************
109100     IF BILL-DISCHARGE-DATE < 19961001
109200        MOVE 11 TO X4
109300        ADD 1             TO COUNT-TOTAL (X4)
109400     ELSE
109500
109600*******************************************************
109700****       FY - -PPCAL970
109800*******************************************************
109900     IF BILL-DISCHARGE-DATE < 19971001
110000        MOVE 12 TO X4
110100        ADD 1             TO COUNT-TOTAL (X4)
110200     ELSE
110300
110400*******************************************************
110500****       FY - -PPCAL980
110600*******************************************************
110700     IF BILL-DISCHARGE-DATE < 19981001
110800        MOVE 13 TO X4
110900        ADD 1             TO COUNT-TOTAL (X4)
111000     ELSE
111100
111200*******************************************************
111300****       FY - -PPCAL990
111400*******************************************************
111500     IF BILL-DISCHARGE-DATE < 19991001
111600        MOVE 14 TO X4
111700        ADD 1             TO COUNT-TOTAL (X4)
111800     ELSE
111900
112000*******************************************************
112100****       FY - -PPCAL000
112200*******************************************************
112300     IF BILL-DISCHARGE-DATE < 20001001
112400        MOVE 15 TO X4
112500        ADD 1             TO COUNT-TOTAL (X4)
112600     ELSE
112700
112800*******************************************************
112900****       FY - -PPCAL010
113000*******************************************************
113100     IF BILL-DISCHARGE-DATE < 20011001
113200        MOVE 16 TO X4
113300        ADD 1             TO COUNT-TOTAL (X4)
113400     ELSE
113500
113600*******************************************************
113700****       FY - -PPCAL020
113800*******************************************************
113900     IF BILL-DISCHARGE-DATE < 20021001
114000        MOVE 17                            TO X4
114100*       ADD 1             TO DRG-CNT (X4 B-DRG)
114200        ADD 1             TO COUNT-TOTAL (X4)
114300     ELSE
114400
114500*******************************************************
114600****       FY - -PPCAL030
114700*******************************************************
114800     IF BILL-DISCHARGE-DATE < 20031001
114900        MOVE 18 TO X4
115000*       ADD 1             TO DRG-CNT (X4 B-DRG)
115100        ADD 1             TO COUNT-TOTAL (X4)
115200     ELSE
115300
115400*******************************************************
115500****       FY - -PPCAL040
115600*******************************************************
115700     IF BILL-DISCHARGE-DATE < 20041001
115800        MOVE 19 TO X4
115900*       ADD 1             TO DRG-CNT (X4 B-DRG)
116000        ADD 1             TO COUNT-TOTAL (X4)
116100     ELSE
116200
116300*******************************************************
116400****       FY - -PPCAL050
116500*******************************************************
116600     IF BILL-DISCHARGE-DATE < 20051001
116700        MOVE 20 TO X4
116800*       ADD 1             TO DRG-CNT (X4 B-DRG)
116900        ADD 1             TO COUNT-TOTAL (X4)
117000     ELSE
117100
117200*******************************************************
117300****       FY - -PPCAL060
117400*******************************************************
117500     IF BILL-DISCHARGE-DATE < 20061001
117600        MOVE 21 TO X4
117700*       ADD 1             TO DRG-CNT (X4 B-DRG)
117800        ADD 1             TO COUNT-TOTAL (X4)
117900     ELSE
118000
118100*******************************************************
118200****       FY - -PPCAL070
118300*******************************************************
118400     IF BILL-DISCHARGE-DATE < 20071001
118500        MOVE 22 TO X4
118600*       ADD 1             TO DRG-CNT (X4 B-DRG)
118700        ADD 1             TO COUNT-TOTAL (X4)
118800     ELSE
118900
119000*******************************************************
119100****       FY - -PPCAL080
119200*******************************************************
119300     IF BILL-DISCHARGE-DATE < 20081001
119400        MOVE 23 TO X4
119500*       ADD 1             TO DRG-CNT (X4 B-DRG)
119600        ADD 1             TO COUNT-TOTAL (X4)
119700     ELSE
119800
119900*******************************************************
120000*******************************************************
120100****       FY - -PPCAL090
120200*******************************************************
120300     IF BILL-DISCHARGE-DATE < 20091001
120400        MOVE 24 TO X4
120500*       ADD 1             TO DRG-CNT (X4 B-DRG)
120600        ADD 1             TO COUNT-TOTAL (X4)
120700     ELSE
120800
120900*******************************************************
121000****       FY - -PPCAL10A
121100*******************************************************
121200     IF BILL-DISCHARGE-DATE < 20100401
121300        MOVE 25 TO X4
121400*       ADD 1             TO DRG-CNT (X4 B-DRG)
121500        ADD 1             TO COUNT-TOTAL (X4)
121600     ELSE
121700
121800*******************************************************
121900*******************************************************
122000****       FY - -PPCAL10B
122100*******************************************************
122200     IF BILL-DISCHARGE-DATE < 20101001
122300        MOVE 26 TO X4
122400*       ADD 1             TO DRG-CNT (X4 B-DRG)
122500        ADD 1             TO COUNT-TOTAL (X4)
122600     ELSE
122700
122800*******************************************************
122900****       FY - -PPCAL110
123000*******************************************************
123100     IF BILL-DISCHARGE-DATE < 20111001
123200        MOVE 27 TO X4
123300*       ADD 1             TO DRG-CNT (X4 B-DRG)
123400        ADD 1             TO COUNT-TOTAL (X4)
123500     ELSE
123600
123700*******************************************************
123800****       FY - -PPCAL120
123900*******************************************************
124000     IF BILL-DISCHARGE-DATE < 20121001
124100        MOVE 28 TO X4
124200*       ADD 1             TO DRG-CNT (X4 B-DRG)
124300        ADD 1             TO COUNT-TOTAL (X4)
124400     ELSE
124500
124600*******************************************************
124700****       FY - -PPCAL134
124800*******************************************************
124900     IF BILL-DISCHARGE-DATE < 20131001
125000        MOVE 29 TO X4
125100*       ADD 1             TO DRG-CNT (X4 B-DRG)
125200        ADD 1             TO COUNT-TOTAL (X4)
125300     ELSE
125400
125500*******************************************************
125600*******************************************************
125700****       FY - -PPCAL149
125800*******************************************************
125900     IF BILL-DISCHARGE-DATE < 20141001
126000        MOVE 30 TO X4
126100*       ADD 1             TO DRG-CNT (X4 B-DRG)
126200        ADD 1             TO COUNT-TOTAL (X4)
126300     ELSE
126400
126500*******************************************************
126600*******************************************************
126700****       FY - -PPCAL155
126800*******************************************************
126900     IF BILL-DISCHARGE-DATE < 20151001
127000        MOVE 31 TO X4
127100*       ADD 1             TO DRG-CNT (X4 B-DRG)
127200        ADD 1             TO COUNT-TOTAL (X4)
127300     ELSE
127400
127500*******************************************************
127600*******************************************************
127700****       FY - -PPCAL162
127800*******************************************************
127900     IF BILL-DISCHARGE-DATE < 20161001
128000        MOVE 32 TO X4
128100*       ADD 1             TO DRG-CNT (X4 B-DRG)
128200        ADD 1             TO COUNT-TOTAL (X4)
128300     ELSE
128400
128500*******************************************************
128600****       FY - -PPCAL171
128700*******************************************************
128800     IF BILL-DISCHARGE-DATE < 20171001
128900        MOVE 33 TO X4
129000*       ADD 1             TO DRG-CNT (X4 B-DRG)
129100        ADD 1             TO COUNT-TOTAL (X4).
129200
129300*******************************************************
129400*******************************************************
129500****       FY - -PPCAL182
129600*******************************************************
129700     IF BILL-DISCHARGE-DATE < 20181001
129800        MOVE 34 TO X4
129900*       ADD 1             TO DRG-CNT (X4 B-DRG)
130000        ADD 1             TO COUNT-TOTAL (X4).
130100
130200*******************************************************
130300*******************************************************
130400****       FY - -PPCAL192
130500*******************************************************
130600     IF BILL-DISCHARGE-DATE < 20191001
130700        MOVE 35 TO X4
130800*       ADD 1             TO DRG-CNT (X4 B-DRG)
130900        ADD 1             TO COUNT-TOTAL (X4).
131000
131100*******************************************************
131200*******************************************************
131300****       FY - -PPCAL203
131400*******************************************************
131500     IF BILL-DISCHARGE-DATE < 20201001
131600        MOVE 36 TO X4
131700*       ADD 1             TO DRG-CNT (X4 B-DRG)
131800        ADD 1             TO COUNT-TOTAL (X4).
131900
132000*******************************************************
132100*******************************************************
132200****       FY - -PPCAL210
132300*******************************************************
132400        MOVE 37 TO X4
132500*       ADD 1             TO DRG-CNT (X4 B-DRG)
132600        ADD 1             TO COUNT-TOTAL (X4).
132700
132800*******************************************************
132900*******************************************************
133000 0200-EXIT.  EXIT.
133100
133200
133300 1000-CALC-PAYMENT.
133400*******************************************************
133500*    CALL TO THE PPS SUBROUTINE TO CALCULATE THE      *
133600*    PAYMENT                                          *
133700*******************************************************
133800***************************************************************
133900* OPTION (1)                                                  *
134000*       (1)  MOVE ' ' TO PRICER-OPTION-SW.                    *
134100*            CALL 'PPOPN___' USING BILL-DATA                  *
134200*                                  PPS-DATA                   *
134300*                                  PRICER-OPT-VERS-SW.        *
134400*        THIS PASSES THE STANDARD VARIABLES USED FOR PRICING. *
134500*                        *  *  *  *                           *
134600* OPTION (2)                                                  *
134700*       (2)  MOVE 'M' TO PRICER-OPTION-SW.                    *
134800*            CALL 'PPOPN___' USING BILL-DATA                  *
134900*                                  PPS-DATA                   *
135000*                                  PRICER-OPT-VERS-SW         *
135100*                                  PPS-ADDITIONAL-VARIABLES   *
135200*                                  PPHOLDAR-HOLD-AREA.        *
135300*        THIS PASSES THE STANDARD VARIIABLES AND THE          *
135400*      ADDITIONAL VARIABLES USED FOR PRICING.                 *
135500*                        *  *  *  *                           *
135600* OPTION (3)                                                  *
135700*       (3)  MOVE 'P' TO PRICER-OPTION-SW.                    *
135800*            CALL 'PPOPN___' USING BILL-DATA                  *
135900*                                  PPS-DATA                   *
136000*                                  PRICER-OPT-VERS-SW         *
136100*                                  PPS-ADDITIONAL-VARIABLES   *
136200*                                  PROV-RECORD-FROM-USER.     *
136300*        THIS PASSES THE STANDARD VARIABLES                   *
136400*       AND ADDITIONAL VARIABLES USED FOR PRICING.            *
136500*        THE PROVIDER RECORD FROM THE USER                    *
136600*       USED FOR THIS BILL ONLY IS ALSO PASSED.               *
136700*                        *  *  *  *                           *
136800* OPTION (4)                                                  *
136900*       (4)  MOVE 'A' TO PRICER-OPTION-SW.                    *
137000*            CALL 'PPOPN___' USING BILL-DATA                  *
137100*                                  PPS-DATA                   *
137200*                                  PRICER-OPT-VERS-SW         *
137300*                                  PPS-ADDITIONAL-VARIABLES   *
137400*                                  PROV-RECORD-FROM-USER      *
137500*                                  MSAX-TABLE-FROM-USER.      *
137600*        THIS IS THE ONLINE COMPATIBLE INTERFACE.             *
137700*        THIS PASSES THE STANDARD VARIIABLES AND THE          *
137800*      ADDITIONAL VARIABLES USED FOR PRICING.                 *
137900*        THE PROVIDER RECORD AND THE WAGE INDEX TABLE FROM    *
138000*      THE USERS ARE PASSED.                                  *
138100***************************************************************
138200
138300*** OPTION (1)
138400*    MOVE ' ' TO PRICER-OPTION-SW.
138500*    CALL  PPOPN074   USING BILL-DATA
138600*                           PPS-DATA
138700*                           PRICER-OPT-VERS-SW.
138800*** OPTION (2)
138900     MOVE 'M' TO PRICER-OPTION-SW.
139000     CALL  PPOPN210   USING BILL-DATA
139100                            PPS-DATA
139200                            PRICER-OPT-VERS-SW
139300                            PPS-ADDITIONAL-VARIABLES
139400                            PPHOLDAR-HOLD-AREA.
139500*** OPTION (3)
139600*    MOVE 'P' TO PRICER-OPTION-SW.
139700*    CALL  PPOPN074   USING BILL-DATA
139800*                           PPS-DATA
139900*                           PRICER-OPT-VERS-SW
140000*                           PPS-ADDITIONAL-VARIABLES
140100*                           PROV-RECORD-FROM-USER.
140200*** OPTION (4)
140300*    MOVE 'A' TO PRICER-OPTION-SW.
140400*    CALL  PPOPN074   USING BILL-DATA
140500*                           PPS-DATA
140600*                           PRICER-OPT-VERS-SW
140700*                           PPS-ADDITIONAL-VARIABLES
140800*                           PROV-RECORD-FROM-USER
140900*                           MSAX-TABLE-FROM-USER
141000*                           CBSA-TABLE-FROM-USER.
141100
141200 1000-EXIT.  EXIT.
141300
141400 1100-WRITE-SYSUT2.
141500******************************************************************
141600*    PRINT OPERATING PROSPECTIVE PAYMENT TEST DATA DETAIL
141700*    REPORT AND WRITE TEST PAYMENT RECORD ROUTINE
141800******************************************************************
141900     IF  OPERLINE-CTR > 54
142000         PERFORM 1200-PPS-HEADINGS THRU 1200-EXIT.
142100     MOVE SPACES            TO  PPS-DETAIL-LINE-OPER.
142200     MOVE BILL-HI-CLAIM-NO  TO  PRT-HIC.
142300     MOVE B-PROVIDER-NO     TO  PRT-PROV.
142400     MOVE PPS-WAGE-INDX     TO  PRT-WAGE-INDX.
142500     MOVE B-DRG             TO  PRT-GRP-DRG.
142600     MOVE PPS-AVG-LOS       TO  PRT-ALOS.
142700     MOVE PPS-DAYS-CUTOFF   TO  PRT-DAY-CUT.
142800     MOVE B-DISCHARGE-DATE  TO  PRT-DISCHG-DATE.
142900***  MOVE B-DISCHG-MM       TO  PRT-DISCHG-MM.
143000**   MOVE B-DISCHG-DD       TO  PRT-DISCHG-DD.
143100**   MOVE '/'               TO  PRT-SLASH1.
143200**   MOVE '/'               TO  PRT-SLASH2.
143300
143400
143500     MOVE PPS-TOTAL-PAYMENT TO  PRT-TOT-PAY.
143600     MOVE PPS-OPER-FSP-PART TO  PRT-FSP-PART.
143700     MOVE PPS-OPER-HSP-PART TO  PRT-HSP-PART.
143800     MOVE PPS-OPER-OUTLIER-PART TO PRT-OUTLIER-PART.
143900     MOVE PPS-OPER-DSH-ADJ  TO  PRT-DSH-ADJ.
144000     MOVE PPS-OPER-IME-ADJ  TO  PRT-INDTCH-ADJ.
144100     MOVE PPS-REG-DAYS-USED TO  PRT-LOS.
144200     MOVE PPS-OUTLIER-DAYS  TO  PRT-OUTLIER-DAYS.
144300     MOVE B-REVIEW-CODE     TO  PRT-REV-CODE.
144400     MOVE PPS-RTC           TO  PRT-PPS-RTC.
144500
144600     WRITE PRTOPER-LINE FROM PPS-DETAIL-LINE-OPER
144700                             AFTER ADVANCING 1.
144800     IF OPR-STAT1 > 0 DISPLAY ' BAD4 WRITE ON PRTOPER FILE'.
144900     ADD 1 TO OPERLINE-CTR.
145000
145100        WRITE OUT-REC FROM BILL-WORK.
145200
145300     IF UT2-STAT1 > 0 DISPLAY ' BAD1 WRITE ON PPSOUT  FILE'.
145400     ADD 1 TO PPSOUT-CTR.
145500
145600**************************************************************
145700**************************************************************
145800**************************************************************
145900******************************************************************
146000*         PRINT CAPIITAL PROSPECTIVE PAYMENT
146100*              TEST DATA DETAIL REPORT
146200******************************************************************
146300     IF  CAPILINE-CTR > 55
146400         PERFORM 1250-PPS-HEADINGS-CAPI THRU 1250-EXIT.
146500
146600     MOVE SPACES              TO PPS-DETAIL-LINE-CAPI.
146700     MOVE 0                   TO PRT-CAPI-TOT-PAY
146800                                 PRT-CAPI-HSP
146900                                 PRT-CAPI-FSP
147000                                 PRT-CAPI-OUTLIER
147100                                 PRT-CAPI-OLD-HARM
147200                                 PRT-CAPI-DSH-ADJ
147300                                 PRT-CAPI-IME-ADJ
147400                                 PRT-CAPI-EXCEPTIONS.
147500     MOVE BILL-HI-CLAIM-NO    TO PRT-CAPI-HIC.
147600     MOVE BILL-PROVIDER-NO    TO PRT-CAPI-PROV.
147700     MOVE PPS-CAPI-TOTAL-PAY  TO PRT-CAPI-TOT-PAY.
147800     MOVE PPS-CAPI-HSP        TO PRT-CAPI-HSP.
147900     MOVE PPS-CAPI-FSP        TO PRT-CAPI-FSP.
148000     MOVE PPS-CAPI-OUTLIER    TO PRT-CAPI-OUTLIER.
148100     MOVE PPS-CAPI-OLD-HARM   TO PRT-CAPI-OLD-HARM.
148200     MOVE PPS-CAPI-DSH-ADJ    TO PRT-CAPI-DSH-ADJ.
148300     MOVE PPS-CAPI-IME-ADJ    TO PRT-CAPI-IME-ADJ.
148400     MOVE PPS-CAPI-EXCEPTIONS TO PRT-CAPI-EXCEPTIONS.
148500
148600     WRITE PRTCAPI-LINE FROM PPS-DETAIL-LINE-CAPI
148700                            AFTER ADVANCING 1.
148800     IF CAP-STAT1 > 0 DISPLAY ' BAD1 WRITE ON PRTCAPI FILE'.
148900     ADD 1 TO CAPILINE-CTR.
149000 1100-EXIT.  EXIT.
149100
149200 1200-PPS-HEADINGS.
149300     WRITE PRTOPER-LINE FROM PPS-HEAD1
149400                             AFTER ADVANCING PAGE.
149500     IF OPR-STAT1 > 0 DISPLAY ' BAD5 WRITE ON PRTOPER FILE'.
149600     WRITE PRTOPER-LINE FROM PPS-HEAD2-OPER
149700                             AFTER ADVANCING 1.
149800     IF OPR-STAT1 > 0 DISPLAY ' BAD6 WRITE ON PRTOPER FILE'.
149900     WRITE PRTOPER-LINE FROM PPS-HEAD3-OPER
150000                             AFTER ADVANCING 2.
150100     IF OPR-STAT1 > 0 DISPLAY ' BAD7 WRITE ON PRTOPER FILE'.
150200     WRITE PRTOPER-LINE FROM PPS-HEAD4-OPER
150300                             AFTER ADVANCING 1.
150400     IF OPR-STAT1 > 0 DISPLAY ' BAD8 WRITE ON PRTOPER FILE'.
150500     MOVE ALL '  -' TO PRTOPER-LINE.
150600     WRITE PRTOPER-LINE AFTER ADVANCING 1.
150700     IF OPR-STAT1 > 0 DISPLAY ' BAD9 WRITE ON PRTOPER FILE'.
150800     MOVE 5 TO OPERLINE-CTR.
150900
151000 1200-EXIT.  EXIT.
151100
151200 1250-PPS-HEADINGS-CAPI.
151300     WRITE PRTCAPI-LINE FROM PPS-HEAD1 AFTER ADVANCING PAGE.
151400     IF CAP-STAT1 > 0 DISPLAY ' BAD2 WRITE ON PRTCAPI FILE'.
151500     WRITE PRTCAPI-LINE FROM PPS-HEAD2-CAPI AFTER ADVANCING 1.
151600     IF CAP-STAT1 > 0 DISPLAY ' BAD3 WRITE ON PRTCAPI FILE'.
151700     WRITE PRTCAPI-LINE FROM PPS-HEAD3-CAPI AFTER ADVANCING 2.
151800     IF CAP-STAT1 > 0 DISPLAY ' BAD4 WRITE ON PRTCAPI FILE'.
151900     MOVE ALL '  -' TO PRTCAPI-LINE.
152000     WRITE PRTCAPI-LINE AFTER ADVANCING 1.
152100     IF CAP-STAT1 > 0 DISPLAY ' BAD5 WRITE ON PRTCAPI FILE'.
152200     MOVE 5 TO CAPILINE-CTR.
152300
152400 1250-EXIT.  EXIT.
152500
152600*****        LAST STATEMENT               *************
