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