IDENTIFICATION DIVISION. PROGRAM-ID. OPPSCAL. *AUTHOR. CMS. *REMARKS. CMS. *********************************************************** * * * OPPS PRICER CHANGE LOG * * * *********************************************************** * 5/8/00 - ADD WINX TO RETURN RECORD * * 5/10/00 - ADD MSA TO RETURN RECORD * * 5/11/00 - CHANGE PROVIDER FILE FROM 9999 OCCURS TO 999 * * - CHANGE ALL LINE OCCURS FROM 999 TO 450 * * 5/17/00 - RELOCATE MOVE OF H-WINX1 TO A-WINX TO * * 0000-PROCESS-MAINLINE * * 6/08/00 - ADD CODE IN 0550-CALC-STANDARD: * * MOVE W-MIN-COIN (W-LP-INDX) TO H-MIN-COIN * * - CORRECTED PROBLEM OF COINSURANCE ELECTION * * BEING DROPPED AFTER FIRST LINE WAS PROCESSED * * 6/14/00 - UPDATED WAGE INDEX TABLE * * - CREATED NEW COPY BOOK * * 7/10/00 - CORRECTED 0150-INIT PARAGRAPH * * - WILL INCLUDE ALL PACKAGED LINES IN TOTAL * * CHARGES FOR OUTLIER CALCULATION * * - INCLUDED OPPS-PKG-FLAG = 0 OR 1 OR 2 * * 7/18/00 - CORRECTED MAX-COINSURANCE PARAGRAPH 0550-CALC * * - CHANGED >> MOVE 776 TO H-NAT-COIN << TO * * - MOVE H-MAX-COIN TO H-NAT-COIN * * 8/02/00 - CHANGED OPPSAPCS COPYBOOK TO RANK NEW DEVICES * * LAST IN DEDUCTIBLE CALCULATION * * - OCE SERVICE INDICATOR = H * * - PAYMENT AND COINSURANCE = ZERO * * 8/02/00 - CHANGED OPPSWINX COPYBOOK TO INCLUDE NEW * * MARYLAND CODE * * - ' 80' = 008631 000000 * * 8/03/00 - CHANGED 0300-COIN-DEDUCT * * - REMOVE CONDITION OF SERVICE INDICATOR * * NOT EQUAL 'T' * * - MOVE 1 TO DISCOUNT RATE * * - ALWAYS ACCEPT DISCOUNT FROM OCE * * 8/07/00 - CHANGED 0150-INIT PARAGRAPH * * - ADD CONDITION OF OPPS-PKG-FLAG NOT = ZERO * * - WILL NOT PAY PACKAGED PARTIAL * * HOSPITALIZATIONS FLAG = 1 OR 2 * * 8/07/00 - CHANGED 0250-CALC-DISCOUNT * * - DISCOUNT INDICATOR OF '8' NOW EQUAL TO 2 * * - FORMULA NOW = 2 (DOUBLE) * * - FORMULA WAS = 2 / UNITS * * 8/15/00 - CHANGED 0100-INIT * * - ALLOW PROPER PROCESSING OF SPECIAL WAGE * * INDEX CONSIDERATIONS * * - PERFORM 0220-CHNG-WAGEINDX FIRST * * - IF WAGE INDEX = 0 * * PERFORM 0200-CALC-WAGEINDX * * 8/17/00 - CHANGED 0150-INIT * * - ALLOW THE PROCESSING OF PARTIAL HOSP. IF * * - LINE ITEM DENIAL/REJECT FLAG = 1 * * AND APC = 0033,0034,0322-0325,0373,0374 * * 8/18/00 - CHANGED 0900-END-PRICE-RTN * * - PREVENT OUTLIER PROCESSING OF NON-OPPS * * CLAIMS * * - IF TOTAL CLAIM PAYMENT = 0 * * DO NOT CALCULATE OUTLIER AMOUNT * * 8/18/00 - ADD 0125-INIT PARAGRAPH * * - SET FLAG IF APC = 0033 ON CLAIM * * 8/18/00 - CHANGE 0150-INIT * * - IF TYPE OF BILL INCLUSION = 0 (OLD) * * - (NEW) OR (APC 0033 IS ON THE CLAIM * * AND SERVICE INDICATOR = 'P' * * OR APC = 0322-0325,0373,0374) * * 8/22/00 - CHANGE 0F 200LCULATE * * - IF PROVIDER REDUCED COINSURANCE IS GREATER * * THAN NATIONAL ADJUSTED COINSURANCE * * - MOVE NATIONAL COINSURANCE TO THE * * PROVIDER REDUCE COINSURANCE * * 9/14/00 - CHANGE 0550-CALCULATE-STANDARD * * - CHANGE MINIMUM COINSURANCE CALCULATION * * FOR DRUGS AND DEVICES (SERVICE INDICATORS * * 'G','H', OR 'J') * * 9/14/00 - CHANGE APC AND WAGE INDEX LOOKUP ROUTINES. * * - LOGIC DID NOT ALLOW FOR MULTIPLE RELEASE * * DATES * * 10/12/00- CONTROL THE PROCESSING OF PARAGRAPH 0220- * * CHNG-WAGEINDX BY USING THE SERVICE FROM * * DATE - ONLY PROCESS IF < 20010101 * * 10/12/00- CONTROL THE PROCESSING OF PARAGRAPHS 0105 * * AND 0110 BY USING THE SERVICE FROM * * DATE - RESET FLOOR MSA * * 10/12/00- CONTROL H-MAX-COIN USING THE SERVICE FROM * * DATE - IP MAX = 776 IF < 20010101 * * - IP MAX = 792 IF > 20001231 * * (PARAGRAPH 0550) * * 10/12/00- LIMIT THE H-MAX-COIN FOR STATUS INDICATORS * * 'G' 'J' 'K' (DRUGS) TO $792 PER LINE ITEM * * EFFECT 20010101 (PARAGRAPH 0550) * * 10/12/00- ALLOW FOR A NEW SERVICE INDICATOR 'K' * * 11/15/00- ADJUST THE COST-TO-CHARGE FOR 2001 BY A * * FACTOR OF .981956 * * - PARAGRAPHS 0555 AND 0910 * * 11/16/00- CREATED WAGE INDEX COPY BOOK FOR 20010101 * * 12/06/00- ALLOW FOR NEW SERVICE INDICATOR 'B' * * - NON-ALLOWED ITEM OR SERVICE FOR OPPS * * 12/07/00- INSERTED W-APC-ADJ-TABLE TO ADJUST APC * * FROM OCE * * - RESET SERVICE INDICATOR IF NECESSARY * * - RESET PAYMENT INDICATOR IF NECESSARY * * 12/07/00- INSERTED PARAGRAPH 0160-ADJUST-APC * * 12/28/00- CORRECTED WAGE INDEX LOOK-UP ROUTINE * * - PARAGRAPH 0210-WAGE-LOOKUP ( > INSTEAD OF < ) * * - CHECK RECLASS VALUE OF 'Y' ELSE ALLOW ANY * * OTHER VALUE FOR NON-RECLASS * * 02/28/01- ADDED NEW APCS - 'C' CODES DEVICE PASSTHRUS * * - 125 CODES * * 02/28/01- REMOVED OCE/APC PATCH - EFFECTIVE APR 01,2001 * * (0160-ADJUST-APC) * * 03/05/01- SET RETURN CODE TO '30' TO BY-PASS THE PASS * * THRU PAYMENTS FOR THE FOLLOWING APCS: * * 01111 - 01114, 01117, 06300, AND 06600 * * 03/06/01- ADD PATCH FOR HCPCS CODE C1050 * * CHANGE SERVICE INDICATOR TO 'S' * * CHANGE PAYMENT APC TO '0976' * * 03/07/01- ADDED NEW APCS - 'C' CODES DEVICE PASSTHRUS * * - 25 CODES * * 05/02/01- ADD CODE FOR DAILY COINSURANCE LIMITATION * * - UPDATE APC TABLE FOR 7/1/2001 * * - NEW PROCESS FOR "DELETED" APC CODES * * 06/12/01- CORRECT TRUNCATION OF APC RANKING FACTOR * * - INCREASE THE SIZE OF THE RANKING VARIABLE * * - 9(03) TO 9(05) * * 07/23/01- ADD NEW PROVIDER SPECIFIC WAGE INDEX LOGIC * * - PARAGRAPH 0225-CHNG-WAGEINDX * * 07/23/01- UPDATE APC TABLE * * 08/20/01- REMOVE REFERENCE TO L-PSF-GEO-MSA FROM LOGIC * * - IN PARAGRAPH 0225-CHNG-WAGEINDX * * 12/19/01- ADD INPATIENT LIMIT LOGIC FOR CY 2002 * * - IN PARAGRAPH 0100-INIT * * 01/16/02- CREATE COPYBOOK FOR FY 2002 WAGE INDEX * * - NEW BASEWINX (EFF. 04/01/2002) * * 01/16/02- ADD APC 0339 SERVICE UNITS OVERRIDE * * - UNITS = 1 (EFF. 04/01/2002) * * 01/17/02- ADD SECTION 401 AND FLOOR MSA DESIGNATIONS * * - PARAGRAPHS 0115-FLOOR-2002 AND * * 0115-SEC401-2002 (EFF. 04/01/2002) * * 01/17/02- ADD LOGIC TO PROCESS LINE LEVEL OUTLIER * * PAYMENT * * 01/30/02- ADD NEW COPYBOOK FOR DEVICE OFFSET PROCESS * * - SERVICE INDICATOR TYPE H * * - EFFECTIVE 04/01/2002 * * - TOTAL AND WAGE ADJUST OFFSET AMOUNT AND * * SUBTRACT PROPORTIONATELY FROM ANY SERVICE * * INDICATOR TYPE 'H' THAT HAVE HCPCS CODE * * BEGINNING WITH 'C' (C1713 - C263) * * 01/31/02- ADD LOGIC FOR PRO RATA REDUCTION FOR ALL * * SERVICE INDICATOR TYPES G AND H * * - CURRENTLY .689 * * - EFFECTIVE 04/01/2002 * * 02/27/02- CHANGE PRO RATA REDUCTION TO .634 * * 02/27/02- CHANGE LINE ITEM CALCULATION * * FROM 3.0 * LINE PYMT TO 3.5 * LINE PYMT * * 02/28/02- UPDATE APC RATE TABLE * * 02/28/02- UPDATE DEVICE OFFSET TABLE * * 04/24/02- UPDATE APC TABLE * * - APC 00034 FOR 20020401 * * 04/24/02- MOVED LOGIC TO CALCULATE DISCOUNT RATE * * BEFORE CALCULATING TOTAL OFFSET AMOUNT * * - PERFORM 1250-CALC-DISCOUNT * * 04/24/02- ADDED DISCOUNTING TO OFFSET AMOUNT * * - PARAGRAPH 1160-TOTAL-OFFSET * * 04/24/02- PARAGRAPH 1150-INIT * * - COMPUTE H-TOT-N-CHRG WHEN PACKAGE INDICATOR * * = '1' OR '2' * * 07/23/02- MOVED LOGIC TO RESET SERVICE UNITS TO 1 IF * * APC = 0339 BEFORE CALCULATING DISCOUNT * * FRACTION * * - PERFORM 1150-INIT * * 10/31/02- REMOVED SERVICE INDICATOR 'S' FROM 2500-ADJ- * * CHRGS LOGIC * * 12/02/02- ADDED 2180-MOD-CCODE-PYMT TO ADJUST PYMT FOR * * C9114 AND C9115 BETWEEN 12/31/2002 AND * * 04/01/2003 * * 12/02/02- ADD NEW APC RATE TABLE * * 02/10/03- ADD NEW PROCESS FOR CALCULATING BLOOD * * DEDUCTIBLES * * - 2375-BLOOD-DEDUCT * * 02/10/03- ALLOW FOR NEW INPUT FIELDS TO BE PASSED TO * * OPPSCAL * * -CLAIM LEVEL: * * 01 BENE-BLOOD-PINTS PIC 9(01). * * -LINE LEVEL: * * 05 A-BLOOD-PINTS-USED PIC 9(01). * * 05 A-BLOOD-DEDUCT-DUE PIC 9(05)V9(02).* * 03/03/03- UPDATE APC TABLE FOR: * * APCS: 1348 1607 1814 9111 9202 9203 9204 * * 04/11/03- CORRECT BLOOD DEDUCTIBLE PROCESS * * 07/21/03- INCLUDE OVR '4' LOGIC IN PARAGRAPH 2400 * * BACK TO 8/1/2000 LOGIC * * 10/21/03- INCREASED IP DEDUCTIBLE AMOUNT TO $876 * * FOR CALENDAR YEAR 2004 * * 10/30/03- ADD PARAGRAPHS FOR MSA FLOOR AND SECTION 401 * * HOSPITALS FOR CALENDAR YEAR 2004 * * - 2120-FLOOR-2004 * * - 2120-SEC401-2004 * * 03/02/04- ADD LOGIC IN 2600-ADJ-CHRG-OUTL TO INCLUDE * * SPECIFIED "K" INDICATORS IN OUTLIER * * CALCULATIO - FOR 04/01/2004 * * 03/03/04- INCLUDE NEW APC UPDATES FOR 04/01/2004 AND * * RETROACTIVE RATES * * 03/04/04- NEW LOGIC FOR SPECIFIED "H" INDICATORS TO * * ALTER COINSURANCE AMOUNT IN 2550-CALC-STANDARD* * 04/08/04- REMOVE OVERRIDE LOGIC FROM 2150-INIT * * ALLOW OCE STATUS INDICATOR FOR A9526 & Q4078 * * 10/27/04- ADD NEW SECTION PROCESS FOR CY2005 * * - 3000-PROCESS-MAIN-NEW * * 10/27/04- ALLOW FOR NEW PACKAGING FLAG VALUE - '4' * * - 3150-INIT * * 10/27/04- ADD NEW VARIABLE TO PASS CBSA BACK TO CALLING * * PROGRAM: LOCATED IN - * * - 01 A-ADDITIONAL-VARIABLES * * - 05 A-CBSA * * 10/27/04- ADD NEW IP DEDUCTIBLE FOR CY2005 - $912.00 * * 10/27/04- REMOVE LOGIC IN 2600-ADJ-CHRG-OUTL TO INCLUDE * * SPECIFIED "K" INDICATORS IN OUTLIER * * ALLOW OCE STATUS INDICATOR FOR A9526 & Q4078 * * 10/27/04- CHANGE OUTLIER CALCULATION PROCESS IN * * 3600-ADJ-CHRG-OUT THIS INCLUDES CMHC'S * * 11/09/04- ADD NEW FLOOR AND SECTION 401 HOSPITAL * * OVER RIDES FOR CY2005 * * - 3120-FLOOR-2005 * * - 3120-SEC401-2005 * * 11/09/04- ADD NEW BASEAPCS FILE AND OPPSAPCS TABLE * * FOR CY 2005 * * 11/09/04- CHANGE WAGE INDEX PROCESS TO USE CBSA TO * * LOOK-UP WAGE INDEX FOR CY 2005 * * 11/30/04- ADD NEW APC 9126 * * 02/01/05- UPDATED BLOOD CODES FOR DEDUCTIBLE PROCESS * * - 2550-CALC-GJK * * - 3550-CALC-GJK * * 02/01/05- UPDATED BLOOD CODES IN BLOOD DEDUCTIBLE TABLE * * - CURRENT RANKING TABLE * * - ADDED NEW RANKING TABLE FOR 2005 * * 02/01/05- REVISED PROCESSING OF LINES WITH PACKAGING * * FLAG = '4' * * * * 02/16/05- ALLOW FOR NEW SERVICE INDICATOR * * - 'M' NOT PROCESS IN OPPS * * - WILL TRIGGER RETURN CODE '41' * * * * 02/22/05- CHANGE SPECIAL PAYMENT INDICATOR LOGIC * * - '1' OR '2' SPECIAL PAYMENT INDICATOR * * WILL NOT ALLOW WAGE INDEX TO BE ALTERED * * - CHANGE MADE IN 3100-INIT * * * * 03/14/05- CHANGE 2005 FLOOR AND SEC 401 FOR APRIL * * - UPDATE 2005 FLOOR * * - UPDATE 2005 SEC 401 AND ADD NEW SEC 401 * * EFFECTIVE APRIL 01, 2005 * * * * 05/05/05- CHANGE BLOOD DEDUCTIBLE LOGIC FOR JULY 2005 * * - ACCEPT PAYMENT ADJUSTMENT FLAGS 5 AND 6 * * - ONLY APPLY DEDUCTIBLE TO BLOOD PRODUCT * * REVENUE CODE 0380 * * * * 06/08/05- ADD APC RATES FOR ASP DRUGS * * * * 07/13/05- INCREASE FIELD SIZE FROM 1 TO 2 BYTES FOR: * * - OPPS-SRVC-IND * * - OPPS-PYMT-IND * * - OPPS-PYMT-ADJ-FLAG * * - W-DCP-SRVC-IND * * * * 07/13/05- CHANGE ALL LOGIC ASSOCIATED WITH THE ABOVE * * FIELDS * * * * 09/06/05- UPDATE ASP DRUG RATES IN THE APC TABLE * * * * 09/13/05- CORRECT APC 09224 EFFECTIVE DATE * * * * 11/22/05- ADD 5000 SECTION FOR CY2006 * * * * 11/22/05- UPDATE APC RATES FOR CY2006 * * * * 11/22/05- UPDATE OFFSET LOGIC FOR CY2006 * * - NEW TABLE ADDED * * - OPPSOF06 * * - OFFSET FOR APC 00222 * * * * 11/22/05- ADD LOGIC TO ADJUST PAYMENT FOR 505 * * HOSPITALS (7.1%) * * - 5550-SCH-ADJ * * * * 11/22/05- UPDATE OUTLIER FACTOR FOR CMHC'S * * - 5600-ADJ-CHRG-OUTL * * - H-OUTLIER-FACTOR = 3.4 * * * * 11/22/05- UPDATE OUTLIER THRESHOLD * * - 5600-ADJ-CHRG-OUTL * * - THRESHOLD INCREASED TO $1250 * * * * 06/26/06- UPDATE ASP DRUGS FOR JULY 2006 * * UPDATED THE SCH LOOKUP-PROCESS * * CORRECTED THE PAYMENT PROCESS FOR BLOOD * * PRODUCTS. * * INCREASED THE SIZE OF WORK COINSURACE FIELDS * * * * 11/13/06- ADDED 6000 SECTION FOR CY2007 * * REDEFINE OF UNUSED L-PROV-SPEC-AREA FIELD * * BEFORE * * L-PSF-BED-SIZE PIC 9(5) * * AFTER * * L-PSF-STATE-CODE PIC 9(02) * * L-PSF-TOPS-INDICATOR PIC X(01) * * L-PSF-HOSP-QUAL-IND PIC X(01) * * FILLER PIC X(01) * * * * MOVE 992 TO H-IP-LIMIT. * * OUTLIER HOSPITAL THRESHOLD OF $1825. * * NEW WAC TABLE RENAMED PD-AT-CST-W-COIN7. * * ADDED MANY COMMENTS. * * MOVED PROCEDURE DIV. PARAGRAPHS TO COLUMN 8. * * NEW BLOOD RANKING TABLE FOR 2007. * * NEW 2007 BRACH & RADIOPHARM TABLE FOR 20% COIN* * NEW COPYBOOK OPPSOF07 FOR 2007 OFFSETS. * * NEW COPYBOOK DEVRED07 FOR 2007 DEVICE REDUCT. * * INITIALIZED BLOOD FRACTION IN PARAGRAPH * * 6550-CALC-STANDARD. * * ALLOW OPPS-PYMT-ADJ-FLAG VALUE OF ' 7' * * ALLOW OUTLIER PAYMENT TO CERTAIN BRACHYTHERAPY* * CODES WHEN SERVICE INDICATOR IS K IN * * PARAGRAPH 6600-ADJ-CHRG-OUTL. * * 12/12/06- REMOVED BRACHYTHERAPY CODES FROM OUTLIER LOGIC* * & ADDED THEM TO THE PD-AT-CST LIST TABLE. * * * * 02/20/07- ADDED APC 00039 TO OFFSET TABLES FOR 2006 & * * 2007. ALSO ADDED CODE TO 5160-TOTAL & TO * * 6160-TOTAL PARAGRAPHS TO CHECK THAT OFFSET * * DOES NOT RESULT IN A LINE PAYMENT LESS THAN * * ZERO. * * 04/01/07- PROPOSED: * * ADDED CODE TO 5160-TOTAL & TO 6160-TOTAL * * TO PERFORM 5161 & 6161 RESPECTIVELY. THE * * OFFSET CALCULATIONS WILL BE SKIPPED IN THE * * *161 PARAGRAPHS IF THE OFFSET AMOUNT IS ZERO * * WHEN A HIT IS MADE WHEN LOOKING UP THE APC. * * * * 05/10/07- VERSION 2007.3.0 UPDATES: * * NEW PAID-AT-COST WITH 20% COINSURANCE TABLE * * EFFECTIVE JULY 1, 2007 FOR SPECIFIED * * RADIOPHARMS & BRACHYTHERAPY (INCLUDES NEW * * LOOK-UP LOGIC IN PARAGRAPH 6550-CALC-STANDARD)* * * * ADDED CODE TO 5160-TOTAL & TO 6160-TOTAL * * TO PERFORM 5161 & 6161 RESPECTIVELY. THE * * OFFSET CALCULATIONS WILL BE SKIPPED IN THE * * *161 PARAGRAPHS IF THE OFFSET AMOUNT IS ZERO * * WHEN A HIT IS MADE WHEN LOOKING UP THE APC. * * * * APC 00034 ADDED - EFFECTIVE 01/01/2007 * * * * 14 APC UPDATES EFFECTIVE 07/01/2007 * * * * 06/18/07- VERSION 2007.3.1 UPDATE: * * APC TABLE CORRECTED TO INCLUDE 04/01/2007 * * RECORDS AND UPDATES THAT WERE OMITTED FROM * * VERSION 2007.3.0. * * * * 06/21/07- VERSION 2007.3.2 UPDATE: * * APC TABLE UPDATED WITH THE JULY 2007 ASP DRUG * * RATES AND OTHER RETROACTIVE RATE UPDATES. * * * * 06/27/07- VERSION 2007.3.3 UPDATE: * * APC TABLE CORRECTIONS MADE: * * - APCS 00844, 01695, & 09002 - 20070701 * * RECORDS' PAYMENT RATES CORRECTED * * - APC 02632 - 20070101 RECORD PMT RATE * * CHANGED FROM 'DELETED' (INCORRECTLY DELETED * * IN VERSION 2007.2.1) TO '0000000.' * * * * 07/03/07- VERSION 2007.3.4 UPDATE: * * APC TABLE CORRECTION MADE FOR APC 00951 * * (PAYMENT RATES & COINSURANCE CORRECTED) * * * * 08/10/07- VERSION 2007.4.0 UPDATE: * * 1) UPDATE DEVICE REDUCTION TABLE * * - APC 315 -> $12,422.60 EFFECTIVE 1/1/07 * * - APC 385 -> $ 2,282.53 EFFECTIVE 1/1/07 * * 2) REMOVE HOSPITALS 330044 AND 330245 FROM * * 401 HOSPITAL LOGIC EFFECTIVE 1/1/07 * * * * 08/21/07- PREPARE FOR VERSION 2008.1.0 UPDATE: * * ADDED 7000-... PARAGRAPHS TO PREPARE FOR * * JANUARY 2008 RELEASE * * * * 10/30/07- VERSION 2008.1.0 UPDATES: * * THROUGH - DOCUMENT ENTIRE PROGRAM (COMMENTS) * * 12/07/07 - CREATED CAL-VERSION7 * * - NEW APC TABLE * * - NEW CBSA WAGE INDEX TABLE * * - NEW OFFSET TABLE (ALL OFFSETS = $0) * * - NEW DEVICE REDUCTION TABLE * * - NEW BLOOD DEDUCTIBLE HCPCS TABLE * * - TABLE FOR COMPOSITE APCS CREATED * * - TABLE FOR MENTAL HEALTH (MH) HCPCS CREATED * * - TABLE FOR PARTIAL HOSPITALIZATION (PHP) * * HCPCS CREATED * * - NEW FLAGS: APC34-FLAG, PHP-HCPCS-FLAG, * * MH-HCPCS-FLAG, BRACHY-APC-FLAG, & * * BLD-DEDUC-HCPCS-FLAG * * - NEW INPATIENT LIMIT (H-IP-LIMIT) = $1,024 * * - NEW OUTLIER THRESHOLD = $1,575 * * - NEW CY 2008 CBSA WAGE INDEX FLOORS * * - NEW CY 2008 SECTION 401 HOSPITALS * * - REMOVED PAID AT COST LOGIC - PARAGRAPHS * * 7550-PD-AT-CST-JAN07 & 7550-PD-AT-CST-JUL07 * * - PHP & MH HCPCS ADDED TO LINE ITEM ACTION * * FLAG VALIDATION LOGIC * * - NEW PAYMENT ADJUSTMENT FLAG OF ' 8' & * * CORRESPONDING PARTIAL CREDIT DEVICE * * REDUCTION LOGIC ADDED - 7550-DEVICE-COMPUTE * * (APC PMT REDUCED BY 1/2 THE REDUCTION AMT) * * - PHP HCPCS ADDED TO SITE OF SERVICE VALIDA- * * TION LOGIC * * - ADDED LOGIC TO EXCLUDE COMPOSITE AND MENTAL * * HEALTH CHARGES FROM TOTAL CLAIM PACKAGED * * CHARGES * * - ADDED LOGIC TO ACCUMULATE PACKAGED MENTAL * * HEALTH CHARGES & ADD THEM TO THE APC 34 * * LINE'S CHARGES FOR OUTLIER CALCULATION * * - ADDED LOGIC TO ACCUMULATE NON-PRIME * * COMPOSITE APC CHARGES & ADD THEM TO THE * * PRIME LINE'S CHARGES FOR OUTLIER CALC * * (NEW PARAGRAPHS: 7170-COMPOSITES, * * 7171-SEARCH-PAF, 7172-ADD-ENTRY, * * 7173-UPDATE-ENTRY, 7174-STAGE-CMP-ENTRY) * * - ADDED DISCOUNT FACTOR VALUE OF 9 & * * CORRESPONDING DISCOUNT CALCULATION * * - 7560-CALC-BENE-DEDUCT PERFORM MOVED FROM * * 7550-SCH-ADJ TO 7550-CALC-STANDARD * * - LIST OF BRACHYTHERAPY APCS CREATED IN NEW * * PARAGRAPH 7650-SET-BRACHY-APC-FLAG * * - NEW LIST OF BLOOD DEDUCTIBLE HCPCS IN NEW * * PARAGRAPH 7655-SET-BD-HCPCS-FLAG * * - 7550-CALC-GJK MODIFIED TO CHECK BLOOD * * DEDUCTIBLE HCPCS FLAG INSTEAD OF LIST * * - 7550-SCH-ADJ & 7550-CALC-GJK MODIFIED TO * * APPLY THE SOLE COMMUNITY HOSPITAL ADJ. TO * * BRACHYTHERAPY & BLOOD LINES WHEN APPLICABLE * * - ADDED LOGIC TO CALCULATE LINE REIMBURSEMENT * * & NATIONAL COININSURANCE TO PARAGRAPH * * 7550-CALC-STANDARD (COPIED FROM LOGIC IN * * 7550-PD-AT-CST-JAN07, WHICH WAS DELETED * * ALONG WITH 7550-PD-AT-CST-JUL07 FOR CY 2008)* * * * 12/17/07- VERSION 2008.1.1 UPDATES: * * - REVISED STEP #12 & #13 IN THE PRICING * * PROCESS OVERVIEW FOR THE 7000 SECTION * * - ADDED A PERIOD AFTER THE H-NAT-COIN COMPUTE * * IN PARAGRAPH 7550-CALC-STANDARD & MOVED * * H-MIN-COIN MOVE STATEMENT * * * * 12/27/07- VERSION 2008.1.2 UPDATES: * * - BRACHYTHERPY AND RADIOPHARM LINES' STATUS * * INDICATORS CHANGED BACK TO 'H' IN THE OCE * * - INSERT PAID-AT-COST LOGIC FOR BRACHYTHERAPY * * AND RADIOPHARM LINES * * - NO PAID-AT-COST TABLE FOR 2008 * * - RADIOPHARM APCS ARE IDENTIFIED BY * * RADIOPH-APC-FLAG = 'Y' * * NEW PARAGRAPH: 7660-SET-RADIOPH-APC-FLAG * * - BRACHYTHERAPY APCS ARE IDENTIFIED BY * * BRACHY-APC-FLAG = 'Y' * * - NEW LOGIC FOR BRACHYTHERAPY LINES WITH A * * STATUS INDICATOR OF 'K' RETAINED BECAUSE * * NO LINES WILL MEET THE CRITERIA; AND * * THEREFORE, NO CLAIMS WILL BE AFFECTED * * * * 02/08/08 - UPDATED RECORDS OF 24 APCS IN THE APC TABLE * * THESE RECORDS INCORRECTLY HAD A STATUS * * INDICATOR OF 'K' IN THE JANUARY RELEASE, * * THEIR STATUS INDICATORS WERE CHANGED TO 'H' * * AND THEIR PAYMENT RATES AND COINSURANCE * * AMOUNTS WERE CHANGED TO $0 * * * * 02/08/08 - ADDED NEW TABLES AND LOGIC FOR ADDING PASS- * * THROUGH THROUGH DEVICE CHARGES AND PAYMENTS TO ELIG- * * 02/14/08 IGIBLE PROCEDURES FOR OUTLIER DETERMINATION * * - IN PARAGRAPH 7600-ADJ-CHRG-OUT, A-LITEM-PYMT * * IS NO LONGER USED IN THE OUTLIER CALCS. * * H-LITEM-PYMT-OUTL IS USED INSTEAD * * - USES NEW APC TABLE THAT INCLUDES STATUS * * INDICATOR CHANGES FOR 24 APCS (FROM K TO H) * * AND 2 DELETED HCPCS EFFECTIVE 4/1/08 (APCS * * 1691 & 1692) * * - ROUNDED W-SUB-CHRG WHEN ADDING COMPOSITES IN * * PARAGRAPH 7600-ADJ-CHRG-OUT * * - CODE CHANGES AND ADDITIONS ARE AS FOLLOWS: * * * * LOGIC ADDED TO * * PARAGRAPHS: 7150-INIT * * 7125-INIT * * 7400-CALCULATE * * 7555-CALC-H-STANDARD * * 7600-ADJ-CHRG-OUTL * * * * NEW TABLES: W-PTD-PROC-HCPCS-TBL * * W-PASS-THRU-DEV-PTR-TABLE * * * * NEW PARAGRAPHS: 7390-PASS-THRU-DEVICES * * 7391-STAGE-ENTRY * * 7392-PASS-THRU-DEV-PROCS * * 7393-PERFORM-SEARCH * * 7394-SEARCH-PTD-HCPCS * * 7395-UPDATE-ENTRY * * 7610-PERFORM-SEARCH * * 7611-SEARCH-PTD-HCPCS * * * * NEW VARIABLES: PTD-FLAG * * PTD-LINE-FLAG * * PTD-PROC-FLAG * * W-PTD-LINE-HCPCS * * W-PTD-CNT * * W-PTD-PROC-SUB * * W-END-OF-PTD-TBL * * W-PTD-MAX * * H-PTD-UNIT-RATE * * H-PTD-SUB-CHRG * * H-PTD-LITEM-PYMT * * H-LITEM-PYMT-OUTL * * * * 03/20/08- UPDATED APC TABLE WITH ASP DRUGS * * * * 05/13/08- UPDATED APC TABLE WITH THERAPEUTIC RADIOPHARM * * & BRACHYTHERAPY APC SI CHANGE TO ' K' AND TWO * * DRUG APCS' SI CHANGE FROM ' K' TO ' G' * * (26 TOTAL APC CHANGES) * * * * NEW HANDLING OF THERAPEUTIC RADIOPHARMS & * * BRACHYTHERAPY LINES EFFECTIVE 7/1/2008 * * (LOGIC CREATED IN JANUARY, ENABLED BY THE * * SI CHANGE TO ' K' ON 7/1/2008) * * - BRACHYTHERAPIES ARE ELIGIBLE FOR OUTLIER; * * THERAPEUTIC RADIOPHARMS ARE NOT * * - BRACHYTHERAPIES & THERAPEUTIC RADIOPHARMS * * ARE NO LONGER PAID-AT-COST * * - BRACHYTHERAPIES ARE ELIGIBLE FOR SCH ADJ.; * * THERAPEUTIC RADIOPHARMS ARE NOT * * * * 06/23/08- UPDATED APC TABLE WITH ASP DRUGS * * (271 TOTAL APC CHANGES) * * * * 08/07/08- UPDATED APC TABLE FOR OCTOBER 2008 RELEASE * * - CHANGED STATUS INDICATOR OF BRACHYTHERAPY * * SOURCE & THERAPEUTIC RADIOPHARM APCS FROM * * 'K' BACK TO 'H' - EFFECTIVE 7/1/2008 FOR * * 24 APCS * * - CHANGED STATUS INDICATOR OF APC 1711 FROM * * 'K' TO 'G' EFFECTIVE 10/1/2008 * * UPDATED PROGRAM COMMENTS FOR BRACHYTHERAPY & * * THERAPEUTIC RADIOPHARM SI CHANGE AND * * REVISED MENTAL HEALTH PACKAGING COMMENT IN * * THE OUTLIER ROUTINE. * * * * 08/08/08- CORRECTED PACKAGING LOGIC FOR MENTAL HEALTH * * CLAIMS EFFECTIVE RETROACTIVE TO JANUARY 1, * * 2008 IN PARAGRAPH 7150-INIT. * * * * 09/18/08- ADDED ASP DRUG UPDATES, APC RATE CORRECTIONS, * * & 3 NEW APCS EFFECTIVE 10/01/2008 TO THE APC * * TABLE (251 CHANGES & ADDITIONS). UPDATED * * PRICER VERSION NUMBER TO 2008.4.1. * * * * 11/03/08- CY 2009 UPDATES - VERSION 2009.1.0 * * - ADDED NEW COPY STATEMENTS FOR TABLES * * - CREATED NEW 8000- SECTION * * - ADDED FY 2009 FLOOR LOGIC * * - ADDED FY 2009 401 HOSPITAL LOGIC * * - CHANGED PARTIAL HOSPITALIZATION APC FLAG * * FROM APC33-FLAG TO PHP-APC-FLAG & UPDATED * * RELATED LOGIC * * * * 11/10/08- - ADDED SSRFBN09 TABLE AND COPY STATMENT * * - ADDED LOGIC TO APPLY SSRFBN TO CBSA WAGE * * INDEX VALUES BY PROVIDER STATE - ADDED * * PARAGRAPHS (LOGIC ADAPTED FROM LTCH PRICER * * V 2009.3 PROGRAM LTCAL093) * * - UPDATED DAILY INPATIENT COINSURANCE LIMIT * * TO $1068 * * - UPDATED OUTLIER THRESHOLD TO $1800 * * - UPDATED THE OCE RECORD LAYOUT: * * - SERVICE UNITS INCREASED FROM 7 TO 9 BYTES * * - ADDED COMPOSITE ADJUSTMENT FLAG, 2 BYTES * * (OPPS-COMP-ADJ-FLAG) * * * * 11/12/08- - DISABLED LOGIC THAT FLAGS CLAIMS WITH * * HCPCS C1820 B/C NO HCPCS ARE ELIGIBLE FOR * * PASS-THROUGH FOR CY 2009 (7125-INIT) * * - REMOVED PASS-THROUGH DEVICE (PTD) LIST & * * PROCEDURES ELIGIBLE FOR PTD LIST B/C THERE * * ARE NO PAIRINGS FOR CY 2009 * * (8665-SET-PTD-LINE-FLAG, * * 8670-SET-PTD-PROC-FLAG) * * - CHANGED SECOND PTD-FLAG CHECK IN PARAGRAPH * * 8600-ADJ-CHRG-OUTL TO PTD-PROC-FLAG CHECK * * - CHANGE LOGIC TO LOOK AT COMPOSITE ADJUSTMENT* * FLAG (NEW FOR CY 2009) INSTEAD OF PAYMENT * * ADJUSTMENT FLAGS 91 - 99 TO ID COMPOSITES * * - BRACHYTHERAPY APC LIST REMOVED, * * BRACHYTHERAPY LINES NOW IDENTIFIED WITH A * * STATUS INDICATOR OF ' U' * * PARAGRAPH 8650-SET-BRACHY-APC-FLAG DISABLED * * - ADDED ' U' AND ' R' TO LIST OF VALID STATUS * * INDICATORS FOR BRACHY AND BLOOD LINES * * * * 11/13/08- - EXCLUDED THERAPEUTIC RADIOPHARM LINES FROM * * CLAIM DEVICE UNITS CALC, CLAIM DEVICE * * CHARGES CALC, AND WAGE ADJ DEVICE OFFSET * * CALC * * - EXCLUDED BRACHYTHERAPIES FROM OUTLIER CALC * * - ADDED VARIABLES AND CALC LINE PAYMENTS FOR * * APC 0173 - WITH AND WITHOUT SCH ADJ. * * - ALTERED PHP OUTLIER LOGIC TO ALWAYS USE THE * * PHP "CAP" APC'S LINE PAYMENT IN THE CALC * * - EXCLUDED BRACHY LINES FROM ALL DEVICE LOGIC * * - ADDED REDUCED UPDATE RATIO FOR HOSPITAL * * QUALITY INDICATOR, PAR 8180-REDUCE-APC-PYMT * * - REVISED ALL SI = K LOGIC TO ACCOMODATE * * BLOOD DEDUCTIBLE LINE SI CHANGE FROM K TO R * * (SCH PYMT, BLOOD DEDUCTIBLE CALCS) * * * * 11/24/08- - REVISED COMMENT IN 8560-CALC-BENE-DEDUCT * * TO EXPLAIN THAT LINES WITH A PAF=4 ARE * * CLINICAL TRIAL LINES FOR MANAGED CARE BENES * * * * 12/02/08- - INCREASED H-SRVC-UNITS, W-BD-SRVC-UNITS, * * AND W-SRVC-UNITS FROM 7 TO 9 BYTES * * - INCREASED FILLER IN GROUP OCE-IN-DATE * * FROM 21 TO 23 TO ACCOUNT FOR INCREASE IN * * UNITS * * * * 12/05/08- - ASSIGNED RETURN CODE 11 IN PARAGRAPH * * 8180-REDUCE-APC-PYMT WHEN THE ABSENCE OF * * QUALITY REPORTING LEADS TO A REDUCED PMT, * * ADDED SI=R TO ELIGIBLE SI LIST * * - CORRECTED SCH LOGIC TO CALCULATE BLOOD * * LINES INELIGIBLE FOR A DEDUCTIBLE * * - IN PARAGRAPH 8550-CALC-GJK, CORRECTED LOGIC * * TO CALCULATE THE SCH ADJUSTMENT (WHEN * * APPLICABLE) FOR BLOOD LINES THAT DON'T HAVE * * A PAF OF 5 OR 6 * * - IN PARAGRAPH 8600-ADJ-CHRG-OUTL ADDED * * SI=K TO LIST OF SIS INELIGIBLE FOR OUTLIERS * * * * 12/18/08- CREATE VERSION 2009.1.1 * * - UPDATED APC TABLE WITH ASP DRUGS * * (325 TOTAL APC CHANGES) * * * * 02/09/09- CREATE VERSION 2009.2.0 (FOR APRIL 2009) * * 2009.2.0 ADD COMMENT TO PARAGRAPH 7600-ADJ-CHRG-OUTL * * TO EXPLAIN THAT NO CY 2008 BLOOD LINES ARE * * PAID AN OUTLIER * * * * 02/10/09- ADD COMMENTS TO WORKING STORAGE SECTION * * 2009.2.0 MOVED LOCATION OF PASS-THROUGH DEVICE * * PROCEDURE TABLE IN WORKING STORAGE FOR * * ORGANIZATIONAL PURPOSES * * * * 02/10/09- ADD LOGIC TO PROCESS PASS-THROUGH * * THROUGH RADIOPHARMACEUTICAL OFFSETS * * 02/13/09 * * 2009.2.0 NEW COPYBOOKS: * * - PT RADIOPHARM HCPCS TABLE (OPPSPTRH) * * (HCPCS WITH EFFECTIVE DATE & * * TERMINATION DATE) * * - PT RADIOPHARM OFFSET TABLE (OPPSPTRO) * * (NUCLEAR APCS WITH OFFSET * * AMOUNTS & EFFECTIVE YEAR) * * * * NEW WORKING-STORAGE TABLE: * * - W-NUCMED-APC-TBL * * * * NEW VARIABLES: * * - PTRADIO-CLAIM-FLAG * * - PTRADIO-LINE-FLAG * * - W-PTRADIO-LINE-HCPCS * * - W-PTRADIO-CHRG-RATE * * - W-PTRADIO-LINE-OFFSET * * - NUCMED-LINE-FLAG * * - W-NUCMED-LINE-APC * * - W-NUCMED-SUB * * - W-NUCMED-UNIT-CNT * * - W-END-OF-NUCMED-TBL * * - W-NUCMED-OFFSET * * - W-NUCMED-WA-OFFSET * * - W-LINE-SRVC-DATE * * - H-PTRADIO-TOT-CHRGS * * - H-NUCMED-TOT-OFFSET * * - H-PTRADIO-HCPCS-CNT * * * * NEW PARAGRAPHS: * * - 8165-PROCESS-NUCLEAR-MED * * - 8166-LOAD-NUCMED-TABLE * * - 8167-STAGE-NUCMED-ENTRY * * - 8550-PTRADIO-OFFSET * * - 8680-SET-PTRADIO-LINE-FLAG * * * * EXISTING PARAGRAPHS WITH NEW LOGIC: * * - 8000-PROCESS-MAIN-NEW * * - 8100-INIT * * - 8125-INIT * * - 8150-INIT * * - 8550-CALC-STANDARD * * * * 03/19/09- CREATE VERSION 2009.2.1 * * 2009.2.1 - UPDATED APC TABLE WITH ASP DRUGS * * (254 TOTAL APC CHANGES) * * * * 03/26/09- CREATE VERSION 2009.2.2 * * 2009.2.2 - CORRECTED MEMBERS OPPSPTRO AND BASEPTRO BY * * ADDING APC 00414 TO NUCLEAR MEDICINE LIST * * PER HPAR CR6416H * * * * 05/08/09- CREATE VERSION 2009.3.0 * * 2009.3.0 UPDATED WORKING STORAGE VERSION NUMBER * * * * 05/11/09- REVISED LOGIC THAT IDENTIFIES LINES ELIGIBLE * * 2009.3.0 FOR BLOOD DEDUCTIBLE FOR YEARS 2005 - 2009. * * IN ADDITION TO HAVING A HCPCS IN BD TABLE, * * OPPS-PYMT-ADJ-FLAG (LN-SUB) = (' 5' OR ' 6') * * EXISTING PARAGRAPHS WITH NEW LOGIC: * * - 4150-INIT * * - 5150-INIT * * - 6150-INIT * * - 7150-INIT * * - 8150-INIT * * - 8550-SCH-ADJ * * * * 05/12/09- REVISED LOGIC FOR YEARS 2005 - 2008 TO ALLOW * * 2009.3.0 ALL BLOOD LINES TO ENTER THE OUTLIER LOGIC BY * * IDENTIFYING BLOOD LINES BY HCPCS * * NEW TABLE: W-2005-2008-BLOOD-HCPCS-TABLE * * NEW VARIABLE: W-BLD-HCPCS-FLAG * * EXISTING PARAGRAPHS WITH NEW LOGIC: * * - 4600-ADJ-CHRG-OUTL * * - 5600-ADJ-CHRG-OUTL * * - 6600-ADJ-CHRG-OUTL * * - 7600-ADJ-CHRG-OUTL * * * * 05/12/09- REVISED CY 2008 LOGIC FOR MENTAL HEALTH * * 2009.3.0 COMPOSITES TO DISTRIBUTE PACKAGED MENTAL * * HEALTH CHARGES EVENLY TO ALL PAYABLE APC 34 * * LINES ON THE CLAIM * * NEW VARIABLE: W-APC34-CNT * * EXISTING PARAGRAPHS WITH NEW LOGIC: * * - 7125-INIT * * - 7600-ADJ-CHRG-OUTL * * * * 05/14/09- CORRECTED FORMAT OF FIELD W-BD-RANK * * 2009.3.0 CHANGED FROM PIC 9(05) TO PIC 9(02) * * AFFECTS BLOOD DEDUCTIBLE PAYMENTS FOR YEARS * * 2005 THROUGH 2009; BEFORE CORRECTION BLOOD * * DEDUCTIBLE APC LINES WERE NOT ORDERED FROM * * LOWEST TO HIGHEST RANK (APC PMT) AS INTENDED * * * * 06/18/09- CREATE VERSION 2009.3.1 * * 2009.3.1 - ADDED PERIODS TO END IF STATEMENTS IN * * PARAGRAPH 4550-ADJ-PLATE-COST * * - UPDATED APC TABLE WITH ASP DRUGS * * (270 TOTAL APC CHANGES) * * - UPDATED WORKING STORAGE VERSION NUMBER * * - UPDATED CAL-VERSION TO REFLECT THE THIRD * * QUARTER UPDATE * * * * 06/23/09- CREATE VERSION 2009.3.2 * * 2009.3.2 - UPDATED APC TABLE WITH JULY ASP DRUG RATES * * (270 TOTAL APC CHANGES; 2 CHANGES SINCE THE * * LAST RELEASE: CORRECTIONS TO RATES OF APCS * * 01608 AND 01686) * * - UPDATED WORKING STORAGE VERSION NUMBER * * * * 08/07/09- CREATE VERSION 2009.4.0 (OCTOBER 2009) * * 2009.4.0 - REVISED LOGIC TO ENSURE ELIGIBLE BLOOD * * LINES RECEIVE THE SOLE-COMMUNITY HOSPITAL * * (SCH) ADJUSTMENT FOR YEARS 2006-2008 * * EXISTING PARAGRAPHS WITH NEW LOGIC: * * - 5550-CALC-STANDARD * * - 6550-CALC-STANDARD * * - 5550-CALC-GJK * * - 6550-CALC-GJK * * - 7550-CALC-GJK * * - 5550-SCH-ADJ * * - 6550-SCH-ADJ * * - 7550-SCH-ADJ * * * * 09/17/09- CREATE VERSION 2009.4.1 (OCTOBER 2009) * * 2009.4.1 - UPDATED APC TABLE WITH ASP DRUGS * * (296 TOTAL APC CHANGES) * * * * 10/13/09- CREATE VERSION 2010.1.0 (JANUARY 2010) * * 2010.1.0 - ADD 9000- SECTION AND PERFORM * * - ADDED CAL-VERSION9; UPDATED W-STORAGE-REF * * * * 11/13/09- MAKE UPDATES FOR CY 2010 VERSION 2010.1.0 * * 2010.1.0 - CBSA RURAL FLOOR ASSIGNMENTS * * 9120-FLOOR-2010 * * - SECTION 401 HOSPITAL ASSIGNMENTS * * 9120-SEC401-2010 * * - INPATIENT DAILY COINSURANCE LIMIT: $1,100 * * H-IP-LIMIT * * - RURAL FLOOR BUDGET NEUTRALITY TABLE SEARCH * * 9220-APPLY-SSRFBN, 9225-FIND-SSRFBN * * - BLOOD DEDUCTIBLE HCPCS LIST & TABLE SEARCH * * 9655-SET-BD-HCPCS-FLAG, * * W-2010-BLOOD-APC-FILLS, * * W-2010-BLOOD-APC-TABLE * * - OUTLIER THRESHOLD: $2,175 * * 9600-ADJ-CHRG-OUTL * * - QUALITY RATIO: 0.980, 9180-REDUCE-APC-PYMT * * - DEVICE REDUCTION COPYBOOK & TABLE SEARCH * * 9550-DEVICE-REDUC, 9550-DEVICE-COMPUTE, * * DEVRED10 * * - MENTAL HEALTH HCPCS COPYBOOK & TABLE SEARCH * * 9150-INIT, OPPSMH10 * * - PARTIAL HOSPITALIZATION (PHP) HCPCS COPYBOOK* * & TABLE SEARCH, 9150-INIT, OPPSPH10 * * * * 11/13/09- MAKE UPDATES FOR CY 2010 VERSION 2010.1.0 * * 2010.1.0 - PASS-THROUGH RADIOPHARM HCPCS & NUCLEAR * * MEDICINE APC OFFSETS * * BASEPTRH, BASEPTRO, OPPSPTRH, OPPSPTRO * * - PASS-THROUGH CONTRAST AGENT HCPCS & * * PROCEDURE APC OFFSETS COPYBOOKS * * BASEPTCH, BASEPTCO, OPPSPTCH, OPPSPTCO * * * * 11/14/09- MAKE UPDATES FOR CY 2010 VERSION 2010.1.0 * * 2010.1.0 - STATE-SPECIFIC RURAL FLOOR BUDGET * * NEUTRALITY TABLE: ADDED YEAR (10) TO * * COPYBOOK VARIABLE NAMES (SSRFBN10) & * * UPDATED VARIABLES IN LOGIC ACCORDINGLY * * 9220-APPLY-SSRFBN, 9225-FIND-SSRFBN * * - CBSA WAGE INDEX HISTORY TABLE (OPPSWNXC) * * - APC RATE HISTORY TABLE (OPPSAPCS) * * * * 11/15/09- MAKE UPDATES FOR CY 2010 VERSION 2010.1.0 * * 2010.1.0 - ENSURE BRACHYTHERAPY SERVICES (SI = U) ARE * * GIVEN REGULAR APC PAYMENT LIKE SI G, K, & R * * NO LONGER PAID AT COST * * 9550-CALC-STANDARD, 9550-CALC-GJK * * - ENSURE THERAPEUTIC RADIOPHARM SERVICES * * (PREVIOUSLY SI = H, NOW SI = K) ARE GIVEN * * REGULAR APC PAYMENT LIKE SI G, K, & R * * NO LONGER PAID AT COST * * 9550-CALC-STANDARD, 9550-CALC-GJK * * - REMOVE LOGIC FOR PAID-AT-COST RADIOPHARMS * * 9150-INIT * * 9660-SET-RADIOPH-APC-FLAG * * 9550-CALC-STANDARD * * 9555-CALC-H-TOT * * 9555-CALC-H-STANDARD * * * * 11/16/09 - CREATE TABLES & LOGIC FOR NEW PASS-THROUGH * * 2010.1.0 CONTRAST AGENT LOGIC * * * * NEW VARIABLES: * * - PTCA-CLAIM-FLAG * * - PTCA-LINE-FLAG * * - W-PTCA-LINE-HCPCS * * - W-PTCA-CHRG-RATE * * - W-PTCA-LINE-OFFSET * * - W-CAPROC-LINE-APC * * - W-CAPROC-SUB * * - W-CAPROC-UNIT-CNT * * - W-CAPROC-OFFSET * * - W-CAPROC-KEY * * - H-PTCA-LIDOS * * * * NEW WORKING-STORAGE TABLES: * * - W-PTCA-DAY-TBL * * - W-CAPROC-APC-TBL * * * * EXISTING PARAGRAPHS AFFECTED: * * - 9000-PROCESS-MAIN-NEW * * - 9100-INIT * * - 9125-INIT * * - 9150-INIT * * - 9550-CALC-STANDARD * * * * NEW PARAGRAPHS: * * - 9130-LOAD-PTCA-DAY-TABLE...(& CALLED PARS)* * - 9168-PROCESS-PTCA-PROC...(& CALLED PARS) * * - 9396-TOTAL-DAY-PTCA-OFFS * * - 9550-PTCA-OFFSET * * - 9681-SET-PTCA-LINE-FLAG * * * * 11/17/09 - MAKE BRACHYTHERAPY SERVICES (SI=U) ELIGIBLE * * 2010.1.0 FOR OUTLIER PAYMENT, 9600-ADJ-CHRG-OUTL * * - MAKE BRACHYTHERAPY SERVICES (SI=U) ELIGIBLE * * FOR SOLE COMMUNITY HOSPITAL (SCH) * * ADJUSTMENT, 9550-SCH-ADJ, 9550-CALC-GJK * * * * 12/02/09- CREATE VERSION 2010.1.1 (JANUARY 2010) * * 2010.1.1 - TEST AND CORRECT NEW PASS-THROUGH CONTRAST * * AGENT OFFSET LOGIC * * - REVISE LOGIC IN PARAGRAPH 9550-PTCA-OFFSET * * TO SET OFFSET PAYMENT TO $0 WHEN THE OFFSET * * AMOUNT IS GREATER THAN THE PAYMENT * * 12/03/09 - REVISED LOGIC IN 9396-TOTAL-DAY-PTCA-OFFS * * 2010.1.1 TO LIMIT PERFORM LOOPS TO THE VALUE OF * * W-CAPROC-UNIT-CNT INSTEAD OF W-CAPROC-INDX * * - CORRECT BRACHYTHERAPY STATUS INDICATOR * * IN PAR. 9550-CALC-STANDARD. CHANGED FROM * * 'U' TO ' U' * * * * 12/16/09- CREATE VERSION 2010.1.2 (JANUARY 2010) * * 2010.1.2 - ADD SIS ELIGIBLE FOR OUTLIER PAYMENT TO * * LOGIC THAT DISTRIBUTES PACKAGED CHARGES TO * * PAYABLE LINES. * * CY 2009: 8600-ADJ-CHRG-OUTL, SI R * * CY 2010: 9600-ADJ-CHRG-OUTL, SIS R AND U * * - UPDATE APC TABLE WITH ASP DRUGS * * (296 TOTAL APC UPDATE RECORDS) * * 12/18/09 - ADD SIS ELIGIBLE FOR OUTLIER PAYMENT TO * * 2010.1.2 LOGIC THAT SUMS OUTLIER ELIGIBLE LINE PMTS * * CY 2009: 8500-ADJ-CHRGS, SI R * * CY 2010: 9500-ADJ-CHRGS, SIS R AND U * * 12/22/09 - UPDATE APC TABLE WITH ASP DRUGS * * 2010.1.2 (296 TOTAL APC UPDATE RECORDS - CORRECTION) * * * * 12/30/09- CREATE VERSION 2010.2.0 (APRIL 2010) * * 2010.2.0 - ADD LOGIC TO CATCH DIVISION BY ZERO ERROR * * IN PARAGRAPHS 8550-PTRADIO-OFFSET, * * 9550-PTRADIO-OFFSET, & 9550-PTCA-OFFSET * * (NOTE: FISS EDITS REQUIRE CHARGES TO BE * * > $0, SO THIS CODE IS PRECAUTIONARY, NOT * * NECESSARY FOR FISS.) * * * * 03/19/10- - UPDATED APC TABLE WITH APRIL 2010 ASP DRUG * * 2010.2.0 RATES (274 TOTAL RECORD CHANGES) * * * * 04/03/10- CREATE VERSION 2010.2.1 (ACA RELEASE) * * 2010.2.1 ACA = AFFORDABLE CARE ACT (HEALTH REFORM) * * - UPDATED APC TABLE WITH JANUARY 2010 AND * * APRIL 2010 ASP DRUG RATES (427 & 423 RECORD * * CHANGES RESPECTIVELY) REVISED IN RESPONSE * * TO THE ACA * * 04/04/10 - CREATED NEW PT RADIO OFFSET HISTORY TABLE * * 2010.2.1 (NUCLEAR MEDICINE APCS) TO REFLECT ACA * * CHANGES - SAME TABLE NAME, EFFECTIVE * * RETROACTIVELY 1/1/10 * * (OPPSPTRO) * * - CREATED NEW DEVICE REDUCTION (FB/FC) TABLE * * TO REFLECT ACA CHANGES - SAME TABLE NAME, * * EFFECTIVE RETROACTIVELY 1/1/10 * * (DEVRED10) * * - CREATED NEW PASS-THROUGH CONTRAST AGENT * * OFFSET TABLE TO REFLECT ACA CHANGES - SAME * * TABLE NAME, EFFECTIVE RETROACTIVELY 1/1/10 * * (OPPSPTCO) * * * * 05/06/10- CREATE VERSION 2010.3.0 (JULY 2010) * * 2010.3.0 - UPDATED VERSION AND QUARTER NUMBERS IN PGM * * 05/13/10 - UPDATED BASEWNXC & OPPSWNXC WITH RECORDS * * 2010.3.0 EFFECTIVE 07/01/2010 (CORRESPOND TO IPPS * * RECORDS EFFECTIVE 04/01/2010) - DUE TO IPPS * * SECTION 508 POLICY EXTENSION MANDATED BY * * 2010 ACA * * - CREATED NEW STATE-SPECIFIC RURAL FLOOR * * BUDGET NEUTRALITY FACTOR TABLE EFFECTIVE * * 07/01/2010 (SSRFB10B) - INCLUDES CORRECTED * * FLORIDA FACTOR (DUE TO SECTION 508 EXT.) * * - ADDED NEW LOGIC AND PARAGRAPHS TO APPLY * * FACTORS FROM SSRFB10B TO CLAIMS DISCHARGED * * AFTER 6/30/2010 * * AFFECTED PARAGRAPH: 9200-CALC-WAGEINDX * * NEW PARAGRAPHS: 9226-APPLY-SSRFBN-2ND-HALF * * 9227-FIND-SSRFBN-2ND-HALF * * - CORRECTED FLOOR LOGIC FOR CBSA 33 * * AFFECTED PARAGRAPH: 9120-FLOOR-2010 * * * * 05/20/10- UPDATE TABLES TO REFLECT CORRECTIONS TO THE * * 2010.3.0 ACA RATE UPDATES (TABLES COPIED FROM VERSION* * 2010.2.2); ERROR DUE TO INCORRECT BUDGET * * NEUTRALITY FACTOR USED TO CALCULATE RATES * * IN VERSION 2010.2.1 * * VERSION 2010.2.2 REPLACED BY THIS VERSION * * - UPDATED APC TABLE WITH JANUARY 2010 AND * * APRIL 2010 ASP DRUG RATES (427 & 423 RECORD * * CHANGES RESPECTIVELY) REVISED IN RESPONSE * * TO THE ACA * * - CREATED NEW PT RADIO OFFSET HISTORY TABLE * * (NUCLEAR MEDICINE APCS) TO REFLECT ACA * * CHANGES - SAME TABLE NAME, EFFECTIVE * * RETROACTIVELY 1/1/10 * * (OPPSPTRO) * * - CREATED NEW DEVICE REDUCTION (FB/FC) TABLE * * TO REFLECT ACA CHANGES - SAME TABLE NAME, * * EFFECTIVE RETROACTIVELY 1/1/10 * * (DEVRED10) * * - CREATED NEW PASS-THROUGH CONTRAST AGENT * * OFFSET TABLE TO REFLECT ACA CHANGES - SAME * * TABLE NAME, EFFECTIVE RETROACTIVELY 1/1/10 * * (OPPSPTCO) * * * * 06/17/10- CREATE VERSION 2010.3.1 (JULY 2010) * * 2010.3.1 - UPDATED APC TABLE WITH ASP DRUGS * * (276 TOTAL APC RECORDS ADDED) * * - UPDATED W-STORAGE-REF WITH NEW VERSION # * * * * 06/22/10- CREATE VERSION 2010.3.2 (JULY 2010) * * 2010.3.1 - UPDATED APC TABLE WITH ASP DRUGS * * (276 TOTAL APC RECORDS ADDED) * * CORRERCTION TO PREVIOUS TABLE - RECORD FOR * * APC 01310 ADDED, RECORD FOR APC 01239 * * DELETED. * * - UPDATED W-STORAGE-REF WITH NEW VERSION # * * * * 08/02/10- CREATE VERSION 2010.4.0 (OCTOBER 2010) * * THRU - UPDATED W-STORAGE-REF WITH NEW VERSION # * * 08/13/10 - UPDATED CAL-VERSION9 WITH NEW QTR # * * 2010.4.0 - START CODING REVISED PASS-THROUGH DEVICE * * OFFSET LOGIC FOR CY 2010 - DEVICE C1749 IS * * NEW EFFECTIVE 10/01/2010 * * * * NEW COPYBOOK: * * - OPPSPTDO * * * * NEW VARIABLES: * * - PTDO-CLAIM-FLAG * * - PTDO-LINE-FLAG * * - W-PTDO-LINE-HCPCS * * - W-PTDO-CHRG-RATE * * - W-PTDO-LINE-OFFSETET * * - W-PTDO-EOF-SWITCH * * - W-DOPROC-LINE-APC * * - W-DOPROC-SUB * * - W-DOPROC-UNITS * * - W-DOPROC-OFFSET * * - W-DOPROC-KEY * * - H-PTDO-CHRGUNIT * * - H-PTDO-ASSOC-HCPCS-CTR * * - H-PTDO-PROC-KEY * * * * NEW WORKING-STORAGE TABLES: * * - W-PTDO-HCPCS-TBL * * - W-PTDO-PROC-TBL * * - W-PTDO-ASSOC-HCPCS-TBL * * * * EXISTING PARAGRAPHS AFFECTED: * * - 9000-PROCESS-MAIN-NEW * * - 9100-INIT * * - 9125-INIT * * - 9150-INIT * * - 9550-CALC-STANDARD * * - 9555-CALC-H-STANDARD * * * * NEW PARAGRAPHS: * * - 9132-LOAD-PTDO-HCPCS-TBL * * - 9132-ADD-ENTRY * * - 9132-STAGE-PTDO-HCPCS-ENTRY * * - 9169-PROCESS-PTDO-PROC * * - 9169-LOAD-ASSOC-PTD-HCPCS * * - 9169-COUNT-PTDO-MAPPINGS * * - 9169-LOAD-PTDO-PROC-TABLE * * - 9169-STAGE-PTDO-PROC-ENTRY * * - 9397-PTDO-MAPPINGS-1 * * - 9397-PTDO-MAPPINGS-2 * * - 9556-CALC-PTDO-OFFSET * * - 9682-SET-PTDO-LINE-FLAG * * * * DISABLED/DELETED PARAGRAPHS: * * - 9160-TOTAL-OFFSET * * - 9161-TOTAL-OFFSET-AMT * * - 9555-CALC-H-TOT * * - 9700-CALC-H-OFFSET * * * * 08/12/10- - UPDATE PARAGRAPHS 9665-SET-PTD-LINE-FLAG & * * 2010.4.0 9670-SET-PTD-PROC-FLAG TO PROCESS NEW PASS- * * THROUGH DEVICE & CORRESPONDING PROCEDURES * * - UPDATE APC TABLE WITH THE NEW PASS-THROUGH * * DEVICE APC * * - CREATE, UPDATE OPPSPTDO TABLE FOR REVISED * * PASS-THROUGH DEVICE LOGIC * * * * 09/16/10- CREATE VERSION 2010.4.1 (OCTOBER 2010) * * 2010.4.1 - UPDATED APC TABLE WITH ASP DRUGS * * (273 TOTAL APC RECORDS ADDED/UPDATED) * * - UPDATED W-STORAGE-REF WITH NEW VERSION # * * * * 11/03/10- CREATE VERSION 2011.1.0 (JANUARY 2011) * * THRU - UPDATED W-STORAGE-REF WITH NEW VERSION # * * 11/16/10 - ADDED CAL-VERSION10 FOR CY 2011 CALL * * 2011.1.0 - UPDATED PARAGRAPH NAMES TO REFLECT 10000 * * SERIES * * - UPDATED BASEAPCS & OPPSAPCS, * * BASEPTCH & OPPSPTCH, * * BASEPTCO & OPPSPTCO, * * BASEPTRO & OPPSPTRO, * * BASEWNXC & OPPSWNXC, AND * * DEVRED11 TABLES * * - ADDED STATE RURAL FLOOR LOGIC FOR CY 2011 * * PARAGRAPH: 10120-FLOOR-2011 * * - ADDED SECTION 401 HOSPITAL LOGIC FOR CY 2011* * PARAGRAPH: 10120-SEC401-2011 * * - MODIFIED LOGIC IN PARAGRAPHS 10125-INIT & * * 10550-PHP-PMT-FOR-OUTL TO ACCOMODATE NEW * * APCS 00175 & 00176 FOR HOSPITAL BASED PHP * * LINES. SET PAYMENT TO APC 00176'S RATE FOR * * HOSPITAL PHP OUTLIER CALCULATIONS. * * - CHANGED H-IP-LIMIT TO 1132 * * - CHANGED OUTLIER THRESHOLD TO 2025 * * - ADDED SI = U (BRACHY) LINES TO QUALITY * * REDUCTION LOGIC FOR 2010 AND 2011 * * * * 12/16/10- CREATE VERSION 2011.1.1 (JANUARY 2011) * * 2011.1.1 - UPDATED APC TABLE WITH ASP DRUGS * * (331 TOTAL APC RECORDS ADDED/UPDATED) * * - UPDATED W-STORAGE-REF * * * * 12/22/10- CREATE VERSION 2011.1.2 (JANUARY 2011) * * 2011.1.2 - UPDATED APC TABLE WITH REVISED ASP TABLE * * (331 TOTAL APC RECORDS ADDED/UPDATED) * * - UPDATED W-STORAGE-REF * * * * 03/17/11- CREATE VERSION 2011.2.0 (APRIL 2011) * * 2011.2.0 - UPDATED APC TABLE WITH ASP DRUGS * * (259 TOTAL APC RECORDS ADDED/UPDATED) * * - UPDATED W-STORAGE-REF & CAL-VERSION10 * * * * 04/11/11- CREATE VERSION 2011.2.1 (APRIL 2011) * * 2011.2.1 - ADDED LOGIC TO PREVENT LINES WITH A PAYMENT * * ADJ. FLAG OF 9 FROM RECEIVING CO-INSURANCE * * AND DEDUCTIBLE, AND LINES WITH A PAF OF 10 * * FROM RECEIVING CO-INSURANCE TO IMPLEMENT * * THE PREVENTIVE SERVICES WAIVER FOR CY 2011. * * * * AFFECTED PARAGRAPHS: * * - 10150-INIT: PAFS 9 & 10 ADDED TO LIST OF * * VALID PAFS * * - 10560-CALC-BENE-DEDUCT: LINES WITH PAF 9 * * DIVERTED FROM DEDUCTIBLE CALC * * - 10550-CALC-STANDARD: CO-INSURANCE AMOUNTS * * (NAT, MIN, MAX, & RED) SET TO $0 & * * REIMBURSEMENT CALC MODIFIED FOR LINES * * WITH A PAF = 9 OR 10 * * * * 05/06/11- CREATE VERSION 2011.3.0 (JULY 2011) * * 2011.3.0 - UPDATED W-STORAGE-REF & CAL-VERSION10 * * 05/09/11 - ADDED LOGIC TO PREVENT BILL TYPE 14X FROM * * RECEIVING THE SOLE COMMUNITY HOSPITAL (SCH) * * 7.1% ADD-ON FOR YEARS 2006 - 2011. BECAUSE * * PRICER DOES NOT RECEIVE THE BILL TYPE FROM * * THE IOCE, PRICER IDENTIFIES BILL TYPE 14X * * AS CLAIMS WHERE ALL LINES HAVE A HCPCS * * IN THE RANGE OF 80000 - 89999, INCLUSIVE = * * LAB CODES. * * * * NEW VARIABLE: BILL14X-FLAG * * * * AFFECTED PARAGRAPHS: * * - 5100-INIT * * - 6100-INIT * * - 7100-INIT * * - 8100-INIT * * - 9100-INIT * * - 10100-INIT * * * * - 5125-INIT * * - 6125-INIT * * - 7125-INIT * * - 8125-INIT * * - 9125-INIT * * - 10125-INIT * * * * - 5550-SCH-ADJ * * - 6550-SCH-ADJ * * - 7550-SCH-ADJ * * - 8550-SCH-ADJ * * - 9550-SCH-ADJ * * - 10550-SCH-ADJ * * * * 06/17/11- CREATE VERSION 2011.3.1 (JULY 2011) * * 2011.3.1 - UPDATED APC TABLE WITH ASP DRUGS * * (304 TOTAL APC RECORDS ADDED/UPDATED) * * - UPDATED W-STORAGE-REF * * * * 08/09/11- CREATE VERSION 2011.4.0 (OCTOBER 2011) * * 2011.4.0 - UPDATED APC TABLE WITH TWO NEW NON-ASP APCS * * (2 TOTAL APC RECORDS ADDED/UPDATED) * * - UPDATED W-STORAGE-REF & CAL-VERSION10 * * - UPDATED PT DEVICE OFFSET HISTORY TABLE * * (OPPSPTDO) WITH TWO NEW DEVICES (C1830 & * * C1840) * * * * 08/15/11- - UPDATE PARAGRAPHS 10665-SET-PTD-LINE-FLAG & * * 2011.4.0 10670-SET-PTD-PROC-FLAG TO PROCESS NEW PASS-* * THROUGH DEVICES & CORRESPONDING PROCEDURES * * * * 09/15/11- CREATE VERSION 2011.4.1 (OCTOBER 2011) * * 2011.4.1 - UPDATED APC TABLE WITH ASP DRUGS * * (262 TOTAL APC RECORDS ADDED/UPDATED) * * - UPDATED W-STORAGE-REF * * * * 10/25/11- CREATE VERSION 2012.1.0 (JANUARY 2012) * * THRU - UPDATED W-STORAGE-REF WITH NEW VERSION # * * 11/07/11 - ADDED CAL-VERSION11 FOR CY 2012 CALL * * 2012.1.0 - ADDED NEW 11000 SECTION FOR CY 2012 LOGIC * * - UPDATED INPATIENT DAILY COIN. LIMIT TO 1156 * * - UPDATED OUTPATIENT THRESHOLD TO 1900 * * - ADDED STATE RURAL FLOOR LOGIC FOR CY 2012 * * PARAGRAPH: 11120-FLOOR-2012 * * - ADDED SECTION 401 HOSPITAL LOGIC FOR CY 2012* * PARAGRAPH: 11120-SEC401-2012 * * - NO STATE-SPECIFIC RFBN FOR CY 2012; LOGIC * * REMAINS DISABLED * * - UPDATED BASEAPCS & OPPSAPCS, * * BASEPTCH & OPPSPTCH, * * BASEPTCO & OPPSPTCO, * * BASEPTDO & OPPSPTDO, * * BASEPTRH & OPPSPTRH, * * BASEPTRO & OPPSPTRO, * * BASEWNXC & OPPSWNXC, * * DEVRED12, * * OPPSMH12, AND * * W-2012-BLOOD-APC-TABLE * * - UPDATED PT DEVICE OFFSET LOGIC IN PARAGRAPH * * 11665-SET-PTD-LINE-FLAG & PARAGRAPH * * 11670-SET-PTD-PROC-FLAG * * - UPDATED LIST OF BLOOD DEDUCTIBLE HCPCS IN * * PARAGRAPH 11655-SET-BD-HCPCS-FLAG TO * * REFLECT CY 2012 ORDER OF LOW TO HIGH APC * * PAYMENT RATE * * - MODIFIED CY 2011 & CY 2012 LOGIC TO APPLY * * PHP CAP TO PHP CMHC LINES (APC 173) ONLY, * * NOT TO PHP HOSPITAL LINES (PREVIOUSLY APC * * 176) FOR THE OUTLIER CALCULATION PER * * DIRECTION FROM POLICY. PARAGRAPHS AFFECTED: * * - 10550-PHP-PMT-FOR-OUTL * * - 10600-ADJ-CHRG-OUTL * * - 11550-PHP-PMT-FOR-OUTL * * - 11600-ADJ-CHRG-OUTL * * - ADDED COPY STATEMENTS FOR TABLES): * * - OPPSMH12 * * - DEVRED12 * * - REFERENCED 2012 MH TABLE IN PARAGRAPH * * 11150-INIT * * - REFERENCED 2012 DEVICE REDUCTION TABLE IN * * PARAGRAPHS 11550-DEVICE-REDUC & * * 11550-DEVICE-COMPUTE * * - NO CHANGE TO PHP HCPCS LIST PER POLICY * * * * 11/15/11- REVISED DEVRED12 TABLE * * * * 12/09/11- CREATE VERSION 2012.1.1 (JANUARY 2012) * * THRU - UPDATED W-STORAGE-REF WITH NEW VERSION # * * 12/20/11 - UPDATED ALL RATE TABLES, EXCLUDING THE * * 2012.1.1 CBSA WAGE INDEX HISTORY TABLE, TO CORRECT * * VALUES PER INSTRUCTIONS FROM POLICY - * * SOURCE OF ERROR WAS INCORRECT MEDIAN COST * * UPDATED BASEAPCS & OPPSAPCS, * * BASEPTCO & OPPSPTCO, * * BASEPTDO & OPPSPTDO, * * BASEPTRO & OPPSPTRO, * * DEVRED12 * * - UPDATED APC TABLE WITH ASP DRUGS * * (323 TOTAL APC RECORDS ADDED/UPDATED) * * - CHANGED THE OUTLIER THRESHOLD FROM 1900 * * TO 2025 - ALSO RELATED TO MEDIAN COST ERROR * * - REVISED PASS-THROUGH DEVICE OFFSET LOGIC TO * * ACCOMMODATE PT DEVICES THAT HAVE MULTIPLE * * PROCEDURE PAIRINGS WITH DIFFERENT EFFECTIVE * * & TERMINATION DATES FOR CY 2010 - CY 2012. * * PARAGRAPHS AFFECTED: * * - 9682-SET-PTDO-LINE-FLAG (CY 2010) * * - 10682-SET-PTDO-LINE-FLAG (CY 2011) * * - 11682-SET-PTDO-LINE-FLAG (CY 2012) * * - REVISED TERMINATION DATE COMPARISON LOGIC * * FOR PASS-THROUGH OFFSETS. THE TERMINATION * * DATE IN THE OFFSET TABLES IS THE LAST DAY * * THE RECORD IS VALID, SO A VALID DATE OF * * SERVICE CAN BE EQUAL TO THE TERMINATION * * DATE. LOGIC REVISED TO INCLUDE TERMINATION * * DATE AS A VALID DATE OF SERVICE FOR * * CY 2009 - CY 2012. * * * * PARAGRAPHS AFFECTED: * * * * PASS-THROUGH DEVICE OFFSET * * -9169-PROCESS-PTDO-PROC (CY 2010) * * -10169-PROCESS-PTDO-PROC (CY 2011) * * -11169-PROCESS-PTDO-PROC (CY 2012) * * * * PASS-THROUGH RADIOPHARM OFFSET * * -8680-SET-PTRADIO-LINE-FLAG (CY 2009) * * -9680-SET-PTRADIO-LINE-FLAG (CY 2010) * * -10680-SET-PTRADIO-LINE-FLAG (CY 2011) * * -11680-SET-PTRADIO-LINE-FLAG (CY 2012) * * * * PASS-THROUGH CONTRAST AGENT OFFSET * * -9681-SET-PTCA-LINE-FLAG (CY 2010) * * -10681-SET-PTCA-LINE-FLAG (CY 2011) * * -10681-SET-PTCA-LINE-FLAG (CY 2012) * * * *********************************************************** DATE-COMPILED. ENVIRONMENT DIVISION. CONFIGURATION SECTION. SOURCE-COMPUTER. IBM-370. OBJECT-COMPUTER. IBM-370. INPUT-OUTPUT SECTION. FILE-CONTROL. DATA DIVISION. FILE SECTION. WORKING-STORAGE SECTION. *************************************************************** * OPPS PRICER VERSION NUMBER (YYYY.Q.V - YEAR.QTR.VERSION) * *-------------------------------------------------------------* * UPDATE FOR EVERY NEW RELEASE * *************************************************************** 01 W-STORAGE-REF PIC X(46) VALUE 'OPCAL2012.1.1 - W O R K I N G S T O R A G E'. *************************************************************** 00000100 * OPPS PRICER CALCULATION SECTION VERSION * *-------------------------------------------------------------* * UPDATE EVERY JANUARY & FOR ANY NEW SECTIONS CREATED * 00000300 * MID-YEAR DUE TO A MAJOR LOGIC CHANGE * *************************************************************** 00000600 01 CAL-VERSION0 PIC X(07) VALUE 'C2002.0'. 01 CAL-VERSION1 PIC X(07) VALUE 'C2002.3'. 01 CAL-VERSION2 PIC X(07) VALUE 'C2003.1'. 01 CAL-VERSION3 PIC X(07) VALUE 'C2004.4'. 01 CAL-VERSION4 PIC X(07) VALUE 'C2005.4'. 01 CAL-VERSION5 PIC X(07) VALUE 'C2006.1'. 01 CAL-VERSION6 PIC X(07) VALUE 'C2007.1'. 01 CAL-VERSION7 PIC X(07) VALUE 'C2008.1'. 01 CAL-VERSION8 PIC X(07) VALUE 'C2009.4'. 01 CAL-VERSION9 PIC X(07) VALUE 'C2010.4'. 01 CAL-VERSION10 PIC X(07) VALUE 'C2011.4'. 01 CAL-VERSION11 PIC X(07) VALUE 'C2012.1'. 01 R1 PIC S9(04) COMP SYNC. 01 R2 PIC S9(04) COMP SYNC. 01 R3 PIC S9(04) COMP SYNC. 01 R4 PIC S9(04) COMP SYNC. *************************************************************** *************************************************************** *** *** ** COPYBOOKS ** *** *** *************************************************************** *************************************************************** * * * 1) APC PASS-THROUGH DEVICE OFFSET TABLES * * 2) APC RATE HISTORY TABLE * * 3) MSA WAGE INDEX HISTORY TABLE * * 4) CBSA WAGE INDEX HISTORY TABLE * * 5) PARTIAL HOSPITALIZATION HCPCS TABLES * * 6) MENTAL HEALTH HCPCS TABLES * * 7) DEVICE REDUCTION TABLES * * 8) STATE-SPECIFIC RURAL FLOOR BUDGET NEUTRALITY TABLES * * 9) PASS-THROUGH RADIOPHARMACEUTICAL HCPCS HISTORY TABLE * * 10) NUCLEAR MEDICINE PROCEDURE APC OFFSET HISTORY TABLE * * 11) PASS-THROUGH CONTRAST AGENT HCPCS HISTORY TABLE * * 12) CONTRAST AGENT PROCEDURE APC OFFSET HISTORY TABLE * * 13) PASS-THROUGH DEVICE OFFSET HISTORY TABLE (NEW CY 2010) * * * *************************************************************** *************************************************************** * LAYUP TABLE AREA FOR ANNUAL APC OFFSET ADJUSTMENTS * *-------------------------------------------------------------* 00000100 * OFFSETS ARE THE DIFFERENCE IN APC $'S FOR THAT APC. * 00000300 * DEVICES (C-CODE HCPCS) ARE OFFSET. * 00000400 * * 00000500 * ADJUST YEARS FOR CONSISTENCY * 00000300 * ASK JOEY EACH JANUARY IF THERE ARE OFFSETS FOR THE YR * 00000300 * * 00000500 * OPPSOF02 - EFFECTIVE AS OF 04-01-2002 * * OPPSOF03 - EFFECTIVE AS OF 01-01-2003 * * * 00000500 * CY 2004 - WOO-INDX2 * 00000500 * CY 2005 - WOO-INDX3 * 00000400 * CY 2006 - WOO-INDX4 * 00000400 * CY 2007 - WOO-INDX7 * 00000500 * CY 2008 - WOO-INDX8 - ALL APC OFFSETS = $0 * 00000500 * CY 2009 - NO PASS-THROUGH DEVICE OFFSETS * 00000500 * CY 2010 - REPLACED BY PASS-THROUGH DEVICE OFFSET HISTORY * 00000500 * TABLE (OPPSPTDO) IN OCTOBER 2010 * 00000500 * * 00000500 *************************************************************** 00000600 ****** WOO-INDX ****************************** COPY OPPSOF02. ****** WOO-INDX2 ****************************** COPY OPPSOF03. ****** WOO-INDX3 ****************************** COPY OPPSOF04. ****** WOO-INDX4 ****************************** COPY OPPSOF06. ****** WOO-INDX7 ****************************** COPY OPPSOF07. ****** WOO-INDX8 ****************************** COPY OPPSOF08. *************************************************************** * LAYUP TABLE AREA FOR APC HISTORY TABLE * *-------------------------------------------------------------* * HISTORY TABLE IS UPDATED QUARTERLY, TABLE NAME REMAINS * * THE SAME. * *************************************************************** ****** WAA-INDX ****************************** COPY OPPSAPCS. *************************************************************** * MSA BASED WAGE INDEX HISTORY TABLE * *-------------------------------------------------------------* * THIS AREA IS FROZEN. DON'T USE MSA ANYMORE USE CBSA * 00000300 *************************************************************** 00000600 ****** WWM-INDX ****************************** COPY OPPSWINX. *************************************************************** * CBSA BASED WAGE INDEX HISTORY TABLE * *-------------------------------------------------------------* * HISTORY TABLE IS UPDATED EVERY JANUARY, TABLE NAME * 00000300 * REMAINS THE SAME. * *************************************************************** 00000600 ****** WCM-INDX ****************************** COPY OPPSWNXC. *************************************************************** * LAYUP TABLE AREA FOR ANNUAL PARTIAL HOSPITALIZATION * * (PHP) HCPCS LIST * *-------------------------------------------------------------* 00000100 * THE PHP HCPCS TABLE IS NEW FOR CY 2008 (ADDED 11/5/2007). * 00000300 * ASK JOSEPH BRYSON IF THERE IS A NEW LIST EVERY JANUARY. * 00000500 * WHEN THERE IS A NEW LIST, CREATE A NEW TABLE AND ADD IT * 00000500 * TO THE LIST OF COPYBOOKS. * 00000500 * * 00000500 * CY 2008 - PHP-INDX8 * 00000500 * CY 2009 - PHP-INDX9 * 00000500 * CY 2010 - PHP-INDX10 * 00000500 * CY 2011 - PHP-INDX10 - NO CHANGES TO LIST, USE 2010 TABLE * 00000500 * CY 2012 - PHP-INDX10 - NO CHANGES TO LIST, USE 2010 TABLE * 00000500 * * 00000500 *************************************************************** 00000600 ****** PHP-INDX8 ****************************** COPY OPPSPH08. ****** PHP-INDX9 ****************************** COPY OPPSPH09. ****** PHP-INDX10 ****************************** COPY OPPSPH10. *************************************************************** * LAYUP TABLE AREA FOR ANNUAL MENTAL HEALTH (MH) HCPCS LIST * *-------------------------------------------------------------* 00000100 * THE MH HCPCS TABLE IS NEW FOR CY 2008 (ADDED 11/5/2007). * 00000300 * ASK JOSEPH BRYSON IF THERE IS A NEW LIST EVERY JANUARY. * 00000500 * WHEN THERE IS A NEW LIST, CREATE A NEW TABLE AND ADD IT * 00000500 * TO THE LIST OF COPYBOOKS. * 00000500 * * 00000500 * CY 2008 - MH-INDX8 * 00000500 * CY 2009 - MH-INDX9 * 00000500 * CY 2010 - MH-INDX10 * 00000500 * CY 2011 - MH-INDX10 - NO CHANGES TO LIST, USE 2010 TABLE * 00000500 * CY 2012 - MH-INDX12 * 00000500 * * 00000500 *************************************************************** 00000600 ****** MH-INDX8 ******************************* COPY OPPSMH08. ****** MH-INDX9 ******************************* COPY OPPSMH09. ****** MH-INDX10 ******************************* COPY OPPSMH10. ****** MH-INDX12 ******************************* COPY OPPSMH12. *************************************************************** * THIS IS THE DEVICE REDUCTION TABLE (FB/FC) * * ASSOCIATED WITH DEVICES THAT ARE REPLACED * * FREE OF CHARGE WITH THEIR OFFSET AMOUNTS * *-------------------------------------------------------------* * THE DEVICE REDUCTION TABLE WAS NEW FOR CY 2007. * * CHECK WITH POLICY TO DETERMINE WHETHER A NEW TABLE IS * 00000300 * NEEDED EACH JANUARY. * * * 00000500 * CY 2007 - DEV-INDX7 * 00000500 * CY 2008 - DEV-INDX8 * 00000500 * CY 2009 - DEV-INDX9 * 00000500 * CY 2010 - DEV-INDX10 * 00000500 * CY 2011 - DEV-INDX11 * 00000500 * CY 2012 - DEV-INDX12 * 00000500 * * 00000500 *************************************************************** 00000600 ****** DEV-INDX7 ****************************** COPY DEVRED07. ****** DEV-INDX8 ****************************** COPY DEVRED08. ****** DEV-INDX9 ****************************** COPY DEVRED09. ****** DEV-INDX10 ****************************** COPY DEVRED10. ****** DEV-INDX11 ****************************** COPY DEVRED11. ****** DEV-INDX12 ****************************** COPY DEVRED12. *************************************************************** * THIS IS THE STATE-SPECIFIC RURAL FLOOR BUDGET NEUTRALITY * * TABLE (SSRFBN) - THE FACTORS IN THIS TABLE ARE APPLIED * * TO THE CBSA WAGE INDEX VALUES BY PROVIDER STATE. * *-------------------------------------------------------------* * THE SSRFBN TABLE WAS NEW FOR CY 2009. * * CHECK WITH POLICY EACH JANUARY FOR A NEW TABLE. * 00000300 * COPY THE COPYBOOK IRFBN___ FROM THE MOST CURRENT VERSION * 00000300 * OF THE LTCH PRICER PACKAGE (MU00.@BFN2699.LTNDM___). * 00000500 * * 00000500 * CY 2009 - SSRFBN-IDX09 * 00000500 * CY 2010 - SSRFBN-IDX10 (EFF. 01/01/2010 - 06/30/2010) * 00000500 * CY 2010 - SSRFBN-IDX10B (EFF. 07/01/2010 - 12/31/2010) * 00000500 * CY 2011 - NO SSRFBN TABLE * 00000500 * CY 2012 - NO SSRFBN TABLE * 00000500 * * 00000500 *************************************************************** 00000600 ****** SSRFBN-IDX09 **************************** COPY SSRFBN09. ****** SSRFBN-IDX10 **************************** COPY SSRFBN10. ****** SSRFBN-IDX10B *************************** COPY SSRFB10B. *************************************************************** * LAYUP TABLE AREA FOR PASS-THROUGH RADIOPHARMACEUTICAL * * HCPCS HISTORY TABLE * *-------------------------------------------------------------* * THE PT RADIOPHARM TABLE WAS NEW FOR APRIL 2009 * * CHECK WITH POLICY TO DETERMINE WHETHER TABLE UPDATES ARE * 00000300 * NEEDED EACH QUARTER. BECAUSE THIS IS A HISTORY TABLE, * * THE TABLE NAME REMAINS THE SAME. * * * 00000500 *************************************************************** 00000600 ****** PTRH-INDX ***************************** COPY OPPSPTRH. *************************************************************** * LAYUP TABLE AREA FOR PASS-THROUGH RADIOPHARMACEUTICAL * * OFFSET HISTORY TABLE * *-------------------------------------------------------------* * THE PT RADIOPHARM OFFSET TBL WAS NEW FOR APRIL 2009 * * THIS TABLE LISTS NUCLEAR MEDICINE APCS WITH THEIR PER * * UNIT OFFSET AMOUNTS AND EFFECTIVE YEAR. THESE OFFSETS * * ARE ASSOCIATED WITH PASS-THROUGH RADIOPHARM SERVICES. * * CHECK WITH POLICY FOR ANNUAL UPDATES / TABLES. * 00000300 * BECAUSE THIS IS A HISTORY TABLE, THE TABLE NAME REMAINS * * THE SAME. * * * 00000500 *************************************************************** 00000600 ****** PTRO-INDX ***************************** COPY OPPSPTRO. *************************************************************** * LAYUP TABLE AREA FOR PASS-THROUGH CONTRAST AGENT * * HCPCS HISTORY TABLE * *-------------------------------------------------------------* * THE PT CONTRAST AGENT TABLE WAS NEW FOR JANUARY 2010 * * CHECK WITH POLICY TO DETERMINE WHETHER TABLE UPDATES ARE * 00000300 * NEEDED EACH QUARTER. BECAUSE THIS IS A HISTORY TABLE, * * THE TABLE NAME REMAINS THE SAME. * * * 00000500 *************************************************************** 00000600 ****** PTCH-INDX ***************************** COPY OPPSPTCH. *************************************************************** * LAYUP TABLE AREA FOR PASS-THROUGH CONTRAST AGENT PROCEDURE * * APC OFFSET HISTORY TABLE * *-------------------------------------------------------------* * THE PT CONTRAST AGENT OFFSET TBL WAS NEW FOR JANUARY 2010 * * THIS TABLE LISTS CONTRAST AGENT PROC APCS WITH THEIR PER * * UNIT OFFSET AMOUNTS AND EFFECTIVE YEAR. THESE OFFSETS * * ARE ASSOCIATED WITH PASS-THROUGH CONTRAST AGENT SERVICES. * * CHECK WITH POLICY FOR ANNUAL UPDATES / TABLES. * 00000300 * BECAUSE THIS IS A HISTORY TABLE, THE TABLE NAME REMAINS * * THE SAME. * * * 00000500 *************************************************************** 00000600 ****** PTCO-INDX ***************************** COPY OPPSPTCO. *************************************************************** * LAYUP TABLE AREA FOR PASS-THROUGH DEVICE OFFSET HISTORY * * TABLE * *-------------------------------------------------------------* * THE PT DEVICE OFFSET HISTORY TABLE WAS NEW FOR OCT 2010 * * THIS TABLE LISTS DEVICE OFFSET HCPCS, OFFSET PROCEDURE * * UNIT OFFSET AMOUNTS AND EFFECTIVE YEAR. THESE OFFSETS * * APCS, PER UNIT OFFSET AMOUNTS, EFFECTIVE DATES, AND * * TERMINATION DATES. * * CHECK WITH POLICY FOR ANNUAL UPDATES / TABLES. * 00000300 * BECAUSE THIS IS A HISTORY TABLE, THE TABLE NAME REMAINS * * THE SAME. * * * 00000500 *************************************************************** 00000600 ****** PTDO-INDX ***************************** COPY OPPSPTDO. *************************************************************** *************************************************************** *** *** ** WORKING-STORAGE DATA TABLES ** *** *** *************************************************************** *************************************************************** * * * 1) BLOOD DEDUCTIBLE RANKING TABLES (2005 - 2010) * * 2) MAXIMUM COINSURANCE DATE TABLE (NOT USED) * * 3) PAID AT COST / 20% COIN TABLES (2006 - 2007) * * 4) BLOOD HCPCS TABLE (2005 - 2008) * * * *************************************************************** *************************************************************** * THIS IS THE BLOOD DEDUCTIBLE RANKING TABLE * * FOR THE BILL BEING PROCESSED BEFORE 01/01/2005 * *************************************************************** ****** WBD-INDX ****************************** 01 W-BLOOD-APC-FILLS. 03 PIC X(42) VALUE 'P902101P901002P903803P901604C101005P905106'. 03 PIC X(42) VALUE 'C101807P905608P902209P903910P904011C102112'. 03 PIC X(35) VALUE 'P905813C101614P905415C102016P905717'. 01 W-BLOOD-APC-TABLE REDEFINES W-BLOOD-APC-FILLS. 03 WBD-ENTRY OCCURS 17 TIMES INDEXED BY WBD-INDX. 05 W-BLOOD-HCPCS PIC X(05). 05 W-BLOOD-RANK PIC 9(02). *************************************************************** * THIS IS THE BLOOD DEDUCTIBLE RANKING TABLE * * FOR THE BILL BEING PROCESSED FROM 01/01/2005 * *************************************************************** ****** WNBD-INDX ****************************** 01 W-NEW-BLOOD-APC-FILLS. 03 PIC X(42) VALUE 'P901001P902102P903803P901604P905105P905606'. 03 PIC X(42) VALUE 'P902207P904008P905409P905810P903911P905712'. 01 W-NEW-BLOOD-APC-TABLE REDEFINES W-NEW-BLOOD-APC-FILLS. 03 WNBD-ENTRY OCCURS 12 TIMES INDEXED BY WNBD-INDX. 05 W-NEW-BLOOD-HCPCS PIC X(05). 05 W-NEW-BLOOD-RANK PIC 9(02). *************************************************************** * THIS IS THE BLOOD DEDUCTIBLE RANKING TABLE * * FOR THE BILL BEING PROCESSED FROM 01/01/2006 * *-------------------------------------------------------------* * ASK POLICY IF DIFFERENT EACH YEAR * 00000300 * P-CODES - BLOOD * 00000500 * * 00000500 * BENE IS RESPONSIBLE FOR CHEAPEST BLOOD PRODUCT. * 00000500 * 3 UNITS/CALENDAR YEAR. * 00000500 *************************************************************** 00000600 ****** W6BD-INDX ****************************** 01 W-2006-BLOOD-APC-FILLS. 03 PIC X(42) VALUE 'P901001P902102P903803P901604P905605P902206'. 03 PIC X(42) VALUE 'P905107P904008P905409P905810P903911P905712'. 01 W-2006-BLOOD-APC-TABLE REDEFINES W-2006-BLOOD-APC-FILLS. 03 W6BD-ENTRY OCCURS 12 TIMES INDEXED BY W6BD-INDX. 05 W-2006-BLOOD-HCPCS PIC X(05). 05 W-2006-BLOOD-RANK PIC 9(02). *************************************************************** * THIS IS THE BLOOD DEDUCTIBLE RANKING TABLE * * FOR THE BILL BEING PROCESSED FROM 01/01/2007 * *-------------------------------------------------------------* * ASK POLICY IF DIFFERENT EACH YEAR * 00000300 * P-CODES - BLOOD * 00000500 * * 00000500 * BENE IS RESPONSIBLE FOR CHEAPEST BLOOD PRODUCT. * 00000500 * 3 UNITS/CALENDAR YEAR. * 00000500 *************************************************************** 00000600 ****** W7BD-INDX ****************************** 01 W-2007-BLOOD-APC-FILLS. 03 PIC X(42) VALUE 'P902101P901002P905603P905104P901605P903806'. 03 PIC X(42) VALUE 'P902207P905408P904009P905810P903911P905712'. 01 W-2007-BLOOD-APC-TABLE REDEFINES W-2007-BLOOD-APC-FILLS. 03 W7BD-ENTRY OCCURS 12 TIMES INDEXED BY W7BD-INDX. 05 W-2007-BLOOD-HCPCS PIC X(05). 05 W-2007-BLOOD-RANK PIC 9(02). *************************************************************** * THIS IS THE BLOOD DEDUCTIBLE RANKING TABLE * * FOR THE BILL BEING PROCESSED FROM 01/01/2008 * *-------------------------------------------------------------* * ASK POLICY IF DIFFERENT EACH YEAR * 00000300 * P-CODES - BLOOD * 00000500 * * 00000500 * BENE IS RESPONSIBLE FOR CHEAPEST BLOOD PRODUCT. * 00000500 * DEDUCTIBLE LIMIT IS 3 UNITS/CALENDAR YEAR. * 00000500 * BLOOD HCPCS ARE ORDERED FROM THE LOWEST TO HIGHEST * * APC PAYMENT RATE. * *************************************************************** 00000600 ****** W8BD-INDX ****************************** 01 W-2008-BLOOD-APC-FILLS. 03 PIC X(42) VALUE 'P902101P905602P905103P901604P903805P905406'. 03 PIC X(42) VALUE 'P904007P901008P905809P902210P903911P905712'. 01 W-2008-BLOOD-APC-TABLE REDEFINES W-2008-BLOOD-APC-FILLS. 03 W8BD-ENTRY OCCURS 12 TIMES INDEXED BY W8BD-INDX. 05 W-2008-BLOOD-HCPCS PIC X(05). 05 W-2008-BLOOD-RANK PIC 9(02). *************************************************************** * THIS IS THE BLOOD DEDUCTIBLE RANKING TABLE * * FOR THE BILL BEING PROCESSED FROM 01/01/2009 * *-------------------------------------------------------------* * ASK POLICY IF DIFFERENT EACH YEAR * 00000300 * P-CODES - BLOOD * 00000500 * * 00000500 * BENE IS RESPONSIBLE FOR CHEAPEST BLOOD PRODUCT. * 00000500 * DEDUCTIBLE LIMIT IS 3 UNITS/CALENDAR YEAR. * 00000500 * BLOOD HCPCS ARE ORDERED FROM THE LOWEST TO HIGHEST * * APC PAYMENT RATE. * *************************************************************** 00000600 ****** W9BD-INDX ****************************** 01 W-2009-BLOOD-APC-FILLS. 03 PIC X(42) VALUE 'P905401P902102P905103P901604P905605P901006'. 03 PIC X(42) VALUE 'P903807P904008P902209P905810P903911P905712'. 01 W-2009-BLOOD-APC-TABLE REDEFINES W-2009-BLOOD-APC-FILLS. 03 W9BD-ENTRY OCCURS 12 TIMES INDEXED BY W9BD-INDX. 05 W-2009-BLOOD-HCPCS PIC X(05). 05 W-2009-BLOOD-RANK PIC 9(02). *************************************************************** * THIS IS THE BLOOD DEDUCTIBLE RANKING TABLE * * FOR THE BILL BEING PROCESSED FROM 01/01/2010 * *-------------------------------------------------------------* * ASK POLICY IF DIFFERENT EACH YEAR * 00000300 * P-CODES - BLOOD * 00000500 * * 00000500 * BENE IS RESPONSIBLE FOR CHEAPEST BLOOD PRODUCT. * 00000500 * DEDUCTIBLE LIMIT IS 3 UNITS/CALENDAR YEAR. * 00000500 * BLOOD HCPCS ARE ORDERED FROM THE LOWEST TO HIGHEST * * APC PAYMENT RATE. * *************************************************************** 00000600 ****** W10BD-INDX ***************************** 01 W-2010-BLOOD-APC-FILLS. 03 PIC X(42) VALUE 'P905401P905102P902103P905604P901605P901006'. 03 PIC X(42) VALUE 'P903807P904008P902209P905810P905711P903912'. 01 W-2010-BLOOD-APC-TABLE REDEFINES W-2010-BLOOD-APC-FILLS. 03 W10BD-ENTRY OCCURS 12 TIMES INDEXED BY W10BD-INDX. 05 W-2010-BLOOD-HCPCS PIC X(05). 05 W-2010-BLOOD-RANK PIC 9(02). *************************************************************** * THIS IS THE BLOOD DEDUCTIBLE RANKING TABLE * * FOR THE BILL BEING PROCESSED FROM 01/01/2011 * *-------------------------------------------------------------* * ASK POLICY IF DIFFERENT EACH YEAR * 00000300 * P-CODES - BLOOD * 00000500 * * 00000500 * BENE IS RESPONSIBLE FOR CHEAPEST BLOOD PRODUCT. * 00000500 * DEDUCTIBLE LIMIT IS 3 UNITS/CALENDAR YEAR. * 00000500 * BLOOD HCPCS ARE ORDERED FROM THE LOWEST TO HIGHEST * * APC PAYMENT RATE. * *************************************************************** 00000600 ****** W11BD-INDX ***************************** 01 W-2011-BLOOD-APC-FILLS. 03 PIC X(42) VALUE 'P905401P902102P905603P905104P901605P901006'. 03 PIC X(42) VALUE 'P903807P904008P905809P902210P905711P903912'. 01 W-2011-BLOOD-APC-TABLE REDEFINES W-2011-BLOOD-APC-FILLS. 03 W11BD-ENTRY OCCURS 12 TIMES INDEXED BY W11BD-INDX. 05 W-2011-BLOOD-HCPCS PIC X(05). 05 W-2011-BLOOD-RANK PIC 9(02). *************************************************************** * THIS IS THE BLOOD DEDUCTIBLE RANKING TABLE * * FOR THE BILL BEING PROCESSED FROM 01/01/2012 * *-------------------------------------------------------------* * ASK POLICY IF DIFFERENT EACH YEAR * 00000300 * P-CODES - BLOOD * 00000500 * * 00000500 * BENE IS RESPONSIBLE FOR CHEAPEST BLOOD PRODUCT. * 00000500 * DEDUCTIBLE LIMIT IS 3 UNITS/CALENDAR YEAR. * 00000500 * BLOOD HCPCS ARE ORDERED FROM THE LOWEST TO HIGHEST * * APC PAYMENT RATE. * *************************************************************** 00000600 ****** W12BD-INDX ***************************** 01 W-2012-BLOOD-APC-FILLS. 03 PIC X(42) VALUE 'P905401P902102P905603P905104P901005P901606'. 03 PIC X(42) VALUE 'P903807P903908P904009P905810P902211P905712'. 01 W-2012-BLOOD-APC-TABLE REDEFINES W-2012-BLOOD-APC-FILLS. 03 W12BD-ENTRY OCCURS 12 TIMES INDEXED BY W12BD-INDX. 05 W-2012-BLOOD-HCPCS PIC X(05). 05 W-2012-BLOOD-RANK PIC 9(02). *************************************************************** * THIS IS THE MAX-COINSURANCE * * DETERMINED BY DATE LINE-ITEM PROCESSING * *-------------------------------------------------------------* * THIS TABLE IS NOT REFERENCED ANYWHERE IN THE PROGRAM * * (THE REASON FOR THIS TABLE IS NOT KNOWN AS OF 11/6/2007) * *************************************************************** ****** WMC-INDX ****************************** 01 W-MAX-COIN-DATE-FILLS. 03 PIC X(44) VALUE '20000801001200101010022002010100320030101004'. 03 PIC X(33) VALUE '200401010052005010100620060101007'. 01 W-MAX-COIN-DATE-TABLE REDEFINES W-MAX-COIN-DATE-FILLS. 03 WMC-ENTRY OCCURS 7 TIMES. 05 WMC-DATE PIC X(8). 05 WMC-DTCD PIC 9(3). *************************************************************** 00000100 * FOR THESE 2006 APC'S, 20% COINSURANCE. * 00000300 * VERIFY IF NEW LIST EACH YEAR * 00000500 * CONTAINS BRACHYTHERAPY CODES. * 00000500 *************************************************************** 00000600 01 W-APC-CODE-FILLS. 03 PIC X(44) VALUE '07010702070407050737104510641065108810961150'. 03 PIC X(44) VALUE '16001602160316041641164216431644164516461647'. 03 PIC X(44) VALUE '16481649165016511652165316541671167216731674'. 03 PIC X(44) VALUE '16751676167716781679171617171718171917202616'. 03 PIC X(44) VALUE '26322633263426352636263791009146914891499150'. 01 W-APC-CODE-TABLE REDEFINES W-APC-CODE-FILLS. 03 WAC-ENTRY OCCURS 55 TIMES INDEXED BY WAC-INDX. 05 WAC-CODE PIC X(4). *************************************************************** 00000100 * FOR THESE 2007 APC'S, 20% COINSURANCE. (NEW WAC NAME) * 00000300 * VERIFY IF NEW LIST EACH YEAR * 00000500 * CONTAINS BRACHYTHERAPY & RADIOPHARM CODES * 00000500 * TABLE EFFECTIVE 1/1/2007 - 6/30/2007 * *************************************************************** 00000600 01 W-PD-AT-CST-W-COIN7. 03 PIC X(44) VALUE '07010702070407050722072307240737073907400741'. 03 PIC X(44) VALUE '07420743082910451064108810961150160016031604'. 03 PIC X(44) VALUE '16421643164416451646164716481650165116541671'. 03 PIC X(44) VALUE '16721675167616771678171617171718171917202616'. 03 PIC X(32) VALUE '26322633263426352636263791009148'. 01 W-PD-AT-CST-TABLE7 REDEFINES W-PD-AT-CST-W-COIN7. 03 PD-AT-CST-W-COIN7-ENTRY OCCURS 52 TIMES INDEXED BY PD-AT-CST-INDX7. 05 PD-AT-CST-CODE7 PIC X(4). *************************************************************** 00000100 * FOR THESE 2007 APC'S, 20% COINSURANCE. (NEW WAC NAME) * 00000300 * VERIFY IF NEW LIST EACH YEAR * 00000500 * CONTAINS BRACHYTHERAPY & RADIOPHARM CODES * 00000500 * NEW 2007 TABLE, EFFECTIVE JULY 2007 * *************************************************************** 00000600 01 W-PD-AT-CST-W-COIN7B. 03 PIC X(44) VALUE '07010702070407050722072307240737073907400741'. 03 PIC X(44) VALUE '07420743082910451064108810961150160016031604'. 03 PIC X(44) VALUE '16421643164416451646164716481650165116541671'. 03 PIC X(44) VALUE '16721675167616771678171617171719261626322634'. 03 PIC X(44) VALUE '26352636263726382639264026412642264326982699'. 03 PIC X(08) VALUE '91009148'. 01 W-PD-AT-CST-TABLE7B REDEFINES W-PD-AT-CST-W-COIN7B. 03 PD-AT-CST-W-COIN7B-ENTRY OCCURS 57 TIMES INDEXED BY PD-AT-CST-INDX7B. 05 PD-AT-CST-CODE7B PIC X(4). *************************************************************** * THIS IS THE BLOOD HCPCS TABLE * * FOR THE BILL BEING PROCESSED FROM 01/01/2005 - 12/31/2008 * *-------------------------------------------------------------* * THIS TABLE LISTS EVERY BLOOD AND BLOOD PRODUCT HCPCS * 00000300 * EFFECTIVE CY 2005 THROUGH CY 2008 * 00000500 * * 00000500 *************************************************************** 00000600 ****** WBLH-INDX ****************************** 01 W-2005-2008-BLOOD-HCPCS-FILLS. 03 PIC X(45) VALUE 'P9010P9011P9012P9016P9017P9019P9020P9021P9022'. 03 PIC X(45) VALUE 'P9023P9031P9032P9033P9034P9035P9036P9037P9038'. 03 PIC X(45) VALUE 'P9039P9040P9043P9044P9048P9050P9051P9052P9053'. 03 PIC X(35) VALUE 'P9054P9055P9056P9057P9058P9059P9060'. 01 W-2005-2008-BLOOD-HCPCS-TABLE REDEFINES W-2005-2008-BLOOD-HCPCS-FILLS. 03 WBLHCPCS-ENTRY OCCURS 34 TIMES INDEXED BY WBLH-INDX. 05 W-2005-2008-BLOOD-HCPCS PIC X(05). *************************************************************** *************************************************************** *** *** ** MISCELLANEOUS WORK VARIABLES ** *** *** *************************************************************** *************************************************************** 01 WORK-AREA. 05 H-SUB PIC S9(07) COMP-3 VALUE ZERO. 05 W-SUB1 PIC S9(07) COMP-3 VALUE ZERO. 05 W-SUB2 PIC S9(07) COMP-3 VALUE ZERO. 05 W-SUB3 PIC S9(07) COMP-3 VALUE ZERO. 05 PS-SUB PIC S9(07) COMP-3 VALUE ZERO. 05 LN-SUB PIC S9(07) COMP-3 VALUE ZERO. 05 DISC-FRACTION PIC 9V9(03) VALUE .500. 05 TERM-PROC-DISC PIC 9V9(03) VALUE .500. 05 APC33-FLAG PIC X(01). *----------------------------------------------* * 11/03/2008 - PHP APC FLAG ADDED * *----------------------------------------------* 05 PHP-APC-FLAG PIC X(01). *----------------------------------------------* * 11/28/2007 - APC 34 FLAG ADDED * *----------------------------------------------* 05 APC34-FLAG PIC X(01). *----------------------------------------------* * 05/12/2009 - APC 34 COUNTER ADDED * *----------------------------------------------* 05 W-APC34-CNT PIC 9(03). 05 C1820-OFFSET-FLAG PIC X(01). 05 GJK-FLAG PIC X(01). 05 ST0-FLAG PIC X(01). 05 N-FLAG PIC X(01). 05 C-FLAG PIC X(01). 05 T-LITEM-PYMT PIC S9(07)V9(02). 05 W-OFF-APC PIC X(05). *--------------------------------------------------* * 11/5/2007 - PHP-HCPCS-FLAG & MH-HCPCS-FLAG ADDED * *--------------------------------------------------* 05 PHP-HCPCS-FLAG PIC X(01). 05 MH-HCPCS-FLAG PIC X(01). *--------------------------------------------------* * 11/6/2007 - BRACHYTHERAPY APC FLAG ADDED * *--------------------------------------------------* 05 BRACHY-APC-FLAG PIC X(01). *--------------------------------------------------* * 12/27/2007 - RADIOPHARM APC FLAG ADDED * *--------------------------------------------------* 05 RADIOPH-APC-FLAG PIC X(01). *-------------------------------------------------------------* * 11/13/2007 - BLOOD HCPCS SUBJECT TO BLOOD DEDUC. FLAG ADDED * *-------------------------------------------------------------* 05 BLD-DEDUC-HCPCS-FLAG PIC X(01). *-------------------------------------------------------------* * 02/11/2008 - PASS-THROUGH DEVICE FLAGS ADDED * *-------------------------------------------------------------* 05 PTD-FLAG PIC X(01). 05 PTD-LINE-FLAG PIC X(01). 05 PTD-PROC-FLAG PIC X(01). *-------------------------------------------------------------* * 02/13/2008 - ADDED W-PTD VARIABLES FOR PASS-THROUGH DEVICES * *-------------------------------------------------------------* 05 W-PTD-LINE-HCPCS PIC X(05). 05 W-PTD-CNT PIC 9(03). 05 W-PTD-PROC-SUB PIC 9(03). 05 W-END-OF-PTD-TBL PIC X(01). *-------------------------------------------------------------* * 02/10/2009 - VARIABLES FOR PASS-THROUGH RADIOPHARM LOGIC * *-------------------------------------------------------------* 05 PTRADIO-CLAIM-FLAG PIC X(01). 05 PTRADIO-LINE-FLAG PIC X(01). 05 W-PTRADIO-LINE-HCPCS PIC X(05). 05 W-PTRADIO-CHRG-RATE PIC 9(01)V9(8). 05 W-PTRADIO-LINE-OFFSET PIC 9(07)V99. 05 NUCMED-LINE-FLAG PIC X(01). 05 W-NUCMED-LINE-APC PIC X(05). 05 W-NUCMED-SUB PIC 9(03). 05 W-NUCMED-UNIT-CNT PIC 9(03). 05 W-END-OF-NUCMED-TBL PIC X(01). 05 W-NUCMED-OFFSET PIC 9(07)V99. 05 W-NUCMED-WA-OFFSET PIC 9(07)V99. 05 W-LINE-SRVC-DATE. 10 W-LINE-SRVC-YEAR PIC 9(04). 10 W-LINE-SRVC-MONTH PIC 9(02). 10 W-LINE-SRVC-DAY PIC 9(02). *-------------------------------------------------------------* * 05/12/2009 - ADDED TO IDENTIFY BLOOD HCPCS FOR 2005 - 2008 * *-------------------------------------------------------------* 05 W-BLD-HCPCS-FLAG PIC X(01). *-------------------------------------------------------------* * 11/15/2009 - VARIABLES FOR PASS-THROUGH CONTRAST AGENT LOGIC* *-------------------------------------------------------------* 05 PTCA-CLAIM-FLAG PIC X(01). 05 PTCA-LINE-FLAG PIC X(01). 05 W-PTCA-LINE-HCPCS PIC X(05). 05 W-PTCA-CHRG-RATE PIC 9(01)V9(8). 05 W-PTCA-LINE-OFFSET PIC 9(07)V99. 05 W-CAPROC-LINE-APC PIC X(05). 05 W-CAPROC-SUB PIC 9(03). 05 W-CAPROC-UNIT-CNT PIC 9(03). 05 W-CAPROC-OFFSET PIC 9(07)V99. 05 W-CAPROC-KEY. 10 W-CAPROC-SRVC-DATE. 15 W-CAPROC-SRVC-YEAR PIC 9(04). 15 W-CAPROC-SRVC-MONTH PIC 9(02). 15 W-CAPROC-SRVC-DAY PIC 9(02). 10 W-CAPROC-WA-OFFSET PIC 9(07)V99. *-------------------------------------------------------------* * 08/02/2010 - VARIABLES FOR PASS-THROUGH DEVICE OFFSET LOGIC * *-------------------------------------------------------------* 05 PTDO-CLAIM-FLAG PIC X(01). 05 PTDO-LINE-FLAG PIC X(01). 05 W-PTDO-LINE-HCPCS PIC X(05). 05 W-PTDO-CHRG-RATE PIC 9(01)V9(8). 05 W-PTDO-LINE-OFFSET PIC 9(07)V99. 05 W-PTDO-EOF-SWITCH PIC X. 05 W-DOPROC-LINE-APC PIC X(05). 05 W-DOPROC-SUB PIC 9(03). 05 W-DOPROC-UNITS PIC 9(09). 05 W-DOPROC-OFFSET PIC 9(07)V99. 05 W-DOPROC-KEY. 10 W-DOPROC-SRVC-DATE. 15 W-DOPROC-SRVC-YEAR PIC 9(04). 15 W-DOPROC-SRVC-MONTH PIC 9(02). 15 W-DOPROC-SRVC-DAY PIC 9(02). 10 W-DOPROC-WA-OFFSET PIC 9(07)V99. *----------------------------------------------* * 05/09/2011 - BILL TYPE 14X FLAG ADDED * *----------------------------------------------* 05 BILL14X-FLAG PIC X(01). 01 EIGHTY-8-SWS. 05 GEO-CBSA-FLAG PIC X(5). 88 RURAL-GEO VALUE ' 01' THRU ' 99'. 05 WI-CBSA-FLAG PIC X(5). 88 RURAL-WI VALUE ' 01' THRU ' 99'. *************************************************************** *************************************************************** *** *** ** BELOW ARE THE VARIABLES THAT WILL BE HELD FOR CLAIM ** ** LEVEL PROCESSING (OUTLIER/DEDUCTIBLE/COINSURANCE) ** *** *** *************************************************************** *************************************************************** 01 H-ADDITIONAL-VARIABLES. 05 H-OUTLIER-PYMT PIC S9(07)V9(02). 05 H-PRTL-HOSP-PYMT PIC 9(07)V9(02). 05 H-TOTAL-CLM-DEDUCT PIC 9(03)V9(02). 05 H-TOTAL-OFFSET PIC S9(07)V9(02). 05 H-TOTAL-WAOFF PIC 9(07)V9(02). 05 H-TOT-CHRG PIC 9(07)V9(02). 05 H-TOT-PYMT PIC 9(07)V9(02). 05 H-BENE-DEDUCT PIC 9(03)V9(02). 05 H-MAX-COIN PIC 9(07)V9(02). 05 H-IP-LIMIT PIC 9(05)V9(02). 05 H-NEW-COIN PIC 9(05)V9(02). 05 H-NEW-WGNAT PIC 9(05)V9(02). 05 H-BLOOD-DEDUCT-DUE PIC 9(05)V9(02). 05 H-TOT-ST-CHRG PIC 9(08)V99. 05 H-TOT-N-CHRG PIC 9(08)V99. 05 H-TOT-H-CHRG PIC 9(08)V99. *-------------------------------------------------------------* * 11/28/2007 - TOTAL MENTAL HEALTH CHARGES ADDED * *-------------------------------------------------------------* 05 H-TOT-MH-CHRG PIC 9(08)V99. 05 H-TOT-38X PIC 9(08)V99. 05 H-TOT-38X-39X PIC 9(08)V99. 05 H-38X-39X-RATE PIC 9(01)V9(04). 05 H-TOT-ST-PYMT PIC 9(08)V99. 05 H-TOT-STVX-PYMT PIC 9(08)V99. 05 H-TOT-HTD-UNITS PIC S9(09). 05 H-TOT-OFF-UNITS PIC S9(09). 05 H-BENE-BLOOD-PINTS PIC 9(01). 05 H-BENE-PINTS-USED PIC 9(01). *-------------------------------------------------------------* * 02/10/2009 - VARIABLES FOR PASS-THROUGH RADIOPHARM LOGIC * *-------------------------------------------------------------* 05 H-PTRADIO-TOT-CHRGS PIC 9(08)V99. 05 H-NUCMED-TOT-OFFSET PIC 9(08)V99. 05 H-PTRADIO-HCPCS-CNT PIC 9(03). *************************************************************** *************************************************************** *** *** ** BELOW ARE THE VARIABLES THAT WILL BE HELD FOR LINE ** ** LEVEL PROCESSING ** *** *** *************************************************************** *************************************************************** 05 LINE-HOLD-ITEMS. 10 H-COIN-PERCENT PIC 9(01)V9(04). 10 H-LITEM-PYMT PIC S9(07)V9(02). 10 H-LITEM-OUTL-PYMT PIC S9(07)V9(02). 10 H-COST PIC S9(07)V9(02). 10 H-LITEM-REIM PIC 9(07)V9(02). 10 H-SCH-PYMT PIC 9(07)V9(02). 10 H-APC-PYMT PIC 9(07)V9(02). 10 H-APC-ADJ-PYMT PIC 9(07)V9(02). 10 H-TOTAL-LN-DEDUCT PIC 9(03)V9(02). 10 H-LN-BLOOD-DEDUCT PIC 9(05)V9(02). 10 H-LN-BLD-PYMT PIC 9(05)V9(02). 10 H-NAT-COIN PIC 9(07)V9(02). 10 H-MIN-COIN PIC 9(05)V9(02). 10 H-PSF-COIN PIC 9(05)V9(02). 10 H-RED-COIN PIC 9(05)V9(02). 10 H-RATIO PIC S9(03)V9(07). 10 H-SHIFT PIC 9(05)V9(02). 10 H-TOTAL PIC 9(05)V9(02). 10 H-OUTLIER-FACTOR PIC 9(01)V9(02). 10 H-OUTLIER-PCT PIC 9(01)V9(02). 10 H-LN-PTR PIC 9(03). 10 H-SRVC-UNITS PIC 9(09). * 10 H-SRVC-UNITS PIC 9(07). CHANGED FOR CY09 10 H-RANK PIC 9(05). 10 H-BLD-RNK. 15 H-BLD-DOS PIC 9(08). 15 H-BLOOD-RANK PIC 9(02). *-------------------------------------------------------------* * 11/28/2007 - ADDED PAF FOR COMPOSITE LINES * * 11/12/2008 - ADDED CAF FOR COMPOSITE LINES (COMP ADJ FLAG) * *-------------------------------------------------------------* 10 H-CMP-PAF PIC 9(02). 10 H-CMP-CAF PIC 9(02). 10 H-PSF-MSA PIC X(04). 10 H-PSF-CBSA PIC X(05). 10 H-DCP-STAGE. 15 H-DCP-DOS PIC 9(08). 15 H-DCP-CODE PIC 9(01). 10 H-PPCT PIC S9V9(06) COMP-3. 10 H-DISC-RATE PIC S9V9(08) COMP-3. 10 H-BLOOD-FRACTION PIC S9V9(08) COMP-3. 10 H-WINX1 PIC S9V9(04) COMP-3. 10 H-SUB-CHRG PIC 9(08)V99. 10 H-CHRG-RATE PIC 9(01)V9(8). 10 H-OFF-RATE PIC 9(01)V9(8). *-------------------------------------------------------------* * 02/14/2008 - ADDED W-PTD VARIABLES FOR PASS-THROUGH DEVICES * *-------------------------------------------------------------* 10 H-PTD-UNIT-RATE PIC 9(01)V9(8). 10 H-PTD-SUB-CHRG PIC 9(08)V99. 10 H-PTD-LITEM-PYMT PIC 9(07)V99. *-------------------------------------------------------------* * 02/14/2008 - ADDED H-LITEM-PYMT-OUTL FOR OUTLIER CALC * *-------------------------------------------------------------* 10 H-LITEM-PYMT-OUTL PIC 9(07)V99. *-------------------------------------------------------------* * 11/16/2009 - ADDED H-PTCA-LIDOS FOR PT CONTRAST AGENT LOGIC * *-------------------------------------------------------------* 10 H-PTCA-LIDOS PIC 9(08). *-------------------------------------------------------------* * 08/02/2010 - ADDED VARIBLES FOR NEW PT DEVICE OFFSET LOGIC * *-------------------------------------------------------------* 10 H-PTDO-CHRGUNIT. 15 H-PTDO-CHRG PIC 9(08)V99. 15 H-PTDO-UNITS PIC 9(09). 10 H-PTDO-ASSOC-HCPCS-CTR PIC 9(03). 10 H-PTDO-PROC-KEY. 15 H-PTDO-PROC-WA-OFFSET PIC 9(08)V99. 15 H-PTDO-PROC-UNITS PIC 9(09). *-------------------------------------------------------------* * 11/13/2008 - ADDED VARIABLE FOR PHP APC PAYMENTS * *-------------------------------------------------------------* 05 H-PHP-LITEM-PYMT-OUTL PIC 9(07)V99. *************************************************************** *************************************************************** *** *** ** WORKING-STORAGE TABLES TO BE POPULATED IN PROGRAM ** *** *** *************************************************************** *************************************************************** * * * 1) COINSURANCE DEDUCTIBLE TABLE (TO HOLD CLAIM LINES) * * 2) BLOOD DEDUCTIBLE TABLE (TO HOLD BLOOD DEDUCTIBLE LINES)* * 3) DRUG COINSURANCE ROLL-UP TABLE * * 4) PACKAGED COMPOSITE CHARGES TABLE * * 5) PASS-THROUGH DEVICE TABLE * * 6) PASS-THROUGH DEVICE PROCEDURE TABLE * * 7) NUCLEAR MEDICINE APC TABLE (FOR PT RADIOPHARM LOGIC) * * 8) PASS-THROUGH CONTRAST AGENT DAILY SUMMARY TABLE * * 9) PASS-THROUGH CONTRAST AGENT PROCEDURE APC TABLE * * * *************************************************************** *************************************************************** * BELOW IS THE LAY-UP TABLE TO PROCESS DEDUCTIBLES. * *-------------------------------------------------------------* * THIS TABLE RANKS APC LOW PAYMENT TO HIGH PAYMENT % * * TABLE TO RANK PRICE DEDUCTIBLES. * * * *************************************************************** ****** W-LP-INDX ****************************** 01 W-LNC-MAX PIC S9(07) COMP-3 VALUE +0. 01 W-LINE-PTR-TABLE. 05 W-LP-ENTRY OCCURS 0 TO 450 TIMES DEPENDING ON W-LNC-MAX ASCENDING KEY IS W-RANK INDEXED BY W-LP-INDX. 10 W-LP-SUB PIC S9(07) COMP-3. 10 W-APC-PYMT PIC 9(07)V99. 10 W-NAT-COIN PIC 9(05)V99. 10 W-MIN-COIN PIC 9(05)V99. 10 W-RED-COIN PIC 9(04)V99. 10 W-DISC-RATE PIC 9(01)V9(08). 10 W-SRVC-UNITS PIC 9(09). * 10 W-SRVC-UNITS PIC 9(07). CHANGED FOR CY09 10 W-RANK PIC 9(05). 10 W-PPCT PIC S9V9(06) COMP-3. 10 W-WINX1 PIC S9V9(04) COMP-3. 10 W-SUB-CHRG PIC 9(08)V99. *************************************************************** * BELOW IS THE LAY-UP TABLE TO PROCESS BLOOD DEDUCTIBLES * *-------------------------------------------------------------* * RANK BLOOD DEDUCTIBLE TO DETERMINE LOWEST PRICE FOR * 00000300 * BENE TO PAY. * 00000400 * * 00000500 * IF PINTS REMAINING, THIS DETERMINES THE CHEAPEST UNIT * 00000500 * FOR BENE TO PAY. * 00000500 *************************************************************** 00000600 ****** W-BD-INDX ****************************** 01 W-BLD-MAX PIC S9(07) COMP-3 VALUE +0. 01 W-BLOOD-PTR-TABLE. 05 W-BD-ENTRY OCCURS 0 TO 450 TIMES DEPENDING ON W-BLD-MAX INDEXED BY W-BD-INDX. 10 W-BD-SUB PIC S9(07) COMP-3. 10 W-BD-APC-PYMT PIC 9(07)V99. 10 W-BD-NAT-COIN PIC 9(05)V99. 10 W-BD-MIN-COIN PIC 9(05)V99. 10 W-BD-RED-COIN PIC 9(04)V99. 10 W-BD-DISC-RATE PIC 9(01)V9(08). 10 W-BD-SRVC-UNITS PIC 9(09). * 10 W-BD-SRVC-UNITS PIC 9(07). CHANGED FOR CY09 10 W-BD-RNK. 15 W-BD-DOS PIC 9(08). 15 W-BD-RANK PIC 9(02). 10 W-BD-PPCT PIC S9V9(06) COMP-3. 10 W-BD-WINX1 PIC S9V9(04) COMP-3. 10 W-BD-SUB-CHRG PIC 9(08)V99. *************************************************************** * BELOW IS THE LAY-UP TABLE TO PROCESS DRUG COINSURANCE * * ROLL-UP * *************************************************************** ****** W-DCP-INDX ****************************** 01 W-DCP-MAX PIC S9(07) COMP-3 VALUE +0. 01 W-DOS-COIN-PTR-TABLE. 05 W-DCP-ENTRY OCCURS 0 TO 450 TIMES DEPENDING ON W-DCP-MAX ASCENDING KEY IS W-DCP-STAGE INDEXED BY W-DCP-INDX. 10 W-DCP-SUB PIC S9(07). 10 W-DCP-STAGE. 15 W-DCP-DOS PIC 9(08). 15 W-DCP-CODE PIC 9(01). 10 W-DCP-SRVC-IND PIC X(02). 10 W-DCP-COIN1 PIC 9(05)V99. 10 W-DCP-COIN2 PIC 9(05)V99. 10 W-DCP-WGNAT PIC 9(05)V99. *************************************************************** * BELOW IS THE LAY-UP TABLE TO ACCUMULATE COMPOSITE APC * * NON-PRIME LINE CHARGES * * NEW FOR JANUARY 2008 * *************************************************************** ****** W-CMP-INDX ****************************** 01 W-CMP-MAX PIC S9(07) COMP-3 VALUE +0. 01 W-COMPOSITE-PTR-TABLE. 05 W-CMP-ENTRY OCCURS 0 TO 450 TIMES DEPENDING ON W-CMP-MAX ASCENDING KEY IS W-CMP-PAF INDEXED BY W-CMP-INDX. 10 W-CMP-PAF PIC 9(02). 10 W-CMP-TOT-SUB-CHRG PIC 9(10)V99. *************************************************************** * BELOW IS THE LAY-UP TABLE FOR PASS-THROUGH DEVICES * * NEW FOR APRIL 2008 * *************************************************************** ****** W-PTD-INDX ***************************** 01 W-PTD-MAX PIC S9(07) COMP-3 VALUE +0. 01 W-PASS-THRU-DEV-PTR-TABLE. 05 W-PTD-ENTRY OCCURS 0 TO 450 TIMES DEPENDING ON W-PTD-MAX ASCENDING KEY IS W-PTD-HCPCS INDEXED BY W-PTD-INDX. 10 W-PTD-HCPCS PIC X(05). 10 W-PTD-SUB PIC S9(07) COMP-3. 10 W-PTD-SUB-CHRG PIC 9(08)V99. 10 W-PTD-LITEM-PYMT PIC 9(07)V99. 10 W-PTD-TOTAL-PROC-UNITS PIC 9(03). 10 W-PTD-PROC-CNT PIC 9(03). *************************************************************** * BELOW IS THE LAY-UP TABLE FOR PASS-THROUGH DEVICE PROCS * * NEW FOR APRIL 2008 * * 02/11/2009 - CHANGED OCCURS FROM 999 TO '0 TO 450' TIMES * *************************************************************** 01 W-PTD-PROC-HCPCS-TBL. 05 W-PTD-PROC-HCPCS-ENTRY OCCURS 0 TO 450 TIMES DEPENDING ON W-PTD-CNT. 10 W-PTD-PROC-HCPCS PIC X(05). *************************************************************** * BELOW IS THE LAY-UP TABLE FOR NUCLEAR MEDICINE APCS * * * * THIS TABLE HOLDS A NUCLEAR MEDICINE APC RECORD WITH ITS * * WAGE ADJUSTED OFFSET AMOUNT FOR EVERY NUCLEAR MEDICINE * * UNIT ON THE CLAIM WHEN A PASS-THROUGH RADIOPHARM HCPCS * * IS ALSO ON THE CLAIM. * * NEW FOR APRIL 2009 - TABLE ADDED 02/10/2009 * * * *************************************************************** ****** W-NUCMED-INDX *************************** 01 W-NUCMED-MAX PIC S9(07) COMP-3 VALUE +0. 01 W-NUCMED-APC-TBL. 05 W-NUCMED-APC-ENTRY OCCURS 0 TO 450 TIMES DEPENDING ON W-NUCMED-MAX INDEXED BY W-NUCMED-INDX. 10 W-NUCMED-APC PIC X(05). 10 W-NUCMED-WAGE-ADJ-OFFSET PIC 9(07)V99. *************************************************************** * BELOW IS THE LAY-UP TABLE FOR THE PASS-THROUGH CONTRAST * * AGENT DAILY SUMMARY * * NEW FOR JANUARY 2010 - TABLE ADDED 11/15/2009 * * * * THIS TABLE HOLDS A PT CONTRAST AGENT DAY RECORD WITH ITS * * DATE OF SERVICE, PT CONTRAST AGENT HCPCS COUNT, TOTAL * * CONTRAST CHARGES, AND TOTAL CONTRAST PROCEDURE OFFSET. A * * DAY RECORD IS CREATED WHEN A PT CONTRAST AGENT HCPCS * * LINE FALLS ON THE DATE OF SERVICE. * * * *************************************************************** ****** W-PTCA-DAY-INDX ************************* 01 W-PTCA-DAY-MAX PIC S9(07) COMP-3 VALUE +0. 01 W-PTCA-DAY-TBL. 05 W-PTCA-DAY-ENTRY OCCURS 0 TO 450 TIMES DEPENDING ON W-PTCA-DAY-MAX INDEXED BY W-PTCA-DAY-INDX. 10 W-PTCA-DAY-LIDOS PIC 9(08). 10 W-PTCA-DAY-HCPCS-CNT PIC 9(03). 10 W-PTCA-DAY-TOT-CHRGS PIC 9(08)V99. 10 W-PTCA-DAY-TOT-OFFSET PIC 9(08)V99. *************************************************************** * BELOW IS THE LAY-UP TABLE FOR PASS-THROUGH CONTRAST AGENT * * PROCEDURE APCS * * * * THIS TABLE HOLDS A PASS-THROUGH CONTRAST AGENT PROCEDURE * * APC RECORD WITH ITS WAGE ADJUSTED OFFSET AMOUNT AND LINE * * ITEM DATE OF SERVICE (LIDOS) FOR EACH CONTRAST AGENT * * PROCEDURE ON THE CLAIM WITH A LIDOS THAT MATCHES THE * * LIDOS ON A PASS-THROUGH CONTRAST AGENT LINE. * * NEW FOR JANUARY 2010 - TABLE ADDED 11/15/2009 * * * *************************************************************** ****** W-CAPROC-INDX *************************** 01 W-CAPROC-MAX PIC S9(07) COMP-3 VALUE +0. 01 W-CAPROC-APC-TBL. 05 W-CAPROC-APC-ENTRY OCCURS 0 TO 450 TIMES DEPENDING ON W-CAPROC-MAX INDEXED BY W-CAPROC-INDX. 10 W-CAPROC-TBL-KEY. 15 W-CAPROC-LIDOS PIC 9(8). 15 W-CAPROC-WAGE-ADJ-OFFSET PIC 9(07)V99. 10 W-CAPROC-APC PIC X(05). *************************************************************** * BELOW IS THE LAY-UP TABLE FOR THE PASS-THROUGH DEVICE * * HCPCS (FOR REVISED PASS-THROUGH DEVICE OFFSET LOGIC) * * NEW FOR OCT 2010 - TABLE ADDED 08/04/2010 * * * * THIS TABLE HOLDS A PT DEVICE HCPCS RECORD FOR EACH PT * * DEVICE HCPCS LINE ON THE CLAIM. EACH RECORD HOLDS THE * * DEVICE'S HCPCS, LINE SUBSCRIPT, LINE UNITS, SUBMITTED * * CHARGE, NUMBER OF ASSOC. OFFSET PROCEDURE LINES ON CLAIM, * * ITS ASSIGNED OFFSET PROCEDURE APC, AND ITS ASSIGNED * * OFFSET PROCEDURE APC'S LINE SUBSCRIPT. * * * *************************************************************** ****** W-PTDO-HCPCS-INDX *********************** 01 W-PTDO-HCPCS-MAX PIC S9(07) COMP-3 VALUE +0. 01 W-PTDO-HCPCS-TBL. 05 W-PTDO-HCPCS-ENTRY OCCURS 0 TO 450 TIMES DEPENDING ON W-PTDO-HCPCS-MAX INDEXED BY W-PTDO-HCPCS-INDX. 10 W-PTDO-HCPCS-HCPCS PIC X(05). 10 W-PTDO-HCPCS-LNSUB PIC S9(07) COMP-3. 10 W-PTDO-HCPCS-CHRGUNIT. 15 W-PTDO-HCPCS-SUB-CHRG PIC 9(08)V99. 15 W-PTDO-HCPCS-UNITS PIC 9(09). 10 W-PTDO-HCPCS-PROC-CNT PIC 9(03). 10 W-PTDO-HCPCS-PROC-APC PIC X(05). 10 W-PTDO-HCPCS-PROC-LNSUB PIC S9(07) COMP-3. *************************************************************** * BELOW IS THE LAY-UP TABLE FOR THE PASS-THROUGH DEVICE * * PROCEDURES (FOR REVISED PASS-THROUGH DEVICE OFFSET LOGIC) * * NEW FOR OCT 2010 - TABLE ADDED 08/04/2010 * * * * THIS TABLE HOLDS A PT DEVICE HCPCS RECORD FOR EACH PT * * DEVICE HCPCS LINE ON THE CLAIM. EACH RECORD HOLDS THE * * DEVICE'S HCPCS, LINE SUBSCRIPT, LINE UNITS, SUBMITTED * * CHARGE, NUMBER OF ASSOC. OFFSET PROCEDURE LINES ON CLAIM, * * ITS ASSIGNED OFFSET PROCEDURE APC, AND ITS ASSIGNED * * OFFSET PROCEDURE APC'S LINE SUBSCRIPT. * * * *************************************************************** ****** W-PTDO-PROC-INDX ************************ 01 W-PTDO-PROC-MAX PIC S9(07) COMP-3 VALUE +0. 01 W-PTDO-DARRAY-MAX PIC S9(07) COMP-3 VALUE +0. 01 W-PTDO-PROC-TBL. 05 W-PTDO-PROC-ENTRY OCCURS 0 TO 450 TIMES DEPENDING ON W-PTDO-PROC-MAX INDEXED BY W-PTDO-PROC-INDX. 10 W-PTDO-PROC-APC PIC X(05). 10 W-PTDO-PROC-LNSUB PIC S9(07) COMP-3. 10 W-PTDO-PROC-KEY. 15 W-PTDO-PROC-WA-OFFSET PIC 9(08)V99. 15 W-PTDO-PROC-UNITS PIC 9(09). 10 W-PTDO-PROC-DEVICE-CNT PIC 9(03). 10 W-PTDO-PROC-DARRAY OCCURS 0 TO 450 TIMES DEPENDING ON W-PTDO-DARRAY-MAX INDEXED BY W-PTDO-DARRAY-INDX. 15 W-PTDO-PROC-DHCPCS PIC X(05). 10 W-PTDO-DARRAY-SIZE PIC 9(03). 10 W-PTDO-PROC-TOT-DCHRGS PIC 9(10)V99. 10 W-PTDO-PROC-TOT-DUNITS PIC 9(05). 10 W-PTDO-PROC-USED PIC X(01). *************************************************************** * BELOW IS THE LAY-UP TABLE FOR THE PASS-THROUGH DEVICE * * ASSOCIATED HCPCS ARRAY FOR THE REVISED PASS-THROUGH * * DEVICE OFFSET LOGIC * * NEW FOR OCT 2010 - TABLE ADDED 08/06/2010 * * * * THIS TABLE HOLDS EVERY PT OFFSET DEVICE ASSOCIATED WITH * * A GIVEN PROCEDURE APC. EACH RECORD HOLDS THE HCPCS AND * * AN INDICATOR TO INDICATE WHETHER THE HCPCS APPEARS ON * * THE CLAIM OR NOT. * * * *************************************************************** ****** W-PTDO-ASSOC-HCPCS-INDX ************************ 01 W-PTDO-ASSOC-HCPCS-MAX PIC S9(07) COMP-3 VALUE +0. 01 W-PTDO-ASSOC-HCPCS-TBL. 05 W-PTDO-ASSOC-HCPCS-ENTRY OCCURS 0 TO 450 TIMES DEPENDING ON W-PTDO-ASSOC-HCPCS-MAX INDEXED BY W-PTDO-ASSOC-HCPCS-INDX. 10 W-PTDO-ASSOC-HCPCS-HCPCS PIC X(05). 10 W-PTDO-ASSOC-HCPCS-IND PIC X(01). LINKAGE SECTION. *************************************************************** 00000100 * WHEN FISS CALLS THIS PROGRAM, THEY GET THE LINKAGE * 00000300 * SECTION. * 00000400 *************************************************************** 00000600 *************************************************************** * LAYUP TABLE AREA FOR PROVIDER SPECIFIC RECORD * *************************************************************** 01 L-PROV-SPEC-AREA. 05 L-PSF-NPI PIC X(08). 05 L-PSF-NPI-FILLER PIC X(02). 05 L-PSF-PROV-OSCAR. 10 L-PSF-PROV-ST PIC X(02). 10 L-PSF-PROV-3456 PIC X(04). 05 L-PSF-EFFDT PIC 9(08). 05 L-PSF-FY-BEGIN-DT PIC 9(08). 05 L-PSF-REPORT-DT PIC 9(08). 05 L-PSF-TERMDT PIC 9(08). 05 L-PSF-WAIVE-IND PIC X(01). 05 L-PSF-FI-NUM PIC 9(05). 05 L-PSF-PROV-TYPE PIC X(02). 05 L-PSF-SPCL-LOCATION-IND PIC X(01). 05 L-PSF-WGIDX-RECLASS PIC X(01). 05 L-PSF-GEO-MSA PIC X(04). 05 L-PSF-WI-MSA PIC X(04). 05 L-PSF-COLA PIC 9V9(03). 05 L-PSF-STATE-CODE PIC 9(02). 05 L-PSF-TOPS-INDICATOR PIC X(01). 05 L-PSF-HOSP-QUAL-IND PIC X(01). 05 FILLER PIC X(01). 05 L-PSF-OPCOST-RATIO PIC 9V9(03). 05 L-PSF-GEO-CBSA PIC X(05). 05 L-PSF-WI-CBSA PIC X(05). 05 L-PSF-SPEC-WGIDX PIC 9(02)V9(04). 05 L-PSF-SPEC-PYMT-IND PIC X(01). 05 L-PSF-APC-LINE-CNT PIC 9(04). 05 L-PSF-APC-TABLE OCCURS 999 TIMES DEPENDING ON L-PSF-APC-LINE-CNT. 10 L-PSF-APC PIC X(04). 10 L-PSF-RED-COIN PIC 9(04)V99. *************************************************************** 00000100 * INPUT RECORD FROM THE OCE/STANDARD SYSTEM * *-------------------------------------------------------------* * BELOW ARE THE VARIABLES THAT WILL BE PASSED * * TO PRICER FROM THE OCE BEGINNING OCT. 1, 2005 THERE WILL BE * * - INCREASED SIZE OF SERVICE AND PAYMENT - 1 TO 2 BYTES * * - INCREASED SIZE OF PYMT ADJUSTMENT FLAG - 1 TO 2 BYTES * * CY 2009 EDITS - MADE 11/10/2008: * * - INCREASED SIZE OF SERVICE UNITS - 7 TO 9 BYTES * * - ADDED COMPOSITE ADJUSTMENT FLAG - 2 BYTES * *************************************************************** 01 OPPS-LINE-CNT PIC 9(08) COMP. 01 OCE-DATA. 05 OPPS-OCE-LINE OCCURS 450 TIMES DEPENDING ON OPPS-LINE-CNT. 10 OPPS-HCPCS. 15 OPPS-ALPHA PIC X(01). 15 FILLER PIC X(04). 10 OPPS-GRP. 15 FILLER PIC X(01). 15 OPPS-APC PIC X(04). 10 OPPS-HCPCS-APC PIC X(05). 10 OPPS-SRVC-IND PIC X(02). 10 OPPS-PYMT-IND PIC X(02). 10 OPPS-DISC-FACT PIC 9(01). 10 OPPS-LITEM-DR-FLAG PIC X(01). 10 OPPS-PKG-FLAG PIC X(01). 10 OPPS-PYMT-ADJ-FLAG PIC X(02). 10 OPPS-SITE-SRVC-FLAG PIC X(01). 10 OPPS-SRVC-UNITS PIC 9(09). 10 OPPS-SUB-CHRG PIC 9(08)V99. 10 OPPS-LITEM-ACT-FLAG PIC X(01). 10 OPPS-COMP-ADJ-FLAG PIC X(02). 01 L-SERVICE-FROM-DATE PIC 9(08). 01 BENE-DEDUCT PIC 9(03)V9(02). 01 BENE-BLOOD-PINTS PIC 9(01). *************************************************************** * BELOW ARE THE VARIABLES THAT WILL BE PASSED BACK * * TO SS ASSOCIATED WITH THE BILL BEING PROCESSED * * - EFF. 04/01/2002 CALCULATE LINE ITEM OUTIER PAYMENT * *************************************************************** 01 A-ADDITIONAL-VARIABLES. 05 A-CALC-VERS PIC X(07). 05 A-TOTAL-CLM-DEDUCT PIC 9(03)V9(02). 05 A-OUTLIER-PYMT PIC 9(07)V9(02). 05 A-TOT-CLM-PYMT PIC 9(07)V9(02). 05 A-TOT-CLM-CHRG PIC 9(07)V9(02). 05 A-CLM-RTN-CODE PIC 9(02). 05 A-MSA PIC X(04). 05 A-CBSA PIC X(05). 05 A-WINX PIC S9V9(04). 05 A-BLOOD-PINTS-USED PIC 9(01). 05 A-BLOOD-DEDUCT-DUE PIC 9(05)V9(02). 05 A-LINE-ITEMS OCCURS 450 TIMES DEPENDING ON OPPS-LINE-CNT. 10 A-LITEM-PYMT PIC 9(07)V9(02). 10 A-LITEM-REIM PIC 9(07)V9(02). 10 A-TOTAL-LN-DEDUCT PIC 9(03)V9(02). 10 A-ADJ-COIN PIC 9(05)V9(02). 10 A-RED-COIN PIC 9(05)V9(02). 10 A-BLOOD-LN-DEDUCT PIC 9(05)V9(02). 10 A-RETURN-CODE PIC 9(02). 01 OCE-IN-DATE. 05 OCE-IN-LINES OCCURS 450 TIMES. 10 FILLER PIC X(15). 10 OPPS-LITEM-DOS PIC 9(08). 10 FILLER PIC X(23). * 10 FILLER PIC X(21). CHANGED 12/2/2008 ****************************************************************** ****************************************************************** *** *** ** ** ** OUTPATIENT PROSPECTIVE PAYMENT SYSTEM PRICER ** ** -------------------------------------------- ** ** PROCEDURE DIVISION START ** ** ** *** *** ****************************************************************** ****************************************************************** *************************************************************** * PROCESSING: PRIOR TO 20020401 * * A. WILL PROCESS LINE ITEMS BASED ON OCE FLAGS. * * B. INITIALIZE OPPS HOLD VARIABLES. * * C. EDIT THE DATA PASSED FROM THE OCE. * * D. ASSEMBLE PRICING COMPONENTS. * * E. CALCULATE THE PRICE. * * F. RETURN COINSURANCE/REIMBURSEMENT/DEDUCTIBLE/ * * PAYMENT/OUTLIER AMOUNT/RETURN CODES * *************************************************************** PROCEDURE DIVISION USING OPPS-LINE-CNT OCE-DATA A-ADDITIONAL-VARIABLES L-PROV-SPEC-AREA L-SERVICE-FROM-DATE BENE-DEDUCT BENE-BLOOD-PINTS OCE-IN-DATE. 0000-DATE-CONTROL. ************************************************************ 00000100 * * 00000200 * THIS SEPERATES EACH NEW YEAR INTO ITS OWN 1000-LEVEL * 00000300 * PROCESS AREA. * 00000400 * * 00000500 ************************************************************ 00000600 IF L-SERVICE-FROM-DATE > 20111231 PERFORM 11000-PROCESS-MAIN-NEW THRU 11000-PROCESS-MAIN-NEW-EXIT ELSE IF L-SERVICE-FROM-DATE > 20101231 PERFORM 10000-PROCESS-MAIN-NEW THRU 10000-PROCESS-MAIN-NEW-EXIT ELSE IF L-SERVICE-FROM-DATE > 20091231 PERFORM 9000-PROCESS-MAIN-NEW THRU 9000-PROCESS-MAIN-NEW-EXIT ELSE IF L-SERVICE-FROM-DATE > 20081231 PERFORM 8000-PROCESS-MAIN-NEW THRU 8000-PROCESS-MAIN-NEW-EXIT ELSE IF L-SERVICE-FROM-DATE > 20071231 PERFORM 7000-PROCESS-MAIN-NEW THRU 7000-PROCESS-MAIN-NEW-EXIT ELSE IF L-SERVICE-FROM-DATE > 20061231 PERFORM 6000-PROCESS-MAIN-NEW THRU 6000-PROCESS-MAIN-NEW-EXIT ELSE IF L-SERVICE-FROM-DATE > 20051231 PERFORM 5000-PROCESS-MAIN-NEW THRU 5000-PROCESS-MAIN-NEW-EXIT ELSE IF L-SERVICE-FROM-DATE > 20050630 PERFORM 4000-PROCESS-MAIN-NEW THRU 4000-PROCESS-MAIN-NEW-EXIT ELSE IF L-SERVICE-FROM-DATE > 20041231 PERFORM 3000-PROCESS-MAIN-NEW THRU 3000-PROCESS-MAIN-NEW-EXIT ELSE IF L-SERVICE-FROM-DATE > 20021231 PERFORM 2000-PROCESS-MAIN-NEW THRU 2000-PROCESS-MAIN-NEW-EXIT ELSE IF L-SERVICE-FROM-DATE > 20020331 PERFORM 1000-PROCESS-MAIN-NEW THRU 1000-PROCESS-MAIN-NEW-EXIT ELSE PERFORM 0000-PROCESS-MAIN-OLD THRU 0000-PROCESS-MAIN-OLD-EXIT. GOBACK. 0000-PROCESS-MAIN-OLD. PERFORM 0100-INIT THRU 0100-INIT-EXIT. IF A-CLM-RTN-CODE >= 50 GOBACK. MOVE H-WINX1 TO A-WINX. PERFORM 0125-INIT THRU 0125-INIT-EXIT VARYING LN-SUB FROM 1 BY 1 UNTIL LN-SUB > OPPS-LINE-CNT. MOVE 0 TO W-DCP-MAX W-BLD-MAX. PERFORM 0150-INIT THRU 0150-INIT-EXIT VARYING LN-SUB FROM 1 BY 1 UNTIL LN-SUB > OPPS-LINE-CNT. SET W-BD-INDX TO 1. MOVE 0 TO W-DCP-MAX. PERFORM 0400-CALCULATE THRU 0400-CALCULATE-EXIT VARYING W-LP-INDX FROM 1 BY 1 UNTIL W-LP-INDX > W-LNC-MAX. IF GJK-FLAG = 'Y' PERFORM 0800-ADJ-STV-REIM THRU 0800-ADJ-STV-REIM-EXIT VARYING W-DCP-INDX FROM 1 BY 1 UNTIL W-DCP-INDX > W-DCP-MAX ELSE NEXT SENTENCE. PERFORM 0900-END-PRICE-RTN THRU 0900-END-PRICE-RTN-EXIT. 0000-PROCESS-MAIN-OLD-EXIT. EXIT. *************************************************************** * INITIALIZE WORKING STORAGE HOLD AREAS * * AND ADDITIONAL VARIABLES TO BE PASSED BACK TO * * THE STANDARD SYSTEM. * * - IF PROVIDER SPECIFIC FILE WAGE INDEX RECLASSIFICATION * * CODE INVALID OR MISSING * * - MOVE '52' TO CLAIM LEVEL RETURN CODE * * - DISCONTINUE CLAIM PROCESSING * * - IF SERVICE FROM DATE NOT NUMERIC OR < 20000801 * * - MOVE '53' TO CLAIM LEVEL RETURN CODE * * - DISCONTINUE CLAIM PROCESSING * * - IF SERVICE FROM DATE < PROVIDER EFFECTIVE DATE * * - MOVE '54' TO CLAIM LEVEL RETURN CODE * * - DISCONTINUE CLAIM PROCESSING * * - IF SERVICE FROM DATE > PROVIDER TERMINATION DATE * * - MOVE '54' TO CLAIM LEVEL RETURN CODE * * - DISCONTINUE CLAIM PROCESSING * *************************************************************** 0100-INIT. MOVE 01 TO A-CLM-RTN-CODE. MOVE 'N' TO APC33-FLAG GJK-FLAG. MOVE SPACE TO A-MSA A-CBSA. MOVE ZERO TO A-OUTLIER-PYMT A-TOTAL-CLM-DEDUCT A-TOT-CLM-CHRG A-TOT-CLM-PYMT A-BLOOD-PINTS-USED A-BLOOD-DEDUCT-DUE A-WINX W-LNC-MAX. INITIALIZE H-ADDITIONAL-VARIABLES. INITIALIZE LINE-HOLD-ITEMS. INITIALIZE T-LITEM-PYMT. IF L-SERVICE-FROM-DATE NOT NUMERIC MOVE 53 TO A-CLM-RTN-CODE GO TO 0100-INIT-EXIT ELSE IF L-SERVICE-FROM-DATE < 20000801 MOVE 53 TO A-CLM-RTN-CODE GO TO 0100-INIT-EXIT ELSE IF L-SERVICE-FROM-DATE < L-PSF-EFFDT MOVE 54 TO A-CLM-RTN-CODE GO TO 0100-INIT-EXIT ELSE IF L-PSF-TERMDT > 0 IF L-SERVICE-FROM-DATE > L-PSF-TERMDT MOVE 54 TO A-CLM-RTN-CODE GO TO 0100-INIT-EXIT END-IF END-IF. ********************************************************** 00000100 * COMMENT: * 00000200 * UPDATE EVERY JANUARY * 00000300 ********************************************************** 00000600 MOVE CAL-VERSION0 TO A-CALC-VERS. MOVE BENE-DEDUCT TO H-BENE-DEDUCT. MOVE BENE-BLOOD-PINTS TO H-BENE-BLOOD-PINTS H-BENE-PINTS-USED. MOVE WAD-MAX TO WAD-SUB. PERFORM UNTIL L-SERVICE-FROM-DATE NOT < WAD-DATE (WAD-SUB) SUBTRACT 1 FROM WAD-SUB END-PERFORM. IF L-PSF-WGIDX-RECLASS = 'Y' MOVE L-PSF-WI-MSA TO H-PSF-MSA ELSE IF L-PSF-WGIDX-RECLASS = 'N' MOVE L-PSF-GEO-MSA TO H-PSF-MSA ELSE MOVE 52 TO A-CLM-RTN-CODE GO TO 0100-INIT-EXIT. IF L-SERVICE-FROM-DATE >= 20020101 MOVE 812 TO H-IP-LIMIT ELSE IF L-SERVICE-FROM-DATE >= 20010101 MOVE 792 TO H-IP-LIMIT ELSE IF L-SERVICE-FROM-DATE >= 20000801 MOVE 776 TO H-IP-LIMIT. IF L-SERVICE-FROM-DATE < 20010101 PERFORM 0105-FLOOR-2000 THRU 0105-FLOOR-2000-EXIT. IF L-SERVICE-FROM-DATE > 20001231 PERFORM 0110-FLOOR-2001 THRU 0110-FLOOR-2001-EXIT. MOVE H-PSF-MSA TO A-MSA. IF L-SERVICE-FROM-DATE >= 20010101 PERFORM 0225-CHNG-WAGEINDX THRU 0225-CHNG-WAGEINDX-EXIT ELSE PERFORM 0220-CHNG-WAGEINDX THRU 0220-CHNG-WAGEINDX-EXIT. IF H-WINX1 = 0 THEN PERFORM 0200-CALC-WAGEINDX THRU 0200-CALC-WAGEINDX-EXIT. 0100-INIT-EXIT. EXIT. *************************************************************** * RESET FLOOR MSA - 'FROM-DATE' CONTROLLED * * - YEAR 2000 * * - YEAR 2001 * *************************************************************** 0105-FLOOR-2000. IF (H-PSF-MSA = '6020' OR '9000' OR '8080') AND (L-PSF-PROV-ST = '36') MOVE ' 36' TO H-PSF-MSA ELSE IF (H-PSF-MSA = '2440') AND (L-PSF-PROV-ST = '15') MOVE ' 15' TO H-PSF-MSA ELSE IF (H-PSF-MSA = '2520') AND (L-PSF-PROV-ST = '24') AND (L-PSF-WGIDX-RECLASS = 'Y') MOVE ' 24' TO H-PSF-MSA ELSE IF (H-PSF-MSA = '1123') AND (L-PSF-PROV-ST = '22') MOVE ' 22' TO H-PSF-MSA. 0105-FLOOR-2000-EXIT. EXIT. 0110-FLOOR-2001. IF (H-PSF-MSA = '6020' OR '9000' OR '8080') AND (L-PSF-PROV-ST = '36') MOVE ' 36' TO H-PSF-MSA ELSE IF (H-PSF-MSA = '2440') AND (L-PSF-PROV-ST = '15') MOVE ' 15' TO H-PSF-MSA ELSE IF (H-PSF-MSA = '9000') AND (L-PSF-PROV-ST = '51') MOVE ' 51' TO H-PSF-MSA ELSE IF (H-PSF-MSA = '1900') AND (L-PSF-PROV-ST = '21') MOVE ' 21' TO H-PSF-MSA ELSE IF (H-PSF-MSA = '1123') AND (L-PSF-PROV-ST = '22') MOVE ' 22' TO H-PSF-MSA. 0110-FLOOR-2001-EXIT. EXIT. *************************************************************** * SET FLAG IF APC = 0033 * * - TERMINATE PROCESS IF 0033 LOCATED * * * *************************************************************** 0125-INIT. IF OPPS-APC (LN-SUB) = '0033' MOVE 'Y' TO APC33-FLAG MOVE 451 TO LN-SUB. 0125-INIT-EXIT. EXIT. *************************************************************** * 1. VERIFY THE SERVICE INDICATOR PASSED BY THE OCE * * - IF INVALID SET RETURN CODE TO '40' * * - DISCONTINUE LINE PROCESSING * * - IF VALID SET RETURN CODE TO '01' * * - CONTINUE LINE PROCESSING * * 2. PROCESS LINES AND LOAD WORK TABLE ACCORDING TO PRICE * * RANKING * * 3. CHECK OCE EDIT INDICATORS AND SET RETURN CODES IF * * INDICATORS ARE INVALID. * * - VALID RETURN CODES FOR EDIT INDICATORS * * - '41' - SERVICE INDICATOR INVALID FOR OPPS PRICER * * - '42' - APC = '00000' OR (PACKAGING FLAG = 1 OR 2) * * - '43' - PAYMENT INDICATOR NOT = TO 1 OR 5 THRU 9 * * - '44' - SERVICE INDICATOR = 'H' BUT PAYMENT * * INDICATOR NOT = TO 6 * * - '45' - PACKAGING FLAG NOT = TO 0 * * - '46' - (LINE ITEM DENIAL/REJECT FLAG NOT = TO 0 * * OR LINE ITEM DENIAL/REJECT FLAG = TO 1 * * AND (APC NOT = 0033 OR 0034 OR 0322 OR * * 0323 OR 0324 OR 0325 OR 0373 OR 0374)) * * OR LINE ITEM ACTION FLAG NOT = TO 1 * * - '47' - LINE ITEM ACTION FLAG = 2 OR 3 * * - '48' - PAYMENT ADJUSTMENT FLAG NOT VALID * * - '49' - SITE OF SERVICE FLAG NOT = TO 0 * * - OR (APC 0033 IS NOT ON THE CLAIM * * AND SERVICE INDICATOR = 'P' * * OR APC = 0322-0325,0373,0374) * * 4. IF OCE INDICATORS ARE VALID, SEARCH APC TABLE * * - IF MISSING, DELETED OR INVALID APC * * - SET RETURN CODE TO '30' * * - DISCONTINUE LINE PROCESSING * *************************************************************** 0150-INIT. *************************************************************** * - DISABLED AS OF 04-01-2001 * * PERFORM 0160-ADJUST-APC * * THRU 0160-ADJUST-APC-EXIT. * *************************************************************** * DISABLED AS OF 07-01-2001 * *************************************************************** * IF (L-SERVICE-FROM-DATE > 20010331) AND * * (OPPS-APC (LN-SUB) = '1410') AND * * (OPPS-HCPCS (LN-SUB) = 'C1050') * * MOVE ' S' TO OPPS-SRVC-IND (LN-SUB) * * MOVE '0976' TO OPPS-APC (LN-SUB). * *************************************************************** SET W-BD-INDX TO LN-SUB. SET W-LP-INDX TO LN-SUB. INITIALIZE W-LP-ENTRY (W-LP-INDX). INITIALIZE W-BD-ENTRY (W-BD-INDX). MOVE ZERO TO A-LITEM-PYMT (LN-SUB) A-LITEM-REIM (LN-SUB) A-ADJ-COIN (LN-SUB) A-RED-COIN (LN-SUB) A-TOTAL-LN-DEDUCT (LN-SUB) A-BLOOD-LN-DEDUCT (LN-SUB). * IF OPPS-APC (LN-SUB) = '1111' OR '1112' OR '1113' * OR '1114' OR '1117' OR '6300' OR '6600' * IF L-SERVICE-FROM-DATE > 20010331 * MOVE 30 TO A-RETURN-CODE (LN-SUB) * GO TO 0150-INIT-EXIT. IF NOT (OPPS-SRVC-IND (LN-SUB) = ' A' OR ' B' OR ' C' OR ' E' OR ' F' OR ' G' OR ' H' OR ' J' OR ' K' OR ' L' OR ' N' OR ' P' OR ' S' OR ' T' OR ' V' OR ' X' OR ' W' OR ' Y' OR ' Z') THEN MOVE 40 TO A-RETURN-CODE (LN-SUB) GO TO 0150-INIT-EXIT ELSE MOVE 01 TO A-RETURN-CODE (LN-SUB). IF OPPS-SRVC-IND (LN-SUB) = ' A' OR ' B' OR ' C' OR ' E' OR ' F' MOVE 41 TO A-RETURN-CODE (LN-SUB) GO TO 0150-INIT-EXIT. IF OPPS-PYMT-IND (LN-SUB) = ' 1' OR ' 5' OR ' 6' OR ' 7' OR ' 8' OR ' 9' IF OPPS-PKG-FLAG (LN-SUB) = '0' OR '1' OR '2' IF (OPPS-LITEM-DR-FLAG (LN-SUB) = '0' OR OPPS-LITEM-DR-FLAG (LN-SUB) = '1' AND (OPPS-APC (LN-SUB) = '0033' OR '0034' OR '0322' OR '0323' OR '0324' OR '0325' OR '0373' OR '0374')) OR (OPPS-LITEM-ACT-FLAG (LN-SUB) = '1') IF NOT (OPPS-LITEM-ACT-FLAG (LN-SUB) EQUAL '2' OR '3') IF OPPS-PYMT-ADJ-FLAG (LN-SUB) = ' 0' OR ' 1' OR ' 2' OR ' 3' OR ' 4' IF (OPPS-SITE-SRVC-FLAG (LN-SUB) = '0') OR ((APC33-FLAG = 'Y') AND ((OPPS-SRVC-IND (LN-SUB) = ' P') OR (OPPS-APC (LN-SUB) = '0322' OR '0323' OR '0324' OR '0325' OR '0373' OR '0374'))) MOVE OPPS-SRVC-UNITS (LN-SUB) TO H-SRVC-UNITS MOVE OPPS-SUB-CHRG (LN-SUB) TO H-SUB-CHRG COMPUTE H-TOT-CHRG = H-TOT-CHRG + H-SUB-CHRG IF (OPPS-APC (LN-SUB) = '0000') OR (OPPS-PKG-FLAG (LN-SUB) NOT = 0) MOVE 42 TO A-RETURN-CODE (LN-SUB) GO TO 0150-INIT-EXIT END-IF SEARCH ALL WAA-ENTRY AT END MOVE 30 TO A-RETURN-CODE (LN-SUB) GO TO 0150-INIT-EXIT WHEN WAA-APC (WAA-INDX) = OPPS-GRP (LN-SUB) MOVE WAA-PTR (WAA-INDX) TO W-SUB2 PERFORM 0175-APC-LOOKUP ELSE MOVE 49 TO A-RETURN-CODE (LN-SUB) GO TO 0150-INIT-EXIT ELSE MOVE 48 TO A-RETURN-CODE (LN-SUB) GO TO 0150-INIT-EXIT ELSE MOVE 47 TO A-RETURN-CODE (LN-SUB) GO TO 0150-INIT-EXIT ELSE MOVE 46 TO A-RETURN-CODE (LN-SUB) GO TO 0150-INIT-EXIT ELSE MOVE 45 TO A-RETURN-CODE (LN-SUB) GO TO 0150-INIT-EXIT ELSE MOVE 43 TO A-RETURN-CODE (LN-SUB) GO TO 0150-INIT-EXIT. IF A-RETURN-CODE (LN-SUB) = 01 PERFORM 0250-CALC-DISCOUNT THRU 0250-CALC-DISCOUNT-EXIT ELSE GO TO 0150-INIT-EXIT. IF A-RETURN-CODE (LN-SUB) = 01 PERFORM 0300-COIN-DEDUCT THRU 0300-COIN-DEDUCT-EXIT. IF A-RETURN-CODE (LN-SUB) = 01 SET WBD-INDX TO 1 SEARCH WBD-ENTRY VARYING WBD-INDX AT END GO TO 0150-INIT-EXIT WHEN W-BLOOD-HCPCS (WBD-INDX) = OPPS-HCPCS (LN-SUB) MOVE W-BLOOD-RANK (WBD-INDX) TO H-BLOOD-RANK PERFORM 0375-BLOOD-DEDUCT THRU 0375-BLOOD-DEDUCT-EXIT. 0150-INIT-EXIT. EXIT. *************************************************************** * ADJUST APC FROM 3M USING THE HCPCS CODE AND APC * * - RESET SERVICE INDICATOR WHEN NECESSARY * * - DISABLED AS OF 04-01-2001 * *************************************************************** *0160-ADJUST-APC. * * MOVE OPPS-HCPCS (LN-SUB) TO W-ADJ-HCPCS. * MOVE OPPS-GRP (LN-SUB) TO W-ADJ-APC. * SET WAAJ-INDX TO 1. * SEARCH WAAJ-ENTRY VARYING WAAJ-INDX * AT END * GO TO 0160-ADJUST-APC-EXIT * WHEN WAAJ-HCPCSAPC (WAAJ-INDX) = W-ADJ-HCPCSAPC * MOVE WAAJ-FED-APC (WAAJ-INDX) TO * OPPS-GRP (LN-SUB) * MOVE WAAJ-NEW-SRVC-IND (WAAJ-INDX) TO * OPPS-SRVC-IND (LN-SUB) * MOVE WAAJ-NEW-PYMT-IND (WAAJ-INDX) TO * OPPS-PYMT-IND (LN-SUB) * MOVE WAAJ-NEW-PYMT-ADJ (WAAJ-INDX) TO * OPPS-PYMT-ADJ-FLAG (LN-SUB). *0160-ADJUST-APC-EXIT. * EXIT. *************************************************************** 0175-APC-LOOKUP. IF WAR-DTCD (W-SUB2) NOT > WAD-DTCD (WAD-SUB) IF WAR-RATEX (W-SUB2) = 'DELETED' MOVE 30 TO A-RETURN-CODE (LN-SUB) COMPUTE H-TOT-CHRG = H-TOT-CHRG - H-SUB-CHRG ELSE MOVE WAR-RATE (W-SUB2) TO H-APC-PYMT MOVE WAR-RANK (W-SUB2) TO H-RANK MOVE WAR-MINC (W-SUB2) TO H-MIN-COIN MOVE WAR-COIN (W-SUB2) TO H-NAT-COIN MOVE WAR-PPCT (W-SUB2) TO H-PPCT ELSE SUBTRACT 1 FROM W-SUB2 IF W-SUB2 > WAA-PTR (WAA-INDX - 1) GO TO 0175-APC-LOOKUP ELSE MOVE 0 TO H-APC-PYMT H-RANK H-MIN-COIN H-NAT-COIN H-PPCT. 0175-APC-LOOKUP-EXIT. EXIT. *************************************************************** * SEARCH WAGE INDEX TABLE AND SELECT THE WAGE INDEX * * WHEN EQUAL TO PROVIDER SPECIFIC WAGE INDEX * * IF WAGE INDEX NOT LOCATED * * - SET CLAIM RETURN CODE TO '50' * * - DISCONTINUE CLAIM PROCESSING * * IF WAGE INDEX EQUALS ZERO * * - SET CLAIM RETURN CODE TO '51' * * - DISCONTINUE CLAIM PROCESSING * *************************************************************** 0200-CALC-WAGEINDX. MOVE WWD-MAX TO WWD-SUB. PERFORM UNTIL L-SERVICE-FROM-DATE NOT < WWD-DATE (WWD-SUB) SUBTRACT 1 FROM WWD-SUB END-PERFORM. SEARCH ALL WWM-ENTRY AT END MOVE 50 TO A-CLM-RTN-CODE GO TO 0200-CALC-WAGEINDX-EXIT WHEN WWM-MSA (WWM-INDX) = H-PSF-MSA MOVE WWM-PTR (WWM-INDX) TO W-SUB2 PERFORM 0210-WAGE-LOOKUP. IF H-WINX1 = 0 THEN MOVE 51 TO A-CLM-RTN-CODE. 0200-CALC-WAGEINDX-EXIT. EXIT. 0210-WAGE-LOOKUP. IF WWW-DTCD (W-SUB2) NOT > WWD-DTCD (WWD-SUB) IF L-PSF-WGIDX-RECLASS = 'Y' MOVE WWW-WINX2 (W-SUB2) TO H-WINX1 ELSE MOVE WWW-WINX1 (W-SUB2) TO H-WINX1 END-IF ELSE SUBTRACT 1 FROM W-SUB2 IF W-SUB2 > WWM-PTR (WWM-INDX - 1) GO TO 0210-WAGE-LOOKUP ELSE MOVE 0 TO H-WINX1. 0210-WAGE-LOOKUP-EXIT. EXIT. 0220-CHNG-WAGEINDX. IF (L-PSF-PROV-OSCAR = '140012' OR '150002' OR '150004' OR '150008' OR '150034' OR '150090' OR '150125' OR '150128' OR '150132') AND (L-PSF-GEO-MSA = '1600' AND L-PSF-WI-MSA = '1600' AND L-PSF-WGIDX-RECLASS = 'Y') MOVE 01.0750 TO H-WINX1. IF (L-PSF-PROV-OSCAR = '250078') AND (L-PSF-GEO-MSA = '3285' AND L-PSF-WI-MSA = '3285' AND L-PSF-WGIDX-RECLASS = 'Y') MOVE 00.7634 TO H-WINX1. IF (L-PSF-PROV-OSCAR = '330001' OR '330126' OR '330135' OR '330205' OR '330209' OR '330264') AND (L-PSF-GEO-MSA = '5600' AND L-PSF-WI-MSA = '5600' AND L-PSF-WGIDX-RECLASS = 'Y') MOVE 01.4342 TO H-WINX1. IF (L-PSF-PROV-OSCAR = '340039' OR '340129' OR '340144') AND (L-PSF-GEO-MSA = '1520' AND L-PSF-WI-MSA = '1520' AND L-PSF-WGIDX-RECLASS = 'Y') MOVE 00.9434 TO H-WINX1. IF (L-PSF-PROV-OSCAR = '360046' OR '360056' OR '360076' OR '360132') AND (L-PSF-GEO-MSA = '1640' AND L-PSF-WI-MSA = '1640' AND L-PSF-WGIDX-RECLASS = 'Y') MOVE 00.9419 TO H-WINX1. IF (L-PSF-PROV-OSCAR = '390019' OR '390049' OR '390162' OR '390194' OR '390197' OR '390263') AND (L-PSF-GEO-MSA = '0240' AND L-PSF-WI-MSA = '0240' AND L-PSF-WGIDX-RECLASS = 'Y') MOVE 01.0228 TO H-WINX1. IF (L-PSF-PROV-OSCAR = '450065' OR '450072' OR '450591') AND (L-PSF-GEO-MSA = '3360' AND L-PSF-WI-MSA = '3360' AND L-PSF-WGIDX-RECLASS = 'Y') MOVE 00.9388 TO H-WINX1. IF (L-PSF-PROV-OSCAR = '470003') AND (L-PSF-GEO-MSA = '1123' AND L-PSF-WI-MSA = '1123' AND L-PSF-WGIDX-RECLASS = 'Y') MOVE 01.1359 TO H-WINX1. 0220-CHNG-WAGEINDX-EXIT. EXIT. *************************************************************** * FOR FY 2001 NEW LUGAR HOSPITALS ONLY * *************************************************************** 0225-CHNG-WAGEINDX. IF (L-PSF-PROV-OSCAR = '010043') AND (L-PSF-WI-MSA = '1000' AND L-PSF-WGIDX-RECLASS = 'Y') MOVE 00.8490 TO H-WINX1. IF (L-PSF-PROV-OSCAR = '010072' OR '010101') AND (L-PSF-WI-MSA = '0450' AND L-PSF-WGIDX-RECLASS = 'Y') MOVE 00.7871 TO H-WINX1. IF (L-PSF-PROV-OSCAR = '100098') AND (L-PSF-WI-MSA = '8960' AND L-PSF-WGIDX-RECLASS = 'Y') MOVE 00.9615 TO H-WINX1. IF (L-PSF-PROV-OSCAR = '100232') AND (L-PSF-WI-MSA = '2900' AND L-PSF-WGIDX-RECLASS = 'Y') MOVE 01.0074 TO H-WINX1. IF (L-PSF-PROV-OSCAR = '110130') AND (L-PSF-WI-MSA = '0500' AND L-PSF-WGIDX-RECLASS = 'Y') MOVE 00.9739 TO H-WINX1. IF (L-PSF-PROV-OSCAR = '140230') AND (L-PSF-WI-MSA = '1400' AND L-PSF-WGIDX-RECLASS = 'Y') MOVE 00.9069 TO H-WINX1. IF (L-PSF-PROV-OSCAR = '230027') AND (L-PSF-WI-MSA = '3000' AND L-PSF-WGIDX-RECLASS = 'Y') MOVE 01.0119 TO H-WINX1. IF (L-PSF-PROV-OSCAR = '340071' OR '340124') AND (L-PSF-WI-MSA = '6640' AND L-PSF-WGIDX-RECLASS = 'Y') MOVE 00.9506 TO H-WINX1. IF (L-PSF-PROV-OSCAR = '390030' OR '390181' OR '390183') AND (L-PSF-WI-MSA = '6680' AND L-PSF-WGIDX-RECLASS = 'Y') MOVE 00.8992 TO H-WINX1. IF (L-PSF-PROV-OSCAR = '390201') AND (L-PSF-WI-MSA = '5640' AND L-PSF-WGIDX-RECLASS = 'Y') MOVE 01.0890 TO H-WINX1. 0225-CHNG-WAGEINDX-EXIT. EXIT. *************************************************************** * CALCULATE DISCOUNT FACTOR BASED ON THE DISCOUNT * * INDICATOR PASSED BY THE OCE: VALUE 1 - 8 * * IF MISSING OR INVALID DISCOUNT FACTOR * * - SET RETURN CODE TO '38' * * - DISCONTINUE LINE PROCESSING * *************************************************************** 0250-CALC-DISCOUNT. IF OPPS-DISC-FACT (LN-SUB) = 1 THEN MOVE 1 TO H-DISC-RATE ELSE IF OPPS-DISC-FACT (LN-SUB) = 2 THEN COMPUTE H-DISC-RATE = (1 + DISC-FRACTION * (H-SRVC-UNITS - 1)) / H-SRVC-UNITS ELSE IF OPPS-DISC-FACT (LN-SUB) = 3 THEN COMPUTE H-DISC-RATE = TERM-PROC-DISC / H-SRVC-UNITS ELSE IF OPPS-DISC-FACT (LN-SUB) = 4 THEN COMPUTE H-DISC-RATE = (1 + DISC-FRACTION) / H-SRVC-UNITS ELSE IF OPPS-DISC-FACT (LN-SUB) = 5 THEN COMPUTE H-DISC-RATE = DISC-FRACTION ELSE IF OPPS-DISC-FACT (LN-SUB) = 6 THEN COMPUTE H-DISC-RATE = (TERM-PROC-DISC * DISC-FRACTION) / H-SRVC-UNITS ELSE IF OPPS-DISC-FACT (LN-SUB) = 7 THEN COMPUTE H-DISC-RATE = (DISC-FRACTION * (1 + DISC-FRACTION) / H-SRVC-UNITS) ELSE IF OPPS-DISC-FACT (LN-SUB) = 8 THEN MOVE 2 TO H-DISC-RATE ELSE MOVE 38 TO A-RETURN-CODE (LN-SUB). 0250-CALC-DISCOUNT-EXIT. EXIT. *************************************************************** * DETERMINE THE DEDUCTIBLE SEQUENCE. DEDUCTIBLE WILL BE * * TAKEN FROM OPPS SERVICES FIRST, THEN FROM ANY OTHER * * TYPES OF SERVICES FROM THE CLAIM. * * - SET POINTERS TO THE HIGHEST RANKED PERCENTAGE * * (LARGEST NATIONAL UNADJUSTED COINSURANCE / * * THE APC PAYMENT) * * - MOVE ALL PRICING VARIABLES TO STAGING AREA * *************************************************************** 0300-COIN-DEDUCT. ADD 1 TO W-LNC-MAX. SET W-LP-INDX TO W-LNC-MAX. PERFORM 0350-STAGE-ENTRY THRU 0350-STAGE-ENTRY-EXIT UNTIL W-LP-INDX = 1 OR H-RANK NOT < W-RANK (W-LP-INDX - 1). MOVE LN-SUB TO W-LP-SUB (W-LP-INDX). MOVE H-NAT-COIN TO W-NAT-COIN (W-LP-INDX). MOVE H-MIN-COIN TO W-MIN-COIN (W-LP-INDX). MOVE H-APC-PYMT TO W-APC-PYMT (W-LP-INDX). MOVE H-WINX1 TO W-WINX1 (W-LP-INDX). MOVE H-RANK TO W-RANK (W-LP-INDX). MOVE H-PPCT TO W-PPCT (W-LP-INDX). MOVE H-DISC-RATE TO W-DISC-RATE (W-LP-INDX). IF OPPS-SRVC-IND (LN-SUB) = ' P' THEN MOVE 1 TO W-SRVC-UNITS (W-LP-INDX) ELSE MOVE H-SRVC-UNITS TO W-SRVC-UNITS (W-LP-INDX). MOVE 0 TO W-RED-COIN (W-LP-INDX). PERFORM VARYING PS-SUB FROM 1 BY 1 UNTIL PS-SUB > L-PSF-APC-LINE-CNT IF L-PSF-APC (PS-SUB) = OPPS-APC (LN-SUB) COMPUTE W-RED-COIN (W-LP-INDX) ROUNDED = L-PSF-RED-COIN (PS-SUB) * H-SRVC-UNITS * H-DISC-RATE MOVE 25 TO A-RETURN-CODE (LN-SUB) MOVE L-PSF-APC-LINE-CNT TO PS-SUB END-IF END-PERFORM. 0300-COIN-DEDUCT-EXIT. EXIT. 0350-STAGE-ENTRY. MOVE W-LP-ENTRY (W-LP-INDX - 1) TO W-LP-ENTRY (W-LP-INDX). SET W-LP-INDX DOWN BY 1. 0350-STAGE-ENTRY-EXIT. EXIT. *************************************************************** * DETERMINE THE BLOOD DEDUCTIBLE SEQUENCE. DEDUCTIBLE * * WILL BE CALCULATED BASED ON RANKING. * * - SET POINTERS TO THE HIGHEST RANKED APC * * (SMALLEST UNADJUSTED APC PAYMENT) * * - MOVE ALL PRICING VARIABLES TO STAGING AREA * *************************************************************** 0375-BLOOD-DEDUCT. ADD 1 TO W-BLD-MAX. SET W-BD-INDX TO W-BLD-MAX. PERFORM 0385-STAGE-ENTRY THRU 0385-STAGE-ENTRY-EXIT UNTIL W-BD-INDX = 1 OR H-BLOOD-RANK NOT < W-BD-RANK (W-BD-INDX - 1). MOVE LN-SUB TO W-BD-SUB (W-BD-INDX). MOVE H-NAT-COIN TO W-BD-NAT-COIN (W-BD-INDX). MOVE H-MIN-COIN TO W-BD-MIN-COIN (W-BD-INDX). MOVE H-SUB-CHRG TO W-BD-SUB-CHRG (W-BD-INDX). MOVE H-APC-PYMT TO W-BD-APC-PYMT (W-BD-INDX). MOVE H-WINX1 TO W-BD-WINX1 (W-BD-INDX). MOVE H-BLOOD-RANK TO W-BD-RANK (W-BD-INDX). MOVE H-PPCT TO W-BD-PPCT (W-BD-INDX). MOVE H-DISC-RATE TO W-BD-DISC-RATE (W-BD-INDX). MOVE H-SRVC-UNITS TO W-BD-SRVC-UNITS (W-BD-INDX). MOVE 0 TO W-BD-RED-COIN (W-BD-INDX). PERFORM VARYING PS-SUB FROM 1 BY 1 UNTIL PS-SUB > L-PSF-APC-LINE-CNT IF L-PSF-APC (PS-SUB) = OPPS-APC (LN-SUB) COMPUTE W-BD-RED-COIN (W-BD-INDX) ROUNDED = L-PSF-RED-COIN (PS-SUB) * H-SRVC-UNITS * H-DISC-RATE MOVE 25 TO A-RETURN-CODE (LN-SUB) MOVE L-PSF-APC-LINE-CNT TO PS-SUB END-IF END-PERFORM. 0375-BLOOD-DEDUCT-EXIT. EXIT. 0385-STAGE-ENTRY. MOVE W-BD-ENTRY (W-BD-INDX - 1) TO W-BD-ENTRY (W-BD-INDX). SET W-BD-INDX DOWN BY 1. 0385-STAGE-ENTRY-EXIT. EXIT. *************************************************************** * FIRST STEP IN DETERMINING A LINE ITEM PRICE. * * CHECK ALL APPROPRIATE FLAGS AND INDICATORS PASSED * * BY THE OCE. * * - SET RETURN CODES TO INDICATE ERRORS OR STATUS * * - '20' - LINE PROCESSED BUT PAYMENT = 0 * * - BENE DEDUCTIBLE => ADJUSTED PAYMENT * * * *************************************************************** 0400-CALCULATE. MOVE W-LP-SUB (W-LP-INDX) TO LN-SUB. IF A-RETURN-CODE (LN-SUB) > 25 GO TO 0400-CALCULATE-EXIT. IF OPPS-PYMT-IND (LN-SUB) = ' 1' OR ' 5' OR ' 6' OR ' 7' OR ' 8' PERFORM 0550-CALC-STANDARD THRU 0550-CALC-STANDARD-EXIT ELSE GO TO 0400-CALCULATE-EXIT. *************************************************************** * SET STVX AND / OR GJK FLAGS * * - TEST LINE ITEM DATE OF SERVICE > 20010630 * * - TOTAL DRUG / DEVICE COINSURANCE * *************************************************************** IF (A-RETURN-CODE (LN-SUB) < 30) AND (OPPS-LITEM-DOS (LN-SUB) > 20001231) PERFORM 0450-ADJ-PROC-COIN THRU 0450-ADJ-PROC-COIN-EXIT ELSE NEXT SENTENCE. IF A-RETURN-CODE (LN-SUB) < 30 COMPUTE A-TOTAL-CLM-DEDUCT = H-TOTAL-LN-DEDUCT + A-TOTAL-CLM-DEDUCT COMPUTE H-TOT-PYMT = H-TOT-PYMT + H-LITEM-PYMT COMPUTE A-BLOOD-DEDUCT-DUE = A-BLOOD-DEDUCT-DUE + H-LN-BLOOD-DEDUCT MOVE H-LITEM-PYMT TO A-LITEM-PYMT (LN-SUB) MOVE H-LITEM-REIM TO A-LITEM-REIM (LN-SUB) MOVE H-TOTAL-LN-DEDUCT TO A-TOTAL-LN-DEDUCT (LN-SUB) MOVE H-LN-BLOOD-DEDUCT TO A-BLOOD-LN-DEDUCT (LN-SUB) MOVE H-NAT-COIN TO A-ADJ-COIN (LN-SUB) MOVE H-RED-COIN TO A-RED-COIN (LN-SUB) IF H-RED-COIN > H-NAT-COIN MOVE H-NAT-COIN TO A-RED-COIN (LN-SUB) END-IF IF OPPS-LITEM-ACT-FLAG (LN-SUB) = '4' MOVE 0 TO A-LITEM-PYMT (LN-SUB) MOVE 0 TO A-LITEM-REIM (LN-SUB) COMPUTE H-TOT-PYMT = H-TOT-PYMT - H-LITEM-PYMT END-IF END-IF. MOVE ZERO TO LINE-HOLD-ITEMS. 0400-CALCULATE-EXIT. EXIT. *************************************************************** * SET STVX AND / OR GJK FLAGS * * - STAGE BY SERVICE INDICATOR * * * *************************************************************** 0450-ADJ-PROC-COIN. MOVE OPPS-LITEM-DOS (LN-SUB) TO H-DCP-DOS. IF OPPS-SRVC-IND (LN-SUB) = ' S' OR ' T' OR ' V' COMPUTE H-NEW-WGNAT ROUNDED = W-NAT-COIN (W-LP-INDX) * (.6 * W-WINX1 (W-LP-INDX) + .4) IF H-NEW-WGNAT > H-IP-LIMIT MOVE H-IP-LIMIT TO H-NEW-WGNAT END-IF COMPUTE H-NEW-COIN = H-LITEM-PYMT - H-TOTAL-LN-DEDUCT - H-LITEM-REIM - H-LN-BLOOD-DEDUCT MOVE 1 TO H-DCP-CODE PERFORM 0455-SEARCH-KEY THRU 0455-SEARCH-KEY-EXIT ELSE IF OPPS-SRVC-IND (LN-SUB) = ' G' OR ' J' OR ' K' COMPUTE H-NEW-COIN = H-LITEM-PYMT - H-TOTAL-LN-DEDUCT - H-LITEM-REIM - H-LN-BLOOD-DEDUCT MOVE 'Y' TO GJK-FLAG MOVE 1 TO H-DCP-CODE PERFORM 0455-SEARCH-KEY THRU 0455-SEARCH-KEY-EXIT MOVE 2 TO H-DCP-CODE ADD 1 TO W-DCP-MAX SET W-DCP-INDX TO W-DCP-MAX PERFORM 0475-STAGE-DCP-ENTRY THRU 0475-STAGE-DCP-ENTRY-EXIT UNTIL W-DCP-INDX = 1 OR H-DCP-STAGE NOT < W-DCP-STAGE (W-DCP-INDX - 1) MOVE LN-SUB TO W-DCP-SUB (W-DCP-INDX) MOVE H-DCP-STAGE TO W-DCP-STAGE (W-DCP-INDX) MOVE ZERO TO W-DCP-COIN1 (W-DCP-INDX) MOVE ZERO TO W-DCP-WGNAT (W-DCP-INDX) MOVE H-NEW-COIN TO W-DCP-COIN2 (W-DCP-INDX) MOVE OPPS-SRVC-IND (LN-SUB) TO W-DCP-SRVC-IND (W-DCP-INDX). 0450-ADJ-PROC-COIN-EXIT. EXIT. 0455-SEARCH-KEY. SET W-DCP-INDX TO 1. SEARCH W-DCP-ENTRY VARYING W-DCP-INDX AT END PERFORM 0460-ADD-ENTRY THRU 0460-ADD-ENTRY-EXIT WHEN W-DCP-STAGE (W-DCP-INDX) = H-DCP-STAGE PERFORM 0465-UPDATE-ENTRY THRU 0465-UPDATE-ENTRY-EXIT. 0455-SEARCH-KEY-EXIT. EXIT. 0460-ADD-ENTRY. ADD 1 TO W-DCP-MAX. SET W-DCP-INDX TO W-DCP-MAX. PERFORM 0475-STAGE-DCP-ENTRY THRU 0475-STAGE-DCP-ENTRY-EXIT UNTIL W-DCP-INDX = 1 OR H-DCP-STAGE NOT < W-DCP-STAGE (W-DCP-INDX - 1). IF OPPS-SRVC-IND (LN-SUB) = ' G' OR ' J' OR ' K' MOVE ZERO TO W-DCP-SUB (W-DCP-INDX) MOVE H-DCP-STAGE TO W-DCP-STAGE (W-DCP-INDX) MOVE ZERO TO W-DCP-COIN1 (W-DCP-INDX) MOVE ZERO TO W-DCP-WGNAT (W-DCP-INDX) MOVE H-NEW-COIN TO W-DCP-COIN2 (W-DCP-INDX) MOVE ' X' TO W-DCP-SRVC-IND (W-DCP-INDX) ELSE MOVE LN-SUB TO W-DCP-SUB (W-DCP-INDX) MOVE H-DCP-STAGE TO W-DCP-STAGE (W-DCP-INDX) MOVE H-NEW-COIN TO W-DCP-COIN1 (W-DCP-INDX) MOVE H-NEW-WGNAT TO W-DCP-WGNAT (W-DCP-INDX) MOVE ZERO TO W-DCP-COIN2 (W-DCP-INDX) MOVE OPPS-SRVC-IND (LN-SUB) TO W-DCP-SRVC-IND (W-DCP-INDX). 0460-ADD-ENTRY-EXIT. EXIT. 0465-UPDATE-ENTRY. IF OPPS-SRVC-IND (LN-SUB) = ' G' OR ' J' OR ' K' ADD H-NEW-COIN TO W-DCP-COIN2 (W-DCP-INDX) ELSE IF W-DCP-SRVC-IND (W-DCP-INDX) = ' X' PERFORM 0485-REPLACE-TYPE1 THRU 0485-REPLACE-TYPE1-EXIT ELSE PERFORM 0480-RANK-COIN THRU 0480-RANK-COIN-EXIT. 0465-UPDATE-ENTRY-EXIT. EXIT. 0475-STAGE-DCP-ENTRY. MOVE W-DCP-ENTRY (W-DCP-INDX - 1) TO W-DCP-ENTRY (W-DCP-INDX). SET W-DCP-INDX DOWN BY 1. 0475-STAGE-DCP-ENTRY-EXIT. EXIT. 0480-RANK-COIN. IF H-NEW-WGNAT > W-DCP-WGNAT (W-DCP-INDX) MOVE LN-SUB TO W-DCP-SUB (W-DCP-INDX) MOVE H-NEW-COIN TO W-DCP-COIN1 (W-DCP-INDX) MOVE H-NEW-WGNAT TO W-DCP-WGNAT (W-DCP-INDX) MOVE OPPS-SRVC-IND (LN-SUB) TO W-DCP-SRVC-IND (W-DCP-INDX). 0480-RANK-COIN-EXIT. EXIT. 0485-REPLACE-TYPE1. MOVE LN-SUB TO W-DCP-SUB (W-DCP-INDX) MOVE H-NEW-COIN TO W-DCP-COIN1 (W-DCP-INDX) MOVE H-NEW-WGNAT TO W-DCP-WGNAT (W-DCP-INDX) MOVE OPPS-SRVC-IND (LN-SUB) TO W-DCP-SRVC-IND (W-DCP-INDX). 0485-REPLACE-TYPE1-EXIT. EXIT. *************************************************************** * 1. APPLY DEDUCTIBLE TO HIGHEST NATIONAL COINSURANCE AMOUNT * * - DESCENDING UNTIL DEDUCTIBLE = 0. * * 2. CALCULATE THE STANDARD LINE PRICE * * (APC PAYMENT * WAGE INDEX * SERVICE UNITS * * * DISCOUNT FACTOR) * * - WAGE ADJUST 60% OF THE APC PAYMENT ONLY * * 3. ADD LINE PRICE TO OUTLIER HOLD AREA. * * * * 4. CALCULATE THE LINE PRICE FOR DESIGNATED DEVICES * * AND DRUGS * *************************************************************** 0550-CALC-STANDARD. COMPUTE H-MAX-COIN ROUNDED = (H-IP-LIMIT * W-SRVC-UNITS (W-LP-INDX) * W-DISC-RATE (W-LP-INDX)). MOVE 0 TO H-BLOOD-FRACTION. IF (OPPS-SRVC-IND (LN-SUB) = ' S' OR ' X') AND (OPPS-HCPCS (LN-SUB) = 'P9010' OR 'P9016' OR 'P9021' OR 'P9022' OR 'P9038' OR 'P9039' OR 'P9040' OR 'C1010' OR 'C1018') PERFORM 0550-SET-BLOOD-FRACTION THRU 0550-SET-BLOOD-FRACTION-EXIT PERFORM 0550-CALC-FY00-BLOOD-DED THRU 0550-CALC-FY00-BLOOD-DED-EXIT GO TO 0550-CALC-STANDARD-EXIT. IF OPPS-SRVC-IND (LN-SUB) = ' S' OR ' V' OR ' T' OR ' P' OR ' X' THEN COMPUTE H-LITEM-PYMT ROUNDED = (((W-APC-PYMT (W-LP-INDX) * .60) * W-WINX1 (W-LP-INDX)) + (W-APC-PYMT (W-LP-INDX) * .40)) * W-SRVC-UNITS (W-LP-INDX) * W-DISC-RATE (W-LP-INDX) PERFORM 0560-CALC-BENE-DEDUCT THRU 0560-CALC-BENE-DEDUCT-EXIT ELSE IF OPPS-SRVC-IND (LN-SUB) = ' H' THEN IF OPPS-PYMT-IND (LN-SUB) = ' 6' THEN PERFORM 0555-CALC-H-STANDARD THRU 0555-CALC-H-STANDARD-EXIT PERFORM 0560-CALC-BENE-DEDUCT THRU 0560-CALC-BENE-DEDUCT-EXIT ELSE MOVE 44 TO A-RETURN-CODE (LN-SUB) GO TO 0550-CALC-STANDARD-EXIT END-IF ELSE IF OPPS-SRVC-IND (LN-SUB) = ' G' OR ' J' OR ' K' THEN IF OPPS-PYMT-IND (LN-SUB) = ' 1' OR ' 5' OR ' 7' THEN PERFORM 0550-CALC-GJK THRU 0550-CALC-GJK-EXIT PERFORM 0560-CALC-BENE-DEDUCT THRU 0560-CALC-BENE-DEDUCT-EXIT ELSE MOVE 41 TO A-RETURN-CODE (LN-SUB) GO TO 0550-CALC-STANDARD-EXIT END-IF END-IF. IF H-LITEM-PYMT > 0 COMPUTE H-LITEM-REIM ROUNDED = ((H-LITEM-PYMT - H-TOTAL-LN-DEDUCT) - H-LN-BLOOD-DEDUCT) * W-PPCT (W-LP-INDX) COMPUTE H-NAT-COIN = H-LITEM-PYMT - H-TOTAL-LN-DEDUCT - H-LITEM-REIM - H-LN-BLOOD-DEDUCT. MOVE W-MIN-COIN (W-LP-INDX) TO H-MIN-COIN. IF H-MIN-COIN > 0 IF OPPS-SRVC-IND (LN-SUB) = ' G' OR ' H' OR ' J' OR ' K' COMPUTE H-MIN-COIN ROUNDED = H-MIN-COIN * (W-SRVC-UNITS (W-LP-INDX) - (W-SRVC-UNITS (W-LP-INDX) * H-BLOOD-FRACTION)) * W-DISC-RATE (W-LP-INDX) ELSE IF OPPS-APC (LN-SUB) = '0158' OR '0159' COMPUTE H-MIN-COIN ROUNDED = H-LITEM-PYMT * .25 ELSE COMPUTE H-MIN-COIN ROUNDED = H-LITEM-PYMT * .2 END-IF END-IF END-IF. MOVE W-RED-COIN (W-LP-INDX) TO H-RED-COIN. IF (H-RED-COIN > 0 AND < H-MIN-COIN) MOVE H-MIN-COIN TO H-RED-COIN ELSE IF H-RED-COIN < H-NAT-COIN AND > H-MIN-COIN AND > H-MAX-COIN COMPUTE H-LITEM-REIM = H-LITEM-REIM + (H-RED-COIN - H-MAX-COIN) END-IF END-IF. IF H-NAT-COIN > H-MAX-COIN AND H-RED-COIN = 0 THEN COMPUTE H-LITEM-REIM = H-LITEM-REIM + (H-NAT-COIN - H-MAX-COIN) MOVE H-MAX-COIN TO H-NAT-COIN. 0550-CALC-STANDARD-EXIT. EXIT. 0550-CALC-FY00-BLOOD-DED. COMPUTE H-LITEM-PYMT ROUNDED = (((W-BD-APC-PYMT (W-BD-INDX) * .60) * W-BD-WINX1 (W-BD-INDX)) + (W-BD-APC-PYMT (W-BD-INDX) * .40)) * W-BD-SRVC-UNITS (W-BD-INDX) * W-BD-DISC-RATE (W-BD-INDX) COMPUTE H-LN-BLOOD-DEDUCT ROUNDED = H-LITEM-PYMT * H-BLOOD-FRACTION SET W-BD-INDX UP BY 1 PERFORM 0560-CALC-BENE-DEDUCT THRU 0560-CALC-BENE-DEDUCT-EXIT. IF H-LITEM-PYMT > 0 COMPUTE H-LITEM-REIM ROUNDED = ((H-LITEM-PYMT - H-TOTAL-LN-DEDUCT) - H-LN-BLOOD-DEDUCT) * W-PPCT (W-LP-INDX) COMPUTE H-NAT-COIN = H-LITEM-PYMT - H-TOTAL-LN-DEDUCT - H-LITEM-REIM - H-LN-BLOOD-DEDUCT. MOVE W-MIN-COIN (W-LP-INDX) TO H-MIN-COIN. IF H-MIN-COIN > 0 COMPUTE H-MIN-COIN ROUNDED = H-MIN-COIN * (W-SRVC-UNITS (W-LP-INDX) - (W-SRVC-UNITS (W-LP-INDX) * H-BLOOD-FRACTION)) * W-DISC-RATE (W-LP-INDX). MOVE W-RED-COIN (W-LP-INDX) TO H-RED-COIN. IF (H-RED-COIN > 0 AND < H-MIN-COIN) MOVE H-MIN-COIN TO H-RED-COIN ELSE IF H-RED-COIN < H-NAT-COIN AND > H-MIN-COIN AND > H-MAX-COIN COMPUTE H-LITEM-REIM = H-LITEM-REIM + (H-RED-COIN - H-MAX-COIN) END-IF END-IF. IF H-NAT-COIN > H-MAX-COIN AND H-RED-COIN = 0 THEN COMPUTE H-LITEM-REIM = H-LITEM-REIM + (H-NAT-COIN - H-MAX-COIN) MOVE H-MAX-COIN TO H-NAT-COIN. IF H-LITEM-PYMT = H-LN-BLOOD-DEDUCT MOVE 0 TO H-LITEM-REIM MOVE 0 TO H-NAT-COIN. 0550-CALC-FY00-BLOOD-DED-EXIT. EXIT. *************************************************************** * 1. CALCULATE LINE ITEM PAYMENT FOR SERVICE INDICATOR * * TYPES G , J , OR K. * * 2. EFFECTIVE 01/01/2003 REMOVE PRO RATA REDUCTION FOR * * ALL SERVICE INDICATOR 'G' PAYMENTS * *************************************************************** 0550-CALC-GJK. IF OPPS-HCPCS(LN-SUB) = 'P9021' OR 'P9010' OR 'P9038' OR 'P9016' OR 'C1010' OR 'C1018' OR 'P9022' OR 'P9039' OR 'P9040' OR 'C1016' PERFORM 0550-SET-BLOOD-FRACTION THRU 0550-SET-BLOOD-FRACTION-EXIT ELSE COMPUTE H-LITEM-PYMT ROUNDED = W-APC-PYMT (W-LP-INDX) * W-SRVC-UNITS (W-LP-INDX) * W-DISC-RATE (W-LP-INDX) GO TO 0550-CALC-GJK-EXIT. COMPUTE H-LITEM-PYMT ROUNDED = W-BD-APC-PYMT (W-BD-INDX) * W-BD-SRVC-UNITS (W-BD-INDX) * W-BD-DISC-RATE (W-BD-INDX). COMPUTE H-LN-BLOOD-DEDUCT ROUNDED = H-LITEM-PYMT * H-BLOOD-FRACTION. SET W-BD-INDX UP BY 1. 0550-CALC-GJK-EXIT. EXIT. 0550-SET-BLOOD-FRACTION. MOVE W-BD-SUB (W-BD-INDX) TO LN-SUB. IF H-BENE-PINTS-USED > 0 IF W-BD-SRVC-UNITS (W-BD-INDX) <= H-BENE-PINTS-USED MOVE 1 TO H-BLOOD-FRACTION COMPUTE H-BENE-PINTS-USED = H-BENE-PINTS-USED - W-BD-SRVC-UNITS (W-BD-INDX) ELSE IF W-BD-SRVC-UNITS (W-BD-INDX) > H-BENE-PINTS-USED COMPUTE H-BLOOD-FRACTION = H-BENE-PINTS-USED / W-BD-SRVC-UNITS (W-BD-INDX) MOVE 0 TO H-BENE-PINTS-USED ELSE MOVE 0 TO H-BLOOD-FRACTION ELSE MOVE 0 TO H-BLOOD-FRACTION. 0550-SET-BLOOD-FRACTION-EXIT. EXIT. 0555-CALC-H-STANDARD. MOVE OPPS-SUB-CHRG (LN-SUB) TO H-SUB-CHRG IF L-SERVICE-FROM-DATE > 20001231 COMPUTE T-LITEM-PYMT ROUNDED = (H-SUB-CHRG * (L-PSF-OPCOST-RATIO * .981956)) - (((W-APC-PYMT (W-LP-INDX) * .60) * W-WINX1 (W-LP-INDX)) + (W-APC-PYMT (W-LP-INDX) * .40)) ELSE COMPUTE T-LITEM-PYMT ROUNDED = (H-SUB-CHRG * L-PSF-OPCOST-RATIO) - (((W-APC-PYMT (W-LP-INDX) * .60) * W-WINX1 (W-LP-INDX)) + (W-APC-PYMT (W-LP-INDX) * .40)). IF T-LITEM-PYMT < 0 THEN MOVE 0 TO H-LITEM-PYMT ELSE MOVE T-LITEM-PYMT TO H-LITEM-PYMT. 0555-CALC-H-STANDARD-EXIT. EXIT. 0560-CALC-BENE-DEDUCT. IF OPPS-PYMT-ADJ-FLAG (LN-SUB) = ' 4' GO TO 0560-CALC-BENE-DEDUCT-EXIT. IF H-BENE-DEDUCT > 0 THEN COMPUTE H-LN-BLD-PYMT = H-LITEM-PYMT - H-LN-BLOOD-DEDUCT IF H-BENE-DEDUCT <= H-LN-BLD-PYMT THEN MOVE H-BENE-DEDUCT TO H-TOTAL-LN-DEDUCT MOVE 0 TO H-BENE-DEDUCT ELSE COMPUTE H-BENE-DEDUCT = H-BENE-DEDUCT - H-LN-BLD-PYMT MOVE H-LN-BLD-PYMT TO H-TOTAL-LN-DEDUCT MOVE 20 TO A-RETURN-CODE (LN-SUB) END-IF END-IF. 0560-CALC-BENE-DEDUCT-EXIT. EXIT. 0800-ADJ-STV-REIM. IF W-DCP-CODE (W-DCP-INDX) = 1 PERFORM 0810-PROCESS-TYPE1 THRU 0810-PROCESS-TYPE1-EXIT ELSE PERFORM 0840-PROCESS-TYPE2 THRU 0840-PROCESS-TYPE2-EXIT. 0800-ADJ-STV-REIM-EXIT. EXIT. 0810-PROCESS-TYPE1. IF W-DCP-COIN2 (W-DCP-INDX) > 0 MOVE W-DCP-DOS (W-DCP-INDX) TO H-DCP-DOS MOVE W-DCP-WGNAT (W-DCP-INDX) TO H-TOTAL COMPUTE H-RATIO = (H-IP-LIMIT - W-DCP-WGNAT (W-DCP-INDX)) / W-DCP-COIN2 (W-DCP-INDX) IF H-RATIO < 0 MOVE 0 TO H-RATIO. IF H-RATIO > 1 MOVE 1 TO H-RATIO. 0810-PROCESS-TYPE1-EXIT. EXIT. 0840-PROCESS-TYPE2. IF W-DCP-DOS (W-DCP-INDX) >= 20010701 IF W-DCP-DOS (W-DCP-INDX) = H-DCP-DOS MOVE W-DCP-SUB (W-DCP-INDX) TO LN-SUB COMPUTE H-SHIFT = W-DCP-COIN2 (W-DCP-INDX) * (1 - H-RATIO) COMPUTE H-TOTAL = A-ADJ-COIN (LN-SUB) + H-TOTAL - H-SHIFT IF H-TOTAL > H-IP-LIMIT COMPUTE H-SHIFT = H-SHIFT + H-TOTAL - H-IP-LIMIT END-IF COMPUTE A-ADJ-COIN (LN-SUB) = A-ADJ-COIN (LN-SUB) - H-SHIFT COMPUTE A-LITEM-REIM (LN-SUB) = A-LITEM-REIM (LN-SUB) + H-SHIFT MOVE 22 TO A-RETURN-CODE (LN-SUB) END-IF ELSE IF W-DCP-DOS (W-DCP-INDX) >= 20010101 IF W-DCP-COIN2 (W-DCP-INDX) > H-IP-LIMIT MOVE W-DCP-SUB (W-DCP-INDX) TO LN-SUB COMPUTE H-SHIFT = W-DCP-COIN2 (W-DCP-INDX) - H-IP-LIMIT COMPUTE A-ADJ-COIN (LN-SUB) = A-ADJ-COIN (LN-SUB) - H-SHIFT COMPUTE A-LITEM-REIM (LN-SUB) = A-LITEM-REIM (LN-SUB) + H-SHIFT MOVE 22 TO A-RETURN-CODE (LN-SUB) END-IF END-IF END-IF. 0840-PROCESS-TYPE2-EXIT. EXIT. *************************************************************** * 1. MOVE TOTAL CLAIM CHARGE AMOUNT. * * 2. MOVE TOTAL CLAIM PAYMENT AMOUNT. * * 3. MOVE TOTAL CLAIM BLOOD PINTS USED. * * 4. CALCULATE CLAIM LEVEL OUTLIER AMOUNT. * *************************************************************** 0900-END-PRICE-RTN. MOVE H-TOT-CHRG TO A-TOT-CLM-CHRG. MOVE H-TOT-PYMT TO A-TOT-CLM-PYMT. COMPUTE A-BLOOD-PINTS-USED = H-BENE-BLOOD-PINTS - H-BENE-PINTS-USED. IF A-TOT-CLM-PYMT > 0 PERFORM 0910-CALC-OUTLIER THRU 0910-CALC-OUTLIER-EXIT. IF H-OUTLIER-PYMT > 0 MOVE H-OUTLIER-PYMT TO A-OUTLIER-PYMT. 0900-END-PRICE-RTN-EXIT. EXIT. 0910-CALC-OUTLIER. IF L-SERVICE-FROM-DATE > 20001231 COMPUTE H-OUTLIER-PYMT ROUNDED = ((H-TOT-CHRG * (L-PSF-OPCOST-RATIO * .981956)) - (2.5 * H-TOT-PYMT)) * .75 ELSE COMPUTE H-OUTLIER-PYMT ROUNDED = ((H-TOT-CHRG * L-PSF-OPCOST-RATIO) - (2.5 * H-TOT-PYMT)) * .75. 0910-CALC-OUTLIER-EXIT. EXIT. *************************************************************** * PROCESSING: AFTER 20020331 * * A. WILL PROCESS LINE ITEMS BASED ON OCE FLAGS. * * B. INITIALIZE OPPS HOLD VARIABLES. * * C. EDIT THE DATA PASSED FROM THE OCE. * * D. ASSEMBLE PRICING COMPONENTS. * * E. CALCULATE THE PRICE. * * F. RETURN COINSURANCE/REIMBURSEMENT/DEDUCTIBLE/ * * PAYMENT/OUTLIER AMOUNT/RETURN CODES * *************************************************************** 1000-PROCESS-MAIN-NEW. PERFORM 1100-INIT THRU 1100-INIT-EXIT. IF A-CLM-RTN-CODE >= 50 GOBACK. MOVE H-WINX1 TO A-WINX. PERFORM 1125-INIT THRU 1125-INIT-EXIT VARYING LN-SUB FROM 1 BY 1 UNTIL LN-SUB > OPPS-LINE-CNT. MOVE 0 TO W-DCP-MAX W-BLD-MAX. PERFORM 1150-INIT THRU 1150-INIT-EXIT VARYING LN-SUB FROM 1 BY 1 UNTIL LN-SUB > OPPS-LINE-CNT. MOVE 0 TO W-DCP-MAX. IF L-SERVICE-FROM-DATE > 20020331 PERFORM 1555-CALC-H-TOT THRU 1555-CALC-H-TOT-EXIT VARYING W-LP-INDX FROM 1 BY 1 UNTIL W-LP-INDX > W-LNC-MAX. SET W-BD-INDX TO 1. MOVE 0 TO W-DCP-MAX. PERFORM 1400-CALCULATE THRU 1400-CALCULATE-EXIT VARYING W-LP-INDX FROM 1 BY 1 UNTIL W-LP-INDX > W-LNC-MAX. IF L-SERVICE-FROM-DATE > 20020331 PERFORM 1600-ADJ-CHRG-OUTL THRU 1600-ADJ-CHRG-OUTL-EXIT VARYING W-LP-INDX FROM 1 BY 1 UNTIL W-LP-INDX > W-LNC-MAX ELSE NEXT SENTENCE. IF GJK-FLAG = 'Y' PERFORM 1800-ADJ-STV-REIM THRU 1800-ADJ-STV-REIM-EXIT VARYING W-DCP-INDX FROM 1 BY 1 UNTIL W-DCP-INDX > W-DCP-MAX ELSE NEXT SENTENCE. PERFORM 1900-END-PRICE-RTN THRU 1900-END-PRICE-RTN-EXIT. 1000-PROCESS-MAIN-NEW-EXIT. EXIT. *************************************************************** * INITIALIZE WORKING STORAGE HOLD AREAS * * AND ADDITIONAL VARIABLES TO BE PASSED BACK TO * * THE STANDARD SYSTEM. * * - IF PROVIDER SPECIFIC FILE WAGE INDEX RECLASSIFICATION * * CODE INVALID OR MISSING * * - MOVE '52' TO CLAIM LEVEL RETURN CODE * * - DISCONTINUE CLAIM PROCESSING * * - IF SERVICE FROM DATE NOT NUMERIC OR < 20000801 * * - MOVE '53' TO CLAIM LEVEL RETURN CODE * * - DISCONTINUE CLAIM PROCESSING * * - IF SERVICE FROM DATE < PROVIDER EFFECTIVE DATE * * - MOVE '54' TO CLAIM LEVEL RETURN CODE * * - DISCONTINUE CLAIM PROCESSING * * - IF SERVICE FROM DATE > PROVIDER TERMINATION DATE * * - MOVE '54' TO CLAIM LEVEL RETURN CODE * * - DISCONTINUE CLAIM PROCESSING * *************************************************************** 1100-INIT. MOVE 01 TO A-CLM-RTN-CODE. MOVE 'N' TO APC33-FLAG GJK-FLAG ST0-FLAG N-FLAG C-FLAG. MOVE SPACE TO A-MSA A-CBSA. MOVE ZERO TO A-OUTLIER-PYMT A-TOTAL-CLM-DEDUCT A-TOT-CLM-CHRG A-TOT-CLM-PYMT A-BLOOD-PINTS-USED A-BLOOD-DEDUCT-DUE A-WINX W-LNC-MAX. INITIALIZE H-ADDITIONAL-VARIABLES. INITIALIZE LINE-HOLD-ITEMS. INITIALIZE T-LITEM-PYMT. IF L-SERVICE-FROM-DATE NOT NUMERIC MOVE 53 TO A-CLM-RTN-CODE GO TO 1100-INIT-EXIT ELSE IF L-SERVICE-FROM-DATE < 20000801 MOVE 53 TO A-CLM-RTN-CODE GO TO 1100-INIT-EXIT ELSE IF L-SERVICE-FROM-DATE < L-PSF-EFFDT MOVE 54 TO A-CLM-RTN-CODE GO TO 1100-INIT-EXIT ELSE IF L-PSF-TERMDT > 0 IF L-SERVICE-FROM-DATE > L-PSF-TERMDT MOVE 54 TO A-CLM-RTN-CODE GO TO 1100-INIT-EXIT END-IF END-IF. MOVE CAL-VERSION1 TO A-CALC-VERS. MOVE BENE-DEDUCT TO H-BENE-DEDUCT. MOVE BENE-BLOOD-PINTS TO H-BENE-BLOOD-PINTS H-BENE-PINTS-USED. MOVE WAD-MAX TO WAD-SUB. PERFORM UNTIL L-SERVICE-FROM-DATE NOT < WAD-DATE (WAD-SUB) SUBTRACT 1 FROM WAD-SUB END-PERFORM. IF L-PSF-WGIDX-RECLASS = 'Y' MOVE L-PSF-WI-MSA TO H-PSF-MSA ELSE IF L-PSF-WGIDX-RECLASS = 'N' MOVE L-PSF-GEO-MSA TO H-PSF-MSA ELSE MOVE 52 TO A-CLM-RTN-CODE GO TO 1100-INIT-EXIT. IF L-SERVICE-FROM-DATE >= 20020101 MOVE 812 TO H-IP-LIMIT ELSE IF L-SERVICE-FROM-DATE >= 20010101 MOVE 792 TO H-IP-LIMIT ELSE IF L-SERVICE-FROM-DATE >= 20000801 MOVE 776 TO H-IP-LIMIT. IF L-SERVICE-FROM-DATE > 20020331 PERFORM 1115-FLOOR-2002 THRU 1115-FLOOR-2002-EXIT PERFORM 1115-SEC401-2002 THRU 1115-SEC401-2002-EXIT ELSE IF L-SERVICE-FROM-DATE > 20001231 PERFORM 1110-FLOOR-2001 THRU 1110-FLOOR-2001-EXIT ELSE IF L-SERVICE-FROM-DATE > 20000731 PERFORM 1105-FLOOR-2000 THRU 1105-FLOOR-2000-EXIT. MOVE H-PSF-MSA TO A-MSA. IF L-SERVICE-FROM-DATE >= 20010101 PERFORM 1225-CHNG-WAGEINDX THRU 1225-CHNG-WAGEINDX-EXIT ELSE PERFORM 1220-CHNG-WAGEINDX THRU 1220-CHNG-WAGEINDX-EXIT. IF H-WINX1 = 0 THEN PERFORM 1200-CALC-WAGEINDX THRU 1200-CALC-WAGEINDX-EXIT. 1100-INIT-EXIT. EXIT. *************************************************************** * RESET FLOOR MSA - 'FROM-DATE' CONTROLLED * * - YEAR 2000 * * - YEAR 2001 * * - YEAR 2002 * *************************************************************** 1105-FLOOR-2000. IF (H-PSF-MSA = '6020' OR '9000' OR '8080') AND (L-PSF-PROV-ST = '36') MOVE ' 36' TO H-PSF-MSA ELSE IF (H-PSF-MSA = '2440') AND (L-PSF-PROV-ST = '15') MOVE ' 15' TO H-PSF-MSA ELSE IF (H-PSF-MSA = '2520') AND (L-PSF-PROV-ST = '24') AND (L-PSF-WGIDX-RECLASS = 'Y') MOVE ' 24' TO H-PSF-MSA ELSE IF (H-PSF-MSA = '1123') AND (L-PSF-PROV-ST = '22') MOVE ' 22' TO H-PSF-MSA. 1105-FLOOR-2000-EXIT. EXIT. 1110-FLOOR-2001. IF (H-PSF-MSA = '6020' OR '9000' OR '8080') AND (L-PSF-PROV-ST = '36') MOVE ' 36' TO H-PSF-MSA ELSE IF (H-PSF-MSA = '2440') AND (L-PSF-PROV-ST = '15') MOVE ' 15' TO H-PSF-MSA ELSE IF (H-PSF-MSA = '9000') AND (L-PSF-PROV-ST = '51') MOVE ' 51' TO H-PSF-MSA ELSE IF (H-PSF-MSA = '1900') AND (L-PSF-PROV-ST = '21') MOVE ' 21' TO H-PSF-MSA ELSE IF (H-PSF-MSA = '1123') AND (L-PSF-PROV-ST = '22') MOVE ' 22' TO H-PSF-MSA. 1110-FLOOR-2001-EXIT. EXIT. 1115-FLOOR-2002. IF (H-PSF-MSA = '6020' OR '9000' OR '8080') AND (L-PSF-PROV-ST = '36') MOVE ' 36' TO H-PSF-MSA ELSE IF (H-PSF-MSA = '2440') AND (L-PSF-PROV-ST = '15') MOVE ' 15' TO H-PSF-MSA ELSE IF (H-PSF-MSA = '1303') AND (L-PSF-PROV-ST = '47') AND (L-PSF-WGIDX-RECLASS = 'Y') MOVE ' 47' TO H-PSF-MSA MOVE 'N' TO L-PSF-WGIDX-RECLASS ELSE IF (H-PSF-MSA = '1900') AND (L-PSF-PROV-ST = '21') MOVE ' 21' TO H-PSF-MSA ELSE IF (H-PSF-MSA = '1123') AND (L-PSF-PROV-ST = '22') MOVE ' 22' TO H-PSF-MSA ELSE IF (H-PSF-MSA = ' 14') AND (L-PSF-PROV-ST = '16') AND (L-PSF-WGIDX-RECLASS = 'Y') MOVE 'N' TO L-PSF-WGIDX-RECLASS MOVE ' 16' TO H-PSF-MSA. 1115-FLOOR-2002-EXIT. EXIT. 1115-SEC401-2002. IF (L-PSF-PROV-OSCAR = '050192' OR '050286' OR '050446' OR '050469' OR '050528' OR '050542') MOVE ' 05' TO H-PSF-MSA ELSE IF (L-PSF-PROV-OSCAR = '100048' OR '100118') MOVE ' 10' TO H-PSF-MSA ELSE IF (L-PSF-PROV-OSCAR = '170137') MOVE ' 17' TO H-PSF-MSA ELSE IF (L-PSF-PROV-OSCAR = '190048' OR '190110') MOVE ' 19' TO H-PSF-MSA ELSE IF (L-PSF-PROV-OSCAR = '230078') MOVE ' 23' TO H-PSF-MSA ELSE IF (L-PSF-PROV-OSCAR = '260006') MOVE ' 26' TO H-PSF-MSA ELSE IF (L-PSF-PROV-OSCAR = '290038') MOVE ' 29' TO H-PSF-MSA ELSE IF (L-PSF-PROV-OSCAR = '300009') MOVE ' 30' TO H-PSF-MSA ELSE IF (L-PSF-PROV-OSCAR = '390106') MOVE ' 39' TO H-PSF-MSA ELSE IF (L-PSF-PROV-OSCAR = '520007' OR '520153') MOVE ' 52' TO H-PSF-MSA. 1115-SEC401-2002-EXIT. EXIT. *************************************************************** * SET FLAG IF APC = 0033 * * - TERMINATE PROCESS IF 0033 LOCATED * * * *************************************************************** 1125-INIT. IF OPPS-APC (LN-SUB) = '0033' MOVE 'Y' TO APC33-FLAG MOVE 451 TO LN-SUB. 1125-INIT-EXIT. EXIT. *************************************************************** * 1. VERIFY THE SERVICE INDICATOR PASSED BY THE OCE * * - IF INVALID SET RETURN CODE TO '40' * * - DISCONTINUE LINE PROCESSING * * - IF VALID SET RETURN CODE TO '01' * * - CONTINUE LINE PROCESSING * * 2. PROCESS LINES AND LOAD WORK TABLE ACCORDING TO PRICE * * RANKING * * 3. CHECK OCE EDIT INDICATORS AND SET RETURN CODES IF * * INDICATORS ARE INVALID. * * - VALID RETURN CODES FOR EDIT INDICATORS * * - '41' - SERVICE INDICATOR INVALID FOR OPPS PRICER * * - '42' - APC = '00000' OR (PACKAGING FLAG = 1 OR 2) * * - '43' - PAYMENT INDICATOR NOT = TO 1 OR 5 THRU 9 * * - '44' - SERVICE INDICATOR = 'H' BUT PAYMENT * * INDICATOR NOT = TO 6 * * - '45' - PACKAGING FLAG NOT = TO 0 * * - '46' - (LINE ITEM DENIAL/REJECT FLAG NOT = TO 0 * * OR LINE ITEM DENIAL/REJECT FLAG = TO 1 * * AND (APC NOT = 0033 OR 0034 OR 0322 OR * * 0323 OR 0324 OR 0325 OR 0373 OR 0374)) * * OR LINE ITEM ACTION FLAG NOT = TO 1 * * - '47' - LINE ITEM ACTION FLAG = 2 OR 3 * * - '48' - PAYMENT ADJUSTMENT FLAG NOT VALID * * - '49' - SITE OF SERVICE FLAG NOT = TO 0 * * - OR (APC 0033 IS NOT ON THE CLAIM * * AND SERVICE INDICATOR = 'P' * * OR APC = 0322-0325,0373,0374) * * 4. IF OCE INDICATORS ARE VALID, SEARCH APC TABLE * * - IF MISSING, DELETED OR INVALID APC * * - SET RETURN CODE TO '30' * * - DISCONTINUE LINE PROCESSING * *************************************************************** 1150-INIT. MOVE 01 TO A-RETURN-CODE (LN-SUB). *************************************************************** * OVER-RIDE SERVICE UNITS FOR APC 0339 - EFFECTIVE 04/01/2002 * * - CHANGE UNIT VALUE TO 1 * *************************************************************** IF (L-SERVICE-FROM-DATE > 20020331) AND (OPPS-APC (LN-SUB) = '0339') MOVE 1 TO OPPS-SRVC-UNITS (LN-SUB). MOVE OPPS-SRVC-UNITS (LN-SUB) TO H-SRVC-UNITS. PERFORM 1250-CALC-DISCOUNT THRU 1250-CALC-DISCOUNT-EXIT. IF A-RETURN-CODE (LN-SUB) = 42 GO TO 1150-INIT-EXIT. *************************************************************** * EFFECTIVE AS OF 04-01-2002 * * - TOTAL DEVICE OFFSET * *************************************************************** IF L-SERVICE-FROM-DATE > 20020331 AND OPPS-SRVC-IND (LN-SUB) = ' H' MOVE 'Y' TO C-FLAG. IF L-SERVICE-FROM-DATE > 20020331 PERFORM 1160-TOTAL-OFFSET THRU 1160-TOTAL-OFFSET-EXIT. SET W-LP-INDX TO LN-SUB. SET W-BD-INDX TO LN-SUB. INITIALIZE W-LP-ENTRY (W-LP-INDX). INITIALIZE W-BD-ENTRY (W-BD-INDX). MOVE ZERO TO A-LITEM-PYMT (LN-SUB) A-LITEM-REIM (LN-SUB) A-ADJ-COIN (LN-SUB) A-RED-COIN (LN-SUB) A-TOTAL-LN-DEDUCT (LN-SUB) A-BLOOD-LN-DEDUCT (LN-SUB). IF NOT (OPPS-SRVC-IND (LN-SUB) = ' A' OR ' B' OR ' C' OR ' E' OR ' F' OR ' G' OR ' H' OR ' J' OR ' K' OR ' L' OR ' N' OR ' P' OR ' S' OR ' T' OR ' V' OR ' X' OR ' W' OR ' Y' OR ' Z') THEN MOVE 40 TO A-RETURN-CODE (LN-SUB) GO TO 1150-INIT-EXIT ELSE MOVE 01 TO A-RETURN-CODE (LN-SUB). IF OPPS-SRVC-IND (LN-SUB) = ' A' OR ' B' OR ' C' OR ' E' OR ' F' MOVE 41 TO A-RETURN-CODE (LN-SUB) GO TO 1150-INIT-EXIT. IF OPPS-PYMT-IND (LN-SUB) = ' 1' OR ' 5' OR ' 6' OR ' 7' OR ' 8' OR ' 9' IF OPPS-PKG-FLAG (LN-SUB) = '0' OR '1' OR '2' IF (OPPS-LITEM-DR-FLAG (LN-SUB) = '0' OR OPPS-LITEM-DR-FLAG (LN-SUB) = '1' AND (OPPS-APC (LN-SUB) = '0033' OR '0034' OR '0322' OR '0323' OR '0324' OR '0325' OR '0373' OR '0374')) OR (OPPS-LITEM-ACT-FLAG (LN-SUB) = '1') IF NOT (OPPS-LITEM-ACT-FLAG (LN-SUB) EQUAL '2' OR '3') IF OPPS-PYMT-ADJ-FLAG (LN-SUB) = ' 0' OR ' 1' OR ' 2' OR ' 3' OR ' 4' IF (OPPS-SITE-SRVC-FLAG (LN-SUB) = '0') OR ((APC33-FLAG = 'Y') AND ((OPPS-SRVC-IND (LN-SUB) = ' P') OR (OPPS-APC (LN-SUB) = '0322' OR '0323' OR '0324' OR '0325' OR '0373' OR '0374'))) MOVE OPPS-SUB-CHRG (LN-SUB) TO H-SUB-CHRG COMPUTE H-TOT-CHRG = H-TOT-CHRG + H-SUB-CHRG IF OPPS-PKG-FLAG (LN-SUB) = '1' OR '2' COMPUTE H-TOT-N-CHRG = H-SUB-CHRG + H-TOT-N-CHRG MOVE 'Y' TO N-FLAG END-IF IF (OPPS-APC (LN-SUB) = '0000') OR (OPPS-PKG-FLAG (LN-SUB) NOT = 0) MOVE 42 TO A-RETURN-CODE (LN-SUB) GO TO 1150-INIT-EXIT END-IF SEARCH ALL WAA-ENTRY AT END MOVE 30 TO A-RETURN-CODE (LN-SUB) GO TO 1150-INIT-EXIT WHEN WAA-APC (WAA-INDX) = OPPS-GRP (LN-SUB) MOVE WAA-PTR (WAA-INDX) TO W-SUB2 PERFORM 1175-APC-LOOKUP ELSE MOVE 49 TO A-RETURN-CODE (LN-SUB) GO TO 1150-INIT-EXIT ELSE MOVE 48 TO A-RETURN-CODE (LN-SUB) GO TO 1150-INIT-EXIT ELSE MOVE 47 TO A-RETURN-CODE (LN-SUB) GO TO 1150-INIT-EXIT ELSE MOVE 46 TO A-RETURN-CODE (LN-SUB) GO TO 1150-INIT-EXIT ELSE MOVE 45 TO A-RETURN-CODE (LN-SUB) GO TO 1150-INIT-EXIT ELSE MOVE 43 TO A-RETURN-CODE (LN-SUB) GO TO 1150-INIT-EXIT. IF A-RETURN-CODE (LN-SUB) = 01 PERFORM 1300-COIN-DEDUCT THRU 1300-COIN-DEDUCT-EXIT. IF A-RETURN-CODE (LN-SUB) = 01 SET WBD-INDX TO 1 SEARCH WBD-ENTRY VARYING WBD-INDX AT END GO TO 1150-INIT-EXIT WHEN W-BLOOD-HCPCS (WBD-INDX) = OPPS-HCPCS (LN-SUB) MOVE W-BLOOD-RANK (WBD-INDX) TO H-BLOOD-RANK PERFORM 1375-BLOOD-DEDUCT THRU 1375-BLOOD-DEDUCT-EXIT. 1150-INIT-EXIT. EXIT. *************************************************************** * COMPUTE TOTAL OFFSET FROM TABLE 5 FOR DEVICES * * - EFFECTIVE OF 04-01-2002 * *************************************************************** 1160-TOTAL-OFFSET. MOVE OPPS-GRP (LN-SUB) TO W-OFF-APC. SEARCH ALL WOO-ENTRY AT END GO TO 1160-TOTAL-OFFSET-EXIT WHEN WOO-APC (WOO-INDX) = W-OFF-APC COMPUTE H-TOTAL-OFFSET = H-TOTAL-OFFSET + (WOO-OFFSET (WOO-INDX) * H-DISC-RATE). 1160-TOTAL-OFFSET-EXIT. EXIT. *************************************************************** 1175-APC-LOOKUP. IF WAR-DTCD (W-SUB2) NOT > WAD-DTCD (WAD-SUB) IF WAR-RATEX (W-SUB2) = 'DELETED' MOVE 30 TO A-RETURN-CODE (LN-SUB) COMPUTE H-TOT-CHRG = H-TOT-CHRG - H-SUB-CHRG ELSE MOVE WAR-RATE (W-SUB2) TO H-APC-PYMT MOVE WAR-RANK (W-SUB2) TO H-RANK MOVE WAR-MINC (W-SUB2) TO H-MIN-COIN MOVE WAR-COIN (W-SUB2) TO H-NAT-COIN MOVE WAR-PPCT (W-SUB2) TO H-PPCT ELSE SUBTRACT 1 FROM W-SUB2 IF W-SUB2 > WAA-PTR (WAA-INDX - 1) GO TO 1175-APC-LOOKUP ELSE MOVE 0 TO H-APC-PYMT H-RANK H-MIN-COIN H-NAT-COIN H-PPCT. 1175-APC-LOOKUP-EXIT. EXIT. *************************************************************** * SEARCH WAGE INDEX TABLE AND SELECT THE WAGE INDEX * * WHEN EQUAL TO PROVIDER SPECIFIC WAGE INDEX * * IF WAGE INDEX NOT LOCATED * * - SET CLAIM RETURN CODE TO '50' * * - DISCONTINUE CLAIM PROCESSING * * IF WAGE INDEX EQUALS ZERO * * - SET CLAIM RETURN CODE TO '51' * * - DISCONTINUE CLAIM PROCESSING * *************************************************************** 1200-CALC-WAGEINDX. MOVE WWD-MAX TO WWD-SUB. PERFORM UNTIL L-SERVICE-FROM-DATE NOT < WWD-DATE (WWD-SUB) SUBTRACT 1 FROM WWD-SUB END-PERFORM. SEARCH ALL WWM-ENTRY AT END MOVE 50 TO A-CLM-RTN-CODE GO TO 1200-CALC-WAGEINDX-EXIT WHEN WWM-MSA (WWM-INDX) = H-PSF-MSA MOVE WWM-PTR (WWM-INDX) TO W-SUB2 PERFORM 1210-WAGE-LOOKUP. IF H-WINX1 = 0 THEN MOVE 51 TO A-CLM-RTN-CODE. 1200-CALC-WAGEINDX-EXIT. EXIT. 1210-WAGE-LOOKUP. IF WWW-DTCD (W-SUB2) NOT > WWD-DTCD (WWD-SUB) IF L-PSF-WGIDX-RECLASS = 'Y' MOVE WWW-WINX2 (W-SUB2) TO H-WINX1 ELSE MOVE WWW-WINX1 (W-SUB2) TO H-WINX1 END-IF ELSE SUBTRACT 1 FROM W-SUB2 IF W-SUB2 > WWM-PTR (WWM-INDX - 1) GO TO 1210-WAGE-LOOKUP ELSE MOVE 0 TO H-WINX1. 1210-WAGE-LOOKUP-EXIT. EXIT. 1220-CHNG-WAGEINDX. IF (L-PSF-PROV-OSCAR = '140012' OR '150002' OR '150004' OR '150008' OR '150034' OR '150090' OR '150125' OR '150128' OR '150132') AND (L-PSF-GEO-MSA = '1600' AND L-PSF-WI-MSA = '1600' AND L-PSF-WGIDX-RECLASS = 'Y') MOVE 01.0750 TO H-WINX1. IF (L-PSF-PROV-OSCAR = '250078') AND (L-PSF-GEO-MSA = '3285' AND L-PSF-WI-MSA = '3285' AND L-PSF-WGIDX-RECLASS = 'Y') MOVE 00.7634 TO H-WINX1. IF (L-PSF-PROV-OSCAR = '330001' OR '330126' OR '330135' OR '330205' OR '330209' OR '330264') AND (L-PSF-GEO-MSA = '5600' AND L-PSF-WI-MSA = '5600' AND L-PSF-WGIDX-RECLASS = 'Y') MOVE 01.4342 TO H-WINX1. IF (L-PSF-PROV-OSCAR = '340039' OR '340129' OR '340144') AND (L-PSF-GEO-MSA = '1520' AND L-PSF-WI-MSA = '1520' AND L-PSF-WGIDX-RECLASS = 'Y') MOVE 00.9434 TO H-WINX1. IF (L-PSF-PROV-OSCAR = '360046' OR '360056' OR '360076' OR '360132') AND (L-PSF-GEO-MSA = '1640' AND L-PSF-WI-MSA = '1640' AND L-PSF-WGIDX-RECLASS = 'Y') MOVE 00.9419 TO H-WINX1. IF (L-PSF-PROV-OSCAR = '390019' OR '390049' OR '390162' OR '390194' OR '390197' OR '390263') AND (L-PSF-GEO-MSA = '0240' AND L-PSF-WI-MSA = '0240' AND L-PSF-WGIDX-RECLASS = 'Y') MOVE 01.0228 TO H-WINX1. IF (L-PSF-PROV-OSCAR = '450065' OR '450072' OR '450591') AND (L-PSF-GEO-MSA = '3360' AND L-PSF-WI-MSA = '3360' AND L-PSF-WGIDX-RECLASS = 'Y') MOVE 00.9388 TO H-WINX1. IF (L-PSF-PROV-OSCAR = '470003') AND (L-PSF-GEO-MSA = '1123' AND L-PSF-WI-MSA = '1123' AND L-PSF-WGIDX-RECLASS = 'Y') MOVE 01.1359 TO H-WINX1. 1220-CHNG-WAGEINDX-EXIT. EXIT. *************************************************************** * FOR FY 2001 NEW LUGAR HOSPITALS ONLY * *************************************************************** 1225-CHNG-WAGEINDX. IF (L-PSF-PROV-OSCAR = '010043') AND (L-PSF-WI-MSA = '1000' AND L-PSF-WGIDX-RECLASS = 'Y') MOVE 00.8490 TO H-WINX1. IF (L-PSF-PROV-OSCAR = '010072' OR '010101') AND (L-PSF-WI-MSA = '0450' AND L-PSF-WGIDX-RECLASS = 'Y') MOVE 00.7871 TO H-WINX1. IF (L-PSF-PROV-OSCAR = '100098') AND (L-PSF-WI-MSA = '8960' AND L-PSF-WGIDX-RECLASS = 'Y') MOVE 00.9615 TO H-WINX1. IF (L-PSF-PROV-OSCAR = '100232') AND (L-PSF-WI-MSA = '2900' AND L-PSF-WGIDX-RECLASS = 'Y') MOVE 01.0074 TO H-WINX1. IF (L-PSF-PROV-OSCAR = '110130') AND (L-PSF-WI-MSA = '0500' AND L-PSF-WGIDX-RECLASS = 'Y') MOVE 00.9739 TO H-WINX1. IF (L-PSF-PROV-OSCAR = '140230') AND (L-PSF-WI-MSA = '1400' AND L-PSF-WGIDX-RECLASS = 'Y') MOVE 00.9069 TO H-WINX1. IF (L-PSF-PROV-OSCAR = '230027') AND (L-PSF-WI-MSA = '3000' AND L-PSF-WGIDX-RECLASS = 'Y') MOVE 01.0119 TO H-WINX1. IF (L-PSF-PROV-OSCAR = '340071' OR '340124') AND (L-PSF-WI-MSA = '6640' AND L-PSF-WGIDX-RECLASS = 'Y') MOVE 00.9506 TO H-WINX1. IF (L-PSF-PROV-OSCAR = '390030' OR '390181' OR '390183') AND (L-PSF-WI-MSA = '6680' AND L-PSF-WGIDX-RECLASS = 'Y') MOVE 00.8992 TO H-WINX1. IF (L-PSF-PROV-OSCAR = '390201') AND (L-PSF-WI-MSA = '5640' AND L-PSF-WGIDX-RECLASS = 'Y') MOVE 01.0890 TO H-WINX1. 1225-CHNG-WAGEINDX-EXIT. EXIT. *************************************************************** * CALCULATE DISCOUNT FACTOR BASED ON THE DISCOUNT * * INDICATOR PASSED BY THE OCE: VALUE 1 - 8 * * IF MISSING OR INVALID DISCOUNT FACTOR * * - SET RETURN CODE TO '38' * * - DISCONTINUE LINE PROCESSING * *************************************************************** 1250-CALC-DISCOUNT. IF (H-SRVC-UNITS = 0 AND OPPS-APC (LN-SUB) = '0000') MOVE 42 TO A-RETURN-CODE (LN-SUB) GO TO 1250-CALC-DISCOUNT-EXIT ELSE IF (H-SRVC-UNITS = 0 AND OPPS-APC (LN-SUB) > '0000') MOVE 1 TO H-SRVC-UNITS. IF OPPS-DISC-FACT (LN-SUB) = 1 THEN MOVE 1 TO H-DISC-RATE ELSE IF OPPS-DISC-FACT (LN-SUB) = 2 THEN COMPUTE H-DISC-RATE = (1 + DISC-FRACTION * (H-SRVC-UNITS - 1)) / H-SRVC-UNITS ELSE IF OPPS-DISC-FACT (LN-SUB) = 3 THEN COMPUTE H-DISC-RATE = TERM-PROC-DISC / H-SRVC-UNITS ELSE IF OPPS-DISC-FACT (LN-SUB) = 4 THEN COMPUTE H-DISC-RATE = (1 + DISC-FRACTION) / H-SRVC-UNITS ELSE IF OPPS-DISC-FACT (LN-SUB) = 5 THEN COMPUTE H-DISC-RATE = DISC-FRACTION ELSE IF OPPS-DISC-FACT (LN-SUB) = 6 THEN COMPUTE H-DISC-RATE = (TERM-PROC-DISC * DISC-FRACTION) / H-SRVC-UNITS ELSE IF OPPS-DISC-FACT (LN-SUB) = 7 THEN COMPUTE H-DISC-RATE = (DISC-FRACTION * (1 + DISC-FRACTION) / H-SRVC-UNITS) ELSE IF OPPS-DISC-FACT (LN-SUB) = 8 THEN MOVE 2 TO H-DISC-RATE ELSE MOVE 38 TO A-RETURN-CODE (LN-SUB). 1250-CALC-DISCOUNT-EXIT. EXIT. *************************************************************** * DETERMINE THE DEDUCTIBLE SEQUENCE. DEDUCTIBLE WILL BE * * TAKEN FROM OPPS SERVICES FIRST, THEN FROM ANY OTHER * * TYPES OF SERVICES FROM THE CLAIM. * * - SET POINTERS TO THE HIGHEST RANKED PERCENTAGE * * (LARGEST NATIONAL UNADJUSTED COINSURANCE / * * THE APC PAYMENT) * * - MOVE ALL PRICING VARIABLES TO STAGING AREA * *************************************************************** 1300-COIN-DEDUCT. ADD 1 TO W-LNC-MAX. SET W-LP-INDX TO W-LNC-MAX. PERFORM 1350-STAGE-ENTRY THRU 1350-STAGE-ENTRY-EXIT UNTIL W-LP-INDX = 1 OR H-RANK NOT < W-RANK (W-LP-INDX - 1). MOVE LN-SUB TO W-LP-SUB (W-LP-INDX). MOVE H-NAT-COIN TO W-NAT-COIN (W-LP-INDX). MOVE H-MIN-COIN TO W-MIN-COIN (W-LP-INDX). MOVE H-SUB-CHRG TO W-SUB-CHRG (W-LP-INDX). MOVE H-APC-PYMT TO W-APC-PYMT (W-LP-INDX). MOVE H-WINX1 TO W-WINX1 (W-LP-INDX). MOVE H-RANK TO W-RANK (W-LP-INDX). MOVE H-PPCT TO W-PPCT (W-LP-INDX). MOVE H-DISC-RATE TO W-DISC-RATE (W-LP-INDX). IF OPPS-SRVC-IND (LN-SUB) = ' P' THEN MOVE 1 TO W-SRVC-UNITS (W-LP-INDX) ELSE MOVE H-SRVC-UNITS TO W-SRVC-UNITS (W-LP-INDX). MOVE 0 TO W-RED-COIN (W-LP-INDX). PERFORM VARYING PS-SUB FROM 1 BY 1 UNTIL PS-SUB > L-PSF-APC-LINE-CNT IF L-PSF-APC (PS-SUB) = OPPS-APC (LN-SUB) COMPUTE W-RED-COIN (W-LP-INDX) ROUNDED = L-PSF-RED-COIN (PS-SUB) * H-SRVC-UNITS * H-DISC-RATE MOVE 25 TO A-RETURN-CODE (LN-SUB) MOVE L-PSF-APC-LINE-CNT TO PS-SUB END-IF END-PERFORM. 1300-COIN-DEDUCT-EXIT. EXIT. 1350-STAGE-ENTRY. MOVE W-LP-ENTRY (W-LP-INDX - 1) TO W-LP-ENTRY (W-LP-INDX). SET W-LP-INDX DOWN BY 1. 1350-STAGE-ENTRY-EXIT. EXIT. *************************************************************** * DETERMINE THE BLOOD DEDUCTIBLE SEQUENCE. DEDUCTIBLE * * WILL BE CALCULATED BASED ON RANKING. * * - SET POINTERS TO THE HIGHEST RANKED APC * * (SMALLEST UNADJUSTED APC PAYMENT) * * - MOVE ALL PRICING VARIABLES TO STAGING AREA * *************************************************************** 1375-BLOOD-DEDUCT. ADD 1 TO W-BLD-MAX. SET W-BD-INDX TO W-BLD-MAX. PERFORM 1385-STAGE-ENTRY THRU 1385-STAGE-ENTRY-EXIT UNTIL W-BD-INDX = 1 OR H-BLOOD-RANK NOT < W-BD-RANK (W-BD-INDX - 1). MOVE LN-SUB TO W-BD-SUB (W-BD-INDX). MOVE H-NAT-COIN TO W-BD-NAT-COIN (W-BD-INDX). MOVE H-MIN-COIN TO W-BD-MIN-COIN (W-BD-INDX). MOVE H-SUB-CHRG TO W-BD-SUB-CHRG (W-BD-INDX). MOVE H-APC-PYMT TO W-BD-APC-PYMT (W-BD-INDX). MOVE H-WINX1 TO W-BD-WINX1 (W-BD-INDX). MOVE H-BLOOD-RANK TO W-BD-RANK (W-BD-INDX). MOVE H-PPCT TO W-BD-PPCT (W-BD-INDX). MOVE H-DISC-RATE TO W-BD-DISC-RATE (W-BD-INDX). MOVE H-SRVC-UNITS TO W-BD-SRVC-UNITS (W-BD-INDX). MOVE 0 TO W-BD-RED-COIN (W-BD-INDX). PERFORM VARYING PS-SUB FROM 1 BY 1 UNTIL PS-SUB > L-PSF-APC-LINE-CNT IF L-PSF-APC (PS-SUB) = OPPS-APC (LN-SUB) COMPUTE W-BD-RED-COIN (W-BD-INDX) ROUNDED = L-PSF-RED-COIN (PS-SUB) * H-SRVC-UNITS * H-DISC-RATE MOVE 25 TO A-RETURN-CODE (LN-SUB) MOVE L-PSF-APC-LINE-CNT TO PS-SUB END-IF END-PERFORM. 1375-BLOOD-DEDUCT-EXIT. EXIT. 1385-STAGE-ENTRY. MOVE W-BD-ENTRY (W-BD-INDX - 1) TO W-BD-ENTRY (W-BD-INDX). SET W-BD-INDX DOWN BY 1. 1385-STAGE-ENTRY-EXIT. EXIT. *************************************************************** * FIRST STEP IN DETERMINING A LINE ITEM PRICE. * * CHECK ALL APPROPRIATE FLAGS AND INDICATORS PASSED * * BY THE OCE. * * - SET RETURN CODES TO INDICATE ERRORS OR STATUS * * - '20' - LINE PROCESSED BUT PAYMENT = 0 * * - BENE DEDUCTIBLE => ADJUSTED PAYMENT * * * *************************************************************** 1400-CALCULATE. MOVE W-LP-SUB (W-LP-INDX) TO LN-SUB. IF A-RETURN-CODE (LN-SUB) > 25 GO TO 1400-CALCULATE-EXIT. IF OPPS-PYMT-IND (LN-SUB) = ' 1' OR ' 5' OR ' 6' OR ' 7' OR ' 8' PERFORM 1550-CALC-STANDARD THRU 1550-CALC-STANDARD-EXIT ELSE GO TO 1400-CALCULATE-EXIT. *************************************************************** * SET GJK FLAG * * - TEST LINE ITEM DATE OF SERVICE > 20010630 * * - TOTAL DRUG / DEVICE COINSURANCE * *************************************************************** IF (A-RETURN-CODE (LN-SUB) < 30) AND (OPPS-LITEM-DOS (LN-SUB) > 20001231) PERFORM 1450-ADJ-PROC-COIN THRU 1450-ADJ-PROC-COIN-EXIT ELSE NEXT SENTENCE. *************************************************************** * SET ST0 AND STVX FLAGS * * - TEST LINE ITEM DATE OF SERVICE > 20020331 * * - TOTAL PROCEDURE CHARGES AND BUNDLED CHARGES * *************************************************************** IF (OPPS-LITEM-DOS (LN-SUB) > 20020331) PERFORM 1500-ADJ-CHRGS THRU 1500-ADJ-CHRGS-EXIT ELSE NEXT SENTENCE. IF A-RETURN-CODE (LN-SUB) < 30 COMPUTE A-TOTAL-CLM-DEDUCT = H-TOTAL-LN-DEDUCT + A-TOTAL-CLM-DEDUCT COMPUTE H-TOT-PYMT = H-TOT-PYMT + H-LITEM-PYMT COMPUTE A-BLOOD-DEDUCT-DUE = A-BLOOD-DEDUCT-DUE + H-LN-BLOOD-DEDUCT MOVE H-LITEM-PYMT TO A-LITEM-PYMT (LN-SUB) MOVE H-LITEM-REIM TO A-LITEM-REIM (LN-SUB) MOVE H-TOTAL-LN-DEDUCT TO A-TOTAL-LN-DEDUCT (LN-SUB) MOVE H-LN-BLOOD-DEDUCT TO A-BLOOD-LN-DEDUCT (LN-SUB) MOVE H-NAT-COIN TO A-ADJ-COIN (LN-SUB) MOVE H-RED-COIN TO A-RED-COIN (LN-SUB) IF H-RED-COIN > H-NAT-COIN MOVE H-NAT-COIN TO A-RED-COIN (LN-SUB) END-IF IF OPPS-LITEM-ACT-FLAG (LN-SUB) = '4' MOVE 0 TO A-LITEM-PYMT (LN-SUB) MOVE 0 TO A-LITEM-REIM (LN-SUB) COMPUTE H-TOT-PYMT = H-TOT-PYMT - H-LITEM-PYMT END-IF END-IF. MOVE ZERO TO LINE-HOLD-ITEMS. 1400-CALCULATE-EXIT. EXIT. *************************************************************** * SET GJK FLAG * * - STAGE BY SERVICE INDICATOR * * * *************************************************************** 1450-ADJ-PROC-COIN. MOVE OPPS-LITEM-DOS (LN-SUB) TO H-DCP-DOS. IF OPPS-SRVC-IND (LN-SUB) = ' S' OR ' T' OR ' V' COMPUTE H-NEW-WGNAT ROUNDED = W-NAT-COIN (W-LP-INDX) * (.6 * W-WINX1 (W-LP-INDX) + .4) IF H-NEW-WGNAT > H-IP-LIMIT MOVE H-IP-LIMIT TO H-NEW-WGNAT END-IF COMPUTE H-NEW-COIN = H-LITEM-PYMT - H-TOTAL-LN-DEDUCT - H-LITEM-REIM - H-LN-BLOOD-DEDUCT MOVE 1 TO H-DCP-CODE PERFORM 1455-SEARCH-KEY THRU 1455-SEARCH-KEY-EXIT ELSE IF OPPS-SRVC-IND (LN-SUB) = ' G' OR ' J' OR ' K' COMPUTE H-NEW-COIN = H-LITEM-PYMT - H-TOTAL-LN-DEDUCT - H-LITEM-REIM - H-LN-BLOOD-DEDUCT MOVE 'Y' TO GJK-FLAG MOVE 1 TO H-DCP-CODE PERFORM 1455-SEARCH-KEY THRU 1455-SEARCH-KEY-EXIT MOVE 2 TO H-DCP-CODE ADD 1 TO W-DCP-MAX SET W-DCP-INDX TO W-DCP-MAX PERFORM 1475-STAGE-DCP-ENTRY THRU 1475-STAGE-DCP-ENTRY-EXIT UNTIL W-DCP-INDX = 1 OR H-DCP-STAGE NOT < W-DCP-STAGE (W-DCP-INDX - 1) MOVE LN-SUB TO W-DCP-SUB (W-DCP-INDX) MOVE H-DCP-STAGE TO W-DCP-STAGE (W-DCP-INDX) MOVE ZERO TO W-DCP-COIN1 (W-DCP-INDX) MOVE ZERO TO W-DCP-WGNAT (W-DCP-INDX) MOVE H-NEW-COIN TO W-DCP-COIN2 (W-DCP-INDX) MOVE OPPS-SRVC-IND (LN-SUB) TO W-DCP-SRVC-IND (W-DCP-INDX). 1450-ADJ-PROC-COIN-EXIT. EXIT. 1455-SEARCH-KEY. SET W-DCP-INDX TO 1. SEARCH W-DCP-ENTRY VARYING W-DCP-INDX AT END PERFORM 1460-ADD-ENTRY THRU 1460-ADD-ENTRY-EXIT WHEN W-DCP-STAGE (W-DCP-INDX) = H-DCP-STAGE PERFORM 1465-UPDATE-ENTRY THRU 1465-UPDATE-ENTRY-EXIT. 1455-SEARCH-KEY-EXIT. EXIT. 1460-ADD-ENTRY. ADD 1 TO W-DCP-MAX. SET W-DCP-INDX TO W-DCP-MAX. PERFORM 1475-STAGE-DCP-ENTRY THRU 1475-STAGE-DCP-ENTRY-EXIT UNTIL W-DCP-INDX = 1 OR H-DCP-STAGE NOT < W-DCP-STAGE (W-DCP-INDX - 1). IF OPPS-SRVC-IND (LN-SUB) = ' G' OR ' J' OR ' K' MOVE ZERO TO W-DCP-SUB (W-DCP-INDX) MOVE H-DCP-STAGE TO W-DCP-STAGE (W-DCP-INDX) MOVE ZERO TO W-DCP-COIN1 (W-DCP-INDX) MOVE ZERO TO W-DCP-WGNAT (W-DCP-INDX) MOVE H-NEW-COIN TO W-DCP-COIN2 (W-DCP-INDX) MOVE ' X' TO W-DCP-SRVC-IND (W-DCP-INDX) ELSE MOVE LN-SUB TO W-DCP-SUB (W-DCP-INDX) MOVE H-DCP-STAGE TO W-DCP-STAGE (W-DCP-INDX) MOVE H-NEW-COIN TO W-DCP-COIN1 (W-DCP-INDX) MOVE H-NEW-WGNAT TO W-DCP-WGNAT (W-DCP-INDX) MOVE ZERO TO W-DCP-COIN2 (W-DCP-INDX) MOVE OPPS-SRVC-IND (LN-SUB) TO W-DCP-SRVC-IND (W-DCP-INDX). 1460-ADD-ENTRY-EXIT. EXIT. 1465-UPDATE-ENTRY. IF OPPS-SRVC-IND (LN-SUB) = ' G' OR ' J' OR ' K' ADD H-NEW-COIN TO W-DCP-COIN2 (W-DCP-INDX) ELSE IF W-DCP-SRVC-IND (W-DCP-INDX) = ' X' PERFORM 1485-REPLACE-TYPE1 THRU 1485-REPLACE-TYPE1-EXIT ELSE PERFORM 1480-RANK-COIN THRU 1480-RANK-COIN-EXIT. 1465-UPDATE-ENTRY-EXIT. EXIT. 1475-STAGE-DCP-ENTRY. MOVE W-DCP-ENTRY (W-DCP-INDX - 1) TO W-DCP-ENTRY (W-DCP-INDX). SET W-DCP-INDX DOWN BY 1. 1475-STAGE-DCP-ENTRY-EXIT. EXIT. 1480-RANK-COIN. IF H-NEW-WGNAT > W-DCP-WGNAT (W-DCP-INDX) MOVE LN-SUB TO W-DCP-SUB (W-DCP-INDX) MOVE H-NEW-COIN TO W-DCP-COIN1 (W-DCP-INDX) MOVE H-NEW-WGNAT TO W-DCP-WGNAT (W-DCP-INDX) MOVE OPPS-SRVC-IND (LN-SUB) TO W-DCP-SRVC-IND (W-DCP-INDX). 1480-RANK-COIN-EXIT. EXIT. 1485-REPLACE-TYPE1. MOVE LN-SUB TO W-DCP-SUB (W-DCP-INDX) MOVE H-NEW-COIN TO W-DCP-COIN1 (W-DCP-INDX) MOVE H-NEW-WGNAT TO W-DCP-WGNAT (W-DCP-INDX) MOVE OPPS-SRVC-IND (LN-SUB) TO W-DCP-SRVC-IND (W-DCP-INDX). 1485-REPLACE-TYPE1-EXIT. EXIT. 1500-ADJ-CHRGS. IF (OPPS-SRVC-IND (LN-SUB) = ' S' OR ' T') AND (W-SUB-CHRG (W-LP-INDX) < 1.01) MOVE 'Y' TO ST0-FLAG. IF (OPPS-SRVC-IND (LN-SUB) = ' S' OR ' T') AND (OPPS-PKG-FLAG (LN-SUB) = '0') COMPUTE H-TOT-ST-CHRG = W-SUB-CHRG (W-LP-INDX) + H-TOT-ST-CHRG COMPUTE H-TOT-ST-PYMT = H-LITEM-PYMT + H-TOT-ST-PYMT. IF (OPPS-SRVC-IND (LN-SUB) = ' S' OR ' T' OR ' V' OR ' X' OR ' P') AND (OPPS-PKG-FLAG (LN-SUB) = '0') COMPUTE H-TOT-STVX-PYMT = H-LITEM-PYMT + H-TOT-STVX-PYMT. 1500-ADJ-CHRGS-EXIT. EXIT. *************************************************************** * 1. APPLY DEDUCTIBLE TO HIGHEST NATIONAL COINSURANCE AMOUNT * * - DESCENDING UNTIL DEDUCTIBLE = 0. * * 2. CALCULATE THE STANDARD LINE PRICE * * (APC PAYMENT * WAGE INDEX * SERVICE UNITS * * * DISCOUNT FACTOR) * * - WAGE ADJUST 60% OF THE APC PAYMENT ONLY * * 3. ADD LINE PRICE TO OUTLIER HOLD AREA. * * * * 4. CALCULATE THE LINE PRICE FOR DESIGNATED DEVICES * * AND DRUGS * *************************************************************** 1550-CALC-STANDARD. COMPUTE H-MAX-COIN ROUNDED = (H-IP-LIMIT * W-SRVC-UNITS (W-LP-INDX) * W-DISC-RATE (W-LP-INDX)). IF OPPS-SRVC-IND (LN-SUB) = ' S' OR ' V' OR ' T' OR ' P' OR ' X' THEN COMPUTE H-LITEM-PYMT ROUNDED = (((W-APC-PYMT (W-LP-INDX) * .60) * W-WINX1 (W-LP-INDX)) + (W-APC-PYMT (W-LP-INDX) * .40)) * W-SRVC-UNITS (W-LP-INDX) * W-DISC-RATE (W-LP-INDX) PERFORM 1560-CALC-BENE-DEDUCT THRU 1560-CALC-BENE-DEDUCT-EXIT ELSE IF OPPS-SRVC-IND (LN-SUB) = ' H' THEN IF OPPS-PYMT-IND (LN-SUB) = ' 6' THEN PERFORM 1555-CALC-H-STANDARD THRU 1555-CALC-H-STANDARD-EXIT PERFORM 1560-CALC-BENE-DEDUCT THRU 1560-CALC-BENE-DEDUCT-EXIT ELSE MOVE 44 TO A-RETURN-CODE (LN-SUB) GO TO 1550-CALC-STANDARD-EXIT END-IF ELSE IF OPPS-SRVC-IND (LN-SUB) = ' G' OR ' J' OR ' K' THEN IF OPPS-PYMT-IND (LN-SUB) = ' 1' OR ' 5' OR ' 7' THEN MOVE 0 TO H-BLOOD-FRACTION PERFORM 1550-CALC-GJK THRU 1550-CALC-GJK-EXIT PERFORM 1560-CALC-BENE-DEDUCT THRU 1560-CALC-BENE-DEDUCT-EXIT ELSE MOVE 41 TO A-RETURN-CODE (LN-SUB) GO TO 1550-CALC-STANDARD-EXIT END-IF END-IF. IF H-LITEM-PYMT > 0 COMPUTE H-LITEM-REIM ROUNDED = ((H-LITEM-PYMT - H-TOTAL-LN-DEDUCT) - H-LN-BLOOD-DEDUCT) * W-PPCT (W-LP-INDX) COMPUTE H-NAT-COIN = H-LITEM-PYMT - H-TOTAL-LN-DEDUCT - H-LITEM-REIM - H-LN-BLOOD-DEDUCT. MOVE W-MIN-COIN (W-LP-INDX) TO H-MIN-COIN. IF H-MIN-COIN > 0 IF OPPS-SRVC-IND (LN-SUB) = ' G' OR ' H' OR ' J' OR ' K' COMPUTE H-MIN-COIN ROUNDED = H-MIN-COIN * (W-SRVC-UNITS (W-LP-INDX) - (W-SRVC-UNITS (W-LP-INDX) * H-BLOOD-FRACTION)) * W-DISC-RATE (W-LP-INDX) ELSE IF OPPS-APC (LN-SUB) = '0158' OR '0159' COMPUTE H-MIN-COIN ROUNDED = H-LITEM-PYMT * .25 ELSE COMPUTE H-MIN-COIN ROUNDED = H-LITEM-PYMT * .2 END-IF END-IF END-IF. MOVE W-RED-COIN (W-LP-INDX) TO H-RED-COIN. IF (H-RED-COIN > 0 AND < H-MIN-COIN) MOVE H-MIN-COIN TO H-RED-COIN ELSE IF H-RED-COIN < H-NAT-COIN AND > H-MIN-COIN AND > H-MAX-COIN COMPUTE H-LITEM-REIM = H-LITEM-REIM + (H-RED-COIN - H-MAX-COIN) END-IF END-IF. IF H-NAT-COIN > H-MAX-COIN AND H-RED-COIN = 0 THEN COMPUTE H-LITEM-REIM = H-LITEM-REIM + (H-NAT-COIN - H-MAX-COIN) MOVE H-MAX-COIN TO H-NAT-COIN. 1550-CALC-STANDARD-EXIT. EXIT. *************************************************************** * 1. CALCULATE LINE ITEM PAYMENT FOR SERVICE INDICATOR * * TYPES G , J , OR K. * * 2. EFFECTIVE 04/01/2002 A PRO RATA REDUCTION APPLIES TO * * ALL SERVICE INDICATOR 'G' PAYMENTS (CURRENTLY .636) * *************************************************************** 1550-CALC-GJK. IF OPPS-HCPCS(LN-SUB) = 'P9021' OR 'P9010' OR 'P9038' OR 'P9016' OR 'C1010' OR 'C1018' OR 'P9022' OR 'P9039' OR 'P9040' OR 'C1016' PERFORM 1550-SET-BLOOD-FRACTION THRU 1550-SET-BLOOD-FRACTION-EXIT ELSE IF (OPPS-SRVC-IND (LN-SUB) = ' G') COMPUTE H-LITEM-PYMT ROUNDED = (((W-APC-PYMT (W-LP-INDX) - (5 * W-MIN-COIN (W-LP-INDX))) * .364) + (5 * W-MIN-COIN (W-LP-INDX))) * W-SRVC-UNITS (W-LP-INDX) * W-DISC-RATE (W-LP-INDX) COMPUTE W-PPCT (W-LP-INDX) = (H-LITEM-PYMT - (W-NAT-COIN (W-LP-INDX) * W-SRVC-UNITS (W-LP-INDX) * W-DISC-RATE (W-LP-INDX))) / H-LITEM-PYMT GO TO 1550-CALC-GJK-EXIT ELSE COMPUTE H-LITEM-PYMT ROUNDED = (W-APC-PYMT (W-LP-INDX) * W-SRVC-UNITS (W-LP-INDX)) * W-DISC-RATE (W-LP-INDX) GO TO 1550-CALC-GJK-EXIT. COMPUTE H-LITEM-PYMT ROUNDED = W-BD-APC-PYMT (W-BD-INDX) * W-BD-SRVC-UNITS (W-BD-INDX) * W-BD-DISC-RATE (W-BD-INDX). COMPUTE H-LN-BLOOD-DEDUCT ROUNDED = H-LITEM-PYMT * H-BLOOD-FRACTION. SET W-BD-INDX UP BY 1. 1550-CALC-GJK-EXIT. EXIT. 1550-SET-BLOOD-FRACTION. MOVE W-BD-SUB (W-BD-INDX) TO LN-SUB. IF H-BENE-PINTS-USED > 0 IF W-BD-SRVC-UNITS (W-BD-INDX) <= H-BENE-PINTS-USED MOVE 1 TO H-BLOOD-FRACTION COMPUTE H-BENE-PINTS-USED = H-BENE-PINTS-USED - W-BD-SRVC-UNITS (W-BD-INDX) ELSE IF W-BD-SRVC-UNITS (W-BD-INDX) > H-BENE-PINTS-USED COMPUTE H-BLOOD-FRACTION = H-BENE-PINTS-USED / W-BD-SRVC-UNITS (W-BD-INDX) MOVE 0 TO H-BENE-PINTS-USED ELSE MOVE 0 TO H-BLOOD-FRACTION ELSE MOVE 0 TO H-BLOOD-FRACTION. 1550-SET-BLOOD-FRACTION-EXIT. EXIT. *************************************************************** * 1. CALCULATE LINE ITEM PAYMENT FOR SERVICE INDICATOR * * TYPE H. * * 2. EFFECTIVE 04/01/2002 A PRO RATA REDUCTION APPLIES TO * * ALL SERVICE INDICATOR 'H' PAYMENTS (CURRENTLY .689) * *************************************************************** 1555-CALC-H-TOT. MOVE W-LP-SUB (W-LP-INDX) TO LN-SUB. MOVE OPPS-SUB-CHRG (LN-SUB) TO H-SUB-CHRG. IF OPPS-SRVC-IND (LN-SUB) = ' H' IF OPPS-PYMT-IND (LN-SUB) = ' 6' COMPUTE H-TOT-H-CHRG = (H-TOT-H-CHRG + H-SUB-CHRG) ELSE NEXT SENTENCE ELSE NEXT SENTENCE. 1555-CALC-H-TOT-EXIT. EXIT. 1555-CALC-H-STANDARD. MOVE OPPS-SUB-CHRG (LN-SUB) TO H-SUB-CHRG. IF L-SERVICE-FROM-DATE > 20001231 COMPUTE T-LITEM-PYMT ROUNDED = (H-SUB-CHRG * (L-PSF-OPCOST-RATIO * .981956)) - (((W-APC-PYMT (W-LP-INDX) * .60) * W-WINX1 (W-LP-INDX)) + (W-APC-PYMT (W-LP-INDX) * .40)) ELSE COMPUTE T-LITEM-PYMT ROUNDED = (H-SUB-CHRG * L-PSF-OPCOST-RATIO) - (((W-APC-PYMT (W-LP-INDX) * .60) * W-WINX1 (W-LP-INDX)) + (W-APC-PYMT (W-LP-INDX) * .40)). IF C-FLAG = 'Y' AND L-SERVICE-FROM-DATE > 20020331 COMPUTE H-TOTAL-WAOFF ROUNDED = ((H-TOTAL-OFFSET * .60) * A-WINX) + (H-TOTAL-OFFSET * .40) PERFORM 1700-CALC-H-OFFSET THRU 1700-CALC-H-OFFSET-EXIT ELSE NEXT SENTENCE. IF T-LITEM-PYMT < 0 THEN MOVE 0 TO H-LITEM-PYMT ELSE MOVE T-LITEM-PYMT TO H-LITEM-PYMT. 1555-CALC-H-STANDARD-EXIT. EXIT. 1560-CALC-BENE-DEDUCT. IF OPPS-PYMT-ADJ-FLAG (LN-SUB) = ' 4' GO TO 1560-CALC-BENE-DEDUCT-EXIT. IF H-BENE-DEDUCT > 0 THEN COMPUTE H-LN-BLD-PYMT = H-LITEM-PYMT - H-LN-BLOOD-DEDUCT IF H-BENE-DEDUCT <= H-LN-BLD-PYMT THEN MOVE H-BENE-DEDUCT TO H-TOTAL-LN-DEDUCT MOVE 0 TO H-BENE-DEDUCT ELSE COMPUTE H-BENE-DEDUCT = H-BENE-DEDUCT - H-LN-BLD-PYMT MOVE H-LN-BLD-PYMT TO H-TOTAL-LN-DEDUCT MOVE 20 TO A-RETURN-CODE (LN-SUB) END-IF END-IF. 1560-CALC-BENE-DEDUCT-EXIT. EXIT. 1600-ADJ-CHRG-OUTL. MOVE W-LP-SUB (W-LP-INDX) TO LN-SUB. IF OPPS-SRVC-IND (LN-SUB) = ' G' OR ' J' OR ' H' OR ' N' GO TO 1600-ADJ-CHRG-OUTL-EXIT. IF (ST0-FLAG = 'Y') AND (OPPS-SRVC-IND (LN-SUB) = ' S' OR ' T') AND (H-TOT-ST-PYMT > 0) COMPUTE H-CHRG-RATE ROUNDED = (A-LITEM-PYMT (LN-SUB) / H-TOT-ST-PYMT) COMPUTE W-SUB-CHRG (W-LP-INDX) ROUNDED = (H-CHRG-RATE * H-TOT-ST-CHRG) ELSE IF (N-FLAG = 'Y' AND ST0-FLAG = 'N') AND ((OPPS-SRVC-IND (LN-SUB) = ' S' OR ' T' OR ' V' OR ' X' OR ' P') AND (OPPS-PKG-FLAG (LN-SUB) = '0')) AND (H-TOT-STVX-PYMT > 0) COMPUTE H-CHRG-RATE ROUNDED = (A-LITEM-PYMT (LN-SUB) / H-TOT-STVX-PYMT) COMPUTE H-SUB-CHRG ROUNDED = (H-CHRG-RATE * H-TOT-N-CHRG) COMPUTE W-SUB-CHRG (W-LP-INDX) ROUNDED = W-SUB-CHRG (W-LP-INDX) + H-SUB-CHRG. IF (N-FLAG = 'Y' AND ST0-FLAG = 'Y') AND ((OPPS-SRVC-IND (LN-SUB) = ' S' OR ' T' OR ' V' OR ' X' OR ' P') AND (OPPS-PKG-FLAG (LN-SUB) = '0')) AND (H-TOT-STVX-PYMT > 0) COMPUTE H-CHRG-RATE ROUNDED = (A-LITEM-PYMT (LN-SUB) / H-TOT-STVX-PYMT) COMPUTE H-SUB-CHRG ROUNDED = (H-CHRG-RATE * H-TOT-N-CHRG) COMPUTE W-SUB-CHRG (W-LP-INDX) ROUNDED = W-SUB-CHRG (W-LP-INDX) + H-SUB-CHRG. COMPUTE H-LITEM-OUTL-PYMT ROUNDED = ((W-SUB-CHRG (W-LP-INDX) * (L-PSF-OPCOST-RATIO * .981956)) - (3.5 * A-LITEM-PYMT (LN-SUB))) * .50. IF H-LITEM-OUTL-PYMT > 0 COMPUTE H-OUTLIER-PYMT = H-OUTLIER-PYMT + H-LITEM-OUTL-PYMT. 1600-ADJ-CHRG-OUTL-EXIT. EXIT. *************************************************************** * 1. RE-CALCULATE LINE ITEM PAYMENT FOR SERVICE INDICATOR * * TYPE H. * * 2. SUBTRACT WAGE ADJUSTED OFFSET AMOUNT FROM SI TYPE 'H' * * WITH HCPCS CODE BEGINNING WITH 'C' * * 2. EFFECTIVE 04/01/2002 * *************************************************************** 1700-CALC-H-OFFSET. IF H-TOT-H-CHRG > 0 COMPUTE H-OFF-RATE ROUNDED = H-SUB-CHRG / H-TOT-H-CHRG COMPUTE T-LITEM-PYMT ROUNDED = (T-LITEM-PYMT - (H-TOTAL-WAOFF * H-OFF-RATE)) * .364 ELSE NEXT SENTENCE. 1700-CALC-H-OFFSET-EXIT. EXIT. 1800-ADJ-STV-REIM. IF W-DCP-CODE (W-DCP-INDX) = 1 PERFORM 1810-PROCESS-TYPE1 THRU 1810-PROCESS-TYPE1-EXIT ELSE PERFORM 1840-PROCESS-TYPE2 THRU 1840-PROCESS-TYPE2-EXIT. 1800-ADJ-STV-REIM-EXIT. EXIT. 1810-PROCESS-TYPE1. IF W-DCP-COIN2 (W-DCP-INDX) > 0 MOVE W-DCP-DOS (W-DCP-INDX) TO H-DCP-DOS MOVE W-DCP-WGNAT (W-DCP-INDX) TO H-TOTAL COMPUTE H-RATIO = (H-IP-LIMIT - W-DCP-WGNAT (W-DCP-INDX)) / W-DCP-COIN2 (W-DCP-INDX) IF H-RATIO < 0 MOVE 0 TO H-RATIO. IF H-RATIO > 1 MOVE 1 TO H-RATIO. 1810-PROCESS-TYPE1-EXIT. EXIT. 1840-PROCESS-TYPE2. IF W-DCP-DOS (W-DCP-INDX) >= 20010701 IF W-DCP-DOS (W-DCP-INDX) = H-DCP-DOS MOVE W-DCP-SUB (W-DCP-INDX) TO LN-SUB COMPUTE H-SHIFT = W-DCP-COIN2 (W-DCP-INDX) * (1 - H-RATIO) COMPUTE H-TOTAL = A-ADJ-COIN (LN-SUB) + H-TOTAL - H-SHIFT IF H-TOTAL > H-IP-LIMIT COMPUTE H-SHIFT = H-SHIFT + H-TOTAL - H-IP-LIMIT END-IF COMPUTE A-ADJ-COIN (LN-SUB) = A-ADJ-COIN (LN-SUB) - H-SHIFT COMPUTE A-LITEM-REIM (LN-SUB) = A-LITEM-REIM (LN-SUB) + H-SHIFT MOVE 22 TO A-RETURN-CODE (LN-SUB) END-IF ELSE IF W-DCP-DOS (W-DCP-INDX) >= 20010101 IF W-DCP-COIN2 (W-DCP-INDX) > H-IP-LIMIT MOVE W-DCP-SUB (W-DCP-INDX) TO LN-SUB COMPUTE H-SHIFT = W-DCP-COIN2 (W-DCP-INDX) - H-IP-LIMIT COMPUTE A-ADJ-COIN (LN-SUB) = A-ADJ-COIN (LN-SUB) - H-SHIFT COMPUTE A-LITEM-REIM (LN-SUB) = A-LITEM-REIM (LN-SUB) + H-SHIFT MOVE 22 TO A-RETURN-CODE (LN-SUB) END-IF END-IF END-IF. 1840-PROCESS-TYPE2-EXIT. EXIT. *************************************************************** * 1. CALCULATE CLAIM LEVEL OUTLIER AMOUNT * *************************************************************** 1900-END-PRICE-RTN. MOVE H-TOT-CHRG TO A-TOT-CLM-CHRG. MOVE H-TOT-PYMT TO A-TOT-CLM-PYMT. COMPUTE A-BLOOD-PINTS-USED = H-BENE-BLOOD-PINTS - H-BENE-PINTS-USED. * IF (A-TOT-CLM-PYMT > 0) AND * (L-SERVICE-FROM-DATE < 20020401) * PERFORM 1910-CALC-OUTLIER * THRU 1910-CALC-OUTLIER-EXIT. IF H-OUTLIER-PYMT > 0 MOVE H-OUTLIER-PYMT TO A-OUTLIER-PYMT. 1900-END-PRICE-RTN-EXIT. EXIT. *1910-CALC-OUTLIER. * * IF L-SERVICE-FROM-DATE > 20001231 * COMPUTE H-OUTLIER-PYMT ROUNDED = * ((H-TOT-CHRG * (L-PSF-OPCOST-RATIO * .981956)) * - (2.5 * H-TOT-PYMT)) * .75 * ELSE * COMPUTE H-OUTLIER-PYMT ROUNDED = * ((H-TOT-CHRG * L-PSF-OPCOST-RATIO) * - (2.5 * H-TOT-PYMT)) * .75. * *1910-CALC-OUTLIER-EXIT. * EXIT. *************************************************************** * PROCESSING: AFTER 20021231 * * A. WILL PROCESS LINE ITEMS BASED ON OCE FLAGS. * * B. INITIALIZE OPPS HOLD VARIABLES. * * C. EDIT THE DATA PASSED FROM THE OCE. * * D. ASSEMBLE PRICING COMPONENTS. * * E. CALCULATE THE PRICE. * * F. RETURN COINSURANCE/REIMBURSEMENT/DEDUCTIBLE/ * * PAYMENT/OUTLIER AMOUNT/RETURN CODES * *************************************************************** 2000-PROCESS-MAIN-NEW. PERFORM 2100-INIT THRU 2100-INIT-EXIT. IF A-CLM-RTN-CODE >= 50 GOBACK. MOVE H-WINX1 TO A-WINX. PERFORM 2125-INIT THRU 2125-INIT-EXIT VARYING LN-SUB FROM 1 BY 1 UNTIL LN-SUB > OPPS-LINE-CNT. MOVE 0 TO W-DCP-MAX W-BLD-MAX. PERFORM 2150-INIT THRU 2150-INIT-EXIT VARYING LN-SUB FROM 1 BY 1 UNTIL LN-SUB > OPPS-LINE-CNT. MOVE 0 TO W-DCP-MAX. PERFORM 2555-CALC-H-TOT THRU 2555-CALC-H-TOT-EXIT VARYING W-LP-INDX FROM 1 BY 1 UNTIL W-LP-INDX > W-LNC-MAX. SET W-BD-INDX TO 1. MOVE 0 TO W-DCP-MAX. PERFORM 2400-CALCULATE THRU 2400-CALCULATE-EXIT VARYING W-LP-INDX FROM 1 BY 1 UNTIL W-LP-INDX > W-LNC-MAX. PERFORM 2600-ADJ-CHRG-OUTL THRU 2600-ADJ-CHRG-OUTL-EXIT VARYING W-LP-INDX FROM 1 BY 1 UNTIL W-LP-INDX > W-LNC-MAX IF GJK-FLAG = 'Y' PERFORM 2800-ADJ-STV-REIM THRU 2800-ADJ-STV-REIM-EXIT VARYING W-DCP-INDX FROM 1 BY 1 UNTIL W-DCP-INDX > W-DCP-MAX ELSE NEXT SENTENCE. PERFORM 2900-END-PRICE-RTN THRU 2900-END-PRICE-RTN-EXIT. 2000-PROCESS-MAIN-NEW-EXIT. EXIT. *************************************************************** * INITIALIZE WORKING STORAGE HOLD AREAS * * AND ADDITIONAL VARIABLES TO BE PASSED BACK TO * * THE STANDARD SYSTEM. * * - IF PROVIDER SPECIFIC FILE WAGE INDEX RECLASSIFICATION * * CODE INVALID OR MISSING * * - MOVE '52' TO CLAIM LEVEL RETURN CODE * * - DISCONTINUE CLAIM PROCESSING * * - IF SERVICE FROM DATE NOT NUMERIC OR < 20000801 * * - MOVE '53' TO CLAIM LEVEL RETURN CODE * * - DISCONTINUE CLAIM PROCESSING * * - IF SERVICE FROM DATE < PROVIDER EFFECTIVE DATE * * - MOVE '54' TO CLAIM LEVEL RETURN CODE * * - DISCONTINUE CLAIM PROCESSING * * - IF SERVICE FROM DATE > PROVIDER TERMINATION DATE * * - MOVE '54' TO CLAIM LEVEL RETURN CODE * * - DISCONTINUE CLAIM PROCESSING * *************************************************************** 2100-INIT. MOVE 01 TO A-CLM-RTN-CODE. MOVE 'N' TO APC33-FLAG GJK-FLAG ST0-FLAG N-FLAG C-FLAG. MOVE SPACE TO A-MSA A-CBSA. MOVE ZERO TO A-OUTLIER-PYMT A-TOTAL-CLM-DEDUCT A-TOT-CLM-CHRG A-TOT-CLM-PYMT A-BLOOD-DEDUCT-DUE A-BLOOD-PINTS-USED A-WINX W-LNC-MAX. INITIALIZE H-ADDITIONAL-VARIABLES. INITIALIZE LINE-HOLD-ITEMS. INITIALIZE T-LITEM-PYMT. IF L-SERVICE-FROM-DATE NOT NUMERIC MOVE 53 TO A-CLM-RTN-CODE GO TO 2100-INIT-EXIT ELSE IF L-SERVICE-FROM-DATE < L-PSF-EFFDT MOVE 54 TO A-CLM-RTN-CODE GO TO 2100-INIT-EXIT ELSE IF L-PSF-TERMDT > 0 IF L-SERVICE-FROM-DATE > L-PSF-TERMDT MOVE 54 TO A-CLM-RTN-CODE GO TO 2100-INIT-EXIT END-IF END-IF. IF L-SERVICE-FROM-DATE >= 20040101 MOVE CAL-VERSION3 TO A-CALC-VERS ELSE MOVE CAL-VERSION2 TO A-CALC-VERS. MOVE BENE-DEDUCT TO H-BENE-DEDUCT. MOVE BENE-BLOOD-PINTS TO H-BENE-BLOOD-PINTS H-BENE-PINTS-USED. MOVE WAD-MAX TO WAD-SUB. PERFORM UNTIL L-SERVICE-FROM-DATE NOT < WAD-DATE (WAD-SUB) SUBTRACT 1 FROM WAD-SUB END-PERFORM. IF L-PSF-WGIDX-RECLASS = 'Y' MOVE L-PSF-WI-MSA TO H-PSF-MSA ELSE IF L-PSF-WGIDX-RECLASS = 'N' MOVE L-PSF-GEO-MSA TO H-PSF-MSA ELSE MOVE 52 TO A-CLM-RTN-CODE GO TO 2100-INIT-EXIT. IF L-SERVICE-FROM-DATE >= 20040101 MOVE 876 TO H-IP-LIMIT ELSE IF L-SERVICE-FROM-DATE >= 20030101 MOVE 840 TO H-IP-LIMIT. IF L-SERVICE-FROM-DATE >= 20040101 PERFORM 2120-FLOOR-2004 THRU 2120-FLOOR-2004-EXIT PERFORM 2120-SEC401-2004 THRU 2120-SEC401-2004-EXIT ELSE IF L-SERVICE-FROM-DATE >= 20030101 PERFORM 2120-FLOOR-2003 THRU 2120-FLOOR-2003-EXIT PERFORM 2120-SEC401-2003 THRU 2120-SEC401-2003-EXIT. MOVE H-PSF-MSA TO A-MSA. PERFORM 2230-CHNG-WAGEINDX THRU 2230-CHNG-WAGEINDX-EXIT. IF H-WINX1 = 0 THEN PERFORM 2200-CALC-WAGEINDX THRU 2200-CALC-WAGEINDX-EXIT. 2100-INIT-EXIT. EXIT. *************************************************************** * RESET FLOOR MSA - 'FROM-DATE' CONTROLLED * * - YEAR 2003 * * - YEAR 2004 * *************************************************************** 2120-FLOOR-2003. IF H-PSF-MSA = ' 14' AND L-PSF-WGIDX-RECLASS = 'Y' AND L-PSF-PROV-ST = '16' MOVE 'N' TO L-PSF-WGIDX-RECLASS MOVE ' 16' TO H-PSF-MSA. IF H-PSF-MSA = '1123' AND L-PSF-PROV-ST = '22' MOVE ' 22' TO H-PSF-MSA. IF H-PSF-MSA = '1800' AND L-PSF-WGIDX-RECLASS = 'Y' AND L-PSF-PROV-ST = '11' MOVE 'N' TO L-PSF-WGIDX-RECLASS MOVE ' 11' TO H-PSF-MSA. IF H-PSF-MSA = '1900' AND L-PSF-PROV-ST = '21' MOVE ' 21' TO H-PSF-MSA. IF H-PSF-MSA = '2440' AND L-PSF-PROV-ST = '15' MOVE ' 15' TO H-PSF-MSA. IF H-PSF-MSA = '3660' AND L-PSF-PROV-ST = '49' MOVE 'N' TO L-PSF-WGIDX-RECLASS MOVE ' 49' TO H-PSF-MSA. IF H-PSF-MSA = '3700' AND L-PSF-WGIDX-RECLASS = 'Y' AND L-PSF-PROV-ST = '26' MOVE 'N' TO L-PSF-WGIDX-RECLASS MOVE ' 26' TO H-PSF-MSA. IF H-PSF-MSA = '6020' AND L-PSF-PROV-ST = '36' MOVE ' 36' TO H-PSF-MSA. IF H-PSF-MSA = '9000' AND L-PSF-PROV-ST = '36' MOVE ' 36' TO H-PSF-MSA. 2120-FLOOR-2003-EXIT. EXIT. 2120-SEC401-2003. IF (L-PSF-PROV-OSCAR = '050192' OR '050286' OR '050446' OR '050469' OR '050528') MOVE ' 05' TO H-PSF-MSA ELSE IF (L-PSF-PROV-OSCAR = '100048' OR '100118') MOVE ' 10' TO H-PSF-MSA ELSE IF (L-PSF-PROV-OSCAR = '170137') MOVE ' 17' TO H-PSF-MSA ELSE IF (L-PSF-PROV-OSCAR = '190048' OR '190110') MOVE ' 19' TO H-PSF-MSA ELSE IF (L-PSF-PROV-OSCAR = '230078') MOVE ' 23' TO H-PSF-MSA ELSE IF (L-PSF-PROV-OSCAR = '260006') MOVE ' 26' TO H-PSF-MSA ELSE IF (L-PSF-PROV-OSCAR = '300009') MOVE ' 30' TO H-PSF-MSA ELSE IF (L-PSF-PROV-OSCAR = '380084') MOVE ' 38' TO H-PSF-MSA. 2120-SEC401-2003-EXIT. EXIT. 2120-FLOOR-2004. IF H-PSF-MSA = ' 14' AND L-PSF-WGIDX-RECLASS = 'Y' AND L-PSF-PROV-ST = '16' MOVE 'N' TO L-PSF-WGIDX-RECLASS MOVE ' 16' TO H-PSF-MSA. IF H-PSF-MSA = '0200' AND L-PSF-WGIDX-RECLASS = 'Y' AND L-PSF-PROV-ST = '06' MOVE 'N' TO L-PSF-WGIDX-RECLASS MOVE ' 06' TO H-PSF-MSA. IF H-PSF-MSA = '1480' AND L-PSF-WGIDX-RECLASS = 'Y' AND L-PSF-PROV-ST = '36' MOVE 'N' TO L-PSF-WGIDX-RECLASS MOVE ' 36' TO H-PSF-MSA. IF H-PSF-MSA = '1900' AND L-PSF-PROV-ST = '21' MOVE ' 21' TO H-PSF-MSA. IF H-PSF-MSA = '2440' AND L-PSF-PROV-ST = '15' MOVE ' 15' TO H-PSF-MSA. IF H-PSF-MSA = '2985' AND L-PSF-PROV-ST = '24' MOVE ' 24' TO H-PSF-MSA. IF H-PSF-MSA = '3660' AND L-PSF-WGIDX-RECLASS = 'Y' AND L-PSF-PROV-ST = '49' MOVE 'N' TO L-PSF-WGIDX-RECLASS MOVE ' 49' TO H-PSF-MSA. IF H-PSF-MSA = '3660' AND L-PSF-PROV-ST = '49' MOVE ' 49' TO H-PSF-MSA. IF H-PSF-MSA = '3700' AND L-PSF-WGIDX-RECLASS = 'Y' AND L-PSF-PROV-ST = '26' MOVE 'N' TO L-PSF-WGIDX-RECLASS MOVE ' 26' TO H-PSF-MSA. IF H-PSF-MSA = '6020' AND L-PSF-PROV-ST = '36' MOVE ' 36' TO H-PSF-MSA. IF H-PSF-MSA = '6740' AND L-PSF-WGIDX-RECLASS = 'Y' AND L-PSF-PROV-ST = '50' MOVE 'N' TO L-PSF-WGIDX-RECLASS MOVE ' 50' TO H-PSF-MSA. IF H-PSF-MSA = '7720' AND L-PSF-WGIDX-RECLASS = 'Y' AND L-PSF-PROV-ST = '28' MOVE 'N' TO L-PSF-WGIDX-RECLASS MOVE ' 28' TO H-PSF-MSA. IF H-PSF-MSA = '8080' AND L-PSF-PROV-ST = '36' MOVE ' 36' TO H-PSF-MSA. IF H-PSF-MSA = '9000' AND L-PSF-PROV-ST = '36' MOVE ' 36' TO H-PSF-MSA. 2120-FLOOR-2004-EXIT. EXIT. 2120-SEC401-2004. IF (L-PSF-PROV-OSCAR = '050192' OR '050286' OR '050469' OR '050528' OR '050618') MOVE ' 05' TO H-PSF-MSA ELSE IF (L-PSF-PROV-OSCAR = '100048' OR '100118') MOVE ' 10' TO H-PSF-MSA ELSE IF (L-PSF-PROV-OSCAR = '170137') MOVE ' 17' TO H-PSF-MSA ELSE IF (L-PSF-PROV-OSCAR = '190048' OR '190110') MOVE ' 19' TO H-PSF-MSA ELSE IF (L-PSF-PROV-OSCAR = '230078') MOVE ' 23' TO H-PSF-MSA ELSE IF (L-PSF-PROV-OSCAR = '260006') MOVE ' 26' TO H-PSF-MSA ELSE IF (L-PSF-PROV-OSCAR = '300009') MOVE ' 30' TO H-PSF-MSA ELSE IF (L-PSF-PROV-OSCAR = '380084') MOVE ' 38' TO H-PSF-MSA ELSE IF (L-PSF-PROV-OSCAR = '390106') MOVE ' 39' TO H-PSF-MSA. 2120-SEC401-2004-EXIT. EXIT. *************************************************************** * SET FLAG IF APC = 0033 * * - TERMINATE PROCESS IF 0033 LOCATED * * * *************************************************************** 2125-INIT. IF OPPS-APC (LN-SUB) = '0033' MOVE 'Y' TO APC33-FLAG MOVE 451 TO LN-SUB. 2125-INIT-EXIT. EXIT. *************************************************************** * 1. VERIFY THE SERVICE INDICATOR PASSED BY THE OCE * * - IF INVALID SET RETURN CODE TO '40' * * - DISCONTINUE LINE PROCESSING * * - IF VALID SET RETURN CODE TO '01' * * - CONTINUE LINE PROCESSING * * 2. PROCESS LINES AND LOAD WORK TABLE ACCORDING TO PRICE * * RANKING * * 3. CHECK OCE EDIT INDICATORS AND SET RETURN CODES IF * * INDICATORS ARE INVALID. * * - VALID RETURN CODES FOR EDIT INDICATORS * * - '41' - SERVICE INDICATOR INVALID FOR OPPS PRICER * * - '42' - APC = '00000' OR (PACKAGING FLAG = 1 OR 2) * * - '43' - PAYMENT INDICATOR NOT = TO 1 OR 5 THRU 9 * * - '44' - SERVICE INDICATOR = 'H' BUT PAYMENT * * INDICATOR NOT = TO 6 * * - '45' - PACKAGING FLAG NOT = TO 0 OR 1 OR 2 * * - '46' - (LINE ITEM DENIAL/REJECT FLAG NOT = TO 0 * * OR LINE ITEM DENIAL/REJECT FLAG = TO 1 * * AND (APC NOT = 0033 OR 0034 OR 0322 OR * * 0323 OR 0324 OR 0325 OR 0373 OR 0374)) * * OR LINE ITEM ACTION FLAG NOT = TO 1 * * - '47' - LINE ITEM ACTION FLAG = 2 OR 3 * * - '48' - PAYMENT ADJUSTMENT FLAG NOT VALID * * - '49' - SITE OF SERVICE FLAG NOT = TO 0 * * - OR (APC 0033 IS NOT ON THE CLAIM * * AND SERVICE INDICATOR = 'P' * * OR APC = 0322-0325,0373,0374) * * 4. IF OCE INDICATORS ARE VALID, SEARCH APC TABLE * * - IF MISSING, DELETED OR INVALID APC * * - SET RETURN CODE TO '30' * * - DISCONTINUE LINE PROCESSING * *************************************************************** 2150-INIT. MOVE 01 TO A-RETURN-CODE (LN-SUB). *************************************************************** * OVER-RIDE SERVICE UNITS FOR APC 0339 - EFFECTIVE 04/01/2002 * * - CHANGE UNIT VALUE TO 1 * *************************************************************** IF OPPS-APC (LN-SUB) = '0339' MOVE 1 TO OPPS-SRVC-UNITS (LN-SUB). *************************************************************** * OVER-RIDE SERVICE INDICATOR FOR - EFFECTIVE 01/01/2004 * * - CHANGE INDICATOR TO 'N' AND MOVE SPACES TO APC * * - OCE CORRECTION WILL REPLACE THIS OVERRIDE 04/01/2004 * *************************************************************** * IF ((L-SERVICE-FROM-DATE > 20031231) AND * (L-SERVICE-FROM-DATE < 20040401)) AND * (OPPS-HCPCS (LN-SUB) = 'Q4078' OR 'A9526') * MOVE ' N' TO OPPS-SRVC-IND (LN-SUB) * MOVE '00000' TO OPPS-GRP (LN-SUB) * MOVE '00000' TO OPPS-HCPCS-APC (LN-SUB). *************************************************************** *************************************************************** * OVER-RIDE SERVICE INDICATOR FOR - EFFECTIVE 01/01/2004 * * - CHANGE AS OF 04/01/2004 * * - CHANGE INDICATOR TO 'N' AND MOVE ZEROS TO APC 0738 * * - CHANGE PACKGAGE FLAG TO '1' * * - OCE CORRECTION WILL REPLACE THIS OVERRIDE 07/01/2004 * *************************************************************** IF ((L-SERVICE-FROM-DATE > 20031231) AND (L-SERVICE-FROM-DATE < 20040401)) AND (OPPS-APC (LN-SUB) = '0738') MOVE ' N' TO OPPS-SRVC-IND (LN-SUB) MOVE '00000' TO OPPS-GRP (LN-SUB) MOVE '00000' TO OPPS-HCPCS-APC (LN-SUB) MOVE '1' TO OPPS-PKG-FLAG (LN-SUB). *************************************************************** MOVE OPPS-SRVC-UNITS (LN-SUB) TO H-SRVC-UNITS. PERFORM 2250-CALC-DISCOUNT THRU 2250-CALC-DISCOUNT-EXIT. IF A-RETURN-CODE (LN-SUB) = 42 GO TO 2150-INIT-EXIT. *************************************************************** * EFFECTIVE AS OF 04-01-2002 * * - TOTAL DEVICE OFFSET * *************************************************************** IF OPPS-SRVC-IND (LN-SUB) = ' H' MOVE 'Y' TO C-FLAG COMPUTE H-TOT-HTD-UNITS = H-TOT-HTD-UNITS + H-SRVC-UNITS. PERFORM 2160-TOTAL-OFFSET THRU 2160-TOTAL-OFFSET-EXIT. SET W-LP-INDX TO LN-SUB. SET W-BD-INDX TO LN-SUB. INITIALIZE W-LP-ENTRY (W-LP-INDX). INITIALIZE W-BD-ENTRY (W-BD-INDX). MOVE ZERO TO A-LITEM-PYMT (LN-SUB) A-LITEM-REIM (LN-SUB) A-ADJ-COIN (LN-SUB) A-RED-COIN (LN-SUB) A-TOTAL-LN-DEDUCT (LN-SUB) A-BLOOD-LN-DEDUCT (LN-SUB). IF NOT (OPPS-SRVC-IND (LN-SUB) = ' A' OR ' B' OR ' C' OR ' E' OR ' F' OR ' G' OR ' H' OR ' J' OR ' K' OR ' L' OR ' N' OR ' P' OR ' S' OR ' T' OR ' V' OR ' X' OR ' W' OR ' Y' OR ' Z') THEN MOVE 40 TO A-RETURN-CODE (LN-SUB) GO TO 2150-INIT-EXIT ELSE MOVE 01 TO A-RETURN-CODE (LN-SUB). IF OPPS-SRVC-IND (LN-SUB) = ' A' OR ' B' OR ' C' OR ' E' OR ' F' OR ' L' OR ' W' OR ' Y' OR ' Z' MOVE 41 TO A-RETURN-CODE (LN-SUB) GO TO 2150-INIT-EXIT. IF OPPS-PYMT-IND (LN-SUB) = ' 1' OR ' 5' OR ' 6' OR ' 7' OR ' 8' OR ' 9' IF OPPS-PKG-FLAG (LN-SUB) = '0' OR '1' OR '2' OR '3' IF (OPPS-LITEM-DR-FLAG (LN-SUB) = '0' OR OPPS-LITEM-DR-FLAG (LN-SUB) = '1' AND (OPPS-APC (LN-SUB) = '0033' OR '0034' OR '0322' OR '0323' OR '0324' OR '0325' OR '0373' OR '0374')) OR (OPPS-LITEM-ACT-FLAG (LN-SUB) = '1') IF NOT (OPPS-LITEM-ACT-FLAG (LN-SUB) EQUAL '2' OR '3') IF OPPS-PYMT-ADJ-FLAG (LN-SUB) = ' 0' OR ' 1' OR ' 2' OR ' 3' OR ' 4' IF (OPPS-SITE-SRVC-FLAG (LN-SUB) = '0') OR ((APC33-FLAG = 'Y') AND ((OPPS-SRVC-IND (LN-SUB) = ' P') OR (OPPS-APC (LN-SUB) = '0322' OR '0323' OR '0324' OR '0325' OR '0373' OR '0374'))) MOVE OPPS-SUB-CHRG (LN-SUB) TO H-SUB-CHRG COMPUTE H-TOT-CHRG = H-TOT-CHRG + H-SUB-CHRG IF OPPS-LITEM-ACT-FLAG (LN-SUB) = '4' COMPUTE H-TOT-CHRG = H-TOT-CHRG - H-SUB-CHRG END-IF IF OPPS-PKG-FLAG (LN-SUB) = '1' OR '2' COMPUTE H-TOT-N-CHRG = H-SUB-CHRG + H-TOT-N-CHRG MOVE 'Y' TO N-FLAG END-IF IF (OPPS-APC (LN-SUB) = '0000') OR (OPPS-PKG-FLAG (LN-SUB) = '1' OR '2') MOVE 42 TO A-RETURN-CODE (LN-SUB) GO TO 2150-INIT-EXIT END-IF SEARCH ALL WAA-ENTRY AT END MOVE 30 TO A-RETURN-CODE (LN-SUB) GO TO 2150-INIT-EXIT WHEN WAA-APC (WAA-INDX) = OPPS-GRP (LN-SUB) MOVE WAA-PTR (WAA-INDX) TO W-SUB2 PERFORM 2175-APC-LOOKUP ELSE MOVE 49 TO A-RETURN-CODE (LN-SUB) GO TO 2150-INIT-EXIT ELSE MOVE 48 TO A-RETURN-CODE (LN-SUB) GO TO 2150-INIT-EXIT ELSE MOVE 47 TO A-RETURN-CODE (LN-SUB) GO TO 2150-INIT-EXIT ELSE MOVE 46 TO A-RETURN-CODE (LN-SUB) GO TO 2150-INIT-EXIT ELSE MOVE 45 TO A-RETURN-CODE (LN-SUB) GO TO 2150-INIT-EXIT ELSE MOVE 43 TO A-RETURN-CODE (LN-SUB) GO TO 2150-INIT-EXIT. IF (A-RETURN-CODE (LN-SUB) = 01) AND (OPPS-HCPCS (LN-SUB) = 'C9114' OR 'C9115') PERFORM 2180-MOD-CCODE-PYMT THRU 2180-MOD-CCODE-PYMT-EXIT. IF A-RETURN-CODE (LN-SUB) = 01 PERFORM 2300-COIN-DEDUCT THRU 2300-COIN-DEDUCT-EXIT. IF A-RETURN-CODE (LN-SUB) = 01 SET WBD-INDX TO 1 SEARCH WBD-ENTRY VARYING WBD-INDX AT END GO TO 2150-INIT-EXIT WHEN W-BLOOD-HCPCS (WBD-INDX) = OPPS-HCPCS (LN-SUB) MOVE W-BLOOD-RANK (WBD-INDX) TO H-BLOOD-RANK PERFORM 2375-BLOOD-DEDUCT THRU 2375-BLOOD-DEDUCT-EXIT. 2150-INIT-EXIT. EXIT. *************************************************************** * COMPUTE TOTAL OFFSET FROM TABLE 5 FOR DEVICES * * - EFFECTIVE AS OF 01-01-2003 * * - EFFECTIVE AS OF 01-01-2004 * * - SEARCH TABLE OPPSOF04 * * - WHERE ALL OFFSET VALUES EQUAL ZERO * *************************************************************** 2160-TOTAL-OFFSET. MOVE OPPS-GRP (LN-SUB) TO W-OFF-APC. IF L-SERVICE-FROM-DATE >= 20040101 SEARCH ALL WOO-ENTRY3 AT END GO TO 2160-TOTAL-OFFSET-EXIT WHEN WOO-APC3 (WOO-INDX3) = W-OFF-APC COMPUTE H-TOTAL-OFFSET = H-TOTAL-OFFSET + (WOO-OFFSET3 (WOO-INDX3) * H-DISC-RATE * H-SRVC-UNITS) COMPUTE H-TOT-OFF-UNITS = H-TOT-OFF-UNITS + H-SRVC-UNITS ELSE SEARCH ALL WOO-ENTRY2 AT END GO TO 2160-TOTAL-OFFSET-EXIT WHEN WOO-APC2 (WOO-INDX2) = W-OFF-APC COMPUTE H-TOTAL-OFFSET = H-TOTAL-OFFSET + (WOO-OFFSET2 (WOO-INDX2) * H-DISC-RATE * H-SRVC-UNITS) COMPUTE H-TOT-OFF-UNITS = H-TOT-OFF-UNITS + H-SRVC-UNITS. 2160-TOTAL-OFFSET-EXIT. EXIT. *************************************************************** * SEARCH APC TABLE - MOVE VALUES TO HOLD AREA FOR PROCESSING * * - ADJUST TOTAL CHARGE FOR DELETED APC'S * *************************************************************** 2175-APC-LOOKUP. IF WAR-DTCD (W-SUB2) NOT > WAD-DTCD (WAD-SUB) IF WAR-RATEX (W-SUB2) = 'DELETED' MOVE 30 TO A-RETURN-CODE (LN-SUB) COMPUTE H-TOT-CHRG = H-TOT-CHRG - H-SUB-CHRG ELSE MOVE WAR-RATE (W-SUB2) TO H-APC-PYMT MOVE WAR-RANK (W-SUB2) TO H-RANK MOVE WAR-MINC (W-SUB2) TO H-MIN-COIN MOVE WAR-COIN (W-SUB2) TO H-NAT-COIN MOVE WAR-PPCT (W-SUB2) TO H-PPCT ELSE SUBTRACT 1 FROM W-SUB2 IF W-SUB2 > WAA-PTR (WAA-INDX - 1) GO TO 2175-APC-LOOKUP ELSE MOVE 0 TO H-APC-PYMT H-RANK H-MIN-COIN H-NAT-COIN H-PPCT. 2175-APC-LOOKUP-EXIT. EXIT. *************************************************************** * IF DATE OF SERVICE BETWEEN 12/31/2002 AND 04/01/2003 * * IF HCPCS CODE = C9114 OR C9115 ADJUST PAYMENT AND * * COINSURANCE AMOUNTS * *************************************************************** 2180-MOD-CCODE-PYMT. IF L-SERVICE-FROM-DATE > 20021231 AND L-SERVICE-FROM-DATE < 20030401 IF OPPS-HCPCS (LN-SUB) = 'C9114' COMPUTE H-APC-PYMT = H-APC-PYMT * 3 COMPUTE H-NAT-COIN = H-NAT-COIN * 3 COMPUTE H-MIN-COIN = H-MIN-COIN * 3 ELSE IF OPPS-HCPCS (LN-SUB) = 'C9115' COMPUTE H-APC-PYMT = H-APC-PYMT * 2 COMPUTE H-NAT-COIN = H-NAT-COIN * 2 COMPUTE H-MIN-COIN = H-MIN-COIN * 2 ELSE NEXT SENTENCE. 2180-MOD-CCODE-PYMT-EXIT. EXIT. *************************************************************** * SEARCH WAGE INDEX TABLE AND SELECT THE WAGE INDEX * * WHEN EQUAL TO PROVIDER SPECIFIC WAGE INDEX * * IF WAGE INDEX NOT LOCATED * * - SET CLAIM RETURN CODE TO '50' * * - DISCONTINUE CLAIM PROCESSING * * IF WAGE INDEX EQUALS ZERO * * - SET CLAIM RETURN CODE TO '51' * * - DISCONTINUE CLAIM PROCESSING * *************************************************************** 2200-CALC-WAGEINDX. MOVE WWD-MAX TO WWD-SUB. PERFORM UNTIL L-SERVICE-FROM-DATE NOT < WWD-DATE (WWD-SUB) SUBTRACT 1 FROM WWD-SUB END-PERFORM. SEARCH ALL WWM-ENTRY AT END MOVE 50 TO A-CLM-RTN-CODE GO TO 2200-CALC-WAGEINDX-EXIT WHEN WWM-MSA (WWM-INDX) = H-PSF-MSA MOVE WWM-PTR (WWM-INDX) TO W-SUB2 PERFORM 2210-WAGE-LOOKUP. IF H-WINX1 = 0 THEN MOVE 51 TO A-CLM-RTN-CODE. 2200-CALC-WAGEINDX-EXIT. EXIT. 2210-WAGE-LOOKUP. IF WWW-DTCD (W-SUB2) NOT > WWD-DTCD (WWD-SUB) IF L-PSF-WGIDX-RECLASS = 'Y' MOVE WWW-WINX2 (W-SUB2) TO H-WINX1 ELSE MOVE WWW-WINX1 (W-SUB2) TO H-WINX1 END-IF ELSE SUBTRACT 1 FROM W-SUB2 IF W-SUB2 > WWM-PTR (WWM-INDX - 1) GO TO 2210-WAGE-LOOKUP ELSE MOVE 0 TO H-WINX1. 2210-WAGE-LOOKUP-EXIT. EXIT. *************************************************************** * FOR FY 2003 NEW LUGAR HOSPITALS ONLY * *************************************************************** 2230-CHNG-WAGEINDX. IF (L-SERVICE-FROM-DATE > 20021231 AND L-SERVICE-FROM-DATE < 20040101) IF (L-PSF-PROV-OSCAR = '110130') AND (L-PSF-WI-MSA = ' 11' AND L-PSF-WGIDX-RECLASS = 'Y') MOVE 00.8230 TO H-WINX1. IF (L-SERVICE-FROM-DATE > 20031231 AND L-SERVICE-FROM-DATE < 20050101) IF (L-PSF-PROV-OSCAR = '330001' OR '330126' OR '330135' OR '330205' OR '330209' OR '330264') AND (L-PSF-WI-MSA = '5600' AND L-PSF-WGIDX-RECLASS = 'Y') MOVE 01.3892 TO H-WINX1. IF (L-SERVICE-FROM-DATE > 20031231 AND L-SERVICE-FROM-DATE < 20050101) IF (L-PSF-PROV-OSCAR = '470003') AND (L-PSF-WI-MSA = '1123' AND L-PSF-WGIDX-RECLASS = 'Y') MOVE 01.1120 TO H-WINX1. 2230-CHNG-WAGEINDX-EXIT. EXIT. *************************************************************** * CALCULATE DISCOUNT FACTOR BASED ON THE DISCOUNT * * INDICATOR PASSED BY THE OCE: VALUE 1 - 8 * * IF MISSING OR INVALID DISCOUNT FACTOR * * - SET RETURN CODE TO '38' * * - DISCONTINUE LINE PROCESSING * *************************************************************** 2250-CALC-DISCOUNT. IF (H-SRVC-UNITS = 0 AND OPPS-APC (LN-SUB) = '0000') MOVE 42 TO A-RETURN-CODE (LN-SUB) GO TO 2250-CALC-DISCOUNT-EXIT ELSE IF (H-SRVC-UNITS = 0 AND OPPS-APC (LN-SUB) > '0000') MOVE 1 TO H-SRVC-UNITS. IF OPPS-DISC-FACT (LN-SUB) = 1 THEN MOVE 1 TO H-DISC-RATE ELSE IF OPPS-DISC-FACT (LN-SUB) = 2 THEN COMPUTE H-DISC-RATE = (1 + DISC-FRACTION * (H-SRVC-UNITS - 1)) / H-SRVC-UNITS ELSE IF OPPS-DISC-FACT (LN-SUB) = 3 THEN COMPUTE H-DISC-RATE = TERM-PROC-DISC / H-SRVC-UNITS ELSE IF OPPS-DISC-FACT (LN-SUB) = 4 THEN COMPUTE H-DISC-RATE = (1 + DISC-FRACTION) / H-SRVC-UNITS ELSE IF OPPS-DISC-FACT (LN-SUB) = 5 THEN COMPUTE H-DISC-RATE = DISC-FRACTION ELSE IF OPPS-DISC-FACT (LN-SUB) = 6 THEN COMPUTE H-DISC-RATE = (TERM-PROC-DISC * DISC-FRACTION) / H-SRVC-UNITS ELSE IF OPPS-DISC-FACT (LN-SUB) = 7 THEN COMPUTE H-DISC-RATE = (DISC-FRACTION * (1 + DISC-FRACTION) / H-SRVC-UNITS) ELSE IF OPPS-DISC-FACT (LN-SUB) = 8 THEN MOVE 2 TO H-DISC-RATE ELSE MOVE 38 TO A-RETURN-CODE (LN-SUB). 2250-CALC-DISCOUNT-EXIT. EXIT. *************************************************************** * DETERMINE THE DEDUCTIBLE SEQUENCE. DEDUCTIBLE WILL BE * * TAKEN FROM OPPS SERVICES FIRST, THEN FROM ANY OTHER * * TYPES OF SERVICES FROM THE CLAIM. * * - SET POINTERS TO THE HIGHEST RANKED PERCENTAGE * * (LARGEST NATIONAL UNADJUSTED COINSURANCE / * * THE APC PAYMENT) * * - MOVE ALL PRICING VARIABLES TO STAGING AREA * *************************************************************** 2300-COIN-DEDUCT. ADD 1 TO W-LNC-MAX. SET W-LP-INDX TO W-LNC-MAX. PERFORM 2350-STAGE-ENTRY THRU 2350-STAGE-ENTRY-EXIT UNTIL W-LP-INDX = 1 OR H-RANK NOT < W-RANK (W-LP-INDX - 1). MOVE LN-SUB TO W-LP-SUB (W-LP-INDX). MOVE H-NAT-COIN TO W-NAT-COIN (W-LP-INDX). MOVE H-MIN-COIN TO W-MIN-COIN (W-LP-INDX). MOVE H-SUB-CHRG TO W-SUB-CHRG (W-LP-INDX). MOVE H-APC-PYMT TO W-APC-PYMT (W-LP-INDX). MOVE H-WINX1 TO W-WINX1 (W-LP-INDX). MOVE H-RANK TO W-RANK (W-LP-INDX). MOVE H-PPCT TO W-PPCT (W-LP-INDX). MOVE H-DISC-RATE TO W-DISC-RATE (W-LP-INDX). IF OPPS-SRVC-IND (LN-SUB) = ' P' THEN MOVE 1 TO W-SRVC-UNITS (W-LP-INDX) ELSE MOVE H-SRVC-UNITS TO W-SRVC-UNITS (W-LP-INDX). MOVE 0 TO W-RED-COIN (W-LP-INDX). PERFORM VARYING PS-SUB FROM 1 BY 1 UNTIL PS-SUB > L-PSF-APC-LINE-CNT IF L-PSF-APC (PS-SUB) = OPPS-APC (LN-SUB) COMPUTE W-RED-COIN (W-LP-INDX) ROUNDED = L-PSF-RED-COIN (PS-SUB) * H-SRVC-UNITS * H-DISC-RATE MOVE 25 TO A-RETURN-CODE (LN-SUB) MOVE L-PSF-APC-LINE-CNT TO PS-SUB END-IF END-PERFORM. 2300-COIN-DEDUCT-EXIT. EXIT. 2350-STAGE-ENTRY. MOVE W-LP-ENTRY (W-LP-INDX - 1) TO W-LP-ENTRY (W-LP-INDX). SET W-LP-INDX DOWN BY 1. 2350-STAGE-ENTRY-EXIT. EXIT. *************************************************************** * DETERMINE THE BLOOD DEDUCTIBLE SEQUENCE. DEDUCTIBLE * * WILL BE CALCULATED BASED ON RANKING. * * - SET POINTERS TO THE HIGHEST RANKED APC * * (SMALLEST UNADJUSTED APC PAYMENT) * * - MOVE ALL PRICING VARIABLES TO STAGING AREA * *************************************************************** 2375-BLOOD-DEDUCT. ADD 1 TO W-BLD-MAX. SET W-BD-INDX TO W-BLD-MAX. PERFORM 2385-STAGE-ENTRY THRU 2385-STAGE-ENTRY-EXIT UNTIL W-BD-INDX = 1 OR H-BLOOD-RANK NOT < W-BD-RANK (W-BD-INDX - 1). MOVE LN-SUB TO W-BD-SUB (W-BD-INDX). MOVE H-NAT-COIN TO W-BD-NAT-COIN (W-BD-INDX). MOVE H-MIN-COIN TO W-BD-MIN-COIN (W-BD-INDX). MOVE H-SUB-CHRG TO W-BD-SUB-CHRG (W-BD-INDX). MOVE H-APC-PYMT TO W-BD-APC-PYMT (W-BD-INDX). MOVE H-WINX1 TO W-BD-WINX1 (W-BD-INDX). MOVE H-BLOOD-RANK TO W-BD-RANK (W-BD-INDX). MOVE H-PPCT TO W-BD-PPCT (W-BD-INDX). MOVE H-DISC-RATE TO W-BD-DISC-RATE (W-BD-INDX). MOVE H-SRVC-UNITS TO W-BD-SRVC-UNITS (W-BD-INDX). MOVE 0 TO W-BD-RED-COIN (W-BD-INDX). PERFORM VARYING PS-SUB FROM 1 BY 1 UNTIL PS-SUB > L-PSF-APC-LINE-CNT IF L-PSF-APC (PS-SUB) = OPPS-APC (LN-SUB) COMPUTE W-BD-RED-COIN (W-BD-INDX) ROUNDED = L-PSF-RED-COIN (PS-SUB) * H-SRVC-UNITS * H-DISC-RATE MOVE 25 TO A-RETURN-CODE (LN-SUB) MOVE L-PSF-APC-LINE-CNT TO PS-SUB END-IF END-PERFORM. 2375-BLOOD-DEDUCT-EXIT. EXIT. 2385-STAGE-ENTRY. MOVE W-BD-ENTRY (W-BD-INDX - 1) TO W-BD-ENTRY (W-BD-INDX). SET W-BD-INDX DOWN BY 1. 2385-STAGE-ENTRY-EXIT. EXIT. *************************************************************** * FIRST STEP IN DETERMINING A LINE ITEM PRICE. * * CHECK ALL APPROPRIATE FLAGS AND INDICATORS PASSED * * BY THE OCE. * * - SET RETURN CODES TO INDICATE ERRORS OR STATUS * * - '20' - LINE PROCESSED BUT PAYMENT = 0 * * - BENE DEDUCTIBLE => ADJUSTED PAYMENT * * * *************************************************************** 2400-CALCULATE. MOVE W-LP-SUB (W-LP-INDX) TO LN-SUB. IF A-RETURN-CODE (LN-SUB) > 25 GO TO 2400-CALCULATE-EXIT. IF OPPS-PYMT-IND (LN-SUB) = ' 1' OR ' 5' OR ' 6' OR ' 7' OR ' 8' PERFORM 2550-CALC-STANDARD THRU 2550-CALC-STANDARD-EXIT ELSE GO TO 2400-CALCULATE-EXIT. *************************************************************** * SET GJK FLAG * * - TEST LINE ITEM DATE OF SERVICE > 20010630 * * - TOTAL DRUG / DEVICE COINSURANCE * *************************************************************** IF (A-RETURN-CODE (LN-SUB) < 30) PERFORM 2450-ADJ-PROC-COIN THRU 2450-ADJ-PROC-COIN-EXIT ELSE NEXT SENTENCE. *************************************************************** * SET ST0 AND STVX FLAGS * * - TEST LINE ITEM DATE OF SERVICE > 20020331 * * - TOTAL PROCEDURE CHARGES AND BUNDLED CHARGES * *************************************************************** PERFORM 2500-ADJ-CHRGS THRU 2500-ADJ-CHRGS-EXIT. IF A-RETURN-CODE (LN-SUB) < 30 COMPUTE A-TOTAL-CLM-DEDUCT = H-TOTAL-LN-DEDUCT + A-TOTAL-CLM-DEDUCT COMPUTE H-TOT-PYMT = H-TOT-PYMT + H-LITEM-PYMT COMPUTE A-BLOOD-DEDUCT-DUE = A-BLOOD-DEDUCT-DUE + H-LN-BLOOD-DEDUCT MOVE H-LITEM-PYMT TO A-LITEM-PYMT (LN-SUB) MOVE H-LITEM-REIM TO A-LITEM-REIM (LN-SUB) MOVE H-TOTAL-LN-DEDUCT TO A-TOTAL-LN-DEDUCT (LN-SUB) MOVE H-LN-BLOOD-DEDUCT TO A-BLOOD-LN-DEDUCT (LN-SUB) MOVE H-NAT-COIN TO A-ADJ-COIN (LN-SUB) MOVE H-RED-COIN TO A-RED-COIN (LN-SUB) IF H-RED-COIN > H-NAT-COIN MOVE H-NAT-COIN TO A-RED-COIN (LN-SUB) END-IF IF OPPS-LITEM-ACT-FLAG (LN-SUB) = '4' MOVE 0 TO A-LITEM-PYMT (LN-SUB) MOVE 0 TO A-LITEM-REIM (LN-SUB) COMPUTE H-TOT-PYMT = H-TOT-PYMT - H-LITEM-PYMT END-IF END-IF. MOVE ZERO TO LINE-HOLD-ITEMS. 2400-CALCULATE-EXIT. EXIT. *************************************************************** * SET GJK FLAG * * - STAGE BY SERVICE INDICATOR * * * *************************************************************** 2450-ADJ-PROC-COIN. MOVE OPPS-LITEM-DOS (LN-SUB) TO H-DCP-DOS. IF OPPS-SRVC-IND (LN-SUB) = ' S' OR ' T' OR ' V' COMPUTE H-NEW-WGNAT ROUNDED = W-NAT-COIN (W-LP-INDX) * (.6 * W-WINX1 (W-LP-INDX) + .4) IF H-NEW-WGNAT > H-IP-LIMIT MOVE H-IP-LIMIT TO H-NEW-WGNAT END-IF COMPUTE H-NEW-COIN = H-LITEM-PYMT - H-TOTAL-LN-DEDUCT - H-LITEM-REIM - H-LN-BLOOD-DEDUCT MOVE 1 TO H-DCP-CODE PERFORM 2455-SEARCH-KEY THRU 2455-SEARCH-KEY-EXIT ELSE IF OPPS-SRVC-IND (LN-SUB) = ' G' OR ' J' OR ' K' COMPUTE H-NEW-COIN = H-LITEM-PYMT - H-TOTAL-LN-DEDUCT - H-LITEM-REIM - H-LN-BLOOD-DEDUCT MOVE 'Y' TO GJK-FLAG MOVE 1 TO H-DCP-CODE PERFORM 2455-SEARCH-KEY THRU 2455-SEARCH-KEY-EXIT MOVE 2 TO H-DCP-CODE ADD 1 TO W-DCP-MAX SET W-DCP-INDX TO W-DCP-MAX PERFORM 2475-STAGE-DCP-ENTRY THRU 2475-STAGE-DCP-ENTRY-EXIT UNTIL W-DCP-INDX = 1 OR H-DCP-STAGE NOT < W-DCP-STAGE (W-DCP-INDX - 1) MOVE LN-SUB TO W-DCP-SUB (W-DCP-INDX) MOVE H-DCP-STAGE TO W-DCP-STAGE (W-DCP-INDX) MOVE ZERO TO W-DCP-COIN1 (W-DCP-INDX) MOVE ZERO TO W-DCP-WGNAT (W-DCP-INDX) MOVE H-NEW-COIN TO W-DCP-COIN2 (W-DCP-INDX) MOVE OPPS-SRVC-IND (LN-SUB) TO W-DCP-SRVC-IND (W-DCP-INDX). 2450-ADJ-PROC-COIN-EXIT. EXIT. 2455-SEARCH-KEY. SET W-DCP-INDX TO 1. SEARCH W-DCP-ENTRY VARYING W-DCP-INDX AT END PERFORM 2460-ADD-ENTRY THRU 2460-ADD-ENTRY-EXIT WHEN W-DCP-STAGE (W-DCP-INDX) = H-DCP-STAGE PERFORM 2465-UPDATE-ENTRY THRU 2465-UPDATE-ENTRY-EXIT. 2455-SEARCH-KEY-EXIT. EXIT. 2460-ADD-ENTRY. ADD 1 TO W-DCP-MAX. SET W-DCP-INDX TO W-DCP-MAX. PERFORM 2475-STAGE-DCP-ENTRY THRU 2475-STAGE-DCP-ENTRY-EXIT UNTIL W-DCP-INDX = 1 OR H-DCP-STAGE NOT < W-DCP-STAGE (W-DCP-INDX - 1). IF OPPS-SRVC-IND (LN-SUB) = ' G' OR ' J' OR ' K' MOVE ZERO TO W-DCP-SUB (W-DCP-INDX) MOVE H-DCP-STAGE TO W-DCP-STAGE (W-DCP-INDX) MOVE ZERO TO W-DCP-COIN1 (W-DCP-INDX) MOVE ZERO TO W-DCP-WGNAT (W-DCP-INDX) MOVE H-NEW-COIN TO W-DCP-COIN2 (W-DCP-INDX) MOVE ' X' TO W-DCP-SRVC-IND (W-DCP-INDX) ELSE MOVE LN-SUB TO W-DCP-SUB (W-DCP-INDX) MOVE H-DCP-STAGE TO W-DCP-STAGE (W-DCP-INDX) MOVE H-NEW-COIN TO W-DCP-COIN1 (W-DCP-INDX) MOVE H-NEW-WGNAT TO W-DCP-WGNAT (W-DCP-INDX) MOVE ZERO TO W-DCP-COIN2 (W-DCP-INDX) MOVE OPPS-SRVC-IND (LN-SUB) TO W-DCP-SRVC-IND (W-DCP-INDX). 2460-ADD-ENTRY-EXIT. EXIT. 2465-UPDATE-ENTRY. IF OPPS-SRVC-IND (LN-SUB) = ' G' OR ' J' OR ' K' ADD H-NEW-COIN TO W-DCP-COIN2 (W-DCP-INDX) ELSE IF W-DCP-SRVC-IND (W-DCP-INDX) = ' X' PERFORM 2485-REPLACE-TYPE1 THRU 2485-REPLACE-TYPE1-EXIT ELSE PERFORM 2480-RANK-COIN THRU 2480-RANK-COIN-EXIT. 2465-UPDATE-ENTRY-EXIT. EXIT. 2475-STAGE-DCP-ENTRY. MOVE W-DCP-ENTRY (W-DCP-INDX - 1) TO W-DCP-ENTRY (W-DCP-INDX). SET W-DCP-INDX DOWN BY 1. 2475-STAGE-DCP-ENTRY-EXIT. EXIT. 2480-RANK-COIN. IF H-NEW-WGNAT > W-DCP-WGNAT (W-DCP-INDX) MOVE LN-SUB TO W-DCP-SUB (W-DCP-INDX) MOVE H-NEW-COIN TO W-DCP-COIN1 (W-DCP-INDX) MOVE H-NEW-WGNAT TO W-DCP-WGNAT (W-DCP-INDX) MOVE OPPS-SRVC-IND (LN-SUB) TO W-DCP-SRVC-IND (W-DCP-INDX). 2480-RANK-COIN-EXIT. EXIT. 2485-REPLACE-TYPE1. MOVE LN-SUB TO W-DCP-SUB (W-DCP-INDX) MOVE H-NEW-COIN TO W-DCP-COIN1 (W-DCP-INDX) MOVE H-NEW-WGNAT TO W-DCP-WGNAT (W-DCP-INDX) MOVE OPPS-SRVC-IND (LN-SUB) TO W-DCP-SRVC-IND (W-DCP-INDX). 2485-REPLACE-TYPE1-EXIT. EXIT. 2500-ADJ-CHRGS. ***************************************************** ** NEW LOGIC INSERTED FOR WEB USE ONLY * ***************************************************** IF ((OPPS-SRVC-IND (LN-SUB) = ' T') OR ((OPPS-SRVC-IND (LN-SUB) = ' S') AND (OPPS-HCPCS (LN-SUB) > '09999' AND OPPS-HCPCS (LN-SUB) < '70000'))) AND (W-SUB-CHRG (W-LP-INDX) < 1.01) MOVE 'Y' TO ST0-FLAG. IF ((OPPS-SRVC-IND (LN-SUB) = ' T') OR ((OPPS-SRVC-IND (LN-SUB) = ' S') AND (OPPS-HCPCS (LN-SUB) > '09999' AND OPPS-HCPCS (LN-SUB) < '70000'))) AND (OPPS-PKG-FLAG (LN-SUB) = '0' OR '3') COMPUTE H-TOT-ST-CHRG = W-SUB-CHRG (W-LP-INDX) + H-TOT-ST-CHRG COMPUTE H-TOT-ST-PYMT = H-LITEM-PYMT + H-TOT-ST-PYMT. IF (OPPS-SRVC-IND (LN-SUB) = ' S' OR ' T' OR ' V' OR ' X' OR ' P') AND (OPPS-PKG-FLAG (LN-SUB) = '0' OR '3') COMPUTE H-TOT-STVX-PYMT = H-LITEM-PYMT + H-TOT-STVX-PYMT. 2500-ADJ-CHRGS-EXIT. EXIT. *************************************************************** * 1. APPLY DEDUCTIBLE TO HIGHEST NATIONAL COINSURANCE AMOUNT * * - DESCENDING UNTIL DEDUCTIBLE = 0. * * 2. CALCULATE THE STANDARD LINE PRICE * * (APC PAYMENT * WAGE INDEX * SERVICE UNITS * * * DISCOUNT FACTOR) * * - WAGE ADJUST 60% OF THE APC PAYMENT ONLY * * 3. ADD LINE PRICE TO OUTLIER HOLD AREA. * * * * 4. CALCULATE THE LINE PRICE FOR DESIGNATED DEVICES * * AND DRUGS * *************************************************************** 2550-CALC-STANDARD. COMPUTE H-MAX-COIN ROUNDED = (H-IP-LIMIT * W-SRVC-UNITS (W-LP-INDX) * W-DISC-RATE (W-LP-INDX)). IF OPPS-SRVC-IND (LN-SUB) = ' S' OR ' V' OR ' T' OR ' P' OR ' X' THEN COMPUTE H-LITEM-PYMT ROUNDED = (((W-APC-PYMT (W-LP-INDX) * .60) * W-WINX1 (W-LP-INDX)) + (W-APC-PYMT (W-LP-INDX) * .40)) * W-SRVC-UNITS (W-LP-INDX) * W-DISC-RATE (W-LP-INDX) PERFORM 2560-CALC-BENE-DEDUCT THRU 2560-CALC-BENE-DEDUCT-EXIT ELSE IF OPPS-SRVC-IND (LN-SUB) = ' H' THEN IF OPPS-PYMT-IND (LN-SUB) = ' 6' THEN PERFORM 2555-CALC-H-STANDARD THRU 2555-CALC-H-STANDARD-EXIT PERFORM 2560-CALC-BENE-DEDUCT THRU 2560-CALC-BENE-DEDUCT-EXIT ELSE MOVE 44 TO A-RETURN-CODE (LN-SUB) GO TO 2550-CALC-STANDARD-EXIT END-IF ELSE IF OPPS-SRVC-IND (LN-SUB) = ' G' OR ' J' OR ' K' THEN IF OPPS-PYMT-IND (LN-SUB) = ' 1' OR ' 5' OR ' 7' THEN MOVE 0 TO H-BLOOD-FRACTION PERFORM 2550-CALC-GJK THRU 2550-CALC-GJK-EXIT PERFORM 2560-CALC-BENE-DEDUCT THRU 2560-CALC-BENE-DEDUCT-EXIT ELSE MOVE 41 TO A-RETURN-CODE (LN-SUB) GO TO 2550-CALC-STANDARD-EXIT END-IF END-IF. IF H-LITEM-PYMT > 0 IF L-SERVICE-FROM-DATE >= 20040101 IF OPPS-APC (LN-SUB) = ('1716' OR '1717' OR '1718' OR '1719' OR '1720' OR '2616' OR '2633') COMPUTE H-LITEM-REIM ROUNDED = ((H-LITEM-PYMT - H-TOTAL-LN-DEDUCT) - H-LN-BLOOD-DEDUCT) * .8 COMPUTE H-NAT-COIN = H-LITEM-PYMT - H-TOTAL-LN-DEDUCT - H-LITEM-REIM - H-LN-BLOOD-DEDUCT MOVE W-MIN-COIN (W-LP-INDX) TO H-MIN-COIN ELSE COMPUTE H-LITEM-REIM ROUNDED = ((H-LITEM-PYMT - H-TOTAL-LN-DEDUCT) - H-LN-BLOOD-DEDUCT) * W-PPCT (W-LP-INDX) COMPUTE H-NAT-COIN = H-LITEM-PYMT - H-TOTAL-LN-DEDUCT - H-LITEM-REIM - H-LN-BLOOD-DEDUCT MOVE W-MIN-COIN (W-LP-INDX) TO H-MIN-COIN ELSE COMPUTE H-LITEM-REIM ROUNDED = ((H-LITEM-PYMT - H-TOTAL-LN-DEDUCT) - H-LN-BLOOD-DEDUCT) * W-PPCT (W-LP-INDX) COMPUTE H-NAT-COIN = H-LITEM-PYMT - H-TOTAL-LN-DEDUCT - H-LITEM-REIM - H-LN-BLOOD-DEDUCT MOVE W-MIN-COIN (W-LP-INDX) TO H-MIN-COIN ELSE NEXT SENTENCE. IF H-MIN-COIN > 0 IF OPPS-SRVC-IND (LN-SUB) = ' G' OR ' H' OR ' J' OR ' K' COMPUTE H-MIN-COIN ROUNDED = H-MIN-COIN * (W-SRVC-UNITS (W-LP-INDX) - (W-SRVC-UNITS (W-LP-INDX) * H-BLOOD-FRACTION)) * W-DISC-RATE (W-LP-INDX) ELSE IF OPPS-APC (LN-SUB) = '0158' OR '0159' COMPUTE H-MIN-COIN ROUNDED = H-LITEM-PYMT * .25 ELSE COMPUTE H-MIN-COIN ROUNDED = H-LITEM-PYMT * .2 END-IF END-IF END-IF. MOVE W-RED-COIN (W-LP-INDX) TO H-RED-COIN. IF (H-RED-COIN > 0 AND < H-MIN-COIN) MOVE H-MIN-COIN TO H-RED-COIN ELSE IF H-RED-COIN < H-NAT-COIN AND > H-MIN-COIN AND > H-MAX-COIN COMPUTE H-LITEM-REIM = H-LITEM-REIM + (H-RED-COIN - H-MAX-COIN) END-IF END-IF. IF H-NAT-COIN > H-MAX-COIN AND H-RED-COIN = 0 THEN COMPUTE H-LITEM-REIM = H-LITEM-REIM + (H-NAT-COIN - H-MAX-COIN) MOVE H-MAX-COIN TO H-NAT-COIN. 2550-CALC-STANDARD-EXIT. EXIT. *************************************************************** * 1. CALCULATE LINE ITEM PAYMENT FOR SERVICE INDICATOR * * TYPES G , J , OR K. * * 2. EFFECTIVE 01/01/2003 REMOVE PRO RATA REDUCTION FOR * * ALL SERVICE INDICATOR 'G' PAYMENTS * *************************************************************** 2550-CALC-GJK. IF OPPS-HCPCS(LN-SUB) = 'P9021' OR 'P9010' OR 'P9038' OR 'P9016' OR 'C1010' OR 'C1018' OR 'P9022' OR 'P9039' OR 'P9040' OR 'C1016' OR 'C1021' OR 'C1020' OR 'P9051' OR 'P9054' OR 'P9056' OR 'P9057' OR 'P9058' PERFORM 2550-SET-BLOOD-FRACTION THRU 2550-SET-BLOOD-FRACTION-EXIT ELSE COMPUTE H-LITEM-PYMT ROUNDED = W-APC-PYMT (W-LP-INDX) * W-SRVC-UNITS (W-LP-INDX) * W-DISC-RATE (W-LP-INDX) GO TO 2550-CALC-GJK-EXIT. COMPUTE H-LITEM-PYMT ROUNDED = W-BD-APC-PYMT (W-BD-INDX) * W-BD-SRVC-UNITS (W-BD-INDX) * W-BD-DISC-RATE (W-BD-INDX). COMPUTE H-LN-BLOOD-DEDUCT ROUNDED = H-LITEM-PYMT * H-BLOOD-FRACTION. SET W-BD-INDX UP BY 1. 2550-CALC-GJK-EXIT. EXIT. 2550-SET-BLOOD-FRACTION. MOVE W-BD-SUB (W-BD-INDX) TO LN-SUB. IF H-BENE-PINTS-USED > 0 IF W-BD-SRVC-UNITS (W-BD-INDX) <= H-BENE-PINTS-USED MOVE 1 TO H-BLOOD-FRACTION COMPUTE H-BENE-PINTS-USED = H-BENE-PINTS-USED - W-BD-SRVC-UNITS (W-BD-INDX) ELSE IF W-BD-SRVC-UNITS (W-BD-INDX) > H-BENE-PINTS-USED COMPUTE H-BLOOD-FRACTION = H-BENE-PINTS-USED / W-BD-SRVC-UNITS (W-BD-INDX) MOVE 0 TO H-BENE-PINTS-USED ELSE MOVE 0 TO H-BLOOD-FRACTION ELSE MOVE 0 TO H-BLOOD-FRACTION. 2550-SET-BLOOD-FRACTION-EXIT. EXIT. *************************************************************** * 1. CALCULATE LINE ITEM PAYMENT FOR SERVICE INDICATOR * * TYPE H. * * 2. EFFECTIVE 04/01/2002 A PRO RATA REDUCTION APPLIES TO * * ALL SERVICE INDICATOR 'H' PAYMENTS (CURRENTLY .689) * *************************************************************** 2555-CALC-H-TOT. MOVE W-LP-SUB (W-LP-INDX) TO LN-SUB. MOVE OPPS-SUB-CHRG (LN-SUB) TO H-SUB-CHRG. IF OPPS-SRVC-IND (LN-SUB) = ' H' IF OPPS-PYMT-IND (LN-SUB) = ' 6' COMPUTE H-TOT-H-CHRG = (H-TOT-H-CHRG + H-SUB-CHRG) ELSE NEXT SENTENCE ELSE NEXT SENTENCE. 2555-CALC-H-TOT-EXIT. EXIT. 2555-CALC-H-STANDARD. MOVE OPPS-SUB-CHRG (LN-SUB) TO H-SUB-CHRG. COMPUTE T-LITEM-PYMT ROUNDED = (H-SUB-CHRG * L-PSF-OPCOST-RATIO). IF (C-FLAG = 'Y') IF (H-TOT-OFF-UNITS > H-TOT-HTD-UNITS) COMPUTE H-TOTAL-WAOFF ROUNDED = (((H-TOTAL-OFFSET * .60) * A-WINX) + (H-TOTAL-OFFSET * .40)) * (H-TOT-HTD-UNITS / H-TOT-OFF-UNITS) PERFORM 2700-CALC-H-OFFSET THRU 2700-CALC-H-OFFSET-EXIT ELSE COMPUTE H-TOTAL-WAOFF ROUNDED = ((H-TOTAL-OFFSET * .60) * A-WINX) + (H-TOTAL-OFFSET * .40) PERFORM 2700-CALC-H-OFFSET THRU 2700-CALC-H-OFFSET-EXIT ELSE NEXT SENTENCE. IF T-LITEM-PYMT < 0 THEN MOVE 0 TO H-LITEM-PYMT ELSE MOVE T-LITEM-PYMT TO H-LITEM-PYMT. 2555-CALC-H-STANDARD-EXIT. EXIT. 2560-CALC-BENE-DEDUCT. IF OPPS-PYMT-ADJ-FLAG (LN-SUB) = ' 4' GO TO 2560-CALC-BENE-DEDUCT-EXIT. IF H-BENE-DEDUCT > 0 THEN COMPUTE H-LN-BLD-PYMT = H-LITEM-PYMT - H-LN-BLOOD-DEDUCT IF H-BENE-DEDUCT <= H-LN-BLD-PYMT THEN MOVE H-BENE-DEDUCT TO H-TOTAL-LN-DEDUCT MOVE 0 TO H-BENE-DEDUCT ELSE COMPUTE H-BENE-DEDUCT = H-BENE-DEDUCT - H-LN-BLD-PYMT MOVE H-LN-BLD-PYMT TO H-TOTAL-LN-DEDUCT MOVE 20 TO A-RETURN-CODE (LN-SUB) END-IF END-IF. 2560-CALC-BENE-DEDUCT-EXIT. EXIT. ********************************************************************* ** - NEW FOR JANUARY 2004 ** ** - CHECK >= 20040101 AND SRVC-IND = 'K' ** ** - DISCONTINUE OUTLIER PROCESS ** ********************************************************************* 2600-ADJ-CHRG-OUTL. MOVE W-LP-SUB (W-LP-INDX) TO LN-SUB. * IF ((L-SERVICE-FROM-DATE > 20031231) AND * (L-SERVICE-FROM-DATE < 20040401)) AND * (OPPS-SRVC-IND (LN-SUB) = ' K') * GO TO 2600-ADJ-CHRG-OUTL-EXIT. ********************************************************************* ** - NEW FOR APRIL 2004 ** ** - CHECK >= 20040101 AND SRVC-IND = 'K' ** ** - CONTINUE OUTLIER PROCESS FOR SPECIFIED APCS ** ********************************************************************* IF L-SERVICE-FROM-DATE >= 20040101 IF OPPS-SRVC-IND (LN-SUB) = ' K' IF (OPPS-APC (LN-SUB) = '0702' OR '0704' OR '0705' OR '0737' OR '1045' OR '1064' OR '1065' OR '1079' OR '1080' OR '1081' OR '1089' OR '1091' OR '1092' OR '1095' OR '1096' OR '1122' OR '1200' OR '1201' OR '1600' OR '1603' OR '1604' OR '1619' OR '1620' OR '1622' OR '1624' OR '1625' OR '1628' OR '1775' OR '9013' OR '9025' OR '9100' OR '9117' OR '9118' OR '9400' OR '9402' OR '9403' OR '9404' OR '9405' OR '9408' OR '9434' OR '0701') NEXT SENTENCE ELSE GO TO 2600-ADJ-CHRG-OUTL-EXIT ELSE NEXT SENTENCE ELSE NEXT SENTENCE. IF OPPS-SRVC-IND (LN-SUB) = ' G' OR ' J' OR ' H' OR ' N' GO TO 2600-ADJ-CHRG-OUTL-EXIT. ***************************************************** ** NEW LOGIC INSERTED FOR WEB USE ONLY * ***************************************************** IF (ST0-FLAG = 'Y') AND ((OPPS-SRVC-IND (LN-SUB) = ' T' ) OR ((OPPS-SRVC-IND (LN-SUB) = ' S') AND (OPPS-HCPCS (LN-SUB) > '09999' AND OPPS-HCPCS (LN-SUB) < '70000'))) AND (H-TOT-ST-PYMT > 0) COMPUTE H-CHRG-RATE ROUNDED = (A-LITEM-PYMT (LN-SUB) / H-TOT-ST-PYMT) COMPUTE W-SUB-CHRG (W-LP-INDX) ROUNDED = (H-CHRG-RATE * H-TOT-ST-CHRG) ELSE IF (N-FLAG = 'Y' AND ST0-FLAG = 'N') AND ((OPPS-SRVC-IND (LN-SUB) = ' S' OR ' T' OR ' V' OR ' X' OR ' P') AND (OPPS-PKG-FLAG (LN-SUB) = '0' OR '3')) AND (H-TOT-STVX-PYMT > 0) COMPUTE H-CHRG-RATE ROUNDED = (A-LITEM-PYMT (LN-SUB) / H-TOT-STVX-PYMT) COMPUTE H-SUB-CHRG ROUNDED = (H-CHRG-RATE * H-TOT-N-CHRG) COMPUTE W-SUB-CHRG (W-LP-INDX) ROUNDED = W-SUB-CHRG (W-LP-INDX) + H-SUB-CHRG. IF (N-FLAG = 'Y' AND ST0-FLAG = 'Y') AND ((OPPS-SRVC-IND (LN-SUB) = ' S' OR ' T' OR ' V' OR ' X' OR ' P') AND (OPPS-PKG-FLAG (LN-SUB) = '0' OR '3')) AND (H-TOT-STVX-PYMT > 0) COMPUTE H-CHRG-RATE ROUNDED = (A-LITEM-PYMT (LN-SUB) / H-TOT-STVX-PYMT) COMPUTE H-SUB-CHRG ROUNDED = (H-CHRG-RATE * H-TOT-N-CHRG) COMPUTE W-SUB-CHRG (W-LP-INDX) ROUNDED = W-SUB-CHRG (W-LP-INDX) + H-SUB-CHRG. ********************************************************************* ** - NEW FOR JANUARY 2004 ** ** - CHECK >= 20040101 AND PROVIDER RANGE FOR CMHC ** ** - COMPUTE H-LITEM-OUTL-PYMT USING NEW FORMULA ** ********************************************************************* IF L-SERVICE-FROM-DATE >= 20040101 MOVE 2.6 TO H-OUTLIER-FACTOR MOVE .50 TO H-OUTLIER-PCT IF (L-PSF-PROV-3456 >= '1400' AND L-PSF-PROV-3456 <= '1499') OR (L-PSF-PROV-3456 >= '4600' AND L-PSF-PROV-3456 <= '4799') OR (L-PSF-PROV-3456 >= '4900' AND L-PSF-PROV-3456 <= '4999') MOVE 3.65 TO H-OUTLIER-FACTOR ELSE NEXT SENTENCE ELSE MOVE 2.75 TO H-OUTLIER-FACTOR MOVE .45 TO H-OUTLIER-PCT. COMPUTE H-LITEM-OUTL-PYMT ROUNDED = ((W-SUB-CHRG (W-LP-INDX) * L-PSF-OPCOST-RATIO) - (H-OUTLIER-FACTOR * A-LITEM-PYMT (LN-SUB))) * H-OUTLIER-PCT. IF H-LITEM-OUTL-PYMT > 0 COMPUTE H-OUTLIER-PYMT = H-OUTLIER-PYMT + H-LITEM-OUTL-PYMT. IF OPPS-LITEM-ACT-FLAG (LN-SUB) = '4' COMPUTE H-OUTLIER-PYMT = H-OUTLIER-PYMT - H-LITEM-OUTL-PYMT MOVE 0 TO H-LITEM-OUTL-PYMT. 2600-ADJ-CHRG-OUTL-EXIT. EXIT. *************************************************************** * 1. RE-CALCULATE LINE ITEM PAYMENT FOR SERVICE INDICATOR * * TYPE H. * * 2. SUBTRACT WAGE ADJUSTED OFFSET AMOUNT FROM SI TYPE 'H' * * WITH HCPCS CODE BEGINNING WITH 'C' * * 2. EFFECTIVE 04/01/2002 * *************************************************************** 2700-CALC-H-OFFSET. IF H-TOT-H-CHRG > 0 COMPUTE H-OFF-RATE ROUNDED = H-SUB-CHRG / H-TOT-H-CHRG COMPUTE T-LITEM-PYMT ROUNDED = T-LITEM-PYMT - (H-TOTAL-WAOFF * H-OFF-RATE) ELSE NEXT SENTENCE. 2700-CALC-H-OFFSET-EXIT. EXIT. 2800-ADJ-STV-REIM. IF W-DCP-CODE (W-DCP-INDX) = 1 PERFORM 2810-PROCESS-TYPE1 THRU 2810-PROCESS-TYPE1-EXIT ELSE PERFORM 2840-PROCESS-TYPE2 THRU 2840-PROCESS-TYPE2-EXIT. 2800-ADJ-STV-REIM-EXIT. EXIT. 2810-PROCESS-TYPE1. IF W-DCP-COIN2 (W-DCP-INDX) > 0 MOVE W-DCP-DOS (W-DCP-INDX) TO H-DCP-DOS MOVE W-DCP-WGNAT (W-DCP-INDX) TO H-TOTAL COMPUTE H-RATIO = (H-IP-LIMIT - W-DCP-WGNAT (W-DCP-INDX)) / W-DCP-COIN2 (W-DCP-INDX) IF H-RATIO < 0 MOVE 0 TO H-RATIO. IF H-RATIO > 1 MOVE 1 TO H-RATIO. 2810-PROCESS-TYPE1-EXIT. EXIT. 2840-PROCESS-TYPE2. IF W-DCP-DOS (W-DCP-INDX) >= 20010701 IF W-DCP-DOS (W-DCP-INDX) = H-DCP-DOS MOVE W-DCP-SUB (W-DCP-INDX) TO LN-SUB COMPUTE H-SHIFT = W-DCP-COIN2 (W-DCP-INDX) * (1 - H-RATIO) COMPUTE H-TOTAL = A-ADJ-COIN (LN-SUB) + H-TOTAL - H-SHIFT IF H-TOTAL > H-IP-LIMIT COMPUTE H-SHIFT = H-SHIFT + H-TOTAL - H-IP-LIMIT END-IF COMPUTE A-ADJ-COIN (LN-SUB) = A-ADJ-COIN (LN-SUB) - H-SHIFT COMPUTE A-LITEM-REIM (LN-SUB) = A-LITEM-REIM (LN-SUB) + H-SHIFT MOVE 22 TO A-RETURN-CODE (LN-SUB) END-IF ELSE IF W-DCP-DOS (W-DCP-INDX) >= 20010101 IF W-DCP-COIN2 (W-DCP-INDX) > H-IP-LIMIT MOVE W-DCP-SUB (W-DCP-INDX) TO LN-SUB COMPUTE H-SHIFT = W-DCP-COIN2 (W-DCP-INDX) - H-IP-LIMIT COMPUTE A-ADJ-COIN (LN-SUB) = A-ADJ-COIN (LN-SUB) - H-SHIFT COMPUTE A-LITEM-REIM (LN-SUB) = A-LITEM-REIM (LN-SUB) + H-SHIFT MOVE 22 TO A-RETURN-CODE (LN-SUB) END-IF END-IF END-IF. 2840-PROCESS-TYPE2-EXIT. EXIT. *************************************************************** * 1. MOVE TOTAL CLAIM CHARGE AMOUNT. * * 2. MOVE TOTAL CLAIM PAYMENT AMOUNT. * * 3. MOVE TOTAL CLAIM BLOOD PINTS USED. * * 4. CALCULATE CLAIM LEVEL OUTLIER AMOUNT. * *************************************************************** 2900-END-PRICE-RTN. MOVE H-TOT-CHRG TO A-TOT-CLM-CHRG. MOVE H-TOT-PYMT TO A-TOT-CLM-PYMT. COMPUTE A-BLOOD-PINTS-USED = H-BENE-BLOOD-PINTS - H-BENE-PINTS-USED. IF H-OUTLIER-PYMT > 0 MOVE H-OUTLIER-PYMT TO A-OUTLIER-PYMT. 2900-END-PRICE-RTN-EXIT. EXIT. *************************************************************** * PROCESSING: AFTER 20041231 * * PROCESSING: AFTER 20021231 * * A. WILL PROCESS LINE ITEMS BASED ON OCE FLAGS. * * B. INITIALIZE OPPS HOLD VARIABLES. * * C. EDIT THE DATA PASSED FROM THE OCE. * * D. ASSEMBLE PRICING COMPONENTS. * * E. CALCULATE THE PRICE. * * F. RETURN COINSURANCE/REIMBURSEMENT/DEDUCTIBLE/ * * PAYMENT/OUTLIER AMOUNT/RETURN CODES * *************************************************************** 3000-PROCESS-MAIN-NEW. PERFORM 3100-INIT THRU 3100-INIT-EXIT. IF H-WINX1 = 0 AND A-CLM-RTN-CODE = 01 MOVE 51 TO A-CLM-RTN-CODE. IF A-CLM-RTN-CODE >= 50 GOBACK. MOVE H-WINX1 TO A-WINX. PERFORM 3125-INIT THRU 3125-INIT-EXIT VARYING LN-SUB FROM 1 BY 1 UNTIL LN-SUB > OPPS-LINE-CNT. MOVE 0 TO W-DCP-MAX W-BLD-MAX. PERFORM 3150-INIT THRU 3150-INIT-EXIT VARYING LN-SUB FROM 1 BY 1 UNTIL LN-SUB > OPPS-LINE-CNT. MOVE 0 TO W-DCP-MAX. PERFORM 3555-CALC-H-TOT THRU 3555-CALC-H-TOT-EXIT VARYING W-LP-INDX FROM 1 BY 1 UNTIL W-LP-INDX > W-LNC-MAX. SET W-BD-INDX TO 1. MOVE 0 TO W-DCP-MAX. PERFORM 3400-CALCULATE THRU 3400-CALCULATE-EXIT VARYING W-LP-INDX FROM 1 BY 1 UNTIL W-LP-INDX > W-LNC-MAX. PERFORM 3600-ADJ-CHRG-OUTL THRU 3600-ADJ-CHRG-OUTL-EXIT VARYING W-LP-INDX FROM 1 BY 1 UNTIL W-LP-INDX > W-LNC-MAX IF GJK-FLAG = 'Y' PERFORM 3800-ADJ-STV-REIM THRU 3800-ADJ-STV-REIM-EXIT VARYING W-DCP-INDX FROM 1 BY 1 UNTIL W-DCP-INDX > W-DCP-MAX ELSE NEXT SENTENCE. PERFORM 3900-END-PRICE-RTN THRU 3900-END-PRICE-RTN-EXIT. 3000-PROCESS-MAIN-NEW-EXIT. EXIT. *************************************************************** * INITIALIZE WORKING STORAGE HOLD AREAS * * AND ADDITIONAL VARIABLES TO BE PASSED BACK TO * * THE STANDARD SYSTEM. * * - IF PROVIDER SPECIFIC FILE WAGE INDEX RECLASSIFICATION * * CODE INVALID OR MISSING * * - MOVE '52' TO CLAIM LEVEL RETURN CODE * * - DISCONTINUE CLAIM PROCESSING * * - IF SERVICE FROM DATE NOT NUMERIC OR < 20000801 * * - MOVE '53' TO CLAIM LEVEL RETURN CODE * * - DISCONTINUE CLAIM PROCESSING * * - IF SERVICE FROM DATE < PROVIDER EFFECTIVE DATE * * - MOVE '54' TO CLAIM LEVEL RETURN CODE * * - DISCONTINUE CLAIM PROCESSING * * - IF SERVICE FROM DATE > PROVIDER TERMINATION DATE * * - MOVE '54' TO CLAIM LEVEL RETURN CODE * * - DISCONTINUE CLAIM PROCESSING * *************************************************************** 3100-INIT. MOVE 01 TO A-CLM-RTN-CODE. MOVE 'N' TO APC33-FLAG GJK-FLAG ST0-FLAG N-FLAG C-FLAG. MOVE SPACE TO A-MSA A-CBSA. MOVE ZERO TO A-OUTLIER-PYMT A-TOTAL-CLM-DEDUCT A-TOT-CLM-CHRG A-TOT-CLM-PYMT A-BLOOD-DEDUCT-DUE A-BLOOD-PINTS-USED A-WINX W-LNC-MAX. INITIALIZE H-ADDITIONAL-VARIABLES. INITIALIZE LINE-HOLD-ITEMS. INITIALIZE T-LITEM-PYMT. IF L-SERVICE-FROM-DATE NOT NUMERIC MOVE 53 TO A-CLM-RTN-CODE GO TO 3100-INIT-EXIT ELSE IF L-SERVICE-FROM-DATE < L-PSF-EFFDT MOVE 54 TO A-CLM-RTN-CODE GO TO 3100-INIT-EXIT ELSE IF L-PSF-TERMDT > 0 IF L-SERVICE-FROM-DATE > L-PSF-TERMDT MOVE 54 TO A-CLM-RTN-CODE GO TO 3100-INIT-EXIT END-IF END-IF. MOVE CAL-VERSION4 TO A-CALC-VERS. MOVE BENE-DEDUCT TO H-BENE-DEDUCT. MOVE BENE-BLOOD-PINTS TO H-BENE-BLOOD-PINTS H-BENE-PINTS-USED. MOVE WAD-MAX TO WAD-SUB. PERFORM UNTIL L-SERVICE-FROM-DATE NOT < WAD-DATE (WAD-SUB) SUBTRACT 1 FROM WAD-SUB END-PERFORM. IF L-PSF-SPEC-PYMT-IND = 'Y' MOVE L-PSF-WI-CBSA TO H-PSF-CBSA ELSE IF L-PSF-SPEC-PYMT-IND = ' ' MOVE L-PSF-GEO-CBSA TO H-PSF-CBSA ELSE IF L-PSF-SPEC-PYMT-IND = '1' OR '2' MOVE L-PSF-GEO-CBSA TO H-PSF-CBSA A-CBSA MOVE L-PSF-SPEC-WGIDX TO H-WINX1 MOVE 912 TO H-IP-LIMIT GO TO 3100-INIT-EXIT ELSE MOVE 52 TO A-CLM-RTN-CODE GO TO 3100-INIT-EXIT. IF H-PSF-CBSA = SPACE MOVE 52 TO A-CLM-RTN-CODE GO TO 3100-INIT-EXIT. MOVE 912 TO H-IP-LIMIT. PERFORM 3120-FLOOR-2005 THRU 3120-FLOOR-2005-EXIT. IF L-SERVICE-FROM-DATE < 20050401 PERFORM 3120-SEC401-2005 THRU 3120-SEC401-2005-EXIT ELSE PERFORM 3120-SEC401-2005-APR THRU 3120-SEC401-2005-APR-EXIT. MOVE H-PSF-CBSA TO A-CBSA. IF H-WINX1 = 0 PERFORM 3200-CALC-WAGEINDX THRU 3200-CALC-WAGEINDX-EXIT. 3100-INIT-EXIT. EXIT. 000100************************************************************* 02 000200** NEW 2005 FLOOR AND SEC 401 FOR CBSA *** 02 000300************************************************************* 02 260700 3120-FLOOR-2005. 02 260800 00 260900 IF H-PSF-CBSA = '10900' 00 261000 AND L-PSF-PROV-ST = '31' 00 261100 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 00 261200 MOVE ' 31' TO H-PSF-CBSA. 00 261300 00 261400 IF H-PSF-CBSA = '16620' 00 261500 AND L-PSF-SPEC-PYMT-IND = 'Y' 00 261600 AND L-PSF-PROV-ST = '36' 00 261700 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 00 261800 MOVE ' 36' TO H-PSF-CBSA. 00 262500 00 262600 IF H-PSF-CBSA = '19060' 00 262700 AND L-PSF-PROV-ST = '21' 00 262800 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 00 262900 MOVE ' 21' TO H-PSF-CBSA. 00 263500 00 263600 IF H-PSF-CBSA = '21780' 00 263700 AND L-PSF-PROV-ST = '15' 00 263800 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 00 263900 MOVE ' 15' TO H-PSF-CBSA. 00 264500 00 264600 IF H-PSF-CBSA = '22020' 00 264800 AND L-PSF-PROV-ST = '24' 00 264900 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 00 265000 MOVE ' 24' TO H-PSF-CBSA. 00 264500 00 264600 IF H-PSF-CBSA = '22020' 00 264700 AND L-PSF-SPEC-PYMT-IND = 'Y' 00 264800 AND L-PSF-PROV-ST = '24' 00 264900 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 00 265000 MOVE ' 24' TO H-PSF-CBSA. 00 266300 00 266400 IF H-PSF-CBSA = '24220' 00 266500 AND L-PSF-PROV-ST = '24' 00 266600 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 00 266700 MOVE ' 24' TO H-PSF-CBSA. 00 267300 00 267400 IF H-PSF-CBSA = '25540' 00 267500 AND L-PSF-SPEC-PYMT-IND = 'Y' 00 267600 AND L-PSF-PROV-ST = '07' 00 267700 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 00 267800 MOVE ' 07' TO H-PSF-CBSA. 00 267900 00 268000 IF H-PSF-CBSA = '29100' 00 268200 AND L-PSF-PROV-ST = '52' 00 268300 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 00 268400 MOVE ' 52' TO H-PSF-CBSA. 00 267900 00 268000 IF H-PSF-CBSA = '30300' 00 268200 AND L-PSF-PROV-ST = '50' 00 268300 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 00 268400 MOVE ' 50' TO H-PSF-CBSA. 00 269700 00 269800 IF H-PSF-CBSA = '37620' 00 269900 AND L-PSF-PROV-ST = '36' 00 270000 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 00 270100 MOVE ' 36' TO H-PSF-CBSA. 00 270700 00 270800 IF H-PSF-CBSA = '48260' 00 270900 AND L-PSF-PROV-ST = '36' 00 271000 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 00 271100 MOVE ' 36' TO H-PSF-CBSA. 00 271700 00 271800 IF H-PSF-CBSA = '48540' 00 271900 AND L-PSF-PROV-ST = '36' 00 272000 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 00 272100 MOVE ' 36' TO H-PSF-CBSA. 00 273200 00 273300 IF H-PSF-CBSA = '48864' 00 273400 AND L-PSF-PROV-ST = '31' 00 273500 MOVE 'N' TO L-PSF-SPEC-PYMT-IND 00 273600 MOVE ' 31' TO H-PSF-CBSA. 00 273700 00 273800 IF H-PSF-CBSA = '48864' 00 273900 AND L-PSF-SPEC-PYMT-IND = 'Y' 00 274000 AND L-PSF-PROV-ST = '31' 00 274100 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 00 274200 MOVE ' 31' TO H-PSF-CBSA. 00 274300 00 274300 IF H-PSF-CBSA = '39900' 00 274300 AND L-PSF-SPEC-PYMT-IND = 'Y' 00 274300 AND L-PSF-PROV-ST = '05' 00 274300 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 00 274300 MOVE ' 05' TO H-PSF-CBSA. 00 274300 00 274400 3120-FLOOR-2005-EXIT. 02 274500 EXIT. 02 309400 00 309500 3120-SEC401-2005. 02 309600************************************************************* 00 309700**** FOR CY 2005 SECTION 401 HOSPITALS * 02 309800************************************************************* 00 310900 00 309900 IF (L-PSF-PROV-OSCAR = '050192' OR 00 310000 '050469' OR 00 310100 '050528' OR 00 310200 '050618' OR 00 310000 '050286' OR 00 310100 '050446' OR 00 310200 '051301') 00 310300 MOVE ' 05' TO H-PSF-CBSA. 02 310500 00 310600 IF (L-PSF-PROV-OSCAR = '070004') 00 310700 MOVE ' 07' TO H-PSF-CBSA. 02 310900 00 311000 IF (L-PSF-PROV-OSCAR = '100048' OR 00 '100118') 311100 MOVE ' 10' TO H-PSF-CBSA. 02 311300 00 311400 IF (L-PSF-PROV-OSCAR = '170137') 00 311500 MOVE ' 17' TO H-PSF-CBSA. 02 311700 00 311800 IF (L-PSF-PROV-OSCAR = '190048' OR 00 311800 '190110') 00 311900 MOVE ' 19' TO H-PSF-CBSA. 02 312100 00 312200 IF (L-PSF-PROV-OSCAR = '230078') 00 312300 MOVE ' 23' TO H-PSF-CBSA. 02 312500 00 312600 IF (L-PSF-PROV-OSCAR = '260006') 00 312700 MOVE ' 26' TO H-PSF-CBSA. 02 311700 00 311800 IF (L-PSF-PROV-OSCAR = '290038' OR 00 311800 '291301') 00 311900 MOVE ' 29' TO H-PSF-CBSA. 02 313300 00 313400 IF (L-PSF-PROV-OSCAR = '300009') 00 313500 MOVE ' 30' TO H-PSF-CBSA. 02 313700 00 313800 IF (L-PSF-PROV-OSCAR = '380084') 00 313900 MOVE ' 38' TO H-PSF-CBSA. 02 314100 00 314200 IF (L-PSF-PROV-OSCAR = '390106' OR 00 314200 '390181') 00 314300 MOVE ' 39' TO H-PSF-CBSA. 00 314500 00 314600 3120-SEC401-2005-EXIT. 02 314610 EXIT. 02 314500 00 314600 3120-SEC401-2005-APR. 02 309600************************************************************* 00 309700**** FOR CY 2005 SECTION 401 HOSPITALS -EFF. 04/01/2005 * 02 309800************************************************************* 00 310500 00 310600 IF (L-PSF-PROV-OSCAR = '030007') 00 310700 MOVE ' 03' TO H-PSF-CBSA. 02 310500 00 310600 IF (L-PSF-PROV-OSCAR = '040075') 00 310700 MOVE ' 04' TO H-PSF-CBSA. 02 310900 00 309900 IF (L-PSF-PROV-OSCAR = '050192' OR 00 310000 '050469' OR 00 310100 '050528' OR 00 310200 '050618') 00 310300 MOVE ' 05' TO H-PSF-CBSA. 02 310500 00 310600 IF (L-PSF-PROV-OSCAR = '070004') 00 310700 MOVE ' 07' TO H-PSF-CBSA. 02 310900 00 311000 IF (L-PSF-PROV-OSCAR = '100048' OR 00 '100134') 311100 MOVE ' 10' TO H-PSF-CBSA. 02 310500 00 310600 IF (L-PSF-PROV-OSCAR = '130018') 00 310700 MOVE ' 13' TO H-PSF-CBSA. 02 310500 00 310600 IF (L-PSF-PROV-OSCAR = '140167') 00 310700 MOVE ' 14' TO H-PSF-CBSA. 02 310900 00 311000 IF (L-PSF-PROV-OSCAR = '150051' OR 00 '150078') 311100 MOVE ' 15' TO H-PSF-CBSA. 02 311300 00 311400 IF (L-PSF-PROV-OSCAR = '170137') 00 311500 MOVE ' 17' TO H-PSF-CBSA. 02 311700 00 311800 IF (L-PSF-PROV-OSCAR = '190048') 00 311900 MOVE ' 19' TO H-PSF-CBSA. 02 312100 00 312200 IF (L-PSF-PROV-OSCAR = '230078') 00 312300 MOVE ' 23' TO H-PSF-CBSA. 02 312100 00 312200 IF (L-PSF-PROV-OSCAR = '240037') 00 312300 MOVE ' 24' TO H-PSF-CBSA. 02 312500 00 312600 IF (L-PSF-PROV-OSCAR = '260006' OR 00 '260122') 312700 MOVE ' 26' TO H-PSF-CBSA. 02 313300 00 313400 IF (L-PSF-PROV-OSCAR = '300009') 00 313500 MOVE ' 30' TO H-PSF-CBSA. 02 313300 00 313400 IF (L-PSF-PROV-OSCAR = '370054') 00 313500 MOVE ' 37' TO H-PSF-CBSA. 02 313700 00 313800 IF (L-PSF-PROV-OSCAR = '380040' OR 00 '380084') 313900 MOVE ' 38' TO H-PSF-CBSA. 02 314100 00 314200 IF (L-PSF-PROV-OSCAR = '390181' OR 00 314200 '390183' OR 00 314200 '390201') 00 314300 MOVE ' 39' TO H-PSF-CBSA. 00 313300 00 313400 IF (L-PSF-PROV-OSCAR = '450052' OR 00 '450078' OR '450243' OR '450276' OR '450348') 313500 MOVE ' 45' TO H-PSF-CBSA. 02 314100 00 314200 IF (L-PSF-PROV-OSCAR = '500023' OR 00 314200 '500037' OR 00 314200 '500122' OR 00 314200 '500147' OR 00 314200 '500148') 00 314300 MOVE ' 50' TO H-PSF-CBSA. 00 314500 00 314600 3120-SEC401-2005-APR-EXIT. 02 314610 EXIT. 02 314620 02 ************************************************************* * SET FLAG IF APC = 0033 * * - TERMINATE PROCESS IF 0033 LOCATED * * * ************************************************************* 3125-INIT. IF OPPS-APC (LN-SUB) = '0033' MOVE 'Y' TO APC33-FLAG MOVE 451 TO LN-SUB. 3125-INIT-EXIT. EXIT. *************************************************************** * 1. VERIFY THE SERVICE INDICATOR PASSED BY THE OCE * * - IF INVALID SET RETURN CODE TO '40' * * - DISCONTINUE LINE PROCESSING * * - IF VALID SET RETURN CODE TO '01' * * - CONTINUE LINE PROCESSING * * 2. PROCESS LINES AND LOAD WORK TABLE ACCORDING TO PRICE * * RANKING * * 3. CHECK OCE EDIT INDICATORS AND SET RETURN CODES IF * * INDICATORS ARE INVALID. * * - VALID RETURN CODES FOR EDIT INDICATORS * * - '41' - SERVICE INDICATOR INVALID FOR OPPS PRICER * * - '42' - APC = '00000' OR (PACKAGING FLAG = 1, 2,OR 4)* * - '43' - PAYMENT INDICATOR NOT = TO 1 OR 5 THRU 9 * * - '44' - SERVICE INDICATOR = 'H' BUT PAYMENT * * INDICATOR NOT = TO 6 * * - '45' - PACKAGING FLAG NOT = TO 0 OR 1 OR 2 * * - '46' - (LINE ITEM DENIAL/REJECT FLAG NOT = TO 0 * * OR LINE ITEM DENIAL/REJECT FLAG = TO 1 * * AND (APC NOT = 0033 OR 0034 OR 0322 OR * * 0323 OR 0324 OR 0325 OR 0373 OR 0374)) * * OR LINE ITEM ACTION FLAG NOT = TO 1 * * - '47' - LINE ITEM ACTION FLAG = 2 OR 3 * * - '48' - PAYMENT ADJUSTMENT FLAG NOT VALID * * - '49' - SITE OF SERVICE FLAG NOT = TO 0 * * - OR (APC 0033 IS NOT ON THE CLAIM * * AND SERVICE INDICATOR = 'P' * * OR APC = 0322-0325,0373,0374) * * 4. IF OCE INDICATORS ARE VALID, SEARCH APC TABLE * * - IF MISSING, DELETED OR INVALID APC * * - SET RETURN CODE TO '30' * * - DISCONTINUE LINE PROCESSING * *************************************************************** 3150-INIT. MOVE 01 TO A-RETURN-CODE (LN-SUB). *************************************************************** * OVER-RIDE SERVICE UNITS FOR APC 0339 - EFFECTIVE 04/01/2002 * * - CHANGE UNIT VALUE TO 1 * *************************************************************** IF OPPS-APC (LN-SUB) = '0339' MOVE 1 TO OPPS-SRVC-UNITS (LN-SUB). MOVE OPPS-SRVC-UNITS (LN-SUB) TO H-SRVC-UNITS. PERFORM 3250-CALC-DISCOUNT THRU 3250-CALC-DISCOUNT-EXIT. IF A-RETURN-CODE (LN-SUB) = 42 GO TO 3150-INIT-EXIT. *************************************************************** * EFFECTIVE AS OF 04-01-2002 * * - TOTAL DEVICE OFFSET * *************************************************************** IF OPPS-SRVC-IND (LN-SUB) = ' H' MOVE 'Y' TO C-FLAG COMPUTE H-TOT-HTD-UNITS = H-TOT-HTD-UNITS + H-SRVC-UNITS. PERFORM 3160-TOTAL-OFFSET THRU 3160-TOTAL-OFFSET-EXIT. SET W-LP-INDX TO LN-SUB. SET W-BD-INDX TO LN-SUB. INITIALIZE W-LP-ENTRY (W-LP-INDX). INITIALIZE W-BD-ENTRY (W-BD-INDX). MOVE ZERO TO A-LITEM-PYMT (LN-SUB) A-LITEM-REIM (LN-SUB) A-ADJ-COIN (LN-SUB) A-RED-COIN (LN-SUB) A-TOTAL-LN-DEDUCT (LN-SUB) A-BLOOD-LN-DEDUCT (LN-SUB). IF NOT (OPPS-SRVC-IND (LN-SUB) = ' A' OR ' B' OR ' C' OR ' E' OR ' F' OR ' G' OR ' H' OR ' J' OR ' K' OR ' L' OR ' N' OR ' P' OR ' S' OR ' T' OR ' V' OR ' X' OR ' W' OR ' Y' OR ' Z' OR ' M') THEN MOVE 40 TO A-RETURN-CODE (LN-SUB) GO TO 3150-INIT-EXIT ELSE MOVE 01 TO A-RETURN-CODE (LN-SUB). IF OPPS-SRVC-IND (LN-SUB) = ' A' OR ' B' OR ' C' OR ' E' OR ' F' OR ' L' OR ' W' OR ' Y' OR ' Z' OR ' M' MOVE 41 TO A-RETURN-CODE (LN-SUB) GO TO 3150-INIT-EXIT. IF OPPS-PYMT-IND (LN-SUB) = ' 1' OR ' 5' OR ' 6' OR ' 7' OR ' 8' OR ' 9' IF OPPS-PKG-FLAG (LN-SUB) = '0' OR '1' OR '2' OR '3' OR '4' IF (OPPS-LITEM-DR-FLAG (LN-SUB) = '0' OR OPPS-LITEM-DR-FLAG (LN-SUB) = '1' AND (OPPS-APC (LN-SUB) = '0033' OR '0034' OR '0322' OR '0323' OR '0324' OR '0325' OR '0373' OR '0374')) OR (OPPS-LITEM-ACT-FLAG (LN-SUB) = '1') IF NOT (OPPS-LITEM-ACT-FLAG (LN-SUB) EQUAL '2' OR '3') IF OPPS-PYMT-ADJ-FLAG (LN-SUB) = ' 0' OR ' 1' OR ' 2' OR ' 3' OR ' 4' IF (OPPS-SITE-SRVC-FLAG (LN-SUB) = '0') OR ((APC33-FLAG = 'Y') AND ((OPPS-SRVC-IND (LN-SUB) = ' P') OR (OPPS-APC (LN-SUB) = '0322' OR '0323' OR '0324' OR '0325' OR '0373' OR '0374'))) MOVE OPPS-SUB-CHRG (LN-SUB) TO H-SUB-CHRG COMPUTE H-TOT-CHRG = H-TOT-CHRG + H-SUB-CHRG IF OPPS-LITEM-ACT-FLAG (LN-SUB) = '4' COMPUTE H-TOT-CHRG = H-TOT-CHRG - H-SUB-CHRG END-IF IF (OPPS-PKG-FLAG (LN-SUB) = '1' OR '2' OR '4') COMPUTE H-TOT-N-CHRG = H-SUB-CHRG + H-TOT-N-CHRG MOVE 'Y' TO N-FLAG END-IF IF (OPPS-APC (LN-SUB) = '0000') OR (OPPS-PKG-FLAG (LN-SUB) = '1' OR '2' OR '4') MOVE 42 TO A-RETURN-CODE (LN-SUB) GO TO 3150-INIT-EXIT END-IF SEARCH ALL WAA-ENTRY AT END MOVE 30 TO A-RETURN-CODE (LN-SUB) GO TO 3150-INIT-EXIT WHEN WAA-APC (WAA-INDX) = OPPS-GRP (LN-SUB) MOVE WAA-PTR (WAA-INDX) TO W-SUB2 PERFORM 3175-APC-LOOKUP ELSE MOVE 49 TO A-RETURN-CODE (LN-SUB) GO TO 3150-INIT-EXIT ELSE MOVE 48 TO A-RETURN-CODE (LN-SUB) GO TO 3150-INIT-EXIT ELSE MOVE 47 TO A-RETURN-CODE (LN-SUB) GO TO 3150-INIT-EXIT ELSE MOVE 46 TO A-RETURN-CODE (LN-SUB) GO TO 3150-INIT-EXIT ELSE MOVE 45 TO A-RETURN-CODE (LN-SUB) GO TO 3150-INIT-EXIT ELSE MOVE 43 TO A-RETURN-CODE (LN-SUB) GO TO 3150-INIT-EXIT. IF A-RETURN-CODE (LN-SUB) = 01 PERFORM 3300-COIN-DEDUCT THRU 3300-COIN-DEDUCT-EXIT. IF A-RETURN-CODE (LN-SUB) = 01 SET WNBD-INDX TO 1 SEARCH WNBD-ENTRY VARYING WNBD-INDX AT END GO TO 3150-INIT-EXIT WHEN W-NEW-BLOOD-HCPCS (WNBD-INDX) = OPPS-HCPCS (LN-SUB) MOVE W-NEW-BLOOD-RANK (WNBD-INDX) TO H-BLOOD-RANK PERFORM 3375-BLOOD-DEDUCT THRU 3375-BLOOD-DEDUCT-EXIT. 3150-INIT-EXIT. EXIT. *************************************************************** * COMPUTE TOTAL OFFSET FROM TABLE 5 FOR DEVICES * * - EFFECTIVE AS OF 01-01-2003 * * - CONTINUE FOR 01-01-2004 * * - CONTINUE FOR 01-01-2005 * * - SEARCH TABLE OPPSOF04 * * - WHERE ALL OFFSET VALUES EQUAL ZERO * *************************************************************** 3160-TOTAL-OFFSET. MOVE OPPS-GRP (LN-SUB) TO W-OFF-APC. SEARCH ALL WOO-ENTRY3 AT END GO TO 3160-TOTAL-OFFSET-EXIT WHEN WOO-APC3 (WOO-INDX3) = W-OFF-APC COMPUTE H-TOTAL-OFFSET = H-TOTAL-OFFSET + (WOO-OFFSET3 (WOO-INDX3) * H-DISC-RATE * H-SRVC-UNITS) COMPUTE H-TOT-OFF-UNITS = H-TOT-OFF-UNITS + H-SRVC-UNITS. 3160-TOTAL-OFFSET-EXIT. EXIT. *************************************************************** * SEARCH APC TABLE - MOVE VALUES TO HOLD AREA FOR PROCESSING * * - ADJUST TOTAL CHARGE FOR DELETED APC'S * *************************************************************** 3175-APC-LOOKUP. IF WAR-DTCD (W-SUB2) NOT > WAD-DTCD (WAD-SUB) IF WAR-RATEX (W-SUB2) = 'DELETED' MOVE 30 TO A-RETURN-CODE (LN-SUB) COMPUTE H-TOT-CHRG = H-TOT-CHRG - H-SUB-CHRG ELSE MOVE WAR-RATE (W-SUB2) TO H-APC-PYMT MOVE WAR-RANK (W-SUB2) TO H-RANK MOVE WAR-MINC (W-SUB2) TO H-MIN-COIN MOVE WAR-COIN (W-SUB2) TO H-NAT-COIN MOVE WAR-PPCT (W-SUB2) TO H-PPCT ELSE SUBTRACT 1 FROM W-SUB2 IF W-SUB2 > WAA-PTR (WAA-INDX - 1) GO TO 3175-APC-LOOKUP ELSE MOVE 0 TO H-APC-PYMT H-RANK H-MIN-COIN H-NAT-COIN H-PPCT. 3175-APC-LOOKUP-EXIT. EXIT. *************************************************************** * IF DATE OF SERVICE BETWEEN 12/31/2002 AND 04/01/2003 * * IF HCPCS CODE = C9114 OR C9115 ADJUST PAYMENT AND * * COINSURANCE AMOUNTS - LOGIC REMOVED FOR 20050101 * *************************************************************** *************************************************************** * SEARCH WAGE INDEX TABLE AND SELECT THE WAGE INDEX * * WHEN EQUAL TO PROVIDER SPECIFIC WAGE INDEX * * IF WAGE INDEX NOT LOCATED * * - SET CLAIM RETURN CODE TO '50' * * - DISCONTINUE CLAIM PROCESSING * * IF WAGE INDEX EQUALS ZERO * * - SET CLAIM RETURN CODE TO '51' * * - DISCONTINUE CLAIM PROCESSING * *************************************************************** 3200-CALC-WAGEINDX. MOVE WCD-MAX TO WCD-SUB. PERFORM UNTIL L-SERVICE-FROM-DATE NOT < WCD-DATE (WCD-SUB) SUBTRACT 1 FROM WCD-SUB END-PERFORM. SEARCH ALL WCM-ENTRY AT END MOVE 50 TO A-CLM-RTN-CODE GO TO 3200-CALC-WAGEINDX-EXIT WHEN WCM-CBSA (WCM-INDX) = H-PSF-CBSA MOVE WCM-PTR (WCM-INDX) TO W-SUB3 PERFORM 3210-WAGE-LOOKUP. IF H-WINX1 = 0 THEN MOVE 51 TO A-CLM-RTN-CODE. 3200-CALC-WAGEINDX-EXIT. EXIT. 3210-WAGE-LOOKUP. IF WCW-DTCD (W-SUB3) NOT > WCD-DTCD (WCD-SUB) IF L-PSF-SPEC-PYMT-IND = 'Y' MOVE WCW-WINX2 (W-SUB3) TO H-WINX1 ELSE MOVE WCW-WINX1 (W-SUB3) TO H-WINX1 ELSE SUBTRACT 1 FROM W-SUB3 IF W-SUB3 > WCM-PTR (WCM-INDX - 1) GO TO 3210-WAGE-LOOKUP ELSE MOVE 0 TO H-WINX1. 3210-WAGE-LOOKUP-EXIT. EXIT. *************************************************************** * CALCULATE DISCOUNT FACTOR BASED ON THE DISCOUNT * * INDICATOR PASSED BY THE OCE: VALUE 1 - 8 * * IF MISSING OR INVALID DISCOUNT FACTOR * * - SET RETURN CODE TO '38' * * - DISCONTINUE LINE PROCESSING * *************************************************************** 3250-CALC-DISCOUNT. IF (H-SRVC-UNITS = 0 AND OPPS-APC (LN-SUB) = '0000') MOVE 42 TO A-RETURN-CODE (LN-SUB) GO TO 3250-CALC-DISCOUNT-EXIT ELSE IF (H-SRVC-UNITS = 0 AND OPPS-APC (LN-SUB) > '0000') MOVE 1 TO H-SRVC-UNITS. IF OPPS-DISC-FACT (LN-SUB) = 1 THEN MOVE 1 TO H-DISC-RATE ELSE IF OPPS-DISC-FACT (LN-SUB) = 2 THEN COMPUTE H-DISC-RATE = (1 + DISC-FRACTION * (H-SRVC-UNITS - 1)) / H-SRVC-UNITS ELSE IF OPPS-DISC-FACT (LN-SUB) = 3 THEN COMPUTE H-DISC-RATE = TERM-PROC-DISC / H-SRVC-UNITS ELSE IF OPPS-DISC-FACT (LN-SUB) = 4 THEN COMPUTE H-DISC-RATE = (1 + DISC-FRACTION) / H-SRVC-UNITS ELSE IF OPPS-DISC-FACT (LN-SUB) = 5 THEN COMPUTE H-DISC-RATE = DISC-FRACTION ELSE IF OPPS-DISC-FACT (LN-SUB) = 6 THEN COMPUTE H-DISC-RATE = (TERM-PROC-DISC * DISC-FRACTION) / H-SRVC-UNITS ELSE IF OPPS-DISC-FACT (LN-SUB) = 7 THEN COMPUTE H-DISC-RATE = (DISC-FRACTION * (1 + DISC-FRACTION) / H-SRVC-UNITS) ELSE IF OPPS-DISC-FACT (LN-SUB) = 8 THEN MOVE 2 TO H-DISC-RATE ELSE MOVE 38 TO A-RETURN-CODE (LN-SUB). 3250-CALC-DISCOUNT-EXIT. EXIT. *************************************************************** * DETERMINE THE DEDUCTIBLE SEQUENCE. DEDUCTIBLE WILL BE * * TAKEN FROM OPPS SERVICES FIRST, THEN FROM ANY OTHER * * TYPES OF SERVICES FROM THE CLAIM. * * - SET POINTERS TO THE HIGHEST RANKED PERCENTAGE * * (LARGEST NATIONAL UNADJUSTED COINSURANCE / * * THE APC PAYMENT) * * - MOVE ALL PRICING VARIABLES TO STAGING AREA * *************************************************************** 3300-COIN-DEDUCT. ADD 1 TO W-LNC-MAX. SET W-LP-INDX TO W-LNC-MAX. PERFORM 3350-STAGE-ENTRY THRU 3350-STAGE-ENTRY-EXIT UNTIL W-LP-INDX = 1 OR H-RANK NOT < W-RANK (W-LP-INDX - 1). MOVE LN-SUB TO W-LP-SUB (W-LP-INDX). MOVE H-NAT-COIN TO W-NAT-COIN (W-LP-INDX). MOVE H-MIN-COIN TO W-MIN-COIN (W-LP-INDX). MOVE H-SUB-CHRG TO W-SUB-CHRG (W-LP-INDX). MOVE H-APC-PYMT TO W-APC-PYMT (W-LP-INDX). MOVE H-WINX1 TO W-WINX1 (W-LP-INDX). MOVE H-RANK TO W-RANK (W-LP-INDX). MOVE H-PPCT TO W-PPCT (W-LP-INDX). MOVE H-DISC-RATE TO W-DISC-RATE (W-LP-INDX). IF OPPS-SRVC-IND (LN-SUB) = ' P' THEN MOVE 1 TO W-SRVC-UNITS (W-LP-INDX) ELSE MOVE H-SRVC-UNITS TO W-SRVC-UNITS (W-LP-INDX). MOVE 0 TO W-RED-COIN (W-LP-INDX). PERFORM VARYING PS-SUB FROM 1 BY 1 UNTIL PS-SUB > L-PSF-APC-LINE-CNT IF L-PSF-APC (PS-SUB) = OPPS-APC (LN-SUB) COMPUTE W-RED-COIN (W-LP-INDX) ROUNDED = L-PSF-RED-COIN (PS-SUB) * H-SRVC-UNITS * H-DISC-RATE MOVE 25 TO A-RETURN-CODE (LN-SUB) MOVE L-PSF-APC-LINE-CNT TO PS-SUB END-IF END-PERFORM. 3300-COIN-DEDUCT-EXIT. EXIT. 3350-STAGE-ENTRY. MOVE W-LP-ENTRY (W-LP-INDX - 1) TO W-LP-ENTRY (W-LP-INDX). SET W-LP-INDX DOWN BY 1. 3350-STAGE-ENTRY-EXIT. EXIT. *************************************************************** * DETERMINE THE BLOOD DEDUCTIBLE SEQUENCE. DEDUCTIBLE * * WILL BE CALCULATED BASED ON RANKING. * * - SET POINTERS TO THE HIGHEST RANKED APC * * (SMALLEST UNADJUSTED APC PAYMENT) * * - MOVE ALL PRICING VARIABLES TO STAGING AREA * *************************************************************** 3375-BLOOD-DEDUCT. ADD 1 TO W-BLD-MAX. SET W-BD-INDX TO W-BLD-MAX. PERFORM 3385-STAGE-ENTRY THRU 3385-STAGE-ENTRY-EXIT UNTIL W-BD-INDX = 1 OR H-BLOOD-RANK NOT < W-BD-RANK (W-BD-INDX - 1). MOVE LN-SUB TO W-BD-SUB (W-BD-INDX). MOVE H-NAT-COIN TO W-BD-NAT-COIN (W-BD-INDX). MOVE H-MIN-COIN TO W-BD-MIN-COIN (W-BD-INDX). MOVE H-SUB-CHRG TO W-BD-SUB-CHRG (W-BD-INDX). MOVE H-APC-PYMT TO W-BD-APC-PYMT (W-BD-INDX). MOVE H-WINX1 TO W-BD-WINX1 (W-BD-INDX). MOVE H-BLOOD-RANK TO W-BD-RANK (W-BD-INDX). MOVE H-PPCT TO W-BD-PPCT (W-BD-INDX). MOVE H-DISC-RATE TO W-BD-DISC-RATE (W-BD-INDX). MOVE H-SRVC-UNITS TO W-BD-SRVC-UNITS (W-BD-INDX). MOVE 0 TO W-BD-RED-COIN (W-BD-INDX). PERFORM VARYING PS-SUB FROM 1 BY 1 UNTIL PS-SUB > L-PSF-APC-LINE-CNT IF L-PSF-APC (PS-SUB) = OPPS-APC (LN-SUB) COMPUTE W-BD-RED-COIN (W-BD-INDX) ROUNDED = L-PSF-RED-COIN (PS-SUB) * H-SRVC-UNITS * H-DISC-RATE MOVE 25 TO A-RETURN-CODE (LN-SUB) MOVE L-PSF-APC-LINE-CNT TO PS-SUB END-IF END-PERFORM. 3375-BLOOD-DEDUCT-EXIT. EXIT. 3385-STAGE-ENTRY. MOVE W-BD-ENTRY (W-BD-INDX - 1) TO W-BD-ENTRY (W-BD-INDX). SET W-BD-INDX DOWN BY 1. 3385-STAGE-ENTRY-EXIT. EXIT. *************************************************************** * FIRST STEP IN DETERMINING A LINE ITEM PRICE. * * CHECK ALL APPROPRIATE FLAGS AND INDICATORS PASSED * * BY THE OCE. * * - SET RETURN CODES TO INDICATE ERRORS OR STATUS * * - '20' - LINE PROCESSED BUT PAYMENT = 0 * * - BENE DEDUCTIBLE => ADJUSTED PAYMENT * * * *************************************************************** 3400-CALCULATE. MOVE W-LP-SUB (W-LP-INDX) TO LN-SUB. IF A-RETURN-CODE (LN-SUB) > 25 GO TO 3400-CALCULATE-EXIT. IF OPPS-PYMT-IND (LN-SUB) = ' 1' OR ' 5' OR ' 6' OR ' 7' OR ' 8' PERFORM 3550-CALC-STANDARD THRU 3550-CALC-STANDARD-EXIT ELSE GO TO 3400-CALCULATE-EXIT. *************************************************************** * SET GJK FLAG * * - TEST LINE ITEM DATE OF SERVICE > 20010630 * * - TOTAL DRUG / DEVICE COINSURANCE * *************************************************************** IF (A-RETURN-CODE (LN-SUB) < 30) PERFORM 3450-ADJ-PROC-COIN THRU 3450-ADJ-PROC-COIN-EXIT ELSE NEXT SENTENCE. *************************************************************** * SET ST0 AND STVX FLAGS * * - TEST LINE ITEM DATE OF SERVICE > 20020331 * * - TOTAL PROCEDURE CHARGES AND BUNDLED CHARGES * *************************************************************** PERFORM 3500-ADJ-CHRGS THRU 3500-ADJ-CHRGS-EXIT. IF A-RETURN-CODE (LN-SUB) < 30 COMPUTE A-TOTAL-CLM-DEDUCT = H-TOTAL-LN-DEDUCT + A-TOTAL-CLM-DEDUCT COMPUTE H-TOT-PYMT = H-TOT-PYMT + H-LITEM-PYMT COMPUTE A-BLOOD-DEDUCT-DUE = A-BLOOD-DEDUCT-DUE + H-LN-BLOOD-DEDUCT MOVE H-LITEM-PYMT TO A-LITEM-PYMT (LN-SUB) MOVE H-LITEM-REIM TO A-LITEM-REIM (LN-SUB) MOVE H-TOTAL-LN-DEDUCT TO A-TOTAL-LN-DEDUCT (LN-SUB) MOVE H-LN-BLOOD-DEDUCT TO A-BLOOD-LN-DEDUCT (LN-SUB) MOVE H-NAT-COIN TO A-ADJ-COIN (LN-SUB) MOVE H-RED-COIN TO A-RED-COIN (LN-SUB) IF H-RED-COIN > H-NAT-COIN MOVE H-NAT-COIN TO A-RED-COIN (LN-SUB) END-IF IF OPPS-LITEM-ACT-FLAG (LN-SUB) = '4' MOVE 0 TO A-LITEM-PYMT (LN-SUB) MOVE 0 TO A-LITEM-REIM (LN-SUB) COMPUTE H-TOT-PYMT = H-TOT-PYMT - H-LITEM-PYMT END-IF END-IF. MOVE ZERO TO LINE-HOLD-ITEMS. 3400-CALCULATE-EXIT. EXIT. *************************************************************** * SET GJK FLAG * * - STAGE BY SERVICE INDICATOR * * * *************************************************************** 3450-ADJ-PROC-COIN. MOVE OPPS-LITEM-DOS (LN-SUB) TO H-DCP-DOS. IF OPPS-SRVC-IND (LN-SUB) = ' S' OR ' T' OR ' V' COMPUTE H-NEW-WGNAT ROUNDED = W-NAT-COIN (W-LP-INDX) * (.6 * W-WINX1 (W-LP-INDX) + .4) IF H-NEW-WGNAT > H-IP-LIMIT MOVE H-IP-LIMIT TO H-NEW-WGNAT END-IF COMPUTE H-NEW-COIN = H-LITEM-PYMT - H-TOTAL-LN-DEDUCT - H-LITEM-REIM - H-LN-BLOOD-DEDUCT MOVE 1 TO H-DCP-CODE PERFORM 3455-SEARCH-KEY THRU 3455-SEARCH-KEY-EXIT ELSE IF OPPS-SRVC-IND (LN-SUB) = ' G' OR ' J' OR ' K' COMPUTE H-NEW-COIN = H-LITEM-PYMT - H-TOTAL-LN-DEDUCT - H-LITEM-REIM - H-LN-BLOOD-DEDUCT MOVE 'Y' TO GJK-FLAG MOVE 1 TO H-DCP-CODE PERFORM 3455-SEARCH-KEY THRU 3455-SEARCH-KEY-EXIT MOVE 2 TO H-DCP-CODE ADD 1 TO W-DCP-MAX SET W-DCP-INDX TO W-DCP-MAX PERFORM 3475-STAGE-DCP-ENTRY THRU 3475-STAGE-DCP-ENTRY-EXIT UNTIL W-DCP-INDX = 1 OR H-DCP-STAGE NOT < W-DCP-STAGE (W-DCP-INDX - 1) MOVE LN-SUB TO W-DCP-SUB (W-DCP-INDX) MOVE H-DCP-STAGE TO W-DCP-STAGE (W-DCP-INDX) MOVE ZERO TO W-DCP-COIN1 (W-DCP-INDX) MOVE ZERO TO W-DCP-WGNAT (W-DCP-INDX) MOVE H-NEW-COIN TO W-DCP-COIN2 (W-DCP-INDX) MOVE OPPS-SRVC-IND (LN-SUB) TO W-DCP-SRVC-IND (W-DCP-INDX). 3450-ADJ-PROC-COIN-EXIT. EXIT. 3455-SEARCH-KEY. SET W-DCP-INDX TO 1. SEARCH W-DCP-ENTRY VARYING W-DCP-INDX AT END PERFORM 3460-ADD-ENTRY THRU 3460-ADD-ENTRY-EXIT WHEN W-DCP-STAGE (W-DCP-INDX) = H-DCP-STAGE PERFORM 3465-UPDATE-ENTRY THRU 3465-UPDATE-ENTRY-EXIT. 3455-SEARCH-KEY-EXIT. EXIT. 3460-ADD-ENTRY. ADD 1 TO W-DCP-MAX. SET W-DCP-INDX TO W-DCP-MAX. PERFORM 3475-STAGE-DCP-ENTRY THRU 3475-STAGE-DCP-ENTRY-EXIT UNTIL W-DCP-INDX = 1 OR H-DCP-STAGE NOT < W-DCP-STAGE (W-DCP-INDX - 1). IF OPPS-SRVC-IND (LN-SUB) = ' G' OR ' J' OR ' K' MOVE ZERO TO W-DCP-SUB (W-DCP-INDX) MOVE H-DCP-STAGE TO W-DCP-STAGE (W-DCP-INDX) MOVE ZERO TO W-DCP-COIN1 (W-DCP-INDX) MOVE ZERO TO W-DCP-WGNAT (W-DCP-INDX) MOVE H-NEW-COIN TO W-DCP-COIN2 (W-DCP-INDX) MOVE ' X' TO W-DCP-SRVC-IND (W-DCP-INDX) ELSE MOVE LN-SUB TO W-DCP-SUB (W-DCP-INDX) MOVE H-DCP-STAGE TO W-DCP-STAGE (W-DCP-INDX) MOVE H-NEW-COIN TO W-DCP-COIN1 (W-DCP-INDX) MOVE H-NEW-WGNAT TO W-DCP-WGNAT (W-DCP-INDX) MOVE ZERO TO W-DCP-COIN2 (W-DCP-INDX) MOVE OPPS-SRVC-IND (LN-SUB) TO W-DCP-SRVC-IND (W-DCP-INDX). 3460-ADD-ENTRY-EXIT. EXIT. 3465-UPDATE-ENTRY. IF OPPS-SRVC-IND (LN-SUB) = ' G' OR ' J' OR ' K' ADD H-NEW-COIN TO W-DCP-COIN2 (W-DCP-INDX) ELSE IF W-DCP-SRVC-IND (W-DCP-INDX) = ' X' PERFORM 3485-REPLACE-TYPE1 THRU 3485-REPLACE-TYPE1-EXIT ELSE PERFORM 3480-RANK-COIN THRU 3480-RANK-COIN-EXIT. 3465-UPDATE-ENTRY-EXIT. EXIT. 3475-STAGE-DCP-ENTRY. MOVE W-DCP-ENTRY (W-DCP-INDX - 1) TO W-DCP-ENTRY (W-DCP-INDX). SET W-DCP-INDX DOWN BY 1. 3475-STAGE-DCP-ENTRY-EXIT. EXIT. 3480-RANK-COIN. IF H-NEW-WGNAT > W-DCP-WGNAT (W-DCP-INDX) MOVE LN-SUB TO W-DCP-SUB (W-DCP-INDX) MOVE H-NEW-COIN TO W-DCP-COIN1 (W-DCP-INDX) MOVE H-NEW-WGNAT TO W-DCP-WGNAT (W-DCP-INDX) MOVE OPPS-SRVC-IND (LN-SUB) TO W-DCP-SRVC-IND (W-DCP-INDX). 3480-RANK-COIN-EXIT. EXIT. 3485-REPLACE-TYPE1. MOVE LN-SUB TO W-DCP-SUB (W-DCP-INDX) MOVE H-NEW-COIN TO W-DCP-COIN1 (W-DCP-INDX) MOVE H-NEW-WGNAT TO W-DCP-WGNAT (W-DCP-INDX) MOVE OPPS-SRVC-IND (LN-SUB) TO W-DCP-SRVC-IND (W-DCP-INDX). 3485-REPLACE-TYPE1-EXIT. EXIT. 3500-ADJ-CHRGS. ***************************************************** ** NEW LOGIC INSERTED FOR WEB USE ONLY * ***************************************************** IF ((OPPS-SRVC-IND (LN-SUB) = ' T') OR ((OPPS-SRVC-IND (LN-SUB) = ' S') AND (OPPS-HCPCS (LN-SUB) > '09999' AND OPPS-HCPCS (LN-SUB) < '70000'))) AND (W-SUB-CHRG (W-LP-INDX) < 1.01) MOVE 'Y' TO ST0-FLAG. IF ((OPPS-SRVC-IND (LN-SUB) = ' T') OR ((OPPS-SRVC-IND (LN-SUB) = ' S') AND (OPPS-HCPCS (LN-SUB) > '09999' AND OPPS-HCPCS (LN-SUB) < '70000'))) AND (OPPS-PKG-FLAG (LN-SUB) = '0' OR '3') COMPUTE H-TOT-ST-CHRG = W-SUB-CHRG (W-LP-INDX) + H-TOT-ST-CHRG COMPUTE H-TOT-ST-PYMT = H-LITEM-PYMT + H-TOT-ST-PYMT. IF (OPPS-SRVC-IND (LN-SUB) = ' S' OR ' T' OR ' V' OR ' X' OR ' P') AND (OPPS-PKG-FLAG (LN-SUB) = '0' OR '3') COMPUTE H-TOT-STVX-PYMT = H-LITEM-PYMT + H-TOT-STVX-PYMT. 3500-ADJ-CHRGS-EXIT. EXIT. *************************************************************** * 1. APPLY DEDUCTIBLE TO HIGHEST NATIONAL COINSURANCE AMOUNT * * - DESCENDING UNTIL DEDUCTIBLE = 0. * * 2. CALCULATE THE STANDARD LINE PRICE * * (APC PAYMENT * WAGE INDEX * SERVICE UNITS * * * DISCOUNT FACTOR) * * - WAGE ADJUST 60% OF THE APC PAYMENT ONLY * * 3. ADD LINE PRICE TO OUTLIER HOLD AREA. * * * * 4. CALCULATE THE LINE PRICE FOR DESIGNATED DEVICES * * AND DRUGS * *************************************************************** 3550-CALC-STANDARD. COMPUTE H-MAX-COIN ROUNDED = (H-IP-LIMIT * W-SRVC-UNITS (W-LP-INDX) * W-DISC-RATE (W-LP-INDX)). IF OPPS-SRVC-IND (LN-SUB) = ' S' OR ' V' OR ' T' OR ' P' OR ' X' THEN COMPUTE H-LITEM-PYMT ROUNDED = (((W-APC-PYMT (W-LP-INDX) * .60) * W-WINX1 (W-LP-INDX)) + (W-APC-PYMT (W-LP-INDX) * .40)) * W-SRVC-UNITS (W-LP-INDX) * W-DISC-RATE (W-LP-INDX) PERFORM 3560-CALC-BENE-DEDUCT THRU 3560-CALC-BENE-DEDUCT-EXIT ELSE IF OPPS-SRVC-IND (LN-SUB) = ' H' THEN IF OPPS-PYMT-IND (LN-SUB) = ' 6' THEN PERFORM 3555-CALC-H-STANDARD THRU 3555-CALC-H-STANDARD-EXIT PERFORM 3560-CALC-BENE-DEDUCT THRU 3560-CALC-BENE-DEDUCT-EXIT ELSE MOVE 44 TO A-RETURN-CODE (LN-SUB) GO TO 3550-CALC-STANDARD-EXIT END-IF ELSE IF OPPS-SRVC-IND (LN-SUB) = ' G' OR ' J' OR ' K' THEN IF OPPS-PYMT-IND (LN-SUB) = ' 1' OR ' 5' OR ' 7' THEN MOVE 0 TO H-BLOOD-FRACTION PERFORM 3550-CALC-GJK THRU 3550-CALC-GJK-EXIT PERFORM 3560-CALC-BENE-DEDUCT THRU 3560-CALC-BENE-DEDUCT-EXIT ELSE MOVE 41 TO A-RETURN-CODE (LN-SUB) GO TO 3550-CALC-STANDARD-EXIT END-IF END-IF. IF H-LITEM-PYMT > 0 IF OPPS-APC (LN-SUB) = ('1716' OR '1717' OR '1718' OR '1719' OR '1720' OR '2616' OR '2632' OR '2633' OR '2634' OR '2635' OR '2636') COMPUTE H-LITEM-REIM ROUNDED = ((H-LITEM-PYMT - H-TOTAL-LN-DEDUCT) - H-LN-BLOOD-DEDUCT) * .8 COMPUTE H-NAT-COIN = H-LITEM-PYMT - H-TOTAL-LN-DEDUCT - H-LITEM-REIM - H-LN-BLOOD-DEDUCT MOVE W-MIN-COIN (W-LP-INDX) TO H-MIN-COIN ELSE COMPUTE H-LITEM-REIM ROUNDED = ((H-LITEM-PYMT - H-TOTAL-LN-DEDUCT) - H-LN-BLOOD-DEDUCT) * W-PPCT (W-LP-INDX) COMPUTE H-NAT-COIN = H-LITEM-PYMT - H-TOTAL-LN-DEDUCT - H-LITEM-REIM - H-LN-BLOOD-DEDUCT MOVE W-MIN-COIN (W-LP-INDX) TO H-MIN-COIN ELSE NEXT SENTENCE. IF H-MIN-COIN > 0 IF OPPS-SRVC-IND (LN-SUB) = ' G' OR ' H' OR ' J' OR ' K' COMPUTE H-MIN-COIN ROUNDED = H-MIN-COIN * (W-SRVC-UNITS (W-LP-INDX) - (W-SRVC-UNITS (W-LP-INDX) * H-BLOOD-FRACTION)) * W-DISC-RATE (W-LP-INDX) ELSE IF OPPS-APC (LN-SUB) = '0158' OR '0159' COMPUTE H-MIN-COIN ROUNDED = H-LITEM-PYMT * .25 ELSE COMPUTE H-MIN-COIN ROUNDED = H-LITEM-PYMT * .2 END-IF END-IF END-IF. MOVE W-RED-COIN (W-LP-INDX) TO H-RED-COIN. IF (H-RED-COIN > 0 AND < H-MIN-COIN) MOVE H-MIN-COIN TO H-RED-COIN ELSE IF H-RED-COIN < H-NAT-COIN AND > H-MIN-COIN AND > H-MAX-COIN COMPUTE H-LITEM-REIM = H-LITEM-REIM + (H-RED-COIN - H-MAX-COIN) END-IF END-IF. IF H-NAT-COIN > H-MAX-COIN AND H-RED-COIN = 0 THEN COMPUTE H-LITEM-REIM = H-LITEM-REIM + (H-NAT-COIN - H-MAX-COIN) MOVE H-MAX-COIN TO H-NAT-COIN. 3550-CALC-STANDARD-EXIT. EXIT. *************************************************************** * 1. CALCULATE LINE ITEM PAYMENT FOR SERVICE INDICATOR * * TYPES G , J , OR K. * * 2. EFFECTIVE 01/01/2003 REMOVE PRO RATA REDUCTION FOR * * ALL SERVICE INDICATOR 'G' PAYMENTS * *************************************************************** 3550-CALC-GJK. IF OPPS-HCPCS (LN-SUB) = 'P9010' OR 'P9016' OR 'P9021' OR 'P9022' OR 'P9038' OR 'P9039' OR 'P9040' OR 'P9051' OR 'P9054' OR 'P9056' OR 'P9057' OR 'P9058' PERFORM 3550-SET-BLOOD-FRACTION THRU 3550-SET-BLOOD-FRACTION-EXIT ELSE COMPUTE H-LITEM-PYMT ROUNDED = W-APC-PYMT (W-LP-INDX) * W-SRVC-UNITS (W-LP-INDX) * W-DISC-RATE (W-LP-INDX) GO TO 3550-CALC-GJK-EXIT. COMPUTE H-LITEM-PYMT ROUNDED = W-BD-APC-PYMT (W-BD-INDX) * W-BD-SRVC-UNITS (W-BD-INDX) * W-BD-DISC-RATE (W-BD-INDX). COMPUTE H-LN-BLOOD-DEDUCT ROUNDED = H-LITEM-PYMT * H-BLOOD-FRACTION. SET W-BD-INDX UP BY 1. 3550-CALC-GJK-EXIT. EXIT. 3550-SET-BLOOD-FRACTION. MOVE W-BD-SUB (W-BD-INDX) TO LN-SUB. IF H-BENE-PINTS-USED > 0 IF W-BD-SRVC-UNITS (W-BD-INDX) <= H-BENE-PINTS-USED MOVE 1 TO H-BLOOD-FRACTION COMPUTE H-BENE-PINTS-USED = H-BENE-PINTS-USED - W-BD-SRVC-UNITS (W-BD-INDX) ELSE IF W-BD-SRVC-UNITS (W-BD-INDX) > H-BENE-PINTS-USED COMPUTE H-BLOOD-FRACTION = H-BENE-PINTS-USED / W-BD-SRVC-UNITS (W-BD-INDX) MOVE 0 TO H-BENE-PINTS-USED ELSE MOVE 0 TO H-BLOOD-FRACTION ELSE MOVE 0 TO H-BLOOD-FRACTION. 3550-SET-BLOOD-FRACTION-EXIT. EXIT. *************************************************************** * 1. CALCULATE LINE ITEM PAYMENT FOR SERVICE INDICATOR * * TYPE H. * * 2. EFFECTIVE 04/01/2002 A PRO RATA REDUCTION APPLIES TO * * ALL SERVICE INDICATOR 'H' PAYMENTS (CURRENTLY .689) * *************************************************************** 3555-CALC-H-TOT. MOVE W-LP-SUB (W-LP-INDX) TO LN-SUB. MOVE OPPS-SUB-CHRG (LN-SUB) TO H-SUB-CHRG. IF OPPS-SRVC-IND (LN-SUB) = ' H' IF OPPS-PYMT-IND (LN-SUB) = ' 6' COMPUTE H-TOT-H-CHRG = (H-TOT-H-CHRG + H-SUB-CHRG) ELSE NEXT SENTENCE ELSE NEXT SENTENCE. 3555-CALC-H-TOT-EXIT. EXIT. 3555-CALC-H-STANDARD. MOVE OPPS-SUB-CHRG (LN-SUB) TO H-SUB-CHRG. COMPUTE T-LITEM-PYMT ROUNDED = (H-SUB-CHRG * L-PSF-OPCOST-RATIO). IF (C-FLAG = 'Y') IF (H-TOT-OFF-UNITS > H-TOT-HTD-UNITS) COMPUTE H-TOTAL-WAOFF ROUNDED = (((H-TOTAL-OFFSET * .60) * A-WINX) + (H-TOTAL-OFFSET * .40)) * (H-TOT-HTD-UNITS / H-TOT-OFF-UNITS) PERFORM 3700-CALC-H-OFFSET THRU 3700-CALC-H-OFFSET-EXIT ELSE COMPUTE H-TOTAL-WAOFF ROUNDED = ((H-TOTAL-OFFSET * .60) * A-WINX) + (H-TOTAL-OFFSET * .40) PERFORM 3700-CALC-H-OFFSET THRU 3700-CALC-H-OFFSET-EXIT ELSE NEXT SENTENCE. IF T-LITEM-PYMT < 0 THEN MOVE 0 TO H-LITEM-PYMT ELSE MOVE T-LITEM-PYMT TO H-LITEM-PYMT. 3555-CALC-H-STANDARD-EXIT. EXIT. 3560-CALC-BENE-DEDUCT. IF OPPS-PYMT-ADJ-FLAG (LN-SUB) = ' 4' GO TO 3560-CALC-BENE-DEDUCT-EXIT. IF H-BENE-DEDUCT > 0 THEN COMPUTE H-LN-BLD-PYMT = H-LITEM-PYMT - H-LN-BLOOD-DEDUCT IF H-BENE-DEDUCT <= H-LN-BLD-PYMT THEN MOVE H-BENE-DEDUCT TO H-TOTAL-LN-DEDUCT MOVE 0 TO H-BENE-DEDUCT ELSE COMPUTE H-BENE-DEDUCT = H-BENE-DEDUCT - H-LN-BLD-PYMT MOVE H-LN-BLD-PYMT TO H-TOTAL-LN-DEDUCT MOVE 20 TO A-RETURN-CODE (LN-SUB) END-IF END-IF. 3560-CALC-BENE-DEDUCT-EXIT. EXIT. ********************************************************************* ** - NEW FOR JANUARY 2004 ** ** - CHECK >= 20040101 AND SRVC-IND = 'K' ** ** - DISCONTINUE OUTLIER PROCESS ** ********************************************************************* 3600-ADJ-CHRG-OUTL. MOVE W-LP-SUB (W-LP-INDX) TO LN-SUB. ********************************************************************* ** - NEW FOR JANUARY 2005 ** ** - TURN OFF OUTLIER PROCESS FOR SPECIFIED K TYPE APCS ** ** ** ********************************************************************* IF (OPPS-SRVC-IND (LN-SUB) = ' G' OR ' J' OR ' K' OR ' H' OR ' N') OR (OPPS-PKG-FLAG (LN-SUB) = '4') GO TO 3600-ADJ-CHRG-OUTL-EXIT. ***************************************************** ** NEW LOGIC INSERTED FOR WEB USE ONLY * ***************************************************** IF (ST0-FLAG = 'Y') AND ((OPPS-SRVC-IND (LN-SUB) = ' T' ) OR ((OPPS-SRVC-IND (LN-SUB) = ' S') AND (OPPS-HCPCS (LN-SUB) > '09999' AND OPPS-HCPCS (LN-SUB) < '70000'))) AND (H-TOT-ST-PYMT > 0) COMPUTE H-CHRG-RATE ROUNDED = (A-LITEM-PYMT (LN-SUB) / H-TOT-ST-PYMT) COMPUTE W-SUB-CHRG (W-LP-INDX) ROUNDED = (H-CHRG-RATE * H-TOT-ST-CHRG) ELSE IF (N-FLAG = 'Y' AND ST0-FLAG = 'N') AND ((OPPS-SRVC-IND (LN-SUB) = ' S' OR ' T' OR ' V' OR ' X' OR ' P') AND (OPPS-PKG-FLAG (LN-SUB) = '0' OR '3')) AND (H-TOT-STVX-PYMT > 0) COMPUTE H-CHRG-RATE ROUNDED = (A-LITEM-PYMT (LN-SUB) / H-TOT-STVX-PYMT) COMPUTE H-SUB-CHRG ROUNDED = (H-CHRG-RATE * H-TOT-N-CHRG) COMPUTE W-SUB-CHRG (W-LP-INDX) ROUNDED = W-SUB-CHRG (W-LP-INDX) + H-SUB-CHRG. IF (N-FLAG = 'Y' AND ST0-FLAG = 'Y') AND ((OPPS-SRVC-IND (LN-SUB) = ' S' OR ' T' OR ' V' OR ' X' OR ' P') AND (OPPS-PKG-FLAG (LN-SUB) = '0' OR '3')) AND (H-TOT-STVX-PYMT > 0) COMPUTE H-CHRG-RATE ROUNDED = (A-LITEM-PYMT (LN-SUB) / H-TOT-STVX-PYMT) COMPUTE H-SUB-CHRG ROUNDED = (H-CHRG-RATE * H-TOT-N-CHRG) COMPUTE W-SUB-CHRG (W-LP-INDX) ROUNDED = W-SUB-CHRG (W-LP-INDX) + H-SUB-CHRG. ********************************************************************* ** - NEW FOR JANUARY 2005 ** ** - PROVIDER RANGE FOR CMHC ** ** - COMPUTE H-LITEM-OUTL-PYMT USING NEW FORMULA ** ********************************************************************* MOVE 1.75 TO H-OUTLIER-FACTOR. MOVE .50 TO H-OUTLIER-PCT. COMPUTE H-COST ROUNDED = W-SUB-CHRG (W-LP-INDX) * L-PSF-OPCOST-RATIO. COMPUTE H-APC-ADJ-PYMT ROUNDED = H-OUTLIER-FACTOR * A-LITEM-PYMT (LN-SUB). IF (L-PSF-PROV-3456 >= '1400' AND L-PSF-PROV-3456 <= '1499') OR (L-PSF-PROV-3456 >= '4600' AND L-PSF-PROV-3456 <= '4799') OR (L-PSF-PROV-3456 >= '4900' AND L-PSF-PROV-3456 <= '4999') MOVE 3.5 TO H-OUTLIER-FACTOR COMPUTE H-LITEM-OUTL-PYMT ROUNDED = (H-COST - (H-OUTLIER-FACTOR * A-LITEM-PYMT (LN-SUB))) * H-OUTLIER-PCT ELSE IF (H-COST > H-APC-ADJ-PYMT) AND (H-COST > A-LITEM-PYMT (LN-SUB) + 1175) COMPUTE H-LITEM-OUTL-PYMT ROUNDED = (H-COST - H-APC-ADJ-PYMT) * H-OUTLIER-PCT ELSE MOVE ZERO TO H-LITEM-OUTL-PYMT. IF H-LITEM-OUTL-PYMT > 0 COMPUTE H-OUTLIER-PYMT = H-OUTLIER-PYMT + H-LITEM-OUTL-PYMT. IF OPPS-LITEM-ACT-FLAG (LN-SUB) = '4' COMPUTE H-OUTLIER-PYMT = H-OUTLIER-PYMT - H-LITEM-OUTL-PYMT MOVE 0 TO H-LITEM-OUTL-PYMT. 3600-ADJ-CHRG-OUTL-EXIT. EXIT. *************************************************************** * 1. RE-CALCULATE LINE ITEM PAYMENT FOR SERVICE INDICATOR * * TYPE H. * * 2. SUBTRACT WAGE ADJUSTED OFFSET AMOUNT FROM SI TYPE 'H' * * WITH HCPCS CODE BEGINNING WITH 'C' * * 2. EFFECTIVE 04/01/2002 * *************************************************************** 3700-CALC-H-OFFSET. IF H-TOT-H-CHRG > 0 COMPUTE H-OFF-RATE ROUNDED = H-SUB-CHRG / H-TOT-H-CHRG COMPUTE T-LITEM-PYMT ROUNDED = T-LITEM-PYMT - (H-TOTAL-WAOFF * H-OFF-RATE) ELSE NEXT SENTENCE. 3700-CALC-H-OFFSET-EXIT. EXIT. 3800-ADJ-STV-REIM. IF W-DCP-CODE (W-DCP-INDX) = 1 PERFORM 3810-PROCESS-TYPE1 THRU 3810-PROCESS-TYPE1-EXIT ELSE PERFORM 3840-PROCESS-TYPE2 THRU 3840-PROCESS-TYPE2-EXIT. 3800-ADJ-STV-REIM-EXIT. EXIT. 3810-PROCESS-TYPE1. IF W-DCP-COIN2 (W-DCP-INDX) > 0 MOVE W-DCP-DOS (W-DCP-INDX) TO H-DCP-DOS MOVE W-DCP-WGNAT (W-DCP-INDX) TO H-TOTAL COMPUTE H-RATIO = (H-IP-LIMIT - W-DCP-WGNAT (W-DCP-INDX)) / W-DCP-COIN2 (W-DCP-INDX) IF H-RATIO < 0 MOVE 0 TO H-RATIO. IF H-RATIO > 1 MOVE 1 TO H-RATIO. 3810-PROCESS-TYPE1-EXIT. EXIT. 3840-PROCESS-TYPE2. IF W-DCP-DOS (W-DCP-INDX) = H-DCP-DOS MOVE W-DCP-SUB (W-DCP-INDX) TO LN-SUB COMPUTE H-SHIFT = W-DCP-COIN2 (W-DCP-INDX) * (1 - H-RATIO) COMPUTE H-TOTAL = A-ADJ-COIN (LN-SUB) + H-TOTAL - H-SHIFT IF H-TOTAL > H-IP-LIMIT COMPUTE H-SHIFT = H-SHIFT + H-TOTAL - H-IP-LIMIT END-IF COMPUTE A-ADJ-COIN (LN-SUB) = A-ADJ-COIN (LN-SUB) - H-SHIFT COMPUTE A-LITEM-REIM (LN-SUB) = A-LITEM-REIM (LN-SUB) + H-SHIFT MOVE 22 TO A-RETURN-CODE (LN-SUB) END-IF. 3840-PROCESS-TYPE2-EXIT. EXIT. *************************************************************** * 1. MOVE TOTAL CLAIM CHARGE AMOUNT. * * 2. MOVE TOTAL CLAIM PAYMENT AMOUNT. * * 3. MOVE TOTAL CLAIM BLOOD PINTS USED. * * 4. CALCULATE CLAIM LEVEL OUTLIER AMOUNT. * *************************************************************** 3900-END-PRICE-RTN. MOVE H-TOT-CHRG TO A-TOT-CLM-CHRG. MOVE H-TOT-PYMT TO A-TOT-CLM-PYMT. COMPUTE A-BLOOD-PINTS-USED = H-BENE-BLOOD-PINTS - H-BENE-PINTS-USED. IF H-OUTLIER-PYMT > 0 MOVE H-OUTLIER-PYMT TO A-OUTLIER-PYMT. 3900-END-PRICE-RTN-EXIT. EXIT. *************************************************************** * PROCESSING: AFTER 20050701 * * A. WILL PROCESS LINE ITEMS BASED ON OCE FLAGS. * * B. INITIALIZE OPPS HOLD VARIABLES. * * C. EDIT THE DATA PASSED FROM THE OCE. * * D. ASSEMBLE PRICING COMPONENTS. * * E. CALCULATE THE PRICE. * * F. RETURN COINSURANCE/REIMBURSEMENT/DEDUCTIBLE/ * * PAYMENT/OUTLIER AMOUNT/RETURN CODES * *************************************************************** 4000-PROCESS-MAIN-NEW. PERFORM 4100-INIT THRU 4100-INIT-EXIT. IF H-WINX1 = 0 AND A-CLM-RTN-CODE = 01 MOVE 51 TO A-CLM-RTN-CODE. IF A-CLM-RTN-CODE >= 50 GOBACK. MOVE H-WINX1 TO A-WINX. PERFORM 4125-INIT THRU 4125-INIT-EXIT VARYING LN-SUB FROM 1 BY 1 UNTIL LN-SUB > OPPS-LINE-CNT. MOVE 0 TO W-DCP-MAX W-BLD-MAX. PERFORM 4150-INIT THRU 4150-INIT-EXIT VARYING LN-SUB FROM 1 BY 1 UNTIL LN-SUB > OPPS-LINE-CNT. IF H-TOT-38X-39X > 0 COMPUTE H-38X-39X-RATE ROUNDED = H-TOT-38X / H-TOT-38X-39X. MOVE 0 TO W-DCP-MAX. PERFORM 4555-CALC-H-TOT THRU 4555-CALC-H-TOT-EXIT VARYING W-LP-INDX FROM 1 BY 1 UNTIL W-LP-INDX > W-LNC-MAX. SET W-BD-INDX TO 1. MOVE 0 TO W-DCP-MAX. PERFORM 4400-CALCULATE THRU 4400-CALCULATE-EXIT VARYING W-LP-INDX FROM 1 BY 1 UNTIL W-LP-INDX > W-LNC-MAX. PERFORM 4600-ADJ-CHRG-OUTL THRU 4600-ADJ-CHRG-OUTL-EXIT VARYING W-LP-INDX FROM 1 BY 1 UNTIL W-LP-INDX > W-LNC-MAX IF GJK-FLAG = 'Y' PERFORM 4800-ADJ-STV-REIM THRU 4800-ADJ-STV-REIM-EXIT VARYING W-DCP-INDX FROM 1 BY 1 UNTIL W-DCP-INDX > W-DCP-MAX ELSE NEXT SENTENCE. PERFORM 4900-END-PRICE-RTN THRU 4900-END-PRICE-RTN-EXIT. 4000-PROCESS-MAIN-NEW-EXIT. EXIT. *************************************************************** * INITIALIZE WORKING STORAGE HOLD AREAS * * AND ADDITIONAL VARIABLES TO BE PASSED BACK TO * * THE STANDARD SYSTEM. * * - IF PROVIDER SPECIFIC FILE WAGE INDEX RECLASSIFICATION * * CODE INVALID OR MISSING * * - MOVE '52' TO CLAIM LEVEL RETURN CODE * * - DISCONTINUE CLAIM PROCESSING * * - IF SERVICE FROM DATE NOT NUMERIC OR < 20000801 * * - MOVE '53' TO CLAIM LEVEL RETURN CODE * * - DISCONTINUE CLAIM PROCESSING * * - IF SERVICE FROM DATE < PROVIDER EFFECTIVE DATE * * - MOVE '54' TO CLAIM LEVEL RETURN CODE * * - DISCONTINUE CLAIM PROCESSING * * - IF SERVICE FROM DATE > PROVIDER TERMINATION DATE * * - MOVE '54' TO CLAIM LEVEL RETURN CODE * * - DISCONTINUE CLAIM PROCESSING * * 05/12/2009 - W-BLD-HCPCS-FLAG ADDED * *************************************************************** 4100-INIT. MOVE 01 TO A-CLM-RTN-CODE. MOVE 'N' TO APC33-FLAG GJK-FLAG ST0-FLAG N-FLAG C-FLAG W-BLD-HCPCS-FLAG. MOVE SPACE TO A-MSA A-CBSA. MOVE ZERO TO A-OUTLIER-PYMT A-TOTAL-CLM-DEDUCT A-TOT-CLM-CHRG A-TOT-CLM-PYMT A-BLOOD-DEDUCT-DUE A-BLOOD-PINTS-USED A-WINX W-LNC-MAX. INITIALIZE H-ADDITIONAL-VARIABLES. INITIALIZE LINE-HOLD-ITEMS. INITIALIZE T-LITEM-PYMT. IF L-SERVICE-FROM-DATE NOT NUMERIC MOVE 53 TO A-CLM-RTN-CODE GO TO 4100-INIT-EXIT ELSE IF L-SERVICE-FROM-DATE < L-PSF-EFFDT MOVE 54 TO A-CLM-RTN-CODE GO TO 4100-INIT-EXIT ELSE IF L-PSF-TERMDT > 0 IF L-SERVICE-FROM-DATE > L-PSF-TERMDT MOVE 54 TO A-CLM-RTN-CODE GO TO 4100-INIT-EXIT END-IF END-IF. MOVE CAL-VERSION4 TO A-CALC-VERS. MOVE BENE-DEDUCT TO H-BENE-DEDUCT. MOVE BENE-BLOOD-PINTS TO H-BENE-BLOOD-PINTS H-BENE-PINTS-USED. MOVE WAD-MAX TO WAD-SUB. PERFORM UNTIL L-SERVICE-FROM-DATE NOT < WAD-DATE (WAD-SUB) SUBTRACT 1 FROM WAD-SUB END-PERFORM. IF L-PSF-SPEC-PYMT-IND = 'Y' MOVE L-PSF-WI-CBSA TO H-PSF-CBSA ELSE IF L-PSF-SPEC-PYMT-IND = ' ' MOVE L-PSF-GEO-CBSA TO H-PSF-CBSA ELSE IF L-PSF-SPEC-PYMT-IND = '1' OR '2' MOVE L-PSF-GEO-CBSA TO H-PSF-CBSA A-CBSA MOVE L-PSF-SPEC-WGIDX TO H-WINX1 MOVE 912 TO H-IP-LIMIT GO TO 4100-INIT-EXIT ELSE MOVE 52 TO A-CLM-RTN-CODE GO TO 4100-INIT-EXIT. IF H-PSF-CBSA = SPACE MOVE 52 TO A-CLM-RTN-CODE GO TO 4100-INIT-EXIT. MOVE 912 TO H-IP-LIMIT. PERFORM 4120-FLOOR-2005 THRU 4120-FLOOR-2005-EXIT. IF L-SERVICE-FROM-DATE < 20050401 PERFORM 4120-SEC401-2005 THRU 4120-SEC401-2005-EXIT ELSE PERFORM 4120-SEC401-2005-APR THRU 4120-SEC401-2005-APR-EXIT. MOVE H-PSF-CBSA TO A-CBSA. IF H-WINX1 = 0 PERFORM 4200-CALC-WAGEINDX THRU 4200-CALC-WAGEINDX-EXIT. 4100-INIT-EXIT. EXIT. 000100************************************************************* 02 000200** NEW 2005 FLOOR AND SEC 401 FOR CBSA *** 02 000300************************************************************* 02 260700 4120-FLOOR-2005. 02 260800 00 260900 IF H-PSF-CBSA = '10900' 00 261000 AND L-PSF-PROV-ST = '31' 00 261100 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 00 261200 MOVE ' 31' TO H-PSF-CBSA. 00 261300 00 261400 IF H-PSF-CBSA = '16620' 00 261500 AND L-PSF-SPEC-PYMT-IND = 'Y' 00 261600 AND L-PSF-PROV-ST = '36' 00 261700 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 00 261800 MOVE ' 36' TO H-PSF-CBSA. 00 262500 00 262600 IF H-PSF-CBSA = '19060' 00 262700 AND L-PSF-PROV-ST = '21' 00 262800 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 00 262900 MOVE ' 21' TO H-PSF-CBSA. 00 263500 00 263600 IF H-PSF-CBSA = '21780' 00 263700 AND L-PSF-PROV-ST = '15' 00 263800 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 00 263900 MOVE ' 15' TO H-PSF-CBSA. 00 264500 00 264600 IF H-PSF-CBSA = '22020' 00 264800 AND L-PSF-PROV-ST = '24' 00 264900 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 00 265000 MOVE ' 24' TO H-PSF-CBSA. 00 264500 00 264600 IF H-PSF-CBSA = '22020' 00 264700 AND L-PSF-SPEC-PYMT-IND = 'Y' 00 264800 AND L-PSF-PROV-ST = '24' 00 264900 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 00 265000 MOVE ' 24' TO H-PSF-CBSA. 00 266300 00 266400 IF H-PSF-CBSA = '24220' 00 266500 AND L-PSF-PROV-ST = '24' 00 266600 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 00 266700 MOVE ' 24' TO H-PSF-CBSA. 00 267300 00 267400 IF H-PSF-CBSA = '25540' 00 267500 AND L-PSF-SPEC-PYMT-IND = 'Y' 00 267600 AND L-PSF-PROV-ST = '07' 00 267700 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 00 267800 MOVE ' 07' TO H-PSF-CBSA. 00 267900 00 268000 IF H-PSF-CBSA = '29100' 00 268200 AND L-PSF-PROV-ST = '52' 00 268300 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 00 268400 MOVE ' 52' TO H-PSF-CBSA. 00 267900 00 268000 IF H-PSF-CBSA = '30300' 00 268200 AND L-PSF-PROV-ST = '50' 00 268300 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 00 268400 MOVE ' 50' TO H-PSF-CBSA. 00 269700 00 269800 IF H-PSF-CBSA = '37620' 00 269900 AND L-PSF-PROV-ST = '36' 00 270000 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 00 270100 MOVE ' 36' TO H-PSF-CBSA. 00 270700 00 270800 IF H-PSF-CBSA = '48260' 00 270900 AND L-PSF-PROV-ST = '36' 00 271000 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 00 271100 MOVE ' 36' TO H-PSF-CBSA. 00 271700 00 271800 IF H-PSF-CBSA = '48540' 00 271900 AND L-PSF-PROV-ST = '36' 00 272000 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 00 272100 MOVE ' 36' TO H-PSF-CBSA. 00 273200 00 273300 IF H-PSF-CBSA = '48864' 00 273400 AND L-PSF-PROV-ST = '31' 00 273500 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 00 273600 MOVE ' 31' TO H-PSF-CBSA. 00 273700 00 273800 IF H-PSF-CBSA = '48864' 00 273900 AND L-PSF-SPEC-PYMT-IND = 'Y' 00 274000 AND L-PSF-PROV-ST = '31' 00 274100 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 00 274200 MOVE ' 31' TO H-PSF-CBSA. 00 274300 00 274300 IF H-PSF-CBSA = '39900' 00 274300 AND L-PSF-SPEC-PYMT-IND = 'Y' 00 274300 AND L-PSF-PROV-ST = '05' 00 274300 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 00 274300 MOVE ' 05' TO H-PSF-CBSA. 00 274300 00 274400 4120-FLOOR-2005-EXIT. 02 274500 EXIT. 02 309400 00 309500 4120-SEC401-2005. 02 309600************************************************************* 00 309700**** FOR CY 2005 SECTION 401 HOSPITALS * 02 309800************************************************************* 00 310900 00 309900 IF (L-PSF-PROV-OSCAR = '050192' OR 00 310000 '050469' OR 00 310100 '050528' OR 00 310200 '050618' OR 00 310000 '050286' OR 00 310100 '050446' OR 00 310200 '051301') 00 310300 MOVE ' 05' TO H-PSF-CBSA. 02 310500 00 310600 IF (L-PSF-PROV-OSCAR = '070004') 00 310700 MOVE ' 07' TO H-PSF-CBSA. 02 310900 00 311000 IF (L-PSF-PROV-OSCAR = '100048' OR 00 '100118') 311100 MOVE ' 10' TO H-PSF-CBSA. 02 311300 00 311400 IF (L-PSF-PROV-OSCAR = '170137') 00 311500 MOVE ' 17' TO H-PSF-CBSA. 02 311700 00 311800 IF (L-PSF-PROV-OSCAR = '190048' OR 00 311800 '190110') 00 311900 MOVE ' 19' TO H-PSF-CBSA. 02 312100 00 312200 IF (L-PSF-PROV-OSCAR = '230078') 00 312300 MOVE ' 23' TO H-PSF-CBSA. 02 312500 00 312600 IF (L-PSF-PROV-OSCAR = '260006') 00 312700 MOVE ' 26' TO H-PSF-CBSA. 02 311700 00 311800 IF (L-PSF-PROV-OSCAR = '290038' OR 00 311800 '291301') 00 311900 MOVE ' 29' TO H-PSF-CBSA. 02 313300 00 313400 IF (L-PSF-PROV-OSCAR = '300009') 00 313500 MOVE ' 30' TO H-PSF-CBSA. 02 313700 00 313800 IF (L-PSF-PROV-OSCAR = '380084') 00 313900 MOVE ' 38' TO H-PSF-CBSA. 02 314100 00 314200 IF (L-PSF-PROV-OSCAR = '390106' OR 00 314200 '390181') 00 314300 MOVE ' 39' TO H-PSF-CBSA. 00 314500 00 314600 4120-SEC401-2005-EXIT. 02 314610 EXIT. 02 314500 00 314600 4120-SEC401-2005-APR. 02 309600************************************************************* 00 309700**** FOR CY 2005 SECTION 401 HOSPITALS -EFF. 04/01/2005 * 02 309800************************************************************* 00 310500 00 310600 IF (L-PSF-PROV-OSCAR = '030007') 00 310700 MOVE ' 03' TO H-PSF-CBSA. 02 310500 00 310600 IF (L-PSF-PROV-OSCAR = '040075') 00 310700 MOVE ' 04' TO H-PSF-CBSA. 02 310900 00 309900 IF (L-PSF-PROV-OSCAR = '050192' OR 00 310000 '050469' OR 00 310100 '050528' OR 00 310200 '050618') 00 310300 MOVE ' 05' TO H-PSF-CBSA. 02 310500 00 310600 IF (L-PSF-PROV-OSCAR = '070004') 00 310700 MOVE ' 07' TO H-PSF-CBSA. 02 310900 00 311000 IF (L-PSF-PROV-OSCAR = '100048' OR 00 '100134') 311100 MOVE ' 10' TO H-PSF-CBSA. 02 310500 00 310600 IF (L-PSF-PROV-OSCAR = '130018') 00 310700 MOVE ' 13' TO H-PSF-CBSA. 02 310500 00 310600 IF (L-PSF-PROV-OSCAR = '140167') 00 310700 MOVE ' 14' TO H-PSF-CBSA. 02 310900 00 311000 IF (L-PSF-PROV-OSCAR = '150051' OR 00 '150078') 311100 MOVE ' 15' TO H-PSF-CBSA. 02 311300 00 311400 IF (L-PSF-PROV-OSCAR = '170137') 00 311500 MOVE ' 17' TO H-PSF-CBSA. 02 311700 00 311800 IF (L-PSF-PROV-OSCAR = '190048') 00 311900 MOVE ' 19' TO H-PSF-CBSA. 02 312100 00 312200 IF (L-PSF-PROV-OSCAR = '230078') 00 312300 MOVE ' 23' TO H-PSF-CBSA. 02 312100 00 312200 IF (L-PSF-PROV-OSCAR = '240037') 00 312300 MOVE ' 24' TO H-PSF-CBSA. 02 312500 00 312600 IF (L-PSF-PROV-OSCAR = '260006' OR 00 '260122') 312700 MOVE ' 26' TO H-PSF-CBSA. 02 313300 00 313400 IF (L-PSF-PROV-OSCAR = '300009') 00 313500 MOVE ' 30' TO H-PSF-CBSA. 02 313300 00 313400 IF (L-PSF-PROV-OSCAR = '370054') 00 313500 MOVE ' 37' TO H-PSF-CBSA. 02 313700 00 313800 IF (L-PSF-PROV-OSCAR = '380040' OR 00 '380084') 313900 MOVE ' 38' TO H-PSF-CBSA. 02 314100 00 314200 IF (L-PSF-PROV-OSCAR = '390181' OR 00 314200 '390183' OR 00 314200 '390201') 00 314300 MOVE ' 39' TO H-PSF-CBSA. 00 313300 00 313400 IF (L-PSF-PROV-OSCAR = '450052' OR 00 '450078' OR '450243' OR '450276' OR '450348') 313500 MOVE ' 45' TO H-PSF-CBSA. 02 314100 00 314200 IF (L-PSF-PROV-OSCAR = '500023' OR 00 314200 '500037' OR 00 314200 '500122' OR 00 314200 '500147' OR 00 314200 '500148') 00 314300 MOVE ' 50' TO H-PSF-CBSA. 00 314500 00 314600 4120-SEC401-2005-APR-EXIT. 02 314610 EXIT. 02 314620 02 ************************************************************* * SET FLAG IF APC = 0033 * * - TERMINATE PROCESS IF 0033 LOCATED * * * ************************************************************* 4125-INIT. IF OPPS-APC (LN-SUB) = '0033' MOVE 'Y' TO APC33-FLAG MOVE 451 TO LN-SUB. 4125-INIT-EXIT. EXIT. *************************************************************** * 1. VERIFY THE SERVICE INDICATOR PASSED BY THE OCE * * - IF INVALID SET RETURN CODE TO '40' * * - DISCONTINUE LINE PROCESSING * * - IF VALID SET RETURN CODE TO '01' * * - CONTINUE LINE PROCESSING * * 2. PROCESS LINES AND LOAD WORK TABLE ACCORDING TO PRICE * * RANKING * * 3. CHECK OCE EDIT INDICATORS AND SET RETURN CODES IF * * INDICATORS ARE INVALID. * * - VALID RETURN CODES FOR EDIT INDICATORS * * - '41' - SERVICE INDICATOR INVALID FOR OPPS PRICER * * - '42' - APC = '00000' OR (PACKAGING FLAG = 1, 2,OR 4)* * - '43' - PAYMENT INDICATOR NOT = TO 1 OR 5 THRU 9 * * - '44' - SERVICE INDICATOR = 'H' BUT PAYMENT * * INDICATOR NOT = TO 6 * * - '45' - PACKAGING FLAG NOT = TO 0 OR 1 OR 2 * * - '46' - (LINE ITEM DENIAL/REJECT FLAG NOT = TO 0 * * OR LINE ITEM DENIAL/REJECT FLAG = TO 1 * * AND (APC NOT = 0033 OR 0034 OR 0322 OR * * 0323 OR 0324 OR 0325 OR 0373 OR 0374)) * * OR LINE ITEM ACTION FLAG NOT = TO 1 * * - '47' - LINE ITEM ACTION FLAG = 2 OR 3 * * - '48' - PAYMENT ADJUSTMENT FLAG NOT VALID * * - '49' - SITE OF SERVICE FLAG NOT = TO 0 * * - OR (APC 0033 IS NOT ON THE CLAIM * * AND SERVICE INDICATOR = 'P' * * OR APC = 0322-0325,0373,0374) * * 4. IF OCE INDICATORS ARE VALID, SEARCH APC TABLE * * - IF MISSING, DELETED OR INVALID APC * * - SET RETURN CODE TO '30' * * - DISCONTINUE LINE PROCESSING * *************************************************************** 4150-INIT. MOVE 01 TO A-RETURN-CODE (LN-SUB). *************************************************************** * OVER-RIDE SERVICE UNITS FOR APC 0339 - EFFECTIVE 04/01/2002 * * - CHANGE UNIT VALUE TO 1 * *************************************************************** IF OPPS-APC (LN-SUB) = '0339' MOVE 1 TO OPPS-SRVC-UNITS (LN-SUB). MOVE OPPS-SRVC-UNITS (LN-SUB) TO H-SRVC-UNITS. PERFORM 4250-CALC-DISCOUNT THRU 4250-CALC-DISCOUNT-EXIT. IF A-RETURN-CODE (LN-SUB) = 42 GO TO 4150-INIT-EXIT. *************************************************************** * EFFECTIVE AS OF 04-01-2002 * * - TOTAL DEVICE OFFSET * *************************************************************** IF OPPS-SRVC-IND (LN-SUB) = ' H' MOVE 'Y' TO C-FLAG COMPUTE H-TOT-HTD-UNITS = H-TOT-HTD-UNITS + H-SRVC-UNITS. PERFORM 4160-TOTAL-OFFSET THRU 4160-TOTAL-OFFSET-EXIT. SET W-LP-INDX TO LN-SUB. SET W-BD-INDX TO LN-SUB. INITIALIZE W-LP-ENTRY (W-LP-INDX). INITIALIZE W-BD-ENTRY (W-BD-INDX). MOVE ZERO TO A-LITEM-PYMT (LN-SUB) A-LITEM-REIM (LN-SUB) A-ADJ-COIN (LN-SUB) A-RED-COIN (LN-SUB) A-TOTAL-LN-DEDUCT (LN-SUB) A-BLOOD-LN-DEDUCT (LN-SUB). IF NOT (OPPS-SRVC-IND (LN-SUB) = ' A' OR ' B' OR ' C' OR ' E' OR ' F' OR ' G' OR ' H' OR ' K' OR ' L' OR ' N' OR ' P' OR ' S' OR ' T' OR ' V' OR ' X' OR ' W' OR ' Y' OR ' Z' OR ' M') THEN MOVE 40 TO A-RETURN-CODE (LN-SUB) GO TO 4150-INIT-EXIT ELSE MOVE 01 TO A-RETURN-CODE (LN-SUB). IF OPPS-SRVC-IND (LN-SUB) = ' A' OR ' B' OR ' C' OR ' E' OR ' F' OR ' L' OR ' W' OR ' Y' OR ' Z' OR ' M' MOVE 41 TO A-RETURN-CODE (LN-SUB) GO TO 4150-INIT-EXIT. IF OPPS-PYMT-IND (LN-SUB) = ' 1' OR ' 5' OR ' 6' OR ' 7' OR ' 8' OR ' 9' IF OPPS-PKG-FLAG (LN-SUB) = '0' OR '1' OR '2' OR '3' OR '4' IF (OPPS-LITEM-DR-FLAG (LN-SUB) = '0' OR OPPS-LITEM-DR-FLAG (LN-SUB) = '1' AND (OPPS-APC (LN-SUB) = '0033' OR '0034' OR '0322' OR '0323' OR '0324' OR '0325' OR '0373' OR '0374')) OR (OPPS-LITEM-ACT-FLAG (LN-SUB) = '1') IF NOT (OPPS-LITEM-ACT-FLAG (LN-SUB) EQUAL '2' OR '3') IF OPPS-PYMT-ADJ-FLAG (LN-SUB) = ' 0' OR ' 1' OR ' 2' OR ' 3' OR ' 4' OR ' 5' OR ' 6' IF (OPPS-SITE-SRVC-FLAG (LN-SUB) = '0') OR ((APC33-FLAG = 'Y') AND ((OPPS-SRVC-IND (LN-SUB) = ' P') OR (OPPS-APC (LN-SUB) = '0322' OR '0323' OR '0324' OR '0325' OR '0373' OR '0374'))) MOVE OPPS-SUB-CHRG (LN-SUB) TO H-SUB-CHRG COMPUTE H-TOT-CHRG = H-TOT-CHRG + H-SUB-CHRG IF OPPS-LITEM-ACT-FLAG (LN-SUB) = '4' COMPUTE H-TOT-CHRG = H-TOT-CHRG - H-SUB-CHRG END-IF IF (OPPS-PKG-FLAG (LN-SUB) = '1' OR '2' OR '4') COMPUTE H-TOT-N-CHRG = H-SUB-CHRG + H-TOT-N-CHRG MOVE 'Y' TO N-FLAG END-IF IF (OPPS-APC (LN-SUB) = '0000') OR (OPPS-PKG-FLAG (LN-SUB) = '1' OR '2' OR '4') MOVE 42 TO A-RETURN-CODE (LN-SUB) GO TO 4150-INIT-EXIT END-IF SEARCH ALL WAA-ENTRY AT END MOVE 30 TO A-RETURN-CODE (LN-SUB) GO TO 4150-INIT-EXIT WHEN WAA-APC (WAA-INDX) = OPPS-GRP (LN-SUB) MOVE WAA-PTR (WAA-INDX) TO W-SUB2 PERFORM 4175-APC-LOOKUP ELSE MOVE 49 TO A-RETURN-CODE (LN-SUB) GO TO 4150-INIT-EXIT ELSE MOVE 48 TO A-RETURN-CODE (LN-SUB) GO TO 4150-INIT-EXIT ELSE MOVE 47 TO A-RETURN-CODE (LN-SUB) GO TO 4150-INIT-EXIT ELSE MOVE 46 TO A-RETURN-CODE (LN-SUB) GO TO 4150-INIT-EXIT ELSE MOVE 45 TO A-RETURN-CODE (LN-SUB) GO TO 4150-INIT-EXIT ELSE MOVE 43 TO A-RETURN-CODE (LN-SUB) GO TO 4150-INIT-EXIT. *************************************************************** * NEW LOGIC FOR PROCESSING BLOOD DEDUCTIBLE * * EFFECTIVE AS OF 07-01-2005 * * - TOTAL BLOOD CODE CHARGES * * - WHEN PAYMENT ADJUSTMENT FLAG = '5' OR '6' * *************************************************************** IF OPPS-PYMT-ADJ-FLAG (LN-SUB) = ' 5' COMPUTE H-TOT-38X = OPPS-SUB-CHRG (LN-SUB) + H-TOT-38X. IF OPPS-PYMT-ADJ-FLAG (LN-SUB) = ' 5' OR ' 6' COMPUTE H-TOT-38X-39X = OPPS-SUB-CHRG (LN-SUB) + H-TOT-38X-39X. ******************************************************** IF A-RETURN-CODE (LN-SUB) = 01 PERFORM 4300-COIN-DEDUCT THRU 4300-COIN-DEDUCT-EXIT. *************************************************************** * BLOOD DEDUCTIBLE LINE PROCESSING * * 05/11/2009 - ADDED THE REQUIREMENT PAF = 5 OR 6 TO BLOOD * * DEDUCTIBLE LOGIC TO CORRECT PRICING ERROR. * * FIX EFFECTIVE RETROACTIVE TO 01/01/2005. * *************************************************************** IF A-RETURN-CODE (LN-SUB) = 01 SET WNBD-INDX TO 1 SEARCH WNBD-ENTRY VARYING WNBD-INDX AT END GO TO 4150-INIT-EXIT WHEN W-NEW-BLOOD-HCPCS (WNBD-INDX) = OPPS-HCPCS (LN-SUB) IF OPPS-PYMT-ADJ-FLAG (LN-SUB) = (' 5' OR ' 6') MOVE W-NEW-BLOOD-RANK (WNBD-INDX) TO H-BLOOD-RANK MOVE OPPS-LITEM-DOS (LN-SUB) TO H-BLD-DOS PERFORM 4375-BLOOD-DEDUCT THRU 4375-BLOOD-DEDUCT-EXIT END-IF. 4150-INIT-EXIT. EXIT. *************************************************************** * COMPUTE TOTAL OFFSET FROM TABLE 5 FOR DEVICES * * - EFFECTIVE AS OF 01-01-2003 * * - CONTINUE FOR 01-01-2004 * * - CONTINUE FOR 01-01-2005 * * - SEARCH TABLE OPPSOF04 * * - WHERE ALL OFFSET VALUES EQUAL ZERO * *************************************************************** 4160-TOTAL-OFFSET. MOVE OPPS-GRP (LN-SUB) TO W-OFF-APC. SEARCH ALL WOO-ENTRY3 AT END GO TO 4160-TOTAL-OFFSET-EXIT WHEN WOO-APC3 (WOO-INDX3) = W-OFF-APC COMPUTE H-TOTAL-OFFSET = H-TOTAL-OFFSET + (WOO-OFFSET3 (WOO-INDX3) * H-DISC-RATE * H-SRVC-UNITS) COMPUTE H-TOT-OFF-UNITS = H-TOT-OFF-UNITS + H-SRVC-UNITS. 4160-TOTAL-OFFSET-EXIT. EXIT. *************************************************************** * SEARCH APC TABLE - MOVE VALUES TO HOLD AREA FOR PROCESSING * * - ADJUST TOTAL CHARGE FOR DELETED APC'S * *************************************************************** 4175-APC-LOOKUP. IF WAR-DTCD (W-SUB2) NOT > WAD-DTCD (WAD-SUB) IF WAR-RATEX (W-SUB2) = 'DELETED' MOVE 30 TO A-RETURN-CODE (LN-SUB) COMPUTE H-TOT-CHRG = H-TOT-CHRG - H-SUB-CHRG ELSE MOVE WAR-RATE (W-SUB2) TO H-APC-PYMT MOVE WAR-RANK (W-SUB2) TO H-RANK MOVE WAR-MINC (W-SUB2) TO H-MIN-COIN MOVE WAR-COIN (W-SUB2) TO H-NAT-COIN MOVE WAR-PPCT (W-SUB2) TO H-PPCT ELSE SUBTRACT 1 FROM W-SUB2 IF W-SUB2 > WAA-PTR (WAA-INDX - 1) GO TO 4175-APC-LOOKUP ELSE MOVE 0 TO H-APC-PYMT H-RANK H-MIN-COIN H-NAT-COIN H-PPCT. 4175-APC-LOOKUP-EXIT. EXIT. *************************************************************** * IF DATE OF SERVICE BETWEEN 12/31/2002 AND 04/01/2003 * * IF HCPCS CODE = C9114 OR C9115 ADJUST PAYMENT AND * * COINSURANCE AMOUNTS - LOGIC REMOVED FOR 20050101 * *************************************************************** *************************************************************** * SEARCH WAGE INDEX TABLE AND SELECT THE WAGE INDEX * * WHEN EQUAL TO PROVIDER SPECIFIC WAGE INDEX * * IF WAGE INDEX NOT LOCATED * * - SET CLAIM RETURN CODE TO '50' * * - DISCONTINUE CLAIM PROCESSING * * IF WAGE INDEX EQUALS ZERO * * - SET CLAIM RETURN CODE TO '51' * * - DISCONTINUE CLAIM PROCESSING * *************************************************************** 4200-CALC-WAGEINDX. MOVE WCD-MAX TO WCD-SUB. PERFORM UNTIL L-SERVICE-FROM-DATE NOT < WCD-DATE (WCD-SUB) SUBTRACT 1 FROM WCD-SUB END-PERFORM. SEARCH ALL WCM-ENTRY AT END MOVE 50 TO A-CLM-RTN-CODE GO TO 4200-CALC-WAGEINDX-EXIT WHEN WCM-CBSA (WCM-INDX) = H-PSF-CBSA MOVE WCM-PTR (WCM-INDX) TO W-SUB3 PERFORM 4210-WAGE-LOOKUP. IF H-WINX1 = 0 THEN MOVE 51 TO A-CLM-RTN-CODE. 4200-CALC-WAGEINDX-EXIT. EXIT. 4210-WAGE-LOOKUP. IF WCW-DTCD (W-SUB3) NOT > WCD-DTCD (WCD-SUB) IF L-PSF-SPEC-PYMT-IND = 'Y' MOVE WCW-WINX2 (W-SUB3) TO H-WINX1 ELSE MOVE WCW-WINX1 (W-SUB3) TO H-WINX1 ELSE SUBTRACT 1 FROM W-SUB3 IF W-SUB3 > WCM-PTR (WCM-INDX - 1) GO TO 4210-WAGE-LOOKUP ELSE MOVE 0 TO H-WINX1. 4210-WAGE-LOOKUP-EXIT. EXIT. *************************************************************** * CALCULATE DISCOUNT FACTOR BASED ON THE DISCOUNT * * INDICATOR PASSED BY THE OCE: VALUE 1 - 8 * * IF MISSING OR INVALID DISCOUNT FACTOR * * - SET RETURN CODE TO '38' * * - DISCONTINUE LINE PROCESSING * *************************************************************** 4250-CALC-DISCOUNT. IF (H-SRVC-UNITS = 0 AND OPPS-APC (LN-SUB) = '0000') MOVE 42 TO A-RETURN-CODE (LN-SUB) GO TO 4250-CALC-DISCOUNT-EXIT ELSE IF (H-SRVC-UNITS = 0 AND OPPS-APC (LN-SUB) > '0000') MOVE 1 TO H-SRVC-UNITS. IF OPPS-DISC-FACT (LN-SUB) = 1 THEN MOVE 1 TO H-DISC-RATE ELSE IF OPPS-DISC-FACT (LN-SUB) = 2 THEN COMPUTE H-DISC-RATE = (1 + DISC-FRACTION * (H-SRVC-UNITS - 1)) / H-SRVC-UNITS ELSE IF OPPS-DISC-FACT (LN-SUB) = 3 THEN COMPUTE H-DISC-RATE = TERM-PROC-DISC / H-SRVC-UNITS ELSE IF OPPS-DISC-FACT (LN-SUB) = 4 THEN COMPUTE H-DISC-RATE = (1 + DISC-FRACTION) / H-SRVC-UNITS ELSE IF OPPS-DISC-FACT (LN-SUB) = 5 THEN COMPUTE H-DISC-RATE = DISC-FRACTION ELSE IF OPPS-DISC-FACT (LN-SUB) = 6 THEN COMPUTE H-DISC-RATE = (TERM-PROC-DISC * DISC-FRACTION) / H-SRVC-UNITS ELSE IF OPPS-DISC-FACT (LN-SUB) = 7 THEN COMPUTE H-DISC-RATE = (DISC-FRACTION * (1 + DISC-FRACTION) / H-SRVC-UNITS) ELSE IF OPPS-DISC-FACT (LN-SUB) = 8 THEN MOVE 2 TO H-DISC-RATE ELSE MOVE 38 TO A-RETURN-CODE (LN-SUB). 4250-CALC-DISCOUNT-EXIT. EXIT. *************************************************************** * DETERMINE THE DEDUCTIBLE SEQUENCE. DEDUCTIBLE WILL BE * * TAKEN FROM OPPS SERVICES FIRST, THEN FROM ANY OTHER * * TYPES OF SERVICES FROM THE CLAIM. * * - SET POINTERS TO THE HIGHEST RANKED PERCENTAGE * * (LARGEST NATIONAL UNADJUSTED COINSURANCE / * * THE APC PAYMENT) * * - MOVE ALL PRICING VARIABLES TO STAGING AREA * *************************************************************** 4300-COIN-DEDUCT. ADD 1 TO W-LNC-MAX. SET W-LP-INDX TO W-LNC-MAX. PERFORM 4350-STAGE-ENTRY THRU 4350-STAGE-ENTRY-EXIT UNTIL W-LP-INDX = 1 OR H-RANK NOT < W-RANK (W-LP-INDX - 1). MOVE LN-SUB TO W-LP-SUB (W-LP-INDX). MOVE H-NAT-COIN TO W-NAT-COIN (W-LP-INDX). MOVE H-MIN-COIN TO W-MIN-COIN (W-LP-INDX). MOVE H-SUB-CHRG TO W-SUB-CHRG (W-LP-INDX). MOVE H-APC-PYMT TO W-APC-PYMT (W-LP-INDX). MOVE H-WINX1 TO W-WINX1 (W-LP-INDX). MOVE H-RANK TO W-RANK (W-LP-INDX). MOVE H-PPCT TO W-PPCT (W-LP-INDX). MOVE H-DISC-RATE TO W-DISC-RATE (W-LP-INDX). IF OPPS-SRVC-IND (LN-SUB) = ' P' THEN MOVE 1 TO W-SRVC-UNITS (W-LP-INDX) ELSE MOVE H-SRVC-UNITS TO W-SRVC-UNITS (W-LP-INDX). MOVE 0 TO W-RED-COIN (W-LP-INDX). PERFORM VARYING PS-SUB FROM 1 BY 1 UNTIL PS-SUB > L-PSF-APC-LINE-CNT IF L-PSF-APC (PS-SUB) = OPPS-APC (LN-SUB) COMPUTE W-RED-COIN (W-LP-INDX) ROUNDED = L-PSF-RED-COIN (PS-SUB) * H-SRVC-UNITS * H-DISC-RATE MOVE 25 TO A-RETURN-CODE (LN-SUB) MOVE L-PSF-APC-LINE-CNT TO PS-SUB END-IF END-PERFORM. 4300-COIN-DEDUCT-EXIT. EXIT. 4350-STAGE-ENTRY. MOVE W-LP-ENTRY (W-LP-INDX - 1) TO W-LP-ENTRY (W-LP-INDX). SET W-LP-INDX DOWN BY 1. 4350-STAGE-ENTRY-EXIT. EXIT. *************************************************************** * DETERMINE THE BLOOD DEDUCTIBLE SEQUENCE. DEDUCTIBLE * * WILL BE CALCULATED BASED ON RANKING. * * - SET POINTERS TO THE HIGHEST RANKED APC * * (SMALLEST UNADJUSTED APC PAYMENT) * * - MOVE ALL PRICING VARIABLES TO STAGING AREA * *************************************************************** 4375-BLOOD-DEDUCT. ADD 1 TO W-BLD-MAX. SET W-BD-INDX TO W-BLD-MAX. PERFORM 4385-STAGE-ENTRY THRU 4385-STAGE-ENTRY-EXIT UNTIL W-BD-INDX = 1 OR H-BLD-RNK NOT < W-BD-RNK (W-BD-INDX - 1). MOVE LN-SUB TO W-BD-SUB (W-BD-INDX). MOVE H-NAT-COIN TO W-BD-NAT-COIN (W-BD-INDX). MOVE H-MIN-COIN TO W-BD-MIN-COIN (W-BD-INDX). MOVE H-SUB-CHRG TO W-BD-SUB-CHRG (W-BD-INDX). MOVE H-APC-PYMT TO W-BD-APC-PYMT (W-BD-INDX). MOVE H-WINX1 TO W-BD-WINX1 (W-BD-INDX). MOVE H-BLOOD-RANK TO W-BD-RANK (W-BD-INDX). MOVE H-BLD-DOS TO W-BD-DOS (W-BD-INDX). MOVE H-PPCT TO W-BD-PPCT (W-BD-INDX). MOVE H-DISC-RATE TO W-BD-DISC-RATE (W-BD-INDX). MOVE H-SRVC-UNITS TO W-BD-SRVC-UNITS (W-BD-INDX). MOVE 0 TO W-BD-RED-COIN (W-BD-INDX). PERFORM VARYING PS-SUB FROM 1 BY 1 UNTIL PS-SUB > L-PSF-APC-LINE-CNT IF L-PSF-APC (PS-SUB) = OPPS-APC (LN-SUB) COMPUTE W-BD-RED-COIN (W-BD-INDX) ROUNDED = L-PSF-RED-COIN (PS-SUB) * H-SRVC-UNITS * H-DISC-RATE MOVE 25 TO A-RETURN-CODE (LN-SUB) MOVE L-PSF-APC-LINE-CNT TO PS-SUB END-IF END-PERFORM. 4375-BLOOD-DEDUCT-EXIT. EXIT. 4385-STAGE-ENTRY. MOVE W-BD-ENTRY (W-BD-INDX - 1) TO W-BD-ENTRY (W-BD-INDX). SET W-BD-INDX DOWN BY 1. 4385-STAGE-ENTRY-EXIT. EXIT. *************************************************************** * FIRST STEP IN DETERMINING A LINE ITEM PRICE. * * CHECK ALL APPROPRIATE FLAGS AND INDICATORS PASSED * * BY THE OCE. * * - SET RETURN CODES TO INDICATE ERRORS OR STATUS * * - '20' - LINE PROCESSED BUT PAYMENT = 0 * * - BENE DEDUCTIBLE => ADJUSTED PAYMENT * * * *************************************************************** 4400-CALCULATE. MOVE W-LP-SUB (W-LP-INDX) TO LN-SUB. IF A-RETURN-CODE (LN-SUB) > 25 GO TO 4400-CALCULATE-EXIT. IF OPPS-PYMT-IND (LN-SUB) = ' 1' OR ' 5' OR ' 6' OR ' 7' OR ' 8' PERFORM 4550-CALC-STANDARD THRU 4550-CALC-STANDARD-EXIT ELSE GO TO 4400-CALCULATE-EXIT. *************************************************************** * SET GJK FLAG * * - TEST LINE ITEM DATE OF SERVICE > 20010630 * * - TOTAL DRUG / DEVICE COINSURANCE * *************************************************************** IF (A-RETURN-CODE (LN-SUB) < 30) PERFORM 4450-ADJ-PROC-COIN THRU 4450-ADJ-PROC-COIN-EXIT ELSE NEXT SENTENCE. *************************************************************** * SET ST0 AND STVX FLAGS * * - TEST LINE ITEM DATE OF SERVICE > 20020331 * * - TOTAL PROCEDURE CHARGES AND BUNDLED CHARGES * *************************************************************** PERFORM 4500-ADJ-CHRGS THRU 4500-ADJ-CHRGS-EXIT. IF A-RETURN-CODE (LN-SUB) < 30 COMPUTE A-TOTAL-CLM-DEDUCT = H-TOTAL-LN-DEDUCT + A-TOTAL-CLM-DEDUCT COMPUTE H-TOT-PYMT = H-TOT-PYMT + H-LITEM-PYMT COMPUTE A-BLOOD-DEDUCT-DUE = A-BLOOD-DEDUCT-DUE + H-LN-BLOOD-DEDUCT MOVE H-LITEM-PYMT TO A-LITEM-PYMT (LN-SUB) MOVE H-LITEM-REIM TO A-LITEM-REIM (LN-SUB) MOVE H-TOTAL-LN-DEDUCT TO A-TOTAL-LN-DEDUCT (LN-SUB) MOVE H-LN-BLOOD-DEDUCT TO A-BLOOD-LN-DEDUCT (LN-SUB) MOVE H-NAT-COIN TO A-ADJ-COIN (LN-SUB) MOVE H-RED-COIN TO A-RED-COIN (LN-SUB) IF H-RED-COIN > H-NAT-COIN MOVE H-NAT-COIN TO A-RED-COIN (LN-SUB) END-IF IF OPPS-LITEM-ACT-FLAG (LN-SUB) = '4' MOVE 0 TO A-LITEM-PYMT (LN-SUB) MOVE 0 TO A-LITEM-REIM (LN-SUB) COMPUTE H-TOT-PYMT = H-TOT-PYMT - H-LITEM-PYMT END-IF END-IF. MOVE ZERO TO LINE-HOLD-ITEMS. 4400-CALCULATE-EXIT. EXIT. *************************************************************** * SET GJK FLAG * * - STAGE BY SERVICE INDICATOR * * * *************************************************************** 4450-ADJ-PROC-COIN. MOVE OPPS-LITEM-DOS (LN-SUB) TO H-DCP-DOS. IF OPPS-SRVC-IND (LN-SUB) = ' S' OR ' T' OR ' V' COMPUTE H-NEW-WGNAT ROUNDED = W-NAT-COIN (W-LP-INDX) * (.6 * W-WINX1 (W-LP-INDX) + .4) IF H-NEW-WGNAT > H-IP-LIMIT MOVE H-IP-LIMIT TO H-NEW-WGNAT END-IF COMPUTE H-NEW-COIN = H-LITEM-PYMT - H-TOTAL-LN-DEDUCT - H-LITEM-REIM - H-LN-BLOOD-DEDUCT MOVE 1 TO H-DCP-CODE PERFORM 4455-SEARCH-KEY THRU 4455-SEARCH-KEY-EXIT ELSE IF OPPS-SRVC-IND (LN-SUB) = ' G' OR ' K' COMPUTE H-NEW-COIN = H-LITEM-PYMT - H-TOTAL-LN-DEDUCT - H-LITEM-REIM - H-LN-BLOOD-DEDUCT MOVE 'Y' TO GJK-FLAG MOVE 1 TO H-DCP-CODE PERFORM 4455-SEARCH-KEY THRU 4455-SEARCH-KEY-EXIT MOVE 2 TO H-DCP-CODE ADD 1 TO W-DCP-MAX SET W-DCP-INDX TO W-DCP-MAX PERFORM 4475-STAGE-DCP-ENTRY THRU 4475-STAGE-DCP-ENTRY-EXIT UNTIL W-DCP-INDX = 1 OR H-DCP-STAGE NOT < W-DCP-STAGE (W-DCP-INDX - 1) MOVE LN-SUB TO W-DCP-SUB (W-DCP-INDX) MOVE H-DCP-STAGE TO W-DCP-STAGE (W-DCP-INDX) MOVE ZERO TO W-DCP-COIN1 (W-DCP-INDX) MOVE ZERO TO W-DCP-WGNAT (W-DCP-INDX) MOVE H-NEW-COIN TO W-DCP-COIN2 (W-DCP-INDX) MOVE OPPS-SRVC-IND (LN-SUB) TO W-DCP-SRVC-IND (W-DCP-INDX). 4450-ADJ-PROC-COIN-EXIT. EXIT. 4455-SEARCH-KEY. SET W-DCP-INDX TO 1. SEARCH W-DCP-ENTRY VARYING W-DCP-INDX AT END PERFORM 4460-ADD-ENTRY THRU 4460-ADD-ENTRY-EXIT WHEN W-DCP-STAGE (W-DCP-INDX) = H-DCP-STAGE PERFORM 4465-UPDATE-ENTRY THRU 4465-UPDATE-ENTRY-EXIT. 4455-SEARCH-KEY-EXIT. EXIT. 4460-ADD-ENTRY. ADD 1 TO W-DCP-MAX. SET W-DCP-INDX TO W-DCP-MAX. PERFORM 4475-STAGE-DCP-ENTRY THRU 4475-STAGE-DCP-ENTRY-EXIT UNTIL W-DCP-INDX = 1 OR H-DCP-STAGE NOT < W-DCP-STAGE (W-DCP-INDX - 1). IF OPPS-SRVC-IND (LN-SUB) = ' G' OR ' K' MOVE ZERO TO W-DCP-SUB (W-DCP-INDX) MOVE H-DCP-STAGE TO W-DCP-STAGE (W-DCP-INDX) MOVE ZERO TO W-DCP-COIN1 (W-DCP-INDX) MOVE ZERO TO W-DCP-WGNAT (W-DCP-INDX) MOVE H-NEW-COIN TO W-DCP-COIN2 (W-DCP-INDX) MOVE ' X' TO W-DCP-SRVC-IND (W-DCP-INDX) ELSE MOVE LN-SUB TO W-DCP-SUB (W-DCP-INDX) MOVE H-DCP-STAGE TO W-DCP-STAGE (W-DCP-INDX) MOVE H-NEW-COIN TO W-DCP-COIN1 (W-DCP-INDX) MOVE H-NEW-WGNAT TO W-DCP-WGNAT (W-DCP-INDX) MOVE ZERO TO W-DCP-COIN2 (W-DCP-INDX) MOVE OPPS-SRVC-IND (LN-SUB) TO W-DCP-SRVC-IND (W-DCP-INDX). 4460-ADD-ENTRY-EXIT. EXIT. 4465-UPDATE-ENTRY. IF OPPS-SRVC-IND (LN-SUB) = ' G' OR ' K' ADD H-NEW-COIN TO W-DCP-COIN2 (W-DCP-INDX) ELSE IF W-DCP-SRVC-IND (W-DCP-INDX) = ' X' PERFORM 4485-REPLACE-TYPE1 THRU 4485-REPLACE-TYPE1-EXIT ELSE PERFORM 4480-RANK-COIN THRU 4480-RANK-COIN-EXIT. 4465-UPDATE-ENTRY-EXIT. EXIT. 4475-STAGE-DCP-ENTRY. MOVE W-DCP-ENTRY (W-DCP-INDX - 1) TO W-DCP-ENTRY (W-DCP-INDX). SET W-DCP-INDX DOWN BY 1. 4475-STAGE-DCP-ENTRY-EXIT. EXIT. 4480-RANK-COIN. IF H-NEW-WGNAT > W-DCP-WGNAT (W-DCP-INDX) MOVE LN-SUB TO W-DCP-SUB (W-DCP-INDX) MOVE H-NEW-COIN TO W-DCP-COIN1 (W-DCP-INDX) MOVE H-NEW-WGNAT TO W-DCP-WGNAT (W-DCP-INDX) MOVE OPPS-SRVC-IND (LN-SUB) TO W-DCP-SRVC-IND (W-DCP-INDX). 4480-RANK-COIN-EXIT. EXIT. 4485-REPLACE-TYPE1. MOVE LN-SUB TO W-DCP-SUB (W-DCP-INDX) MOVE H-NEW-COIN TO W-DCP-COIN1 (W-DCP-INDX) MOVE H-NEW-WGNAT TO W-DCP-WGNAT (W-DCP-INDX) MOVE OPPS-SRVC-IND (LN-SUB) TO W-DCP-SRVC-IND (W-DCP-INDX). 4485-REPLACE-TYPE1-EXIT. EXIT. 4500-ADJ-CHRGS. ***************************************************** ** NEW LOGIC INSERTED FOR WEB USE ONLY * ***************************************************** IF ((OPPS-SRVC-IND (LN-SUB) = ' T') OR ((OPPS-SRVC-IND (LN-SUB) = ' S') AND (OPPS-HCPCS (LN-SUB) > '09999' AND OPPS-HCPCS (LN-SUB) < '70000'))) AND (W-SUB-CHRG (W-LP-INDX) < 1.01) MOVE 'Y' TO ST0-FLAG. IF ((OPPS-SRVC-IND (LN-SUB) = ' T') OR ((OPPS-SRVC-IND (LN-SUB) = ' S') AND (OPPS-HCPCS (LN-SUB) > '09999' AND OPPS-HCPCS (LN-SUB) < '70000'))) AND (OPPS-PKG-FLAG (LN-SUB) = '0' OR '3') COMPUTE H-TOT-ST-CHRG = W-SUB-CHRG (W-LP-INDX) + H-TOT-ST-CHRG COMPUTE H-TOT-ST-PYMT = H-LITEM-PYMT + H-TOT-ST-PYMT. IF (OPPS-SRVC-IND (LN-SUB) = ' S' OR ' T' OR ' V' OR ' X' OR ' P') AND (OPPS-PKG-FLAG (LN-SUB) = '0' OR '3') COMPUTE H-TOT-STVX-PYMT = H-LITEM-PYMT + H-TOT-STVX-PYMT. 4500-ADJ-CHRGS-EXIT. EXIT. *************************************************************** * 1. APPLY DEDUCTIBLE TO HIGHEST NATIONAL COINSURANCE AMOUNT * * - DESCENDING UNTIL DEDUCTIBLE = 0. * * 2. CALCULATE THE STANDARD LINE PRICE * * (APC PAYMENT * WAGE INDEX * SERVICE UNITS * * * DISCOUNT FACTOR) * * - WAGE ADJUST 60% OF THE APC PAYMENT ONLY * * 3. ADD LINE PRICE TO OUTLIER HOLD AREA. * * * * 4. CALCULATE THE LINE PRICE FOR DESIGNATED DEVICES * * AND DRUGS * *************************************************************** 4550-CALC-STANDARD. COMPUTE H-MAX-COIN ROUNDED = (H-IP-LIMIT * W-SRVC-UNITS (W-LP-INDX) * W-DISC-RATE (W-LP-INDX)). IF OPPS-SRVC-IND (LN-SUB) = ' S' OR ' V' OR ' T' OR ' P' OR ' X' THEN COMPUTE H-LITEM-PYMT ROUNDED = (((W-APC-PYMT (W-LP-INDX) * .60) * W-WINX1 (W-LP-INDX)) + (W-APC-PYMT (W-LP-INDX) * .40)) * W-SRVC-UNITS (W-LP-INDX) * W-DISC-RATE (W-LP-INDX) PERFORM 4560-CALC-BENE-DEDUCT THRU 4560-CALC-BENE-DEDUCT-EXIT ELSE IF OPPS-SRVC-IND (LN-SUB) = ' H' THEN IF OPPS-PYMT-IND (LN-SUB) = ' 6' THEN PERFORM 4555-CALC-H-STANDARD THRU 4555-CALC-H-STANDARD-EXIT PERFORM 4560-CALC-BENE-DEDUCT THRU 4560-CALC-BENE-DEDUCT-EXIT ELSE MOVE 44 TO A-RETURN-CODE (LN-SUB) GO TO 4550-CALC-STANDARD-EXIT END-IF ELSE IF OPPS-SRVC-IND (LN-SUB) = ' G' OR ' K' THEN IF OPPS-PYMT-IND (LN-SUB) = ' 1' OR ' 5' OR ' 7' THEN MOVE 0 TO H-BLOOD-FRACTION PERFORM 4550-CALC-GJK THRU 4550-CALC-GJK-EXIT PERFORM 4560-CALC-BENE-DEDUCT THRU 4560-CALC-BENE-DEDUCT-EXIT ELSE MOVE 41 TO A-RETURN-CODE (LN-SUB) GO TO 4550-CALC-STANDARD-EXIT END-IF END-IF. IF H-LITEM-PYMT > 0 IF OPPS-APC (LN-SUB) = ('1716' OR '1717' OR '1718' OR '1719' OR '1720' OR '2616' OR '2632' OR '2633' OR '2634' OR '2635' OR '2636' OR '2637') COMPUTE H-LITEM-REIM ROUNDED = ((H-LITEM-PYMT - H-TOTAL-LN-DEDUCT) - H-LN-BLOOD-DEDUCT) * .8 COMPUTE H-NAT-COIN = H-LITEM-PYMT - H-TOTAL-LN-DEDUCT - H-LITEM-REIM - H-LN-BLOOD-DEDUCT MOVE W-MIN-COIN (W-LP-INDX) TO H-MIN-COIN ELSE COMPUTE H-LITEM-REIM ROUNDED = ((H-LITEM-PYMT - H-TOTAL-LN-DEDUCT) - H-LN-BLOOD-DEDUCT) * W-PPCT (W-LP-INDX) COMPUTE H-NAT-COIN = H-LITEM-PYMT - H-TOTAL-LN-DEDUCT - H-LITEM-REIM - H-LN-BLOOD-DEDUCT MOVE W-MIN-COIN (W-LP-INDX) TO H-MIN-COIN ELSE NEXT SENTENCE. IF H-MIN-COIN > 0 IF OPPS-SRVC-IND (LN-SUB) = ' G' OR ' H' OR ' K' COMPUTE H-MIN-COIN ROUNDED = H-MIN-COIN * (W-SRVC-UNITS (W-LP-INDX) - (W-SRVC-UNITS (W-LP-INDX) * H-BLOOD-FRACTION)) * W-DISC-RATE (W-LP-INDX) ELSE IF OPPS-APC (LN-SUB) = '0158' OR '0159' COMPUTE H-MIN-COIN ROUNDED = H-LITEM-PYMT * .25 ELSE COMPUTE H-MIN-COIN ROUNDED = H-LITEM-PYMT * .2 END-IF END-IF END-IF. MOVE W-RED-COIN (W-LP-INDX) TO H-RED-COIN. IF (H-RED-COIN > 0 AND < H-MIN-COIN) MOVE H-MIN-COIN TO H-RED-COIN ELSE IF H-RED-COIN < H-NAT-COIN AND > H-MIN-COIN AND > H-MAX-COIN COMPUTE H-LITEM-REIM = H-LITEM-REIM + (H-RED-COIN - H-MAX-COIN) END-IF END-IF. IF H-NAT-COIN > H-MAX-COIN AND H-RED-COIN = 0 THEN COMPUTE H-LITEM-REIM = H-LITEM-REIM + (H-NAT-COIN - H-MAX-COIN) MOVE H-MAX-COIN TO H-NAT-COIN. 4550-CALC-STANDARD-EXIT. EXIT. *************************************************************** * 1. CALCULATE LINE ITEM PAYMENT FOR SERVICE INDICATOR * * TYPES G OR K. * * 2. EFFECTIVE 01/01/2003 REMOVE PRO RATA REDUCTION FOR * * ALL SERVICE INDICATOR 'G' PAYMENTS * *************************************************************** 4550-CALC-GJK. IF (OPPS-HCPCS(LN-SUB) = ('P9010' OR 'P9016' OR 'P9021' OR 'P9022' OR 'P9038' OR 'P9039' OR 'P9040' OR 'P9051' OR 'P9054' OR 'P9056' OR 'P9057' OR 'P9058') AND OPPS-PYMT-ADJ-FLAG (LN-SUB) = (' 5' OR ' 6')) PERFORM 4550-SET-BLOOD-FRACTION THRU 4550-SET-BLOOD-FRACTION-EXIT PERFORM 4550-ADJ-BLOOD-COST THRU 4550-ADJ-BLOOD-COST-EXIT ELSE IF OPPS-PYMT-ADJ-FLAG (LN-SUB) = (' 5' OR ' 6') PERFORM 4550-ADJ-PLATE-COST THRU 4550-ADJ-PLATE-COST-EXIT GO TO 4550-CALC-GJK-EXIT ELSE COMPUTE H-LITEM-PYMT ROUNDED = W-APC-PYMT (W-LP-INDX) * W-SRVC-UNITS (W-LP-INDX) * W-DISC-RATE (W-LP-INDX) GO TO 4550-CALC-GJK-EXIT. COMPUTE H-LITEM-PYMT ROUNDED = W-BD-APC-PYMT (W-BD-INDX) * W-BD-SRVC-UNITS (W-BD-INDX) * W-BD-DISC-RATE (W-BD-INDX). COMPUTE H-LN-BLOOD-DEDUCT ROUNDED = H-LITEM-PYMT * H-BLOOD-FRACTION. SET W-BD-INDX UP BY 1. 4550-CALC-GJK-EXIT. EXIT. 4550-SET-BLOOD-FRACTION. MOVE W-BD-SUB (W-BD-INDX) TO LN-SUB. IF OPPS-PYMT-ADJ-FLAG (LN-SUB) = ' 5' IF H-BENE-PINTS-USED > 0 IF W-BD-SRVC-UNITS (W-BD-INDX) <= H-BENE-PINTS-USED MOVE 1 TO H-BLOOD-FRACTION COMPUTE H-BENE-PINTS-USED = H-BENE-PINTS-USED - W-BD-SRVC-UNITS (W-BD-INDX) ELSE IF W-BD-SRVC-UNITS (W-BD-INDX) > H-BENE-PINTS-USED COMPUTE H-BLOOD-FRACTION = H-BENE-PINTS-USED / W-BD-SRVC-UNITS (W-BD-INDX) MOVE 0 TO H-BENE-PINTS-USED ELSE MOVE 0 TO H-BLOOD-FRACTION ELSE MOVE 0 TO H-BLOOD-FRACTION ELSE MOVE 0 TO H-BLOOD-FRACTION. 4550-SET-BLOOD-FRACTION-EXIT. EXIT. 4550-ADJ-BLOOD-COST. MOVE W-BD-SUB (W-BD-INDX) TO LN-SUB. IF OPPS-PYMT-ADJ-FLAG (LN-SUB) = ' 5' COMPUTE W-BD-APC-PYMT (W-BD-INDX) = W-BD-APC-PYMT (W-BD-INDX) * H-38X-39X-RATE. IF OPPS-PYMT-ADJ-FLAG (LN-SUB) = ' 6' COMPUTE W-BD-APC-PYMT (W-BD-INDX) = W-BD-APC-PYMT (W-BD-INDX) * (1 - H-38X-39X-RATE). 4550-ADJ-BLOOD-COST-EXIT. EXIT. 4550-ADJ-PLATE-COST. IF OPPS-PYMT-ADJ-FLAG (LN-SUB) = ' 5' COMPUTE W-APC-PYMT (W-LP-INDX) = W-APC-PYMT (W-LP-INDX) * H-38X-39X-RATE. IF OPPS-PYMT-ADJ-FLAG (LN-SUB) = ' 6' COMPUTE W-APC-PYMT (W-LP-INDX) = W-APC-PYMT (W-LP-INDX) * (1 - H-38X-39X-RATE). COMPUTE H-LITEM-PYMT ROUNDED = W-APC-PYMT (W-LP-INDX) * W-SRVC-UNITS (W-LP-INDX) * W-DISC-RATE (W-LP-INDX). 4550-ADJ-PLATE-COST-EXIT. EXIT. *************************************************************** * 1. CALCULATE LINE ITEM PAYMENT FOR SERVICE INDICATOR * * TYPE H. * * 2. EFFECTIVE 04/01/2002 A PRO RATA REDUCTION APPLIES TO * * ALL SERVICE INDICATOR 'H' PAYMENTS (CURRENTLY .689) * *************************************************************** 4555-CALC-H-TOT. MOVE W-LP-SUB (W-LP-INDX) TO LN-SUB. MOVE OPPS-SUB-CHRG (LN-SUB) TO H-SUB-CHRG. IF OPPS-SRVC-IND (LN-SUB) = ' H' IF OPPS-PYMT-IND (LN-SUB) = ' 6' COMPUTE H-TOT-H-CHRG = (H-TOT-H-CHRG + H-SUB-CHRG) ELSE NEXT SENTENCE ELSE NEXT SENTENCE. 4555-CALC-H-TOT-EXIT. EXIT. 4555-CALC-H-STANDARD. MOVE OPPS-SUB-CHRG (LN-SUB) TO H-SUB-CHRG. COMPUTE T-LITEM-PYMT ROUNDED = (H-SUB-CHRG * L-PSF-OPCOST-RATIO). IF (C-FLAG = 'Y') IF (H-TOT-OFF-UNITS > H-TOT-HTD-UNITS) COMPUTE H-TOTAL-WAOFF ROUNDED = (((H-TOTAL-OFFSET * .60) * A-WINX) + (H-TOTAL-OFFSET * .40)) * (H-TOT-HTD-UNITS / H-TOT-OFF-UNITS) PERFORM 4700-CALC-H-OFFSET THRU 4700-CALC-H-OFFSET-EXIT ELSE COMPUTE H-TOTAL-WAOFF ROUNDED = ((H-TOTAL-OFFSET * .60) * A-WINX) + (H-TOTAL-OFFSET * .40) PERFORM 4700-CALC-H-OFFSET THRU 4700-CALC-H-OFFSET-EXIT ELSE NEXT SENTENCE. IF T-LITEM-PYMT < 0 THEN MOVE 0 TO H-LITEM-PYMT ELSE MOVE T-LITEM-PYMT TO H-LITEM-PYMT. 4555-CALC-H-STANDARD-EXIT. EXIT. 4560-CALC-BENE-DEDUCT. IF OPPS-PYMT-ADJ-FLAG (LN-SUB) = ' 4' GO TO 4560-CALC-BENE-DEDUCT-EXIT. IF H-BENE-DEDUCT > 0 THEN COMPUTE H-LN-BLD-PYMT = H-LITEM-PYMT - H-LN-BLOOD-DEDUCT IF H-BENE-DEDUCT <= H-LN-BLD-PYMT THEN MOVE H-BENE-DEDUCT TO H-TOTAL-LN-DEDUCT MOVE 0 TO H-BENE-DEDUCT ELSE COMPUTE H-BENE-DEDUCT = H-BENE-DEDUCT - H-LN-BLD-PYMT MOVE H-LN-BLD-PYMT TO H-TOTAL-LN-DEDUCT MOVE 20 TO A-RETURN-CODE (LN-SUB) END-IF END-IF. 4560-CALC-BENE-DEDUCT-EXIT. EXIT. ********************************************************************* ** - NEW FOR JANUARY 2004 ** ** - CHECK >= 20040101 AND SRVC-IND = 'K' ** ** - DISCONTINUE OUTLIER PROCESS ** ********************************************************************* 4600-ADJ-CHRG-OUTL. MOVE W-LP-SUB (W-LP-INDX) TO LN-SUB. ********************************************************************* ** - NEW FOR JANUARY 2005 ** ** - TURN OFF OUTLIER PROCESS FOR SPECIFIED K TYPE APCS ** ** ** ** 05/12/2009 - ALTERED LOGIC TO ALLOW ALL BLOOD LINES (WITH A ** ** STATUS INDICATOR = ' K') TO ENTER OUTLIER LOGIC ** ** ** ********************************************************************* MOVE 'N' TO W-BLD-HCPCS-FLAG. SET WBLH-INDX TO 1. SEARCH WBLHCPCS-ENTRY VARYING WBLH-INDX AT END MOVE 'N' TO W-BLD-HCPCS-FLAG WHEN W-2005-2008-BLOOD-HCPCS (WBLH-INDX) = OPPS-HCPCS (LN-SUB) MOVE 'Y' TO W-BLD-HCPCS-FLAG. IF (OPPS-SRVC-IND (LN-SUB) = ' G' OR ' H' OR ' N') OR (OPPS-PKG-FLAG (LN-SUB) = '4') OR (OPPS-SRVC-IND (LN-SUB) = ' K' AND W-BLD-HCPCS-FLAG = 'N') GO TO 4600-ADJ-CHRG-OUTL-EXIT. *----------------------------------------------------------* * CODE COMMENTED OUT 05/12/2009 & REPLACED WITH CODE ABOVE * *----------------------------------------------------------* * IF (OPPS-SRVC-IND (LN-SUB) = ' G' OR ' K' OR * ' H' OR ' N') OR (OPPS-PKG-FLAG (LN-SUB) = '4') * GO TO 4600-ADJ-CHRG-OUTL-EXIT. ***************************************************** ** NEW LOGIC INSERTED FOR WEB USE ONLY * ***************************************************** IF (ST0-FLAG = 'Y') AND ((OPPS-SRVC-IND (LN-SUB) = ' T' ) OR ((OPPS-SRVC-IND (LN-SUB) = ' S') AND (OPPS-HCPCS (LN-SUB) > '09999' AND OPPS-HCPCS (LN-SUB) < '70000'))) AND (H-TOT-ST-PYMT > 0) COMPUTE H-CHRG-RATE ROUNDED = (A-LITEM-PYMT (LN-SUB) / H-TOT-ST-PYMT) COMPUTE W-SUB-CHRG (W-LP-INDX) ROUNDED = (H-CHRG-RATE * H-TOT-ST-CHRG) ELSE IF (N-FLAG = 'Y' AND ST0-FLAG = 'N') AND ((OPPS-SRVC-IND (LN-SUB) = ' S' OR ' T' OR ' V' OR ' X' OR ' P') AND (OPPS-PKG-FLAG (LN-SUB) = '0' OR '3')) AND (H-TOT-STVX-PYMT > 0) COMPUTE H-CHRG-RATE ROUNDED = (A-LITEM-PYMT (LN-SUB) / H-TOT-STVX-PYMT) COMPUTE H-SUB-CHRG ROUNDED = (H-CHRG-RATE * H-TOT-N-CHRG) COMPUTE W-SUB-CHRG (W-LP-INDX) ROUNDED = W-SUB-CHRG (W-LP-INDX) + H-SUB-CHRG. IF (N-FLAG = 'Y' AND ST0-FLAG = 'Y') AND ((OPPS-SRVC-IND (LN-SUB) = ' S' OR ' T' OR ' V' OR ' X' OR ' P') AND (OPPS-PKG-FLAG (LN-SUB) = '0' OR '3')) AND (H-TOT-STVX-PYMT > 0) COMPUTE H-CHRG-RATE ROUNDED = (A-LITEM-PYMT (LN-SUB) / H-TOT-STVX-PYMT) COMPUTE H-SUB-CHRG ROUNDED = (H-CHRG-RATE * H-TOT-N-CHRG) COMPUTE W-SUB-CHRG (W-LP-INDX) ROUNDED = W-SUB-CHRG (W-LP-INDX) + H-SUB-CHRG. ********************************************************************* ** - NEW FOR JANUARY 2005 ** ** - PROVIDER RANGE FOR CMHC ** ** - COMPUTE H-LITEM-OUTL-PYMT USING NEW FORMULA ** ********************************************************************* MOVE 1.75 TO H-OUTLIER-FACTOR. MOVE .50 TO H-OUTLIER-PCT. COMPUTE H-COST ROUNDED = W-SUB-CHRG (W-LP-INDX) * L-PSF-OPCOST-RATIO. COMPUTE H-APC-ADJ-PYMT ROUNDED = H-OUTLIER-FACTOR * A-LITEM-PYMT (LN-SUB). IF (L-PSF-PROV-3456 >= '1400' AND L-PSF-PROV-3456 <= '1499') OR (L-PSF-PROV-3456 >= '4600' AND L-PSF-PROV-3456 <= '4799') OR (L-PSF-PROV-3456 >= '4900' AND L-PSF-PROV-3456 <= '4999') MOVE 3.5 TO H-OUTLIER-FACTOR COMPUTE H-LITEM-OUTL-PYMT ROUNDED = (H-COST - (H-OUTLIER-FACTOR * A-LITEM-PYMT (LN-SUB))) * H-OUTLIER-PCT ELSE IF (H-COST > H-APC-ADJ-PYMT) AND (H-COST > A-LITEM-PYMT (LN-SUB) + 1175) COMPUTE H-LITEM-OUTL-PYMT ROUNDED = (H-COST - H-APC-ADJ-PYMT) * H-OUTLIER-PCT ELSE MOVE ZERO TO H-LITEM-OUTL-PYMT. IF H-LITEM-OUTL-PYMT > 0 COMPUTE H-OUTLIER-PYMT = H-OUTLIER-PYMT + H-LITEM-OUTL-PYMT. IF OPPS-LITEM-ACT-FLAG (LN-SUB) = '4' COMPUTE H-OUTLIER-PYMT = H-OUTLIER-PYMT - H-LITEM-OUTL-PYMT MOVE 0 TO H-LITEM-OUTL-PYMT. 4600-ADJ-CHRG-OUTL-EXIT. EXIT. *************************************************************** * 1. RE-CALCULATE LINE ITEM PAYMENT FOR SERVICE INDICATOR * * TYPE H. * * 2. SUBTRACT WAGE ADJUSTED OFFSET AMOUNT FROM SI TYPE 'H' * * WITH HCPCS CODE BEGINNING WITH 'C' * * 2. EFFECTIVE 04/01/2002 * *************************************************************** 4700-CALC-H-OFFSET. IF H-TOT-H-CHRG > 0 COMPUTE H-OFF-RATE ROUNDED = H-SUB-CHRG / H-TOT-H-CHRG COMPUTE T-LITEM-PYMT ROUNDED = T-LITEM-PYMT - (H-TOTAL-WAOFF * H-OFF-RATE) ELSE NEXT SENTENCE. 4700-CALC-H-OFFSET-EXIT. EXIT. 4800-ADJ-STV-REIM. IF W-DCP-CODE (W-DCP-INDX) = 1 PERFORM 4810-PROCESS-TYPE1 THRU 4810-PROCESS-TYPE1-EXIT ELSE PERFORM 4840-PROCESS-TYPE2 THRU 4840-PROCESS-TYPE2-EXIT. 4800-ADJ-STV-REIM-EXIT. EXIT. 4810-PROCESS-TYPE1. IF W-DCP-COIN2 (W-DCP-INDX) > 0 MOVE W-DCP-DOS (W-DCP-INDX) TO H-DCP-DOS MOVE W-DCP-WGNAT (W-DCP-INDX) TO H-TOTAL COMPUTE H-RATIO = (H-IP-LIMIT - W-DCP-WGNAT (W-DCP-INDX)) / W-DCP-COIN2 (W-DCP-INDX) IF H-RATIO < 0 MOVE 0 TO H-RATIO. IF H-RATIO > 1 MOVE 1 TO H-RATIO. 4810-PROCESS-TYPE1-EXIT. EXIT. 4840-PROCESS-TYPE2. IF W-DCP-DOS (W-DCP-INDX) = H-DCP-DOS MOVE W-DCP-SUB (W-DCP-INDX) TO LN-SUB COMPUTE H-SHIFT = W-DCP-COIN2 (W-DCP-INDX) * (1 - H-RATIO) COMPUTE H-TOTAL = A-ADJ-COIN (LN-SUB) + H-TOTAL - H-SHIFT IF H-TOTAL > H-IP-LIMIT COMPUTE H-SHIFT = H-SHIFT + H-TOTAL - H-IP-LIMIT END-IF COMPUTE A-ADJ-COIN (LN-SUB) = A-ADJ-COIN (LN-SUB) - H-SHIFT COMPUTE A-LITEM-REIM (LN-SUB) = A-LITEM-REIM (LN-SUB) + H-SHIFT MOVE 22 TO A-RETURN-CODE (LN-SUB) END-IF. 4840-PROCESS-TYPE2-EXIT. EXIT. *************************************************************** * 1. MOVE TOTAL CLAIM CHARGE AMOUNT. * * 2. MOVE TOTAL CLAIM PAYMENT AMOUNT. * * 3. MOVE TOTAL CLAIM BLOOD PINTS USED. * * 4. CALCULATE CLAIM LEVEL OUTLIER AMOUNT. * *************************************************************** 4900-END-PRICE-RTN. MOVE H-TOT-CHRG TO A-TOT-CLM-CHRG. MOVE H-TOT-PYMT TO A-TOT-CLM-PYMT. COMPUTE A-BLOOD-PINTS-USED = H-BENE-BLOOD-PINTS - H-BENE-PINTS-USED. IF H-OUTLIER-PYMT > 0 MOVE H-OUTLIER-PYMT TO A-OUTLIER-PYMT. 4900-END-PRICE-RTN-EXIT. EXIT. 5000-PROCESS-MAIN-NEW. PERFORM 5100-INIT THRU 5100-INIT-EXIT. IF H-WINX1 = 0 AND A-CLM-RTN-CODE = 01 MOVE 51 TO A-CLM-RTN-CODE. IF A-CLM-RTN-CODE >= 50 GOBACK. MOVE H-WINX1 TO A-WINX. PERFORM 5125-INIT THRU 5125-INIT-EXIT VARYING LN-SUB FROM 1 BY 1 UNTIL LN-SUB > OPPS-LINE-CNT. MOVE 0 TO W-DCP-MAX W-BLD-MAX. PERFORM 5150-INIT THRU 5150-INIT-EXIT VARYING LN-SUB FROM 1 BY 1 UNTIL LN-SUB > OPPS-LINE-CNT. IF H-TOT-38X-39X > 0 COMPUTE H-38X-39X-RATE ROUNDED = H-TOT-38X / H-TOT-38X-39X. MOVE 0 TO W-DCP-MAX. PERFORM 5555-CALC-H-TOT THRU 5555-CALC-H-TOT-EXIT VARYING W-LP-INDX FROM 1 BY 1 UNTIL W-LP-INDX > W-LNC-MAX. SET W-BD-INDX TO 1. MOVE 0 TO W-DCP-MAX. PERFORM 5400-CALCULATE THRU 5400-CALCULATE-EXIT VARYING W-LP-INDX FROM 1 BY 1 UNTIL W-LP-INDX > W-LNC-MAX. PERFORM 5600-ADJ-CHRG-OUTL THRU 5600-ADJ-CHRG-OUTL-EXIT VARYING W-LP-INDX FROM 1 BY 1 UNTIL W-LP-INDX > W-LNC-MAX IF GJK-FLAG = 'Y' PERFORM 5800-ADJ-STV-REIM THRU 5800-ADJ-STV-REIM-EXIT VARYING W-DCP-INDX FROM 1 BY 1 UNTIL W-DCP-INDX > W-DCP-MAX ELSE NEXT SENTENCE. PERFORM 5900-END-PRICE-RTN THRU 5900-END-PRICE-RTN-EXIT. 5000-PROCESS-MAIN-NEW-EXIT. EXIT. *************************************************************** * INITIALIZE WORKING STORAGE HOLD AREAS * * AND ADDITIONAL VARIABLES TO BE PASSED BACK TO * * THE STANDARD SYSTEM. * * - IF PROVIDER SPECIFIC FILE WAGE INDEX RECLASSIFICATION * * CODE INVALID OR MISSING * * - MOVE '52' TO CLAIM LEVEL RETURN CODE * * - DISCONTINUE CLAIM PROCESSING * * - IF SERVICE FROM DATE NOT NUMERIC OR < 20000801 * * - MOVE '53' TO CLAIM LEVEL RETURN CODE * * - DISCONTINUE CLAIM PROCESSING * * - IF SERVICE FROM DATE < PROVIDER EFFECTIVE DATE * * - MOVE '54' TO CLAIM LEVEL RETURN CODE * * - DISCONTINUE CLAIM PROCESSING * * - IF SERVICE FROM DATE > PROVIDER TERMINATION DATE * * - MOVE '54' TO CLAIM LEVEL RETURN CODE * * - DISCONTINUE CLAIM PROCESSING * * 05/12/2009 - W-BLD-HCPCS-FLAG ADDED * *************************************************************** 5100-INIT. MOVE 01 TO A-CLM-RTN-CODE. MOVE 'N' TO APC33-FLAG GJK-FLAG ST0-FLAG N-FLAG C-FLAG C1820-OFFSET-FLAG W-BLD-HCPCS-FLAG. MOVE SPACE TO A-MSA A-CBSA BILL14X-FLAG. MOVE ZERO TO A-OUTLIER-PYMT A-TOTAL-CLM-DEDUCT A-TOT-CLM-CHRG A-TOT-CLM-PYMT A-BLOOD-DEDUCT-DUE A-BLOOD-PINTS-USED A-WINX W-LNC-MAX. INITIALIZE H-ADDITIONAL-VARIABLES. INITIALIZE LINE-HOLD-ITEMS. INITIALIZE T-LITEM-PYMT. IF L-SERVICE-FROM-DATE NOT NUMERIC MOVE 53 TO A-CLM-RTN-CODE GO TO 5100-INIT-EXIT ELSE IF L-SERVICE-FROM-DATE < L-PSF-EFFDT MOVE 54 TO A-CLM-RTN-CODE GO TO 5100-INIT-EXIT ELSE IF L-PSF-TERMDT > 0 IF L-SERVICE-FROM-DATE > L-PSF-TERMDT MOVE 54 TO A-CLM-RTN-CODE GO TO 5100-INIT-EXIT END-IF END-IF. MOVE CAL-VERSION5 TO A-CALC-VERS. MOVE BENE-DEDUCT TO H-BENE-DEDUCT. MOVE BENE-BLOOD-PINTS TO H-BENE-BLOOD-PINTS H-BENE-PINTS-USED. MOVE WAD-MAX TO WAD-SUB. PERFORM UNTIL L-SERVICE-FROM-DATE NOT < WAD-DATE (WAD-SUB) SUBTRACT 1 FROM WAD-SUB END-PERFORM. IF L-PSF-SPEC-PYMT-IND = 'Y' MOVE L-PSF-WI-CBSA TO H-PSF-CBSA ELSE IF L-PSF-SPEC-PYMT-IND = ' ' MOVE L-PSF-GEO-CBSA TO H-PSF-CBSA ELSE IF L-PSF-SPEC-PYMT-IND = '1' OR '2' MOVE L-PSF-GEO-CBSA TO H-PSF-CBSA A-CBSA MOVE L-PSF-SPEC-WGIDX TO H-WINX1 MOVE 952 TO H-IP-LIMIT GO TO 5100-INIT-EXIT ELSE MOVE 52 TO A-CLM-RTN-CODE GO TO 5100-INIT-EXIT. IF H-PSF-CBSA = SPACE MOVE 52 TO A-CLM-RTN-CODE GO TO 5100-INIT-EXIT. MOVE 952 TO H-IP-LIMIT. PERFORM 5120-FLOOR-2006 THRU 5120-FLOOR-2006-EXIT. PERFORM 5120-SEC401-2006 THRU 5120-SEC401-2006-EXIT. MOVE H-PSF-CBSA TO A-CBSA. IF H-WINX1 = 0 PERFORM 5200-CALC-WAGEINDX THRU 5200-CALC-WAGEINDX-EXIT. 5100-INIT-EXIT. EXIT. 000100************************************************************* 02 000200** NEW 2006 FLOOR AND SEC 401 FOR CBSA *** 02 000300************************************************************* 02 260700 5120-FLOOR-2006. 02 261300 00 261400 IF H-PSF-CBSA = ' 10' 00 261500 AND L-PSF-SPEC-PYMT-IND = 'Y' 00 261600 AND L-PSF-PROV-ST = '10' 00 261700 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 00 261800 MOVE ' 10' TO H-PSF-CBSA. 00 261300 00 261400 IF H-PSF-CBSA = ' 50' 00 261500 AND L-PSF-SPEC-PYMT-IND = 'Y' 00 261600 AND L-PSF-PROV-ST = '50' 00 261700 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 00 261800 MOVE ' 50' TO H-PSF-CBSA. 00 260800 00 260900 IF H-PSF-CBSA = '10900' 00 261000 AND L-PSF-PROV-ST = '31' 00 261100 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 00 261200 MOVE ' 31' TO H-PSF-CBSA. 00 261300 00 261400 IF H-PSF-CBSA = '15764' 00 261500 AND L-PSF-SPEC-PYMT-IND = 'Y' 00 261600 AND L-PSF-PROV-ST = '30' 00 261700 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 00 261800 MOVE ' 30' TO H-PSF-CBSA. 00 261300 00 261400 IF H-PSF-CBSA = '16620' 00 261500 AND L-PSF-SPEC-PYMT-IND = 'Y' 00 261600 AND L-PSF-PROV-ST = '36' 00 261700 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 00 261800 MOVE ' 36' TO H-PSF-CBSA. 00 262500 00 262600 IF H-PSF-CBSA = '19060' 00 262700 AND L-PSF-PROV-ST = '21' 00 262800 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 00 262900 MOVE ' 21' TO H-PSF-CBSA. 00 264500 00 264600 IF H-PSF-CBSA = '22020' 00 264800 AND L-PSF-PROV-ST = '24' 00 264900 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 00 265000 MOVE ' 24' TO H-PSF-CBSA. 00 266300 00 266400 IF H-PSF-CBSA = '24220' 00 266500 AND L-PSF-PROV-ST = '24' 00 266600 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 00 266700 MOVE ' 24' TO H-PSF-CBSA. 00 267300 00 267400 IF H-PSF-CBSA = '24580' 00 267500 AND L-PSF-SPEC-PYMT-IND = 'Y' 00 267600 AND L-PSF-PROV-ST = '52' 00 267700 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 00 267800 MOVE ' 52' TO H-PSF-CBSA. 00 267300 00 267400 IF H-PSF-CBSA = '25540' 00 267500 AND L-PSF-SPEC-PYMT-IND = 'Y' 00 267600 AND L-PSF-PROV-ST = '07' 00 267700 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 00 267800 MOVE ' 07' TO H-PSF-CBSA. 00 267900 00 268000 IF H-PSF-CBSA = '30300' 00 268200 AND L-PSF-PROV-ST = '50' 00 268300 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 00 268400 MOVE ' 50' TO H-PSF-CBSA. 00 269700 00 269800 IF H-PSF-CBSA = '37620' 00 269900 AND L-PSF-PROV-ST = '36' 00 270000 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 00 270100 MOVE ' 36' TO H-PSF-CBSA. 00 267300 00 267400 IF H-PSF-CBSA = '39900' 00 267500 AND L-PSF-SPEC-PYMT-IND = 'Y' 00 267600 AND L-PSF-PROV-ST = '05' 00 267700 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 00 267800 MOVE ' 05' TO H-PSF-CBSA. 00 270700 00 270800 IF H-PSF-CBSA = '48260' 00 270900 AND L-PSF-PROV-ST = '36' 00 271000 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 00 271100 MOVE ' 36' TO H-PSF-CBSA. 00 271700 00 271800 IF H-PSF-CBSA = '48540' 00 271900 AND L-PSF-PROV-ST = '36' 00 272000 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 00 272100 MOVE ' 36' TO H-PSF-CBSA. 00 271700 00 271800 IF H-PSF-CBSA = '48540' 00 271900 AND L-PSF-PROV-ST = '51' 00 272000 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 00 272100 MOVE ' 51' TO H-PSF-CBSA. 00 273200 00 273300 IF H-PSF-CBSA = '48864' 00 273400 AND L-PSF-PROV-ST = '31' 00 273500 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 00 273600 MOVE ' 31' TO H-PSF-CBSA. 00 273700 00 273800 IF H-PSF-CBSA = '49660' 00 274000 AND L-PSF-PROV-ST = '36' 00 274100 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 00 274200 MOVE ' 36' TO H-PSF-CBSA. 00 274300 00 274400 5120-FLOOR-2006-EXIT. 02 274500 EXIT. 02 309400 00 309500 5120-SEC401-2006. 02 309600************************************************************* 00 309700**** FOR CY 2006 SECTION 401 HOSPITALS * 02 309800************************************************************* 00 310500 00 310600 IF (L-PSF-PROV-OSCAR = '030007') 00 310700 MOVE ' 03' TO H-PSF-CBSA. 02 310500 00 310600 IF (L-PSF-PROV-OSCAR = '040075') 00 310700 MOVE ' 04' TO H-PSF-CBSA. 02 310900 00 309900 IF (L-PSF-PROV-OSCAR = '050192' OR 00 310000 '050469' OR 00 310100 '050528' OR 00 310200 '050618') 00 310300 MOVE ' 05' TO H-PSF-CBSA. 02 310500 00 310600 IF (L-PSF-PROV-OSCAR = '070004') 00 310700 MOVE ' 07' TO H-PSF-CBSA. 02 310900 00 311000 IF (L-PSF-PROV-OSCAR = '100048' OR 00 '100134') 311100 MOVE ' 10' TO H-PSF-CBSA. 02 311300 00 311400 IF (L-PSF-PROV-OSCAR = '130018') 00 311500 MOVE ' 13' TO H-PSF-CBSA. 02 311300 00 311400 IF (L-PSF-PROV-OSCAR = '140167') 00 311500 MOVE ' 14' TO H-PSF-CBSA. 02 310900 00 311000 IF (L-PSF-PROV-OSCAR = '150051' OR 00 '150078') 311100 MOVE ' 15' TO H-PSF-CBSA. 02 311300 00 311400 IF (L-PSF-PROV-OSCAR = '170137') 00 311500 MOVE ' 17' TO H-PSF-CBSA. 02 311700 00 311800 IF (L-PSF-PROV-OSCAR = '190048' OR 00 311800 '190110') 00 311900 MOVE ' 19' TO H-PSF-CBSA. 02 312100 00 311800 IF (L-PSF-PROV-OSCAR = '230042' OR 00 311800 '230078') 00 312300 MOVE ' 23' TO H-PSF-CBSA. 02 312100 00 311800 IF (L-PSF-PROV-OSCAR = '240037' OR 00 311800 '240122') 00 312300 MOVE ' 24' TO H-PSF-CBSA. 02 312500 00 312600 IF (L-PSF-PROV-OSCAR = '260006') 00 312700 MOVE ' 26' TO H-PSF-CBSA. 02 313300 00 313400 IF (L-PSF-PROV-OSCAR = '300009') 00 313500 MOVE ' 30' TO H-PSF-CBSA. 02 313300 00 313400 IF (L-PSF-PROV-OSCAR = '330268') 00 313500 MOVE ' 33' TO H-PSF-CBSA. 02 313300 00 313400 IF (L-PSF-PROV-OSCAR = '370054') 00 313500 MOVE ' 37' TO H-PSF-CBSA. 02 313700 00 313800 IF (L-PSF-PROV-OSCAR = '380040' OR 00 314200 '380084') 00 313900 MOVE ' 38' TO H-PSF-CBSA. 02 314100 00 314200 IF (L-PSF-PROV-OSCAR = '390181' OR 00 314200 '390183' OR 00 314200 '390201') 00 314300 MOVE ' 39' TO H-PSF-CBSA. 00 313300 00 313400 IF (L-PSF-PROV-OSCAR = '440135') 00 313500 MOVE ' 44' TO H-PSF-CBSA. 02 314100 00 314200 IF (L-PSF-PROV-OSCAR = '450052' OR 00 314200 '450078' OR 00 314200 '450243' OR 00 314200 '450276' OR 00 314200 '450348') 00 314300 MOVE ' 45' TO H-PSF-CBSA. 00 314100 00 314200 IF (L-PSF-PROV-OSCAR = '500023' OR 00 314200 '500043' OR 00 314200 '500086' OR 00 314200 '500103' OR 00 314200 '500122' OR 00 314200 '500147' OR 00 314200 '500148') 00 314300 MOVE ' 50' TO H-PSF-CBSA. 00 314500 00 314600 5120-SEC401-2006-EXIT. 02 314610 EXIT. 02 314500 00 ************************************************************* * SET FLAG IF APC = 0033 * * - TERMINATE PROCESS IF 0033 LOCATED * * * ************************************************************* 5125-INIT. IF OPPS-APC (LN-SUB) = '0033' MOVE 'Y' TO APC33-FLAG. IF OPPS-HCPCS (LN-SUB) = 'C1820' MOVE 'Y' TO C1820-OFFSET-FLAG. *-------------------------------------------------------------* * FLAG CLAIM WHEN ALL LINES HAVE A HCPCS BETWEEN 80000-89999 * * INCLUSIVE (LAB CODES), INDICATES BILL TYPE 14X * * 05/09/2011 - LOGIC ADDED * *-------------------------------------------------------------* IF (OPPS-HCPCS (LN-SUB) >= '80000' AND <= '89999') IF BILL14X-FLAG NOT = 'N' MOVE 'Y' TO BILL14X-FLAG END-IF ELSE MOVE 'N' TO BILL14X-FLAG END-IF. 5125-INIT-EXIT. EXIT. *************************************************************** * 1. VERIFY THE SERVICE INDICATOR PASSED BY THE OCE * * - IF INVALID SET RETURN CODE TO '40' * * - DISCONTINUE LINE PROCESSING * * - IF VALID SET RETURN CODE TO '01' * * - CONTINUE LINE PROCESSING * * 2. PROCESS LINES AND LOAD WORK TABLE ACCORDING TO PRICE * * RANKING * * 3. CHECK OCE EDIT INDICATORS AND SET RETURN CODES IF * * INDICATORS ARE INVALID. * * - VALID RETURN CODES FOR EDIT INDICATORS * * - '41' - SERVICE INDICATOR INVALID FOR OPPS PRICER * * - '42' - APC = '00000' OR (PACKAGING FLAG = 1, 2,OR 4)* * - '43' - PAYMENT INDICATOR NOT = TO 1 OR 5 THRU 9 * * - '44' - SERVICE INDICATOR = 'H' BUT PAYMENT * * INDICATOR NOT = TO 6 * * - '45' - PACKAGING FLAG NOT = TO 0 OR 1 OR 2 * * - '46' - (LINE ITEM DENIAL/REJECT FLAG NOT = TO 0 * * OR LINE ITEM DENIAL/REJECT FLAG = TO 1 * * AND (APC NOT = 0033 OR 0034 OR 0322 OR * * 0323 OR 0324 OR 0325 OR 0373 OR 0374)) * * OR LINE ITEM ACTION FLAG NOT = TO 1 * * - '47' - LINE ITEM ACTION FLAG = 2 OR 3 * * - '48' - PAYMENT ADJUSTMENT FLAG NOT VALID * * - '49' - SITE OF SERVICE FLAG NOT = TO 0 * * - OR (APC 0033 IS NOT ON THE CLAIM * * AND SERVICE INDICATOR = 'P' * * OR APC = 0322-0325,0373,0374) * * 4. IF OCE INDICATORS ARE VALID, SEARCH APC TABLE * * - IF MISSING, DELETED OR INVALID APC * * - SET RETURN CODE TO '30' * * - DISCONTINUE LINE PROCESSING * *************************************************************** 5150-INIT. MOVE 01 TO A-RETURN-CODE (LN-SUB). *************************************************************** * OVER-RIDE SERVICE UNITS FOR APC 0339 - EFFECTIVE 04/01/2002 * * - CHANGE UNIT VALUE TO 1 * *************************************************************** IF OPPS-APC (LN-SUB) = '0339' MOVE 1 TO OPPS-SRVC-UNITS (LN-SUB). MOVE OPPS-SRVC-UNITS (LN-SUB) TO H-SRVC-UNITS. PERFORM 5250-CALC-DISCOUNT THRU 5250-CALC-DISCOUNT-EXIT. IF A-RETURN-CODE (LN-SUB) = 42 GO TO 5150-INIT-EXIT. *************************************************************** * EFFECTIVE AS OF 04-01-2002 * * - TOTAL DEVICE OFFSET * *************************************************************** IF OPPS-SRVC-IND (LN-SUB) = ' H' MOVE 'Y' TO C-FLAG COMPUTE H-TOT-HTD-UNITS = H-TOT-HTD-UNITS + H-SRVC-UNITS. IF C1820-OFFSET-FLAG = 'Y' PERFORM 5160-TOTAL-OFFSET THRU 5160-TOTAL-OFFSET-EXIT. SET W-LP-INDX TO LN-SUB. SET W-BD-INDX TO LN-SUB. INITIALIZE W-LP-ENTRY (W-LP-INDX). INITIALIZE W-BD-ENTRY (W-BD-INDX). MOVE ZERO TO A-LITEM-PYMT (LN-SUB) A-LITEM-REIM (LN-SUB) A-ADJ-COIN (LN-SUB) A-RED-COIN (LN-SUB) A-TOTAL-LN-DEDUCT (LN-SUB) A-BLOOD-LN-DEDUCT (LN-SUB). IF NOT (OPPS-SRVC-IND (LN-SUB) = ' A' OR ' B' OR ' C' OR ' E' OR ' F' OR ' G' OR ' H' OR ' K' OR ' L' OR ' N' OR ' P' OR ' S' OR ' T' OR ' V' OR ' X' OR ' W' OR ' Y' OR ' Z' OR ' M') THEN MOVE 40 TO A-RETURN-CODE (LN-SUB) GO TO 5150-INIT-EXIT ELSE MOVE 01 TO A-RETURN-CODE (LN-SUB). IF OPPS-SRVC-IND (LN-SUB) = ' A' OR ' B' OR ' C' OR ' E' OR ' F' OR ' L' OR ' W' OR ' Y' OR ' Z' OR ' M' MOVE 41 TO A-RETURN-CODE (LN-SUB) GO TO 5150-INIT-EXIT. IF OPPS-PYMT-IND (LN-SUB) = ' 1' OR ' 5' OR ' 6' OR ' 7' OR ' 8' OR ' 9' IF OPPS-PKG-FLAG (LN-SUB) = '0' OR '1' OR '2' OR '3' OR '4' IF (OPPS-LITEM-DR-FLAG (LN-SUB) = '0' OR OPPS-LITEM-DR-FLAG (LN-SUB) = '1' AND (OPPS-APC (LN-SUB) = '0033' OR '0034' OR '0322' OR '0323' OR '0324' OR '0325' OR '0373' OR '0374')) OR (OPPS-LITEM-ACT-FLAG (LN-SUB) = '1') IF NOT (OPPS-LITEM-ACT-FLAG (LN-SUB) EQUAL '2' OR '3') IF OPPS-PYMT-ADJ-FLAG (LN-SUB) = ' 0' OR ' 1' OR ' 2' OR ' 3' OR ' 4' OR ' 5' OR ' 6' IF (OPPS-SITE-SRVC-FLAG (LN-SUB) = '0') OR ((APC33-FLAG = 'Y') AND ((OPPS-SRVC-IND (LN-SUB) = ' P') OR (OPPS-APC (LN-SUB) = '0322' OR '0323' OR '0324' OR '0325' OR '0373' OR '0374'))) MOVE OPPS-SUB-CHRG (LN-SUB) TO H-SUB-CHRG COMPUTE H-TOT-CHRG = H-TOT-CHRG + H-SUB-CHRG IF OPPS-LITEM-ACT-FLAG (LN-SUB) = '4' COMPUTE H-TOT-CHRG = H-TOT-CHRG - H-SUB-CHRG END-IF IF (OPPS-PKG-FLAG (LN-SUB) = '1' OR '2' OR '4') COMPUTE H-TOT-N-CHRG = H-SUB-CHRG + H-TOT-N-CHRG MOVE 'Y' TO N-FLAG END-IF IF (OPPS-APC (LN-SUB) = '0000') OR (OPPS-PKG-FLAG (LN-SUB) = '1' OR '2' OR '4') MOVE 42 TO A-RETURN-CODE (LN-SUB) GO TO 5150-INIT-EXIT END-IF SEARCH ALL WAA-ENTRY AT END MOVE 30 TO A-RETURN-CODE (LN-SUB) GO TO 5150-INIT-EXIT WHEN WAA-APC (WAA-INDX) = OPPS-GRP (LN-SUB) MOVE WAA-PTR (WAA-INDX) TO W-SUB2 PERFORM 5175-APC-LOOKUP ELSE MOVE 49 TO A-RETURN-CODE (LN-SUB) GO TO 5150-INIT-EXIT ELSE MOVE 48 TO A-RETURN-CODE (LN-SUB) GO TO 5150-INIT-EXIT ELSE MOVE 47 TO A-RETURN-CODE (LN-SUB) GO TO 5150-INIT-EXIT ELSE MOVE 46 TO A-RETURN-CODE (LN-SUB) GO TO 5150-INIT-EXIT ELSE MOVE 45 TO A-RETURN-CODE (LN-SUB) GO TO 5150-INIT-EXIT ELSE MOVE 43 TO A-RETURN-CODE (LN-SUB) GO TO 5150-INIT-EXIT. *************************************************************** * NEW LOGIC FOR PROCESSING BLOOD DEDUCTIBLE * * EFFECTIVE AS OF 07-01-2005 * * - TOTAL BLOOD CODE CHARGES * * - WHEN PAYMENT ADJUSTMENT FLAG = '5' OR '6' * *************************************************************** IF OPPS-PYMT-ADJ-FLAG (LN-SUB) = ' 5' COMPUTE H-TOT-38X = OPPS-SUB-CHRG (LN-SUB) + H-TOT-38X. IF OPPS-PYMT-ADJ-FLAG (LN-SUB) = ' 5' OR ' 6' COMPUTE H-TOT-38X-39X = OPPS-SUB-CHRG (LN-SUB) + H-TOT-38X-39X. ******************************************************** IF A-RETURN-CODE (LN-SUB) = 01 PERFORM 5300-COIN-DEDUCT THRU 5300-COIN-DEDUCT-EXIT. *************************************************************** * BLOOD DEDUCTIBLE LINE PROCESSING * * 05/11/2009 - ADDED THE REQUIREMENT PAF = 5 OR 6 TO BLOOD * * DEDUCTIBLE LOGIC TO CORRECT PRICING ERROR. * * FIX EFFECTIVE RETROACTIVE TO 01/01/2006. * *************************************************************** IF A-RETURN-CODE (LN-SUB) = 01 SET W6BD-INDX TO 1 SEARCH W6BD-ENTRY VARYING W6BD-INDX AT END GO TO 5150-INIT-EXIT WHEN W-2006-BLOOD-HCPCS (W6BD-INDX) = OPPS-HCPCS (LN-SUB) IF OPPS-PYMT-ADJ-FLAG (LN-SUB) = (' 5' OR ' 6') MOVE W-2006-BLOOD-RANK (W6BD-INDX) TO H-BLOOD-RANK MOVE OPPS-LITEM-DOS (LN-SUB) TO H-BLD-DOS PERFORM 5375-BLOOD-DEDUCT THRU 5375-BLOOD-DEDUCT-EXIT END-IF. 5150-INIT-EXIT. EXIT. *************************************************************** * COMPUTE TOTAL OFFSET FROM TABLE 5 FOR DEVICES * * - EFFECTIVE AS OF 01-01-2003 * * - CONTINUE FOR 01-01-2004 * * - CONTINUE FOR 01-01-2005 * * - SEARCH TABLE OPPSOF04 * * - WHERE ALL OFFSET VALUES EQUAL ZERO * *************************************************************** 5160-TOTAL-OFFSET. MOVE OPPS-GRP (LN-SUB) TO W-OFF-APC. SEARCH ALL WOO-ENTRY4 AT END GO TO 5160-TOTAL-OFFSET-EXIT WHEN WOO-APC4 (WOO-INDX4) = W-OFF-APC PERFORM 5161-TOTAL-OFFSET-AMT THRU 5161-TOTAL-OFFSET-AMT-EXIT. 5160-TOTAL-OFFSET-EXIT. EXIT. 5161-TOTAL-OFFSET-AMT. IF WOO-OFFSET4 (WOO-INDX4) EQUAL 0 GO TO 5161-TOTAL-OFFSET-AMT-EXIT. COMPUTE H-TOTAL-OFFSET = H-TOTAL-OFFSET + (WOO-OFFSET4 (WOO-INDX4) * H-DISC-RATE * H-SRVC-UNITS). COMPUTE H-TOT-OFF-UNITS = H-TOT-OFF-UNITS + H-SRVC-UNITS. IF H-TOTAL-OFFSET < 0 MOVE 0 TO H-TOTAL-OFFSET. 5161-TOTAL-OFFSET-AMT-EXIT. EXIT. *************************************************************** * SEARCH APC TABLE - MOVE VALUES TO HOLD AREA FOR PROCESSING * * - ADJUST TOTAL CHARGE FOR DELETED APC'S * *************************************************************** 5175-APC-LOOKUP. IF WAR-DTCD (W-SUB2) NOT > WAD-DTCD (WAD-SUB) IF WAR-RATEX (W-SUB2) = 'DELETED' MOVE 30 TO A-RETURN-CODE (LN-SUB) COMPUTE H-TOT-CHRG = H-TOT-CHRG - H-SUB-CHRG ELSE MOVE WAR-RATE (W-SUB2) TO H-APC-PYMT MOVE WAR-RANK (W-SUB2) TO H-RANK MOVE WAR-MINC (W-SUB2) TO H-MIN-COIN MOVE WAR-COIN (W-SUB2) TO H-NAT-COIN MOVE WAR-PPCT (W-SUB2) TO H-PPCT ELSE SUBTRACT 1 FROM W-SUB2 IF W-SUB2 > WAA-PTR (WAA-INDX - 1) GO TO 5175-APC-LOOKUP ELSE MOVE 0 TO H-APC-PYMT H-RANK H-MIN-COIN H-NAT-COIN H-PPCT. 5175-APC-LOOKUP-EXIT. EXIT. *************************************************************** * IF DATE OF SERVICE BETWEEN 12/31/2002 AND 04/01/2003 * * IF HCPCS CODE = C9114 OR C9115 ADJUST PAYMENT AND * * COINSURANCE AMOUNTS - LOGIC REMOVED FOR 20050101 * *************************************************************** *************************************************************** * SEARCH WAGE INDEX TABLE AND SELECT THE WAGE INDEX * * WHEN EQUAL TO PROVIDER SPECIFIC WAGE INDEX * * IF WAGE INDEX NOT LOCATED * * - SET CLAIM RETURN CODE TO '50' * * - DISCONTINUE CLAIM PROCESSING * * IF WAGE INDEX EQUALS ZERO * * - SET CLAIM RETURN CODE TO '51' * * - DISCONTINUE CLAIM PROCESSING * *************************************************************** 5200-CALC-WAGEINDX. MOVE WCD-MAX TO WCD-SUB. PERFORM UNTIL L-SERVICE-FROM-DATE NOT < WCD-DATE (WCD-SUB) SUBTRACT 1 FROM WCD-SUB END-PERFORM. SEARCH ALL WCM-ENTRY AT END MOVE 50 TO A-CLM-RTN-CODE GO TO 5200-CALC-WAGEINDX-EXIT WHEN WCM-CBSA (WCM-INDX) = H-PSF-CBSA MOVE WCM-PTR (WCM-INDX) TO W-SUB3 PERFORM 5210-WAGE-LOOKUP. IF H-WINX1 = 0 THEN MOVE 51 TO A-CLM-RTN-CODE. 5200-CALC-WAGEINDX-EXIT. EXIT. 5210-WAGE-LOOKUP. IF WCW-DTCD (W-SUB3) NOT > WCD-DTCD (WCD-SUB) IF L-PSF-SPEC-PYMT-IND = 'Y' MOVE WCW-WINX2 (W-SUB3) TO H-WINX1 ELSE MOVE WCW-WINX1 (W-SUB3) TO H-WINX1 ELSE SUBTRACT 1 FROM W-SUB3 IF W-SUB3 > WCM-PTR (WCM-INDX - 1) GO TO 5210-WAGE-LOOKUP ELSE MOVE 0 TO H-WINX1. 5210-WAGE-LOOKUP-EXIT. EXIT. *************************************************************** * CALCULATE DISCOUNT FACTOR BASED ON THE DISCOUNT * * INDICATOR PASSED BY THE OCE: VALUE 1 - 8 * * IF MISSING OR INVALID DISCOUNT FACTOR * * - SET RETURN CODE TO '38' * * - DISCONTINUE LINE PROCESSING * *************************************************************** 5250-CALC-DISCOUNT. IF (H-SRVC-UNITS = 0 AND OPPS-APC (LN-SUB) = '0000') MOVE 42 TO A-RETURN-CODE (LN-SUB) GO TO 5250-CALC-DISCOUNT-EXIT ELSE IF (H-SRVC-UNITS = 0 AND OPPS-APC (LN-SUB) > '0000') MOVE 1 TO H-SRVC-UNITS. IF OPPS-DISC-FACT (LN-SUB) = 1 THEN MOVE 1 TO H-DISC-RATE ELSE IF OPPS-DISC-FACT (LN-SUB) = 2 THEN COMPUTE H-DISC-RATE = (1 + DISC-FRACTION * (H-SRVC-UNITS - 1)) / H-SRVC-UNITS ELSE IF OPPS-DISC-FACT (LN-SUB) = 3 THEN COMPUTE H-DISC-RATE = TERM-PROC-DISC / H-SRVC-UNITS ELSE IF OPPS-DISC-FACT (LN-SUB) = 4 THEN COMPUTE H-DISC-RATE = (1 + DISC-FRACTION) / H-SRVC-UNITS ELSE IF OPPS-DISC-FACT (LN-SUB) = 5 THEN COMPUTE H-DISC-RATE = DISC-FRACTION ELSE IF OPPS-DISC-FACT (LN-SUB) = 6 THEN COMPUTE H-DISC-RATE = (TERM-PROC-DISC * DISC-FRACTION) / H-SRVC-UNITS ELSE IF OPPS-DISC-FACT (LN-SUB) = 7 THEN COMPUTE H-DISC-RATE = (DISC-FRACTION * (1 + DISC-FRACTION) / H-SRVC-UNITS) ELSE IF OPPS-DISC-FACT (LN-SUB) = 8 THEN MOVE 2 TO H-DISC-RATE ELSE MOVE 38 TO A-RETURN-CODE (LN-SUB). 5250-CALC-DISCOUNT-EXIT. EXIT. *************************************************************** * DETERMINE THE DEDUCTIBLE SEQUENCE. DEDUCTIBLE WILL BE * * TAKEN FROM OPPS SERVICES FIRST, THEN FROM ANY OTHER * * TYPES OF SERVICES FROM THE CLAIM. * * - SET POINTERS TO THE HIGHEST RANKED PERCENTAGE * * (LARGEST NATIONAL UNADJUSTED COINSURANCE / * * THE APC PAYMENT) * * - MOVE ALL PRICING VARIABLES TO STAGING AREA * *************************************************************** 5300-COIN-DEDUCT. ADD 1 TO W-LNC-MAX. SET W-LP-INDX TO W-LNC-MAX. PERFORM 5350-STAGE-ENTRY THRU 5350-STAGE-ENTRY-EXIT UNTIL W-LP-INDX = 1 OR H-RANK NOT < W-RANK (W-LP-INDX - 1). MOVE LN-SUB TO W-LP-SUB (W-LP-INDX). MOVE H-NAT-COIN TO W-NAT-COIN (W-LP-INDX). MOVE H-MIN-COIN TO W-MIN-COIN (W-LP-INDX). MOVE H-SUB-CHRG TO W-SUB-CHRG (W-LP-INDX). MOVE H-APC-PYMT TO W-APC-PYMT (W-LP-INDX). MOVE H-WINX1 TO W-WINX1 (W-LP-INDX). MOVE H-RANK TO W-RANK (W-LP-INDX). MOVE H-PPCT TO W-PPCT (W-LP-INDX). MOVE H-DISC-RATE TO W-DISC-RATE (W-LP-INDX). IF OPPS-SRVC-IND (LN-SUB) = ' P' THEN MOVE 1 TO W-SRVC-UNITS (W-LP-INDX) ELSE MOVE H-SRVC-UNITS TO W-SRVC-UNITS (W-LP-INDX). MOVE 0 TO W-RED-COIN (W-LP-INDX). PERFORM VARYING PS-SUB FROM 1 BY 1 UNTIL PS-SUB > L-PSF-APC-LINE-CNT IF L-PSF-APC (PS-SUB) = OPPS-APC (LN-SUB) COMPUTE W-RED-COIN (W-LP-INDX) ROUNDED = L-PSF-RED-COIN (PS-SUB) * H-SRVC-UNITS * H-DISC-RATE MOVE 25 TO A-RETURN-CODE (LN-SUB) MOVE L-PSF-APC-LINE-CNT TO PS-SUB END-IF END-PERFORM. 5300-COIN-DEDUCT-EXIT. EXIT. 5350-STAGE-ENTRY. MOVE W-LP-ENTRY (W-LP-INDX - 1) TO W-LP-ENTRY (W-LP-INDX). SET W-LP-INDX DOWN BY 1. 5350-STAGE-ENTRY-EXIT. EXIT. *************************************************************** * DETERMINE THE BLOOD DEDUCTIBLE SEQUENCE. DEDUCTIBLE * * WILL BE CALCULATED BASED ON RANKING. * * - SET POINTERS TO THE HIGHEST RANKED APC * * (SMALLEST UNADJUSTED APC PAYMENT) * * - MOVE ALL PRICING VARIABLES TO STAGING AREA * *************************************************************** 5375-BLOOD-DEDUCT. ADD 1 TO W-BLD-MAX. SET W-BD-INDX TO W-BLD-MAX. PERFORM 5385-STAGE-ENTRY THRU 5385-STAGE-ENTRY-EXIT UNTIL W-BD-INDX = 1 OR H-BLD-RNK NOT < W-BD-RNK (W-BD-INDX - 1). MOVE LN-SUB TO W-BD-SUB (W-BD-INDX). MOVE H-NAT-COIN TO W-BD-NAT-COIN (W-BD-INDX). MOVE H-MIN-COIN TO W-BD-MIN-COIN (W-BD-INDX). MOVE H-SUB-CHRG TO W-BD-SUB-CHRG (W-BD-INDX). MOVE H-APC-PYMT TO W-BD-APC-PYMT (W-BD-INDX). MOVE H-WINX1 TO W-BD-WINX1 (W-BD-INDX). MOVE H-BLOOD-RANK TO W-BD-RANK (W-BD-INDX). MOVE H-BLD-DOS TO W-BD-DOS (W-BD-INDX). MOVE H-PPCT TO W-BD-PPCT (W-BD-INDX). MOVE H-DISC-RATE TO W-BD-DISC-RATE (W-BD-INDX). MOVE H-SRVC-UNITS TO W-BD-SRVC-UNITS (W-BD-INDX). MOVE 0 TO W-BD-RED-COIN (W-BD-INDX). PERFORM VARYING PS-SUB FROM 1 BY 1 UNTIL PS-SUB > L-PSF-APC-LINE-CNT IF L-PSF-APC (PS-SUB) = OPPS-APC (LN-SUB) COMPUTE W-BD-RED-COIN (W-BD-INDX) ROUNDED = L-PSF-RED-COIN (PS-SUB) * H-SRVC-UNITS * H-DISC-RATE MOVE 25 TO A-RETURN-CODE (LN-SUB) MOVE L-PSF-APC-LINE-CNT TO PS-SUB END-IF END-PERFORM. 5375-BLOOD-DEDUCT-EXIT. EXIT. 5385-STAGE-ENTRY. MOVE W-BD-ENTRY (W-BD-INDX - 1) TO W-BD-ENTRY (W-BD-INDX). SET W-BD-INDX DOWN BY 1. 5385-STAGE-ENTRY-EXIT. EXIT. *************************************************************** * FIRST STEP IN DETERMINING A LINE ITEM PRICE. * * CHECK ALL APPROPRIATE FLAGS AND INDICATORS PASSED * * BY THE OCE. * * - SET RETURN CODES TO INDICATE ERRORS OR STATUS * * - '20' - LINE PROCESSED BUT PAYMENT = 0 * * - BENE DEDUCTIBLE => ADJUSTED PAYMENT * * * *************************************************************** 5400-CALCULATE. MOVE W-LP-SUB (W-LP-INDX) TO LN-SUB. IF A-RETURN-CODE (LN-SUB) > 25 GO TO 5400-CALCULATE-EXIT. IF OPPS-PYMT-IND (LN-SUB) = ' 1' OR ' 5' OR ' 6' OR ' 7' OR ' 8' PERFORM 5550-CALC-STANDARD THRU 5550-CALC-STANDARD-EXIT ELSE GO TO 5400-CALCULATE-EXIT. *************************************************************** * SET GJK FLAG * * - TEST LINE ITEM DATE OF SERVICE > 20010630 * * - TOTAL DRUG / DEVICE COINSURANCE * *************************************************************** IF (A-RETURN-CODE (LN-SUB) < 30) PERFORM 5450-ADJ-PROC-COIN THRU 5450-ADJ-PROC-COIN-EXIT ELSE NEXT SENTENCE. *************************************************************** * SET ST0 AND STVX FLAGS * * - TEST LINE ITEM DATE OF SERVICE > 20020331 * * - TOTAL PROCEDURE CHARGES AND BUNDLED CHARGES * *************************************************************** PERFORM 5500-ADJ-CHRGS THRU 5500-ADJ-CHRGS-EXIT. IF A-RETURN-CODE (LN-SUB) < 30 COMPUTE A-TOTAL-CLM-DEDUCT = H-TOTAL-LN-DEDUCT + A-TOTAL-CLM-DEDUCT COMPUTE H-TOT-PYMT = H-TOT-PYMT + H-LITEM-PYMT COMPUTE A-BLOOD-DEDUCT-DUE = A-BLOOD-DEDUCT-DUE + H-LN-BLOOD-DEDUCT MOVE H-LITEM-PYMT TO A-LITEM-PYMT (LN-SUB) MOVE H-LITEM-REIM TO A-LITEM-REIM (LN-SUB) MOVE H-TOTAL-LN-DEDUCT TO A-TOTAL-LN-DEDUCT (LN-SUB) MOVE H-LN-BLOOD-DEDUCT TO A-BLOOD-LN-DEDUCT (LN-SUB) MOVE H-NAT-COIN TO A-ADJ-COIN (LN-SUB) MOVE H-RED-COIN TO A-RED-COIN (LN-SUB) IF H-RED-COIN > H-NAT-COIN MOVE H-NAT-COIN TO A-RED-COIN (LN-SUB) END-IF IF OPPS-LITEM-ACT-FLAG (LN-SUB) = '4' MOVE 0 TO A-LITEM-PYMT (LN-SUB) MOVE 0 TO A-LITEM-REIM (LN-SUB) COMPUTE H-TOT-PYMT = H-TOT-PYMT - H-LITEM-PYMT END-IF END-IF. MOVE ZERO TO LINE-HOLD-ITEMS. 5400-CALCULATE-EXIT. EXIT. *************************************************************** * SET GJK FLAG * * - STAGE BY SERVICE INDICATOR * * * *************************************************************** 5450-ADJ-PROC-COIN. MOVE OPPS-LITEM-DOS (LN-SUB) TO H-DCP-DOS. IF OPPS-SRVC-IND (LN-SUB) = ' S' OR ' T' OR ' V' COMPUTE H-NEW-WGNAT ROUNDED = W-NAT-COIN (W-LP-INDX) * (.6 * W-WINX1 (W-LP-INDX) + .4) IF H-NEW-WGNAT > H-IP-LIMIT MOVE H-IP-LIMIT TO H-NEW-WGNAT END-IF COMPUTE H-NEW-COIN = H-LITEM-PYMT - H-TOTAL-LN-DEDUCT - H-LITEM-REIM - H-LN-BLOOD-DEDUCT MOVE 1 TO H-DCP-CODE PERFORM 5455-SEARCH-KEY THRU 5455-SEARCH-KEY-EXIT ELSE IF OPPS-SRVC-IND (LN-SUB) = ' G' OR ' K' COMPUTE H-NEW-COIN = H-LITEM-PYMT - H-TOTAL-LN-DEDUCT - H-LITEM-REIM - H-LN-BLOOD-DEDUCT MOVE 'Y' TO GJK-FLAG MOVE 1 TO H-DCP-CODE PERFORM 5455-SEARCH-KEY THRU 5455-SEARCH-KEY-EXIT MOVE 2 TO H-DCP-CODE ADD 1 TO W-DCP-MAX SET W-DCP-INDX TO W-DCP-MAX PERFORM 5475-STAGE-DCP-ENTRY THRU 5475-STAGE-DCP-ENTRY-EXIT UNTIL W-DCP-INDX = 1 OR H-DCP-STAGE NOT < W-DCP-STAGE (W-DCP-INDX - 1) MOVE LN-SUB TO W-DCP-SUB (W-DCP-INDX) MOVE H-DCP-STAGE TO W-DCP-STAGE (W-DCP-INDX) MOVE ZERO TO W-DCP-COIN1 (W-DCP-INDX) MOVE ZERO TO W-DCP-WGNAT (W-DCP-INDX) MOVE H-NEW-COIN TO W-DCP-COIN2 (W-DCP-INDX) MOVE OPPS-SRVC-IND (LN-SUB) TO W-DCP-SRVC-IND (W-DCP-INDX). 5450-ADJ-PROC-COIN-EXIT. EXIT. 5455-SEARCH-KEY. SET W-DCP-INDX TO 1. SEARCH W-DCP-ENTRY VARYING W-DCP-INDX AT END PERFORM 5460-ADD-ENTRY THRU 5460-ADD-ENTRY-EXIT WHEN W-DCP-STAGE (W-DCP-INDX) = H-DCP-STAGE PERFORM 5465-UPDATE-ENTRY THRU 5465-UPDATE-ENTRY-EXIT. 5455-SEARCH-KEY-EXIT. EXIT. 5460-ADD-ENTRY. ADD 1 TO W-DCP-MAX. SET W-DCP-INDX TO W-DCP-MAX. PERFORM 5475-STAGE-DCP-ENTRY THRU 5475-STAGE-DCP-ENTRY-EXIT UNTIL W-DCP-INDX = 1 OR H-DCP-STAGE NOT < W-DCP-STAGE (W-DCP-INDX - 1). IF OPPS-SRVC-IND (LN-SUB) = ' G' OR ' K' MOVE ZERO TO W-DCP-SUB (W-DCP-INDX) MOVE H-DCP-STAGE TO W-DCP-STAGE (W-DCP-INDX) MOVE ZERO TO W-DCP-COIN1 (W-DCP-INDX) MOVE ZERO TO W-DCP-WGNAT (W-DCP-INDX) MOVE H-NEW-COIN TO W-DCP-COIN2 (W-DCP-INDX) MOVE ' X' TO W-DCP-SRVC-IND (W-DCP-INDX) ELSE MOVE LN-SUB TO W-DCP-SUB (W-DCP-INDX) MOVE H-DCP-STAGE TO W-DCP-STAGE (W-DCP-INDX) MOVE H-NEW-COIN TO W-DCP-COIN1 (W-DCP-INDX) MOVE H-NEW-WGNAT TO W-DCP-WGNAT (W-DCP-INDX) MOVE ZERO TO W-DCP-COIN2 (W-DCP-INDX) MOVE OPPS-SRVC-IND (LN-SUB) TO W-DCP-SRVC-IND (W-DCP-INDX). 5460-ADD-ENTRY-EXIT. EXIT. 5465-UPDATE-ENTRY. IF OPPS-SRVC-IND (LN-SUB) = ' G' OR ' K' ADD H-NEW-COIN TO W-DCP-COIN2 (W-DCP-INDX) ELSE IF W-DCP-SRVC-IND (W-DCP-INDX) = ' X' PERFORM 5485-REPLACE-TYPE1 THRU 5485-REPLACE-TYPE1-EXIT ELSE PERFORM 5480-RANK-COIN THRU 5480-RANK-COIN-EXIT. 5465-UPDATE-ENTRY-EXIT. EXIT. 5475-STAGE-DCP-ENTRY. MOVE W-DCP-ENTRY (W-DCP-INDX - 1) TO W-DCP-ENTRY (W-DCP-INDX). SET W-DCP-INDX DOWN BY 1. 5475-STAGE-DCP-ENTRY-EXIT. EXIT. 5480-RANK-COIN. IF H-NEW-WGNAT > W-DCP-WGNAT (W-DCP-INDX) MOVE LN-SUB TO W-DCP-SUB (W-DCP-INDX) MOVE H-NEW-COIN TO W-DCP-COIN1 (W-DCP-INDX) MOVE H-NEW-WGNAT TO W-DCP-WGNAT (W-DCP-INDX) MOVE OPPS-SRVC-IND (LN-SUB) TO W-DCP-SRVC-IND (W-DCP-INDX). 5480-RANK-COIN-EXIT. EXIT. 5485-REPLACE-TYPE1. MOVE LN-SUB TO W-DCP-SUB (W-DCP-INDX) MOVE H-NEW-COIN TO W-DCP-COIN1 (W-DCP-INDX) MOVE H-NEW-WGNAT TO W-DCP-WGNAT (W-DCP-INDX) MOVE OPPS-SRVC-IND (LN-SUB) TO W-DCP-SRVC-IND (W-DCP-INDX). 5485-REPLACE-TYPE1-EXIT. EXIT. 5500-ADJ-CHRGS. ***************************************************** ** NEW LOGIC INSERTED FOR WEB USE ONLY * ***************************************************** IF ((OPPS-SRVC-IND (LN-SUB) = ' T') OR ((OPPS-SRVC-IND (LN-SUB) = ' S') AND (OPPS-HCPCS (LN-SUB) > '09999' AND OPPS-HCPCS (LN-SUB) < '70000'))) AND (W-SUB-CHRG (W-LP-INDX) < 1.01) MOVE 'Y' TO ST0-FLAG. IF ((OPPS-SRVC-IND (LN-SUB) = ' T') OR ((OPPS-SRVC-IND (LN-SUB) = ' S') AND (OPPS-HCPCS (LN-SUB) > '09999' AND OPPS-HCPCS (LN-SUB) < '70000'))) AND (OPPS-PKG-FLAG (LN-SUB) = '0' OR '3') COMPUTE H-TOT-ST-CHRG = W-SUB-CHRG (W-LP-INDX) + H-TOT-ST-CHRG COMPUTE H-TOT-ST-PYMT = H-LITEM-PYMT + H-TOT-ST-PYMT. IF (OPPS-SRVC-IND (LN-SUB) = ' S' OR ' T' OR ' V' OR ' X' OR ' P') AND (OPPS-PKG-FLAG (LN-SUB) = '0' OR '3') COMPUTE H-TOT-STVX-PYMT = H-LITEM-PYMT + H-TOT-STVX-PYMT. 5500-ADJ-CHRGS-EXIT. EXIT. *************************************************************** * 1. APPLY DEDUCTIBLE TO HIGHEST NATIONAL COINSURANCE AMOUNT * * - DESCENDING UNTIL DEDUCTIBLE = 0. * * 2. CALCULATE THE STANDARD LINE PRICE * * (APC PAYMENT * WAGE INDEX * SERVICE UNITS * * * DISCOUNT FACTOR) * * - WAGE ADJUST 60% OF THE APC PAYMENT ONLY * * 3. ADD LINE PRICE TO OUTLIER HOLD AREA. * * * * 4. CALCULATE THE LINE PRICE FOR DESIGNATED DEVICES * * AND DRUGS * * * * 08/07/2009 - MOVED 5560-CALC-BENE-DEDUCT PERFORM FROM * * 5550-SCH-ADJ TO THIS PARAGRAPH FOR SI SVTPX * * * *************************************************************** 5550-CALC-STANDARD. MOVE 0 TO H-BLOOD-FRACTION. COMPUTE H-MAX-COIN ROUNDED = (H-IP-LIMIT * W-SRVC-UNITS (W-LP-INDX) * W-DISC-RATE (W-LP-INDX)). IF OPPS-SRVC-IND (LN-SUB) = ' S' OR ' V' OR ' T' OR ' P' OR ' X' THEN JB PERFORM 5550-SCH-ADJ THRU 5550-SCH-ADJ-EXIT PERFORM 5560-CALC-BENE-DEDUCT THRU 5560-CALC-BENE-DEDUCT-EXIT ELSE IF OPPS-SRVC-IND (LN-SUB) = ' H' THEN IF OPPS-PYMT-IND (LN-SUB) = ' 6' THEN MOVE 0 TO H-BLOOD-FRACTION PERFORM 5555-CALC-H-STANDARD THRU 5555-CALC-H-STANDARD-EXIT PERFORM 5560-CALC-BENE-DEDUCT THRU 5560-CALC-BENE-DEDUCT-EXIT ELSE MOVE 44 TO A-RETURN-CODE (LN-SUB) GO TO 5550-CALC-STANDARD-EXIT END-IF ELSE IF OPPS-SRVC-IND (LN-SUB) = ' G' OR ' K' THEN IF OPPS-PYMT-IND (LN-SUB) = ' 1' OR ' 5' OR ' 7' THEN MOVE 0 TO H-BLOOD-FRACTION PERFORM 5550-CALC-GJK THRU 5550-CALC-GJK-EXIT PERFORM 5560-CALC-BENE-DEDUCT THRU 5560-CALC-BENE-DEDUCT-EXIT ELSE MOVE 41 TO A-RETURN-CODE (LN-SUB) GO TO 5550-CALC-STANDARD-EXIT END-IF END-IF. JB * JB * THE FOLLOWING SEARCH IS AN APC TABLE SEARCH TO SEE IF PRESENT JB * JB IF H-LITEM-PYMT > 0 JB SET WAC-INDX TO 1 JB SEARCH WAC-ENTRY VARYING WAC-INDX JB AT END JB COMPUTE H-LITEM-REIM ROUNDED = JB ((H-LITEM-PYMT - H-TOTAL-LN-DEDUCT) - JB H-LN-BLOOD-DEDUCT) * W-PPCT (W-LP-INDX) JB COMPUTE H-NAT-COIN = H-LITEM-PYMT - JB H-TOTAL-LN-DEDUCT - H-LITEM-REIM - H-LN-BLOOD-DEDUCT JB MOVE W-MIN-COIN (W-LP-INDX) TO H-MIN-COIN JB WHEN OPPS-APC(LN-SUB) = WAC-CODE (WAC-INDX) JB COMPUTE H-LITEM-REIM ROUNDED = JB ((H-LITEM-PYMT - H-TOTAL-LN-DEDUCT) - JB H-LN-BLOOD-DEDUCT) * .8 JB COMPUTE H-NAT-COIN = H-LITEM-PYMT - JB H-TOTAL-LN-DEDUCT - H-LITEM-REIM - H-LN-BLOOD-DEDUCT JB MOVE W-MIN-COIN (W-LP-INDX) TO H-MIN-COIN JB ELSE NEXT SENTENCE. IF H-MIN-COIN > 0 IF OPPS-SRVC-IND (LN-SUB) = ' G' OR ' H' OR ' K' COMPUTE H-MIN-COIN ROUNDED = H-MIN-COIN * (W-SRVC-UNITS (W-LP-INDX) - (W-SRVC-UNITS (W-LP-INDX) * H-BLOOD-FRACTION)) * W-DISC-RATE (W-LP-INDX) ELSE IF OPPS-APC (LN-SUB) = '0158' OR '0159' COMPUTE H-MIN-COIN ROUNDED = H-LITEM-PYMT * .25 ELSE COMPUTE H-MIN-COIN ROUNDED = H-LITEM-PYMT * .2 END-IF END-IF END-IF. MOVE W-RED-COIN (W-LP-INDX) TO H-RED-COIN. IF (H-RED-COIN > 0 AND < H-MIN-COIN) MOVE H-MIN-COIN TO H-RED-COIN ELSE IF H-RED-COIN < H-NAT-COIN AND > H-MIN-COIN AND > H-MAX-COIN COMPUTE H-LITEM-REIM = H-LITEM-REIM + (H-RED-COIN - H-MAX-COIN) END-IF END-IF. IF H-NAT-COIN > H-MAX-COIN AND H-RED-COIN = 0 THEN COMPUTE H-LITEM-REIM = H-LITEM-REIM + (H-NAT-COIN - H-MAX-COIN) MOVE H-MAX-COIN TO H-NAT-COIN. 5550-CALC-STANDARD-EXIT. EXIT. *************************************************************** * * * CALCULATE WAGE ADJUSTED LINE ITEM PAYMENT WITH RURAL * * SOLE COMMUNITY HOSPITAL (SCH) ADJUSTMENT WHEN APPLICABLE * * * * FOR LINES WITH A SI OF S, V, T, P, X, OR R * * * *************************************************************** * * * THE SCH ADJUSTMENT IS MADE WHEN THE FOLLOWING IS TRUE: * * EITHER THE L-PSF-GEO-CBSA OR THE L-PSF-WI-CBSA MUST BE A * * VALUE OF ' 01' THRU ' 99' AND THE L-PSF-PROV-TYPE * * MUST BE A '16' OR '17' OR '21' OR '22'. * * * * 08/07/2009 - REVISED LOGIC TO ACCOMODATE BLOOD LINES * * 05/09/2011 - REVISED LOGIC TO EXCLUDE BILL TYPE 14X FROM * * RECEIVING THE SCH ADD-ON * * * *************************************************************** JB 5550-SCH-ADJ. JB MOVE L-PSF-GEO-CBSA TO GEO-CBSA-FLAG. JB MOVE L-PSF-WI-CBSA TO WI-CBSA-FLAG. JB *************************************************************** * CALCULATE THE SCH PAYMENT * * - FOR SCHS = APC OR BLOOD APC PAYMENT ADJUSTED BY 7.1% * * - FOR NON-SCHS = UNADJUSTED APC OR BLOOD APC PAYMENT * *************************************************************** JB IF ((RURAL-GEO OR RURAL-WI) AND JB (L-PSF-PROV-TYPE = '16' OR '17' OR '21' OR '22') AND (BILL14X-FLAG = 'N')) *-------------------------------------------------------------* * SCH, BLOOD DEDUCTIBLE HCPCS LINE - ADDED 08/07/2009 * *-------------------------------------------------------------* IF OPPS-SRVC-IND (LN-SUB) = ' K' AND OPPS-HCPCS(LN-SUB) = ('P9010' OR 'P9016' OR 'P9021' OR 'P9022' OR 'P9038' OR 'P9039' OR 'P9040' OR 'P9051' OR 'P9054' OR 'P9056' OR 'P9057' OR 'P9058') AND OPPS-PYMT-ADJ-FLAG (LN-SUB) = (' 5' OR ' 6') COMPUTE H-SCH-PYMT ROUNDED = (W-BD-APC-PYMT (W-BD-INDX) * 1.071) *-------------------------------------------------------------* * SCH, NOT A LINE WITH A BLOOD DEDUCTIBLE HCPCS * *-------------------------------------------------------------* ELSE JB COMPUTE H-SCH-PYMT ROUNDED = JB (W-APC-PYMT (W-LP-INDX) * 1.071) END-IF *-------------------------------------------------------------* * NON-SCH, BLOOD DEDUCTIBLE HCPCS LINE * *-------------------------------------------------------------* ELSE IF OPPS-SRVC-IND (LN-SUB) = ' K' AND OPPS-HCPCS(LN-SUB) = ('P9010' OR 'P9016' OR 'P9021' OR 'P9022' OR 'P9038' OR 'P9039' OR 'P9040' OR 'P9051' OR 'P9054' OR 'P9056' OR 'P9057' OR 'P9058') AND OPPS-PYMT-ADJ-FLAG (LN-SUB) = (' 5' OR ' 6') MOVE W-BD-APC-PYMT (W-BD-INDX) TO H-SCH-PYMT *-------------------------------------------------------------* * NON-SCH, NOT A LINE WITH A BLOOD DEDUCTIBLE HCPCS * *-------------------------------------------------------------* EF ELSE EF MOVE W-APC-PYMT (W-LP-INDX) TO H-SCH-PYMT END-IF END-IF. *************************************************************** * CALCULATE THE LINE ITEM PAYMENT * *************************************************************** *-------------------------------------------------------------* * SI = K LINES (BLOOD) ARE NOT WAGE-ADJUSTED * *-------------------------------------------------------------* IF OPPS-SRVC-IND (LN-SUB) = ' K' IF OPPS-HCPCS(LN-SUB) = ('P9010' OR 'P9016' OR 'P9021' OR 'P9022' OR 'P9038' OR 'P9039' OR 'P9040' OR 'P9051' OR 'P9054' OR 'P9056' OR 'P9057' OR 'P9058') AND OPPS-PYMT-ADJ-FLAG (LN-SUB) = (' 5' OR ' 6') COMPUTE H-LITEM-PYMT ROUNDED = H-SCH-PYMT * W-BD-SRVC-UNITS (W-BD-INDX) * W-BD-DISC-RATE (W-BD-INDX) ELSE COMPUTE H-LITEM-PYMT ROUNDED = H-SCH-PYMT * W-SRVC-UNITS (W-LP-INDX) * W-DISC-RATE (W-LP-INDX) END-IF *-------------------------------------------------------------* * SI = S, V, T, P, OR X LINES ARE WAGE-ADJUSTED (60%) * *-------------------------------------------------------------* ELSE COMPUTE H-LITEM-PYMT ROUNDED = (((H-SCH-PYMT * .60) * W-WINX1 (W-LP-INDX)) + (H-SCH-PYMT * .40)) * W-SRVC-UNITS (W-LP-INDX) * W-DISC-RATE (W-LP-INDX) END-IF. JB 5550-SCH-ADJ-EXIT. JB EXIT. *************************************************************** * * * 1. CALCULATE LINE ITEM PAYMENT FOR SERVICE INDICATOR * * TYPES G OR K. * * 2. EFFECTIVE 01/01/2003 REMOVE PRO RATA REDUCTION FOR * * ALL SERVICE INDICATOR 'G' PAYMENTS * * * * 08/07/2009 - REVISED LOGIC TO FORCE ALL BLOOD LINES TO * * PARAGRAPH 5550-SCH-ADJ; THIS ALLOWS ALL BLOOD * * LINES WITH A SCH PROVIDER TO RECEIVE THE SCH * * ADJ. EFFECTIVE OCTOBER 2009. * * * *************************************************************** 5550-CALC-GJK. *-------------------------------------------------------------* ** * SEARCH BLOOD HCPCS TABLE TO IDENTIFY LINES WITH BLOOD HCPCS * ** * ADDED 08/07/2009 * ** *-------------------------------------------------------------* *** MOVE 'N' TO W-BLD-HCPCS-FLAG. SET WBLH-INDX TO 1. SEARCH WBLHCPCS-ENTRY VARYING WBLH-INDX AT END MOVE 'N' TO W-BLD-HCPCS-FLAG WHEN W-2005-2008-BLOOD-HCPCS (WBLH-INDX) = OPPS-HCPCS (LN-SUB) MOVE 'Y' TO W-BLD-HCPCS-FLAG. *-------------------------------------------------------------* ** * CALCULATE LINE ITEM PAYMENT & BLOOD DEDUCTIBLE FOR BLOOD * ** * LINE WITH A HCPCS SUBJECT TO THE BLOOD DEDUTIBLE * ** * 08/07/2009 - ADDED PERFORM 5550-SCH-ADJ & INSERTED BLOOD * * DEDUCTIBLE CALCULATION & INCREMENT * *-------------------------------------------------------------* *** IF (OPPS-HCPCS(LN-SUB) = ('P9010' OR 'P9016' OR 'P9021' OR 'P9022' OR 'P9038' OR 'P9039' OR 'P9040' OR 'P9051' OR 'P9054' OR 'P9056' OR 'P9057' OR 'P9058') AND OPPS-PYMT-ADJ-FLAG (LN-SUB) = (' 5' OR ' 6')) PERFORM 5550-SET-BLOOD-FRACTION THRU 5550-SET-BLOOD-FRACTION-EXIT PERFORM 5550-ADJ-BLOOD-COST THRU 5550-ADJ-BLOOD-COST-EXIT PERFORM 5550-SCH-ADJ THRU 5550-SCH-ADJ-EXIT COMPUTE H-LN-BLOOD-DEDUCT ROUNDED = H-LITEM-PYMT * H-BLOOD-FRACTION SET W-BD-INDX UP BY 1 *-------------------------------------------------------------* ** * CALCULATE LINE ITEM PAYMENT FOR BLOOD LINE WITH A HCPCS * ** * NOT SUBJECT TO THE BLOOD DEDUCTIBLE , BUT PAF = 5 OR 6 * ** * 08/07/2009 - ADDED BLOOD HCPCS CHECK, AND * * ADDED PERFORM 5550-SCH-ADJ * *-------------------------------------------------------------* *** ELSE IF W-BLD-HCPCS-FLAG = 'Y' AND OPPS-PYMT-ADJ-FLAG (LN-SUB) = (' 5' OR ' 6') PERFORM 5550-ADJ-PLATE-COST THRU 5550-ADJ-PLATE-COST-EXIT PERFORM 5550-SCH-ADJ THRU 5550-SCH-ADJ-EXIT *-------------------------------------------------------------* ** * CALCULATE LINE ITEM PAYMENT FOR BLOOD LINE WITH A HCPCS * ** * NOT SUBJECT TO THE BLOOD DEDUCTIBLE AND PAF NOT = 5 OR 6 * ** * 08/07/2009 - ADDED THIS NEW CONDITION * *-------------------------------------------------------------* *** ELSE IF W-BLD-HCPCS-FLAG = 'Y' PERFORM 5550-SCH-ADJ THRU 5550-SCH-ADJ-EXIT *-------------------------------------------------------------* ** * CALCULATE LINE ITEM PAYMENT FOR NON-BLOOD LINE * ** * (DRUGS & BIOLOGICALS) * *-------------------------------------------------------------* *** ELSE COMPUTE H-LITEM-PYMT ROUNDED = W-APC-PYMT (W-LP-INDX) * W-SRVC-UNITS (W-LP-INDX) * W-DISC-RATE (W-LP-INDX) END-IF END-IF END-IF. 5550-CALC-GJK-EXIT. EXIT. 5550-SET-BLOOD-FRACTION. MOVE W-BD-SUB (W-BD-INDX) TO LN-SUB. IF OPPS-PYMT-ADJ-FLAG (LN-SUB) = ' 5' IF H-BENE-PINTS-USED > 0 IF W-BD-SRVC-UNITS (W-BD-INDX) <= H-BENE-PINTS-USED MOVE 1 TO H-BLOOD-FRACTION COMPUTE H-BENE-PINTS-USED = H-BENE-PINTS-USED - W-BD-SRVC-UNITS (W-BD-INDX) ELSE IF W-BD-SRVC-UNITS (W-BD-INDX) > H-BENE-PINTS-USED COMPUTE H-BLOOD-FRACTION = H-BENE-PINTS-USED / W-BD-SRVC-UNITS (W-BD-INDX) MOVE 0 TO H-BENE-PINTS-USED ELSE MOVE 0 TO H-BLOOD-FRACTION ELSE MOVE 0 TO H-BLOOD-FRACTION ELSE MOVE 0 TO H-BLOOD-FRACTION. 5550-SET-BLOOD-FRACTION-EXIT. EXIT. 5550-ADJ-BLOOD-COST. MOVE W-BD-SUB (W-BD-INDX) TO LN-SUB. IF OPPS-PYMT-ADJ-FLAG (LN-SUB) = ' 5' COMPUTE W-BD-APC-PYMT (W-BD-INDX) = W-BD-APC-PYMT (W-BD-INDX) * H-38X-39X-RATE. IF OPPS-PYMT-ADJ-FLAG (LN-SUB) = ' 6' COMPUTE W-BD-APC-PYMT (W-BD-INDX) = W-BD-APC-PYMT (W-BD-INDX) * (1 - H-38X-39X-RATE). 5550-ADJ-BLOOD-COST-EXIT. EXIT. 5550-ADJ-PLATE-COST. IF OPPS-PYMT-ADJ-FLAG (LN-SUB) = ' 5' COMPUTE W-APC-PYMT (W-LP-INDX) = W-APC-PYMT (W-LP-INDX) * H-38X-39X-RATE. IF OPPS-PYMT-ADJ-FLAG (LN-SUB) = ' 6' COMPUTE W-APC-PYMT (W-LP-INDX) = W-APC-PYMT (W-LP-INDX) * (1 - H-38X-39X-RATE). COMPUTE H-LITEM-PYMT ROUNDED = W-APC-PYMT (W-LP-INDX) * W-SRVC-UNITS (W-LP-INDX) * W-DISC-RATE (W-LP-INDX). 5550-ADJ-PLATE-COST-EXIT. EXIT. *************************************************************** * 1. CALCULATE LINE ITEM PAYMENT FOR SERVICE INDICATOR * * TYPE H. * * 2. EFFECTIVE 04/01/2002 A PRO RATA REDUCTION APPLIES TO * * ALL SERVICE INDICATOR 'H' PAYMENTS (CURRENTLY .689) * *************************************************************** 5555-CALC-H-TOT. MOVE W-LP-SUB (W-LP-INDX) TO LN-SUB. MOVE OPPS-SUB-CHRG (LN-SUB) TO H-SUB-CHRG. IF OPPS-SRVC-IND (LN-SUB) = ' H' IF OPPS-PYMT-IND (LN-SUB) = ' 6' COMPUTE H-TOT-H-CHRG = (H-TOT-H-CHRG + H-SUB-CHRG) ELSE NEXT SENTENCE ELSE NEXT SENTENCE. 5555-CALC-H-TOT-EXIT. EXIT. 5555-CALC-H-STANDARD. MOVE OPPS-SUB-CHRG (LN-SUB) TO H-SUB-CHRG. COMPUTE T-LITEM-PYMT ROUNDED = (H-SUB-CHRG * L-PSF-OPCOST-RATIO). IF (C-FLAG = 'Y') IF (H-TOT-OFF-UNITS > H-TOT-HTD-UNITS) COMPUTE H-TOTAL-WAOFF ROUNDED = (((H-TOTAL-OFFSET * .60) * A-WINX) + (H-TOTAL-OFFSET * .40)) * (H-TOT-HTD-UNITS / H-TOT-OFF-UNITS) PERFORM 5700-CALC-H-OFFSET THRU 5700-CALC-H-OFFSET-EXIT ELSE COMPUTE H-TOTAL-WAOFF ROUNDED = ((H-TOTAL-OFFSET * .60) * A-WINX) + (H-TOTAL-OFFSET * .40) PERFORM 5700-CALC-H-OFFSET THRU 5700-CALC-H-OFFSET-EXIT ELSE NEXT SENTENCE. IF T-LITEM-PYMT < 0 THEN MOVE 0 TO H-LITEM-PYMT ELSE MOVE T-LITEM-PYMT TO H-LITEM-PYMT. 5555-CALC-H-STANDARD-EXIT. EXIT. 5560-CALC-BENE-DEDUCT. IF OPPS-PYMT-ADJ-FLAG (LN-SUB) = ' 4' GO TO 5560-CALC-BENE-DEDUCT-EXIT. IF H-BENE-DEDUCT > 0 THEN COMPUTE H-LN-BLD-PYMT = H-LITEM-PYMT - H-LN-BLOOD-DEDUCT IF H-BENE-DEDUCT <= H-LN-BLD-PYMT THEN MOVE H-BENE-DEDUCT TO H-TOTAL-LN-DEDUCT MOVE 0 TO H-BENE-DEDUCT ELSE COMPUTE H-BENE-DEDUCT = H-BENE-DEDUCT - H-LN-BLD-PYMT MOVE H-LN-BLD-PYMT TO H-TOTAL-LN-DEDUCT MOVE 20 TO A-RETURN-CODE (LN-SUB) END-IF END-IF. 5560-CALC-BENE-DEDUCT-EXIT. EXIT. ********************************************************************* ** - NEW FOR JANUARY 2004 ** ** - CHECK >= 20040101 AND SRVC-IND = 'K' ** ** - DISCONTINUE OUTLIER PROCESS ** ********************************************************************* 5600-ADJ-CHRG-OUTL. MOVE W-LP-SUB (W-LP-INDX) TO LN-SUB. ********************************************************************* ** - NEW FOR JANUARY 2005 ** ** - TURN OFF OUTLIER PROCESS FOR SPECIFIED K TYPE APCS ** ** ** ** 05/12/2009 - ALTERED LOGIC TO ALLOW ALL BLOOD LINES (WITH A ** ** STATUS INDICATOR = ' K') TO ENTER OUTLIER LOGIC ** ** ** ********************************************************************* MOVE 'N' TO W-BLD-HCPCS-FLAG. SET WBLH-INDX TO 1. SEARCH WBLHCPCS-ENTRY VARYING WBLH-INDX AT END MOVE 'N' TO W-BLD-HCPCS-FLAG WHEN W-2005-2008-BLOOD-HCPCS (WBLH-INDX) = OPPS-HCPCS (LN-SUB) MOVE 'Y' TO W-BLD-HCPCS-FLAG. IF (OPPS-SRVC-IND (LN-SUB) = ' G' OR ' H' OR ' N') OR (OPPS-PKG-FLAG (LN-SUB) = '4') OR (OPPS-SRVC-IND (LN-SUB) = ' K' AND W-BLD-HCPCS-FLAG = 'N') GO TO 5600-ADJ-CHRG-OUTL-EXIT. *----------------------------------------------------------* * CODE COMMENTED OUT 05/12/2009 & REPLACED WITH CODE ABOVE * *----------------------------------------------------------* * IF (OPPS-SRVC-IND (LN-SUB) = ' G' OR ' K' OR * ' H' OR ' N') OR (OPPS-PKG-FLAG (LN-SUB) = '4') * GO TO 5600-ADJ-CHRG-OUTL-EXIT. ***************************************************** ** NEW LOGIC INSERTED FOR WEB USE ONLY * ***************************************************** IF (ST0-FLAG = 'Y') AND ((OPPS-SRVC-IND (LN-SUB) = ' T' ) OR ((OPPS-SRVC-IND (LN-SUB) = ' S') AND (OPPS-HCPCS (LN-SUB) > '09999' AND OPPS-HCPCS (LN-SUB) < '70000'))) AND (H-TOT-ST-PYMT > 0) COMPUTE H-CHRG-RATE ROUNDED = (A-LITEM-PYMT (LN-SUB) / H-TOT-ST-PYMT) COMPUTE W-SUB-CHRG (W-LP-INDX) ROUNDED = (H-CHRG-RATE * H-TOT-ST-CHRG) ELSE IF (N-FLAG = 'Y' AND ST0-FLAG = 'N') AND ((OPPS-SRVC-IND (LN-SUB) = ' S' OR ' T' OR ' V' OR ' X' OR ' P') AND (OPPS-PKG-FLAG (LN-SUB) = '0' OR '3')) AND (H-TOT-STVX-PYMT > 0) COMPUTE H-CHRG-RATE ROUNDED = (A-LITEM-PYMT (LN-SUB) / H-TOT-STVX-PYMT) COMPUTE H-SUB-CHRG ROUNDED = (H-CHRG-RATE * H-TOT-N-CHRG) COMPUTE W-SUB-CHRG (W-LP-INDX) ROUNDED = W-SUB-CHRG (W-LP-INDX) + H-SUB-CHRG. IF (N-FLAG = 'Y' AND ST0-FLAG = 'Y') AND ((OPPS-SRVC-IND (LN-SUB) = ' S' OR ' T' OR ' V' OR ' X' OR ' P') AND (OPPS-PKG-FLAG (LN-SUB) = '0' OR '3')) AND (H-TOT-STVX-PYMT > 0) COMPUTE H-CHRG-RATE ROUNDED = (A-LITEM-PYMT (LN-SUB) / H-TOT-STVX-PYMT) COMPUTE H-SUB-CHRG ROUNDED = (H-CHRG-RATE * H-TOT-N-CHRG) COMPUTE W-SUB-CHRG (W-LP-INDX) ROUNDED = W-SUB-CHRG (W-LP-INDX) + H-SUB-CHRG. ********************************************************************* ** - NEW FOR JANUARY 2005 ** ** - PROVIDER RANGE FOR CMHC ** ** - COMPUTE H-LITEM-OUTL-PYMT USING NEW FORMULA ** ** - THIS IS THE OUTLIER THRESHOLD AMOUNT ** ********************************************************************* MOVE 1.75 TO H-OUTLIER-FACTOR. MOVE .50 TO H-OUTLIER-PCT. COMPUTE H-COST ROUNDED = W-SUB-CHRG (W-LP-INDX) * L-PSF-OPCOST-RATIO. COMPUTE H-APC-ADJ-PYMT ROUNDED = H-OUTLIER-FACTOR * A-LITEM-PYMT (LN-SUB). IF (L-PSF-PROV-3456 >= '1400' AND L-PSF-PROV-3456 <= '1499') OR (L-PSF-PROV-3456 >= '4600' AND L-PSF-PROV-3456 <= '4799') OR (L-PSF-PROV-3456 >= '4900' AND L-PSF-PROV-3456 <= '4999') MOVE 3.4 TO H-OUTLIER-FACTOR COMPUTE H-LITEM-OUTL-PYMT ROUNDED = (H-COST - (H-OUTLIER-FACTOR * A-LITEM-PYMT (LN-SUB))) * H-OUTLIER-PCT ELSE IF (H-COST > H-APC-ADJ-PYMT) AND (H-COST > A-LITEM-PYMT (LN-SUB) + 1250) COMPUTE H-LITEM-OUTL-PYMT ROUNDED = (H-COST - H-APC-ADJ-PYMT) * H-OUTLIER-PCT ELSE MOVE ZERO TO H-LITEM-OUTL-PYMT. IF H-LITEM-OUTL-PYMT > 0 COMPUTE H-OUTLIER-PYMT = H-OUTLIER-PYMT + H-LITEM-OUTL-PYMT. IF OPPS-LITEM-ACT-FLAG (LN-SUB) = '4' COMPUTE H-OUTLIER-PYMT = H-OUTLIER-PYMT - H-LITEM-OUTL-PYMT MOVE 0 TO H-LITEM-OUTL-PYMT. 5600-ADJ-CHRG-OUTL-EXIT. EXIT. *************************************************************** * 1. RE-CALCULATE LINE ITEM PAYMENT FOR SERVICE INDICATOR * * TYPE H. * * 2. SUBTRACT WAGE ADJUSTED OFFSET AMOUNT FROM SI TYPE 'H' * * WITH HCPCS CODE BEGINNING WITH 'C' * * 2. EFFECTIVE 04/01/2002 * *************************************************************** 5700-CALC-H-OFFSET. IF H-TOT-H-CHRG > 0 COMPUTE H-OFF-RATE ROUNDED = H-SUB-CHRG / H-TOT-H-CHRG COMPUTE T-LITEM-PYMT ROUNDED = T-LITEM-PYMT - (H-TOTAL-WAOFF * H-OFF-RATE) ELSE NEXT SENTENCE. IF T-LITEM-PYMT < 0 MOVE 0 TO T-LITEM-PYMT. 5700-CALC-H-OFFSET-EXIT. EXIT. 5800-ADJ-STV-REIM. IF W-DCP-CODE (W-DCP-INDX) = 1 PERFORM 5810-PROCESS-TYPE1 THRU 5810-PROCESS-TYPE1-EXIT ELSE PERFORM 5840-PROCESS-TYPE2 THRU 5840-PROCESS-TYPE2-EXIT. 5800-ADJ-STV-REIM-EXIT. EXIT. 5810-PROCESS-TYPE1. IF W-DCP-COIN2 (W-DCP-INDX) > 0 MOVE W-DCP-DOS (W-DCP-INDX) TO H-DCP-DOS MOVE W-DCP-WGNAT (W-DCP-INDX) TO H-TOTAL COMPUTE H-RATIO = (H-IP-LIMIT - W-DCP-WGNAT (W-DCP-INDX)) / W-DCP-COIN2 (W-DCP-INDX) IF H-RATIO < 0 MOVE 0 TO H-RATIO. IF H-RATIO > 1 MOVE 1 TO H-RATIO. 5810-PROCESS-TYPE1-EXIT. EXIT. 5840-PROCESS-TYPE2. IF W-DCP-DOS (W-DCP-INDX) = H-DCP-DOS MOVE W-DCP-SUB (W-DCP-INDX) TO LN-SUB COMPUTE H-SHIFT = W-DCP-COIN2 (W-DCP-INDX) * (1 - H-RATIO) COMPUTE H-TOTAL = A-ADJ-COIN (LN-SUB) + H-TOTAL - H-SHIFT IF H-TOTAL > H-IP-LIMIT COMPUTE H-SHIFT = H-SHIFT + H-TOTAL - H-IP-LIMIT END-IF COMPUTE A-ADJ-COIN (LN-SUB) = A-ADJ-COIN (LN-SUB) - H-SHIFT COMPUTE A-LITEM-REIM (LN-SUB) = A-LITEM-REIM (LN-SUB) + H-SHIFT MOVE 22 TO A-RETURN-CODE (LN-SUB) END-IF. 5840-PROCESS-TYPE2-EXIT. EXIT. *************************************************************** * 1. MOVE TOTAL CLAIM CHARGE AMOUNT. * * 2. MOVE TOTAL CLAIM PAYMENT AMOUNT. * * 3. MOVE TOTAL CLAIM BLOOD PINTS USED. * * 4. CALCULATE CLAIM LEVEL OUTLIER AMOUNT. * *************************************************************** 5900-END-PRICE-RTN. MOVE H-TOT-CHRG TO A-TOT-CLM-CHRG. MOVE H-TOT-PYMT TO A-TOT-CLM-PYMT. COMPUTE A-BLOOD-PINTS-USED = H-BENE-BLOOD-PINTS - H-BENE-PINTS-USED. IF H-OUTLIER-PYMT > 0 MOVE H-OUTLIER-PYMT TO A-OUTLIER-PYMT. 5900-END-PRICE-RTN-EXIT. EXIT. 6000-PROCESS-MAIN-NEW. ********************************************************** 00000100 * COMMENT: * 00000200 * 1ST LOOP * 00000300 * LOOP THE CLAIM TO FIND APC '0033' * 00000300 ********************************************************** 00000600 PERFORM 6100-INIT THRU 6100-INIT-EXIT. IF H-WINX1 = 0 AND A-CLM-RTN-CODE = 01 MOVE 51 TO A-CLM-RTN-CODE. IF A-CLM-RTN-CODE >= 50 GOBACK. MOVE H-WINX1 TO A-WINX. PERFORM 6125-INIT THRU 6125-INIT-EXIT VARYING LN-SUB FROM 1 BY 1 UNTIL LN-SUB > OPPS-LINE-CNT. ********************************************************** 00000100 * COMMENT: * 00000200 * 2ND LOOP * 00000300 ********************************************************** 00000600 MOVE 0 TO W-DCP-MAX W-BLD-MAX. PERFORM 6150-INIT THRU 6150-INIT-EXIT VARYING LN-SUB FROM 1 BY 1 UNTIL LN-SUB > OPPS-LINE-CNT. ********************************************************** 00000100 * COMMENT: * 00000200 * BREAKING OUT BLOOD PRODUCT & LABOR PORTION * 00000300 ********************************************************** 00000600 IF H-TOT-38X-39X > 0 COMPUTE H-38X-39X-RATE ROUNDED = H-TOT-38X / H-TOT-38X-39X. ********************************************************** 00000100 * COMMENT: * 00000200 * 3RD LOOP * 00000300 * TOTALS H RELEATED CHARGES. * 00000300 ********************************************************** 00000600 MOVE 0 TO W-DCP-MAX. PERFORM 6555-CALC-H-TOT THRU 6555-CALC-H-TOT-EXIT VARYING W-LP-INDX FROM 1 BY 1 UNTIL W-LP-INDX > W-LNC-MAX. SET W-BD-INDX TO 1. MOVE 0 TO W-DCP-MAX. PERFORM 6400-CALCULATE THRU 6400-CALCULATE-EXIT VARYING W-LP-INDX FROM 1 BY 1 UNTIL W-LP-INDX > W-LNC-MAX. PERFORM 6600-ADJ-CHRG-OUTL THRU 6600-ADJ-CHRG-OUTL-EXIT VARYING W-LP-INDX FROM 1 BY 1 UNTIL W-LP-INDX > W-LNC-MAX IF GJK-FLAG = 'Y' PERFORM 6800-ADJ-STV-REIM THRU 6800-ADJ-STV-REIM-EXIT VARYING W-DCP-INDX FROM 1 BY 1 UNTIL W-DCP-INDX > W-DCP-MAX ELSE NEXT SENTENCE. PERFORM 6900-END-PRICE-RTN THRU 6900-END-PRICE-RTN-EXIT. 6000-PROCESS-MAIN-NEW-EXIT. EXIT. *************************************************************** * INITIALIZE WORKING STORAGE HOLD AREAS * * AND ADDITIONAL VARIABLES TO BE PASSED BACK TO * * THE STANDARD SYSTEM. * * - IF PROVIDER SPECIFIC FILE WAGE INDEX RECLASSIFICATION * * CODE INVALID OR MISSING * * - MOVE '52' TO CLAIM LEVEL RETURN CODE * * - DISCONTINUE CLAIM PROCESSING * * - IF SERVICE FROM DATE NOT NUMERIC OR < 20000801 * * - MOVE '53' TO CLAIM LEVEL RETURN CODE * * - DISCONTINUE CLAIM PROCESSING * * - IF SERVICE FROM DATE < PROVIDER EFFECTIVE DATE * * - MOVE '54' TO CLAIM LEVEL RETURN CODE * * - DISCONTINUE CLAIM PROCESSING * * - IF SERVICE FROM DATE > PROVIDER TERMINATION DATE * * - MOVE '54' TO CLAIM LEVEL RETURN CODE * * - DISCONTINUE CLAIM PROCESSING * * 05/12/2009 - W-BLD-HCPCS-FLAG ADDED * *************************************************************** 6100-INIT. MOVE 01 TO A-CLM-RTN-CODE. MOVE 'N' TO APC33-FLAG GJK-FLAG ST0-FLAG N-FLAG C-FLAG C1820-OFFSET-FLAG W-BLD-HCPCS-FLAG. MOVE SPACE TO A-MSA A-CBSA BILL14X-FLAG. MOVE ZERO TO A-OUTLIER-PYMT A-TOTAL-CLM-DEDUCT A-TOT-CLM-CHRG A-TOT-CLM-PYMT A-BLOOD-DEDUCT-DUE A-BLOOD-PINTS-USED A-WINX W-LNC-MAX. INITIALIZE H-ADDITIONAL-VARIABLES. INITIALIZE LINE-HOLD-ITEMS. INITIALIZE T-LITEM-PYMT. IF L-SERVICE-FROM-DATE NOT NUMERIC MOVE 53 TO A-CLM-RTN-CODE GO TO 6100-INIT-EXIT ELSE IF L-SERVICE-FROM-DATE < L-PSF-EFFDT MOVE 54 TO A-CLM-RTN-CODE GO TO 6100-INIT-EXIT ELSE IF L-PSF-TERMDT > 0 IF L-SERVICE-FROM-DATE > L-PSF-TERMDT MOVE 54 TO A-CLM-RTN-CODE GO TO 6100-INIT-EXIT END-IF END-IF. ********************************************************** 00000100 * COMMENT: * 00000200 * UPDATE EVERY JANUARY * 00000300 ********************************************************** 00000600 MOVE CAL-VERSION6 TO A-CALC-VERS. MOVE BENE-DEDUCT TO H-BENE-DEDUCT. MOVE BENE-BLOOD-PINTS TO H-BENE-BLOOD-PINTS H-BENE-PINTS-USED. MOVE WAD-MAX TO WAD-SUB. ********************************************************** 00000100 * COMMENT: * 00000200 * GET TO PROPER APC DATE BY SERVICE DATE * 00000300 * (WALKS APC DATE TABLE) * 00000300 ********************************************************** 00000600 PERFORM UNTIL L-SERVICE-FROM-DATE NOT < WAD-DATE (WAD-SUB) SUBTRACT 1 FROM WAD-SUB END-PERFORM. ********************************************************** 00000100 * COMMENT: * 00000200 * CHANGE FOLOWING 2 HARDCODED VALUES EACH YEAR. * 00000300 * GET THIS AMOUNT EACH YEAR FROM JOEY BRYSON. * 00000300 * FOLLOWING MOVES A SPEC WAGE INDX FROM PROV FILE. * 00000300 ********************************************************** 00000600 IF L-PSF-SPEC-PYMT-IND = 'Y' MOVE L-PSF-WI-CBSA TO H-PSF-CBSA ELSE IF L-PSF-SPEC-PYMT-IND = ' ' MOVE L-PSF-GEO-CBSA TO H-PSF-CBSA ELSE IF L-PSF-SPEC-PYMT-IND = '1' OR '2' MOVE L-PSF-GEO-CBSA TO H-PSF-CBSA A-CBSA MOVE L-PSF-SPEC-WGIDX TO H-WINX1 MOVE 992 TO H-IP-LIMIT GO TO 6100-INIT-EXIT ELSE MOVE 52 TO A-CLM-RTN-CODE GO TO 6100-INIT-EXIT. IF H-PSF-CBSA = SPACE MOVE 52 TO A-CLM-RTN-CODE GO TO 6100-INIT-EXIT. MOVE 992 TO H-IP-LIMIT. PERFORM 6120-FLOOR-2007 THRU 6120-FLOOR-2007-EXIT. PERFORM 6120-SEC401-2007 THRU 6120-SEC401-2007-EXIT. MOVE H-PSF-CBSA TO A-CBSA. *********************************************************** 00000100 * COMMENT: * 00000200 * IF NOT OVERRIDDEN WAGE INDEX AS OF YET, GO LOOK IT UP * 00000300 *********************************************************** 00000600 IF H-WINX1 = 0 PERFORM 6200-CALC-WAGEINDX THRU 6200-CALC-WAGEINDX-EXIT. 6100-INIT-EXIT. EXIT. 000100************************************************************* 02 000200** NEW 2006 FLOOR AND SEC 401 FOR CBSA *** 02 000300************************************************************* 02 *********************************************************** 00000100 * COMMENT: * 00000200 * SYNC ALL OF THE FOLLOWING WITH INPATIENT. * 00000300 * SEE DAVE PANUSKA, OR FOLLOWER. * 00000300 * INPATIENT MOVE 'N' TO L-PSF-SPEC-PYMT-IND * 00000300 * OPPS MOVES ' ' TO L-PSF-SPEC-PYMT-IND * 00000300 *********************************************************** 00000600 260700 6120-FLOOR-2007. 02 261300 00 261400 IF H-PSF-CBSA = ' 10' 00 261500 AND L-PSF-SPEC-PYMT-IND = 'Y' 00 261600 AND L-PSF-PROV-ST = '10' 00 261700 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 00 261800 MOVE ' 10' TO H-PSF-CBSA. 00 261300 00 261400 IF H-PSF-CBSA = ' 14' 00 261500 AND L-PSF-SPEC-PYMT-IND = 'Y' 00 261600 AND L-PSF-PROV-ST = '14' 00 261700 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 00 261800 MOVE ' 14' TO H-PSF-CBSA. 00 260800 00 260900 IF H-PSF-CBSA = ' 26' 00 260910 AND L-PSF-SPEC-PYMT-IND = 'Y' 00 261000 AND L-PSF-PROV-ST = '26' 00 261100 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 00 261200 MOVE ' 26' TO H-PSF-CBSA. 00 261300 00 261400 IF H-PSF-CBSA = ' 50' 00 261500 AND L-PSF-SPEC-PYMT-IND = 'Y' 00 261600 AND L-PSF-PROV-ST = '50' 00 261700 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 00 261800 MOVE ' 50' TO H-PSF-CBSA. 00 261300 00 261400 IF H-PSF-CBSA = '10900' 00 261600 AND L-PSF-PROV-ST = '31' 00 261700 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 00 261800 MOVE ' 31' TO H-PSF-CBSA. 00 262500 00 262600 IF H-PSF-CBSA = '19060' 00 262700 AND L-PSF-PROV-ST = '21' 00 262800 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 00 262900 MOVE ' 21' TO H-PSF-CBSA. 00 264500 00 264600 IF H-PSF-CBSA = '22020' 00 264800 AND L-PSF-PROV-ST = '24' 00 264900 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 00 265000 MOVE ' 24' TO H-PSF-CBSA. 00 266300 00 266400 IF H-PSF-CBSA = '24220' 00 266500 AND L-PSF-PROV-ST = '24' 00 266600 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 00 266700 MOVE ' 24' TO H-PSF-CBSA. 00 267300 00 267400 IF H-PSF-CBSA = '24580' 00 267500 AND L-PSF-SPEC-PYMT-IND = 'Y' 00 267600 AND L-PSF-PROV-ST = '52' 00 267700 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 00 267800 MOVE ' 52' TO H-PSF-CBSA. 00 267900 00 268000 IF H-PSF-CBSA = '25540' 00 268100 AND L-PSF-SPEC-PYMT-IND = 'Y' 00 268200 AND L-PSF-PROV-ST = '07' 00 268300 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 00 268400 MOVE ' 07' TO H-PSF-CBSA. 00 269700 00 269800 IF H-PSF-CBSA = '26580' 00 269810 AND L-PSF-SPEC-PYMT-IND = 'Y' 00 269900 AND L-PSF-PROV-ST = '36' 00 270000 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 00 270100 MOVE ' 36' TO H-PSF-CBSA. 00 267300 00 270800 IF H-PSF-CBSA = '29100' 00 270900 AND L-PSF-PROV-ST = '52' 00 271000 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 00 271100 MOVE ' 52' TO H-PSF-CBSA. 00 271700 00 271800 IF H-PSF-CBSA = '30300' 00 271900 AND L-PSF-PROV-ST = '50' 00 272000 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 00 272100 MOVE ' 50' TO H-PSF-CBSA. 00 271700 00 271800 IF H-PSF-CBSA = '37620' 00 271900 AND L-PSF-PROV-ST = '36' 00 272000 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 00 272100 MOVE ' 36' TO H-PSF-CBSA. 00 273200 00 273300 IF H-PSF-CBSA = '37964' 00 273310 AND L-PSF-SPEC-PYMT-IND = 'Y' 00 273400 AND L-PSF-PROV-ST = '31' 00 273500 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 00 273600 MOVE ' 31' TO H-PSF-CBSA. 00 273700 00 273800 IF H-PSF-CBSA = '38300' 00 273810 AND L-PSF-SPEC-PYMT-IND = 'Y' 00 274000 AND L-PSF-PROV-ST = '36' 00 274100 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 00 274200 MOVE ' 36' TO H-PSF-CBSA. 00 274300 00 273800 IF H-PSF-CBSA = '39300' 00 274000 AND L-PSF-PROV-ST = '22' 00 274100 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 00 274200 MOVE ' 22' TO H-PSF-CBSA. 00 274300 00 273800 IF H-PSF-CBSA = '39300' 00 274000 AND L-PSF-PROV-ST = '41' 00 274100 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 00 274200 MOVE ' 41' TO H-PSF-CBSA. 00 274300 00 273800 IF H-PSF-CBSA = '45500' 00 274000 AND L-PSF-PROV-ST = '45' 00 274100 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 00 274200 MOVE ' 45' TO H-PSF-CBSA. 00 274300 00 273800 IF H-PSF-CBSA = '48260' 00 274000 AND L-PSF-PROV-ST = '36' 00 274100 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 00 274200 MOVE ' 36' TO H-PSF-CBSA. 00 274300 00 273800 IF H-PSF-CBSA = '48540' 00 274000 AND L-PSF-PROV-ST = '36' 00 274100 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 00 274200 MOVE ' 36' TO H-PSF-CBSA. 00 274300 00 273800 IF H-PSF-CBSA = '48540' 00 274000 AND L-PSF-PROV-ST = '51' 00 274100 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 00 274200 MOVE ' 51' TO H-PSF-CBSA. 00 274300 00 273800 IF H-PSF-CBSA = '48864' 00 274000 AND L-PSF-PROV-ST = '31' 00 274100 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 00 274200 MOVE ' 31' TO H-PSF-CBSA. 00 274300 00 274400 6120-FLOOR-2007-EXIT. 02 274500 EXIT. 02 309400 00 309500 6120-SEC401-2007. 02 309600************************************************************* 00 309700**** FOR CY 2007 SECTION 401 HOSPITALS * 02 309800************************************************************* 00 *********************************************************** 00000100 * COMMENT: * 00000200 * SYNC ALL OF THE FOLLOWING WITH INPATIENT. * 00000300 * SEE DAVE PANUSKA, OR FOLLOWER. * 00000300 *********************************************************** 00000100 310500 00 310600 IF (L-PSF-PROV-OSCAR = '050192' OR '050469' OR 00 310700 '050528' OR '050618') 02 310700 MOVE ' 05' TO H-PSF-CBSA. 02 310500 00 310600 IF (L-PSF-PROV-OSCAR = '070004') 00 310700 MOVE ' 07' TO H-PSF-CBSA. 02 310900 00 309900 IF (L-PSF-PROV-OSCAR = '100048' OR '100134') 00 310300 MOVE ' 10' TO H-PSF-CBSA. 02 310500 00 310600 IF (L-PSF-PROV-OSCAR = '140167') 00 310700 MOVE ' 14' TO H-PSF-CBSA. 02 310900 00 311000 IF (L-PSF-PROV-OSCAR = '170137') 00 311100 MOVE ' 17' TO H-PSF-CBSA. 02 311300 00 311400 IF (L-PSF-PROV-OSCAR = '230078') 00 311500 MOVE ' 23' TO H-PSF-CBSA. 02 311300 00 311400 IF (L-PSF-PROV-OSCAR = '260006' OR '260047' OR '260195') 00 311500 MOVE ' 26' TO H-PSF-CBSA. 02 310900 00 310900*--------------------------------------------------------------* 00 310900* THIS LOGIC HAS BEEN DISABLED & REPLACED WITH THE LOGIC BELOW * 00 310900* HOSPITALS 330044 AND 330245 WERE REMOVED 8/10/2007 FOR * 00 310900* VERSION 2007.4.0. * 00 310900*--------------------------------------------------------------* 00 311000* IF (L-PSF-PROV-OSCAR = '330044' OR '330245' OR '330268') * 00 311100* MOVE ' 33' TO H-PSF-CBSA. * 02 310900*--------------------------------------------------------------* 00 310900 00 311000 IF (L-PSF-PROV-OSCAR = '330268') 00 311100 MOVE ' 33' TO H-PSF-CBSA. 02 311300 00 311400 IF (L-PSF-PROV-OSCAR = '360125') 00 311500 MOVE ' 36' TO H-PSF-CBSA. 02 311700 00 311800 IF (L-PSF-PROV-OSCAR = '370054') 00 311900 MOVE ' 37' TO H-PSF-CBSA. 02 312100 00 311800 IF (L-PSF-PROV-OSCAR = '380040') 00 312300 MOVE ' 38' TO H-PSF-CBSA. 02 312100 00 311800 IF (L-PSF-PROV-OSCAR = '440135' OR '440144') 00 312300 MOVE ' 44' TO H-PSF-CBSA. 02 312500 00 312600 IF (L-PSF-PROV-OSCAR = '450052' OR '450078' OR 00 312640 '450243' OR '450348') 00 312700 MOVE ' 45' TO H-PSF-CBSA. 02 313300 00 313400 IF (L-PSF-PROV-OSCAR = '500148') 00 313500 MOVE ' 50' TO H-PSF-CBSA. 02 313300 00 313400 IF (L-PSF-PROV-OSCAR = '520060') 00 313500 MOVE ' 52' TO H-PSF-CBSA. 02 314500 00 314600 6120-SEC401-2007-EXIT. 02 314610 EXIT. 02 314500 00 ************************************************************* * SET FLAG IF APC = 0033 * * - TERMINATE PROCESS IF 0033 LOCATED * * * ************************************************************* 6125-INIT. IF OPPS-APC (LN-SUB) = '0033' MOVE 'Y' TO APC33-FLAG. IF OPPS-HCPCS (LN-SUB) = 'C1820' MOVE 'Y' TO C1820-OFFSET-FLAG. *-------------------------------------------------------------* * FLAG CLAIM WHEN ALL LINES HAVE A HCPCS BETWEEN 80000-89999 * * INCLUSIVE (LAB CODES), INDICATES BILL TYPE 14X * * 05/09/2011 - LOGIC ADDED * *-------------------------------------------------------------* IF (OPPS-HCPCS (LN-SUB) >= '80000' AND <= '89999') IF BILL14X-FLAG NOT = 'N' MOVE 'Y' TO BILL14X-FLAG END-IF ELSE MOVE 'N' TO BILL14X-FLAG END-IF. 6125-INIT-EXIT. EXIT. *************************************************************** * 1. VERIFY THE SERVICE INDICATOR PASSED BY THE OCE * * - IF INVALID SET RETURN CODE TO '40' * * - DISCONTINUE LINE PROCESSING * * - IF VALID SET RETURN CODE TO '01' * * - CONTINUE LINE PROCESSING * * 2. PROCESS LINES AND LOAD WORK TABLE ACCORDING TO PRICE * * RANKING * * 3. CHECK OCE EDIT INDICATORS AND SET RETURN CODES IF * * INDICATORS ARE INVALID. * * - VALID RETURN CODES FOR EDIT INDICATORS * * - '41' - SERVICE INDICATOR INVALID FOR OPPS PRICER * * - '42' - APC = '00000' OR (PACKAGING FLAG = 1, 2,OR 4)* * - '43' - PAYMENT INDICATOR NOT = TO 1 OR 5 THRU 9 * * - '44' - SERVICE INDICATOR = 'H' BUT PAYMENT * * INDICATOR NOT = TO 6 * * - '45' - PACKAGING FLAG NOT = TO 0 OR 1 OR 2 * * - '46' - (LINE ITEM DENIAL/REJECT FLAG NOT = TO 0 * * OR LINE ITEM DENIAL/REJECT FLAG = TO 1 * * AND (APC NOT = 0033 OR 0034 OR 0322 OR * * 0323 OR 0324 OR 0325 OR 0373 OR 0374)) * * OR LINE ITEM ACTION FLAG NOT = TO 1 * * - '47' - LINE ITEM ACTION FLAG = 2 OR 3 * * - '48' - PAYMENT ADJUSTMENT FLAG NOT VALID * * - '49' - SITE OF SERVICE FLAG NOT = TO 0 * * - OR (APC 0033 IS NOT ON THE CLAIM * * AND SERVICE INDICATOR = 'P' * * OR APC = 0322-0325,0373,0374) * * 4. IF OCE INDICATORS ARE VALID, SEARCH APC TABLE * * - IF MISSING, DELETED OR INVALID APC * * - SET RETURN CODE TO '30' * * - DISCONTINUE LINE PROCESSING * *************************************************************** 6150-INIT. MOVE 01 TO A-RETURN-CODE (LN-SUB). *************************************************************** * OVER-RIDE SERVICE UNITS FOR APC 0339 - EFFECTIVE 04/01/2002 * * - CHANGE UNIT VALUE TO 1 * *************************************************************** IF OPPS-APC (LN-SUB) = '0339' MOVE 1 TO OPPS-SRVC-UNITS (LN-SUB). MOVE OPPS-SRVC-UNITS (LN-SUB) TO H-SRVC-UNITS. PERFORM 6250-CALC-DISCOUNT THRU 6250-CALC-DISCOUNT-EXIT. IF A-RETURN-CODE (LN-SUB) = 42 GO TO 6150-INIT-EXIT. *************************************************************** * EFFECTIVE AS OF 04-01-2002 * * - TOTAL DEVICE OFFSET * *************************************************************** IF OPPS-SRVC-IND (LN-SUB) = ' H' MOVE 'Y' TO C-FLAG COMPUTE H-TOT-HTD-UNITS = H-TOT-HTD-UNITS + H-SRVC-UNITS. IF C1820-OFFSET-FLAG = 'Y' PERFORM 6160-TOTAL-OFFSET THRU 6160-TOTAL-OFFSET-EXIT. SET W-LP-INDX TO LN-SUB. SET W-BD-INDX TO LN-SUB. INITIALIZE W-LP-ENTRY (W-LP-INDX). INITIALIZE W-BD-ENTRY (W-BD-INDX). MOVE ZERO TO A-LITEM-PYMT (LN-SUB) A-LITEM-REIM (LN-SUB) A-ADJ-COIN (LN-SUB) A-RED-COIN (LN-SUB) A-TOTAL-LN-DEDUCT (LN-SUB) A-BLOOD-LN-DEDUCT (LN-SUB). IF NOT (OPPS-SRVC-IND (LN-SUB) = ' A' OR ' B' OR ' C' OR ' E' OR ' F' OR ' G' OR ' H' OR ' K' OR ' L' OR ' N' OR ' P' OR ' S' OR ' T' OR ' V' OR ' X' OR ' W' OR ' Y' OR ' Z' OR ' M') THEN MOVE 40 TO A-RETURN-CODE (LN-SUB) GO TO 6150-INIT-EXIT ELSE MOVE 01 TO A-RETURN-CODE (LN-SUB). IF OPPS-SRVC-IND (LN-SUB) = ' A' OR ' B' OR ' C' OR ' E' OR ' F' OR ' L' OR ' W' OR ' Y' OR ' Z' OR ' M' MOVE 41 TO A-RETURN-CODE (LN-SUB) GO TO 6150-INIT-EXIT. IF OPPS-PYMT-IND (LN-SUB) = ' 1' OR ' 5' OR ' 6' OR ' 7' OR ' 8' OR ' 9' IF OPPS-PKG-FLAG (LN-SUB) = '0' OR '1' OR '2' OR '3' OR '4' IF (OPPS-LITEM-DR-FLAG (LN-SUB) = '0' OR OPPS-LITEM-DR-FLAG (LN-SUB) = '1' AND (OPPS-APC (LN-SUB) = '0033' OR '0034' OR '0322' OR '0323' OR '0324' OR '0325' OR '0373' OR '0374')) OR (OPPS-LITEM-ACT-FLAG (LN-SUB) = '1') IF NOT (OPPS-LITEM-ACT-FLAG (LN-SUB) EQUAL '2' OR '3') IF OPPS-PYMT-ADJ-FLAG (LN-SUB) = ' 0' OR ' 1' OR ' 2' OR ' 3' OR ' 4' OR ' 5' OR ' 6' OR ' 7' IF (OPPS-SITE-SRVC-FLAG (LN-SUB) = '0') OR ((APC33-FLAG = 'Y') AND ((OPPS-SRVC-IND (LN-SUB) = ' P') OR (OPPS-APC (LN-SUB) = '0322' OR '0323' OR '0324' OR '0325' OR '0373' OR '0374'))) ********************************************************** 00000100 * COMMENT: * 00000200 * ACCUMULATING TOTAL CHARGES. * 00000300 ********************************************************** 00000600 MOVE OPPS-SUB-CHRG (LN-SUB) TO H-SUB-CHRG COMPUTE H-TOT-CHRG = H-TOT-CHRG + H-SUB-CHRG IF OPPS-LITEM-ACT-FLAG (LN-SUB) = '4' COMPUTE H-TOT-CHRG = H-TOT-CHRG - H-SUB-CHRG END-IF IF (OPPS-PKG-FLAG (LN-SUB) = '1' OR '2' OR '4') COMPUTE H-TOT-N-CHRG = H-SUB-CHRG + H-TOT-N-CHRG MOVE 'Y' TO N-FLAG END-IF IF (OPPS-APC (LN-SUB) = '0000') OR (OPPS-PKG-FLAG (LN-SUB) = '1' OR '2' OR '4') MOVE 42 TO A-RETURN-CODE (LN-SUB) GO TO 6150-INIT-EXIT END-IF ********************************************************** 00000100 * COMMENT: * 00000200 * LOOK-UP APC RATE * 00000300 ********************************************************** 00000600 SEARCH ALL WAA-ENTRY AT END MOVE 30 TO A-RETURN-CODE (LN-SUB) GO TO 6150-INIT-EXIT WHEN WAA-APC (WAA-INDX) = OPPS-GRP (LN-SUB) MOVE WAA-PTR (WAA-INDX) TO W-SUB2 PERFORM 6175-APC-LOOKUP ELSE MOVE 49 TO A-RETURN-CODE (LN-SUB) GO TO 6150-INIT-EXIT ELSE MOVE 48 TO A-RETURN-CODE (LN-SUB) GO TO 6150-INIT-EXIT ELSE MOVE 47 TO A-RETURN-CODE (LN-SUB) GO TO 6150-INIT-EXIT ELSE MOVE 46 TO A-RETURN-CODE (LN-SUB) GO TO 6150-INIT-EXIT ELSE MOVE 45 TO A-RETURN-CODE (LN-SUB) GO TO 6150-INIT-EXIT ELSE MOVE 43 TO A-RETURN-CODE (LN-SUB) GO TO 6150-INIT-EXIT. *************************************************************** * NEW LOGIC FOR PROCESSING BLOOD DEDUCTIBLE * * EFFECTIVE AS OF 07-01-2005 * * - TOTAL BLOOD CODE CHARGES * * - WHEN PAYMENT ADJUSTMENT FLAG = '5' OR '6' * *************************************************************** IF OPPS-PYMT-ADJ-FLAG (LN-SUB) = ' 5' COMPUTE H-TOT-38X = OPPS-SUB-CHRG (LN-SUB) + H-TOT-38X. IF OPPS-PYMT-ADJ-FLAG (LN-SUB) = ' 5' OR ' 6' COMPUTE H-TOT-38X-39X = OPPS-SUB-CHRG (LN-SUB) + H-TOT-38X-39X. ******************************************************** IF A-RETURN-CODE (LN-SUB) = 01 PERFORM 6300-COIN-DEDUCT THRU 6300-COIN-DEDUCT-EXIT. *************************************************************** * BLOOD DEDUCTIBLE LINE PROCESSING * * 05/11/2009 - ADDED THE REQUIREMENT PAF = 5 OR 6 TO BLOOD * * DEDUCTIBLE LOGIC TO CORRECT PRICING ERROR. * * FIX EFFECTIVE RETROACTIVE TO 01/01/2007. * *************************************************************** IF A-RETURN-CODE (LN-SUB) = 01 SET W7BD-INDX TO 1 SEARCH W7BD-ENTRY VARYING W7BD-INDX AT END GO TO 6150-INIT-EXIT WHEN W-2007-BLOOD-HCPCS (W7BD-INDX) = OPPS-HCPCS (LN-SUB) IF OPPS-PYMT-ADJ-FLAG (LN-SUB) = (' 5' OR ' 6') MOVE W-2007-BLOOD-RANK (W7BD-INDX) TO H-BLOOD-RANK MOVE OPPS-LITEM-DOS (LN-SUB) TO H-BLD-DOS PERFORM 6375-BLOOD-DEDUCT THRU 6375-BLOOD-DEDUCT-EXIT END-IF. 6150-INIT-EXIT. EXIT. *************************************************************** * COMPUTE TOTAL OFFSET FROM TABLE 7 FOR DEVICES * * - EFFECTIVE AS OF 01-01-2003 * * - CONTINUE FOR 01-01-2004 * * - CONTINUE FOR 01-01-2005 * * - SEARCH TABLE OPPSOF04 * * - WHERE ALL OFFSET VALUES EQUAL ZERO * *************************************************************** 6160-TOTAL-OFFSET. MOVE OPPS-GRP (LN-SUB) TO W-OFF-APC. SEARCH ALL WOO-ENTRY7 AT END GO TO 6160-TOTAL-OFFSET-EXIT WHEN WOO-APC7 (WOO-INDX7) = W-OFF-APC PERFORM 6161-TOTAL-OFFSET-AMT THRU 6161-TOTAL-OFFSET-AMT-EXIT. 6160-TOTAL-OFFSET-EXIT. EXIT. 6161-TOTAL-OFFSET-AMT. IF WOO-OFFSET7 (WOO-INDX7) EQUAL 0 GO TO 6161-TOTAL-OFFSET-AMT-EXIT. COMPUTE H-TOTAL-OFFSET = H-TOTAL-OFFSET + (WOO-OFFSET7 (WOO-INDX7) * H-DISC-RATE * H-SRVC-UNITS). COMPUTE H-TOT-OFF-UNITS = H-TOT-OFF-UNITS + H-SRVC-UNITS. IF H-TOTAL-OFFSET < 0 MOVE 0 TO H-TOTAL-OFFSET. 6161-TOTAL-OFFSET-AMT-EXIT. EXIT. *************************************************************** * SEARCH APC TABLE - MOVE VALUES TO HOLD AREA FOR PROCESSING * * - ADJUST TOTAL CHARGE FOR DELETED APC'S * *************************************************************** 6175-APC-LOOKUP. IF WAR-DTCD (W-SUB2) NOT > WAD-DTCD (WAD-SUB) IF WAR-RATEX (W-SUB2) = 'DELETED' MOVE 30 TO A-RETURN-CODE (LN-SUB) COMPUTE H-TOT-CHRG = H-TOT-CHRG - H-SUB-CHRG ELSE MOVE WAR-RATE (W-SUB2) TO H-APC-PYMT MOVE WAR-RANK (W-SUB2) TO H-RANK MOVE WAR-MINC (W-SUB2) TO H-MIN-COIN MOVE WAR-COIN (W-SUB2) TO H-NAT-COIN MOVE WAR-PPCT (W-SUB2) TO H-PPCT ELSE SUBTRACT 1 FROM W-SUB2 IF W-SUB2 > WAA-PTR (WAA-INDX - 1) GO TO 6175-APC-LOOKUP ELSE MOVE 0 TO H-APC-PYMT H-RANK H-MIN-COIN H-NAT-COIN H-PPCT. 6175-APC-LOOKUP-EXIT. EXIT. *************************************************************** * IF DATE OF SERVICE BETWEEN 12/31/2002 AND 04/01/2003 * * IF HCPCS CODE = C9114 OR C9115 ADJUST PAYMENT AND * * COINSURANCE AMOUNTS - LOGIC REMOVED FOR 20050101 * *************************************************************** *************************************************************** * SEARCH WAGE INDEX TABLE AND SELECT THE WAGE INDEX * * WHEN EQUAL TO PROVIDER SPECIFIC WAGE INDEX * * IF WAGE INDEX NOT LOCATED * * - SET CLAIM RETURN CODE TO '50' * * - DISCONTINUE CLAIM PROCESSING * * IF WAGE INDEX EQUALS ZERO * * - SET CLAIM RETURN CODE TO '51' * * - DISCONTINUE CLAIM PROCESSING * *************************************************************** 6200-CALC-WAGEINDX. MOVE WCD-MAX TO WCD-SUB. PERFORM UNTIL L-SERVICE-FROM-DATE NOT < WCD-DATE (WCD-SUB) SUBTRACT 1 FROM WCD-SUB END-PERFORM. SEARCH ALL WCM-ENTRY AT END MOVE 50 TO A-CLM-RTN-CODE GO TO 6200-CALC-WAGEINDX-EXIT WHEN WCM-CBSA (WCM-INDX) = H-PSF-CBSA MOVE WCM-PTR (WCM-INDX) TO W-SUB3 PERFORM 6210-WAGE-LOOKUP. IF H-WINX1 = 0 THEN MOVE 51 TO A-CLM-RTN-CODE. 6200-CALC-WAGEINDX-EXIT. EXIT. 6210-WAGE-LOOKUP. IF WCW-DTCD (W-SUB3) NOT > WCD-DTCD (WCD-SUB) IF L-PSF-SPEC-PYMT-IND = 'Y' MOVE WCW-WINX2 (W-SUB3) TO H-WINX1 ELSE MOVE WCW-WINX1 (W-SUB3) TO H-WINX1 ELSE SUBTRACT 1 FROM W-SUB3 IF W-SUB3 > WCM-PTR (WCM-INDX - 1) GO TO 6210-WAGE-LOOKUP ELSE MOVE 0 TO H-WINX1. 6210-WAGE-LOOKUP-EXIT. EXIT. *************************************************************** * CALCULATE DISCOUNT FACTOR BASED ON THE DISCOUNT * * INDICATOR PASSED BY THE OCE: VALUE 1 - 8 * * IF MISSING OR INVALID DISCOUNT FACTOR * * - SET RETURN CODE TO '38' * * - DISCONTINUE LINE PROCESSING * *************************************************************** 6250-CALC-DISCOUNT. IF (H-SRVC-UNITS = 0 AND OPPS-APC (LN-SUB) = '0000') MOVE 42 TO A-RETURN-CODE (LN-SUB) GO TO 6250-CALC-DISCOUNT-EXIT ELSE IF (H-SRVC-UNITS = 0 AND OPPS-APC (LN-SUB) > '0000') MOVE 1 TO H-SRVC-UNITS. IF OPPS-DISC-FACT (LN-SUB) = 1 THEN MOVE 1 TO H-DISC-RATE ELSE IF OPPS-DISC-FACT (LN-SUB) = 2 THEN COMPUTE H-DISC-RATE = (1 + DISC-FRACTION * (H-SRVC-UNITS - 1)) / H-SRVC-UNITS ELSE IF OPPS-DISC-FACT (LN-SUB) = 3 THEN COMPUTE H-DISC-RATE = TERM-PROC-DISC / H-SRVC-UNITS ELSE IF OPPS-DISC-FACT (LN-SUB) = 4 THEN COMPUTE H-DISC-RATE = (1 + DISC-FRACTION) / H-SRVC-UNITS ELSE IF OPPS-DISC-FACT (LN-SUB) = 5 THEN COMPUTE H-DISC-RATE = DISC-FRACTION ELSE IF OPPS-DISC-FACT (LN-SUB) = 6 THEN COMPUTE H-DISC-RATE = (TERM-PROC-DISC * DISC-FRACTION) / H-SRVC-UNITS ELSE IF OPPS-DISC-FACT (LN-SUB) = 7 THEN COMPUTE H-DISC-RATE = (DISC-FRACTION * (1 + DISC-FRACTION) / H-SRVC-UNITS) ELSE IF OPPS-DISC-FACT (LN-SUB) = 8 THEN MOVE 2 TO H-DISC-RATE ELSE MOVE 38 TO A-RETURN-CODE (LN-SUB). 6250-CALC-DISCOUNT-EXIT. EXIT. *************************************************************** * DETERMINE THE DEDUCTIBLE SEQUENCE. DEDUCTIBLE WILL BE * * TAKEN FROM OPPS SERVICES FIRST, THEN FROM ANY OTHER * * TYPES OF SERVICES FROM THE CLAIM. * * - SET POINTERS TO THE HIGHEST RANKED PERCENTAGE * * (LARGEST NATIONAL UNADJUSTED COINSURANCE / * * THE APC PAYMENT) * * - MOVE ALL PRICING VARIABLES TO STAGING AREA * *************************************************************** 6300-COIN-DEDUCT. ADD 1 TO W-LNC-MAX. SET W-LP-INDX TO W-LNC-MAX. PERFORM 6350-STAGE-ENTRY THRU 6350-STAGE-ENTRY-EXIT UNTIL W-LP-INDX = 1 OR H-RANK NOT < W-RANK (W-LP-INDX - 1). MOVE LN-SUB TO W-LP-SUB (W-LP-INDX). MOVE H-NAT-COIN TO W-NAT-COIN (W-LP-INDX). MOVE H-MIN-COIN TO W-MIN-COIN (W-LP-INDX). MOVE H-SUB-CHRG TO W-SUB-CHRG (W-LP-INDX). MOVE H-APC-PYMT TO W-APC-PYMT (W-LP-INDX). MOVE H-WINX1 TO W-WINX1 (W-LP-INDX). MOVE H-RANK TO W-RANK (W-LP-INDX). MOVE H-PPCT TO W-PPCT (W-LP-INDX). MOVE H-DISC-RATE TO W-DISC-RATE (W-LP-INDX). IF OPPS-SRVC-IND (LN-SUB) = ' P' THEN MOVE 1 TO W-SRVC-UNITS (W-LP-INDX) ELSE MOVE H-SRVC-UNITS TO W-SRVC-UNITS (W-LP-INDX). MOVE 0 TO W-RED-COIN (W-LP-INDX). PERFORM VARYING PS-SUB FROM 1 BY 1 UNTIL PS-SUB > L-PSF-APC-LINE-CNT IF L-PSF-APC (PS-SUB) = OPPS-APC (LN-SUB) COMPUTE W-RED-COIN (W-LP-INDX) ROUNDED = L-PSF-RED-COIN (PS-SUB) * H-SRVC-UNITS * H-DISC-RATE MOVE 25 TO A-RETURN-CODE (LN-SUB) MOVE L-PSF-APC-LINE-CNT TO PS-SUB END-IF END-PERFORM. 6300-COIN-DEDUCT-EXIT. EXIT. 6350-STAGE-ENTRY. MOVE W-LP-ENTRY (W-LP-INDX - 1) TO W-LP-ENTRY (W-LP-INDX). SET W-LP-INDX DOWN BY 1. 6350-STAGE-ENTRY-EXIT. EXIT. *************************************************************** * DETERMINE THE BLOOD DEDUCTIBLE SEQUENCE. DEDUCTIBLE * * WILL BE CALCULATED BASED ON RANKING. * * - SET POINTERS TO THE HIGHEST RANKED APC * * (SMALLEST UNADJUSTED APC PAYMENT) * * - MOVE ALL PRICING VARIABLES TO STAGING AREA * *************************************************************** 6375-BLOOD-DEDUCT. ADD 1 TO W-BLD-MAX. SET W-BD-INDX TO W-BLD-MAX. PERFORM 6385-STAGE-ENTRY THRU 6385-STAGE-ENTRY-EXIT UNTIL W-BD-INDX = 1 OR H-BLD-RNK NOT < W-BD-RNK (W-BD-INDX - 1). MOVE LN-SUB TO W-BD-SUB (W-BD-INDX). MOVE H-NAT-COIN TO W-BD-NAT-COIN (W-BD-INDX). MOVE H-MIN-COIN TO W-BD-MIN-COIN (W-BD-INDX). MOVE H-SUB-CHRG TO W-BD-SUB-CHRG (W-BD-INDX). MOVE H-APC-PYMT TO W-BD-APC-PYMT (W-BD-INDX). MOVE H-WINX1 TO W-BD-WINX1 (W-BD-INDX). MOVE H-BLOOD-RANK TO W-BD-RANK (W-BD-INDX). MOVE H-BLD-DOS TO W-BD-DOS (W-BD-INDX). MOVE H-PPCT TO W-BD-PPCT (W-BD-INDX). MOVE H-DISC-RATE TO W-BD-DISC-RATE (W-BD-INDX). MOVE H-SRVC-UNITS TO W-BD-SRVC-UNITS (W-BD-INDX). ********************************************************** 00000100 * COMMENT: * 00000200 * IF PROVIDER ELECTS TO REDUCE COINSURANCE. * 00000300 ********************************************************** 00000600 MOVE 0 TO W-BD-RED-COIN (W-BD-INDX). PERFORM VARYING PS-SUB FROM 1 BY 1 UNTIL PS-SUB > L-PSF-APC-LINE-CNT IF L-PSF-APC (PS-SUB) = OPPS-APC (LN-SUB) COMPUTE W-BD-RED-COIN (W-BD-INDX) ROUNDED = L-PSF-RED-COIN (PS-SUB) * H-SRVC-UNITS * H-DISC-RATE MOVE 25 TO A-RETURN-CODE (LN-SUB) MOVE L-PSF-APC-LINE-CNT TO PS-SUB END-IF END-PERFORM. 6375-BLOOD-DEDUCT-EXIT. EXIT. 6385-STAGE-ENTRY. MOVE W-BD-ENTRY (W-BD-INDX - 1) TO W-BD-ENTRY (W-BD-INDX). SET W-BD-INDX DOWN BY 1. 6385-STAGE-ENTRY-EXIT. EXIT. *************************************************************** * FIRST STEP IN DETERMINING A LINE ITEM PRICE. * * CHECK ALL APPROPRIATE FLAGS AND INDICATORS PASSED * * BY THE OCE. * * - SET RETURN CODES TO INDICATE ERRORS OR STATUS * * - '20' - LINE PROCESSED BUT PAYMENT = 0 * * - BENE DEDUCTIBLE => ADJUSTED PAYMENT * * * *************************************************************** 6400-CALCULATE. MOVE W-LP-SUB (W-LP-INDX) TO LN-SUB. IF A-RETURN-CODE (LN-SUB) > 25 GO TO 6400-CALCULATE-EXIT. IF OPPS-PYMT-IND (LN-SUB) = ' 1' OR ' 5' OR ' 6' OR ' 7' OR ' 8' PERFORM 6550-CALC-STANDARD THRU 6550-CALC-STANDARD-EXIT ELSE GO TO 6400-CALCULATE-EXIT. *************************************************************** * SET GJK FLAG * * - TEST LINE ITEM DATE OF SERVICE > 20010630 * * - TOTAL DRUG / DEVICE COINSURANCE * *************************************************************** IF (A-RETURN-CODE (LN-SUB) < 30) PERFORM 6450-ADJ-PROC-COIN THRU 6450-ADJ-PROC-COIN-EXIT ELSE NEXT SENTENCE. *************************************************************** * SET ST0 AND STVX FLAGS * * - TEST LINE ITEM DATE OF SERVICE > 20020331 * * - TOTAL PROCEDURE CHARGES AND BUNDLED CHARGES * *************************************************************** PERFORM 6500-ADJ-CHRGS THRU 6500-ADJ-CHRGS-EXIT. IF A-RETURN-CODE (LN-SUB) < 30 COMPUTE A-TOTAL-CLM-DEDUCT = H-TOTAL-LN-DEDUCT + A-TOTAL-CLM-DEDUCT COMPUTE H-TOT-PYMT = H-TOT-PYMT + H-LITEM-PYMT COMPUTE A-BLOOD-DEDUCT-DUE = A-BLOOD-DEDUCT-DUE + H-LN-BLOOD-DEDUCT MOVE H-LITEM-PYMT TO A-LITEM-PYMT (LN-SUB) MOVE H-LITEM-REIM TO A-LITEM-REIM (LN-SUB) MOVE H-TOTAL-LN-DEDUCT TO A-TOTAL-LN-DEDUCT (LN-SUB) MOVE H-LN-BLOOD-DEDUCT TO A-BLOOD-LN-DEDUCT (LN-SUB) MOVE H-NAT-COIN TO A-ADJ-COIN (LN-SUB) MOVE H-RED-COIN TO A-RED-COIN (LN-SUB) IF H-RED-COIN > H-NAT-COIN MOVE H-NAT-COIN TO A-RED-COIN (LN-SUB) END-IF IF OPPS-LITEM-ACT-FLAG (LN-SUB) = '4' MOVE 0 TO A-LITEM-PYMT (LN-SUB) MOVE 0 TO A-LITEM-REIM (LN-SUB) COMPUTE H-TOT-PYMT = H-TOT-PYMT - H-LITEM-PYMT END-IF END-IF. MOVE ZERO TO LINE-HOLD-ITEMS. 6400-CALCULATE-EXIT. EXIT. *************************************************************** * SET GJK FLAG * * - STAGE BY SERVICE INDICATOR * * * *************************************************************** 6450-ADJ-PROC-COIN. MOVE OPPS-LITEM-DOS (LN-SUB) TO H-DCP-DOS. IF OPPS-SRVC-IND (LN-SUB) = ' S' OR ' T' OR ' V' COMPUTE H-NEW-WGNAT ROUNDED = W-NAT-COIN (W-LP-INDX) * (.6 * W-WINX1 (W-LP-INDX) + .4) IF H-NEW-WGNAT > H-IP-LIMIT MOVE H-IP-LIMIT TO H-NEW-WGNAT END-IF COMPUTE H-NEW-COIN = H-LITEM-PYMT - H-TOTAL-LN-DEDUCT - H-LITEM-REIM - H-LN-BLOOD-DEDUCT MOVE 1 TO H-DCP-CODE PERFORM 6455-SEARCH-KEY THRU 6455-SEARCH-KEY-EXIT ELSE IF OPPS-SRVC-IND (LN-SUB) = ' G' OR ' K' COMPUTE H-NEW-COIN = H-LITEM-PYMT - H-TOTAL-LN-DEDUCT - H-LITEM-REIM - H-LN-BLOOD-DEDUCT MOVE 'Y' TO GJK-FLAG MOVE 1 TO H-DCP-CODE PERFORM 6455-SEARCH-KEY THRU 6455-SEARCH-KEY-EXIT MOVE 2 TO H-DCP-CODE ADD 1 TO W-DCP-MAX SET W-DCP-INDX TO W-DCP-MAX PERFORM 6475-STAGE-DCP-ENTRY THRU 6475-STAGE-DCP-ENTRY-EXIT UNTIL W-DCP-INDX = 1 OR H-DCP-STAGE NOT < W-DCP-STAGE (W-DCP-INDX - 1) MOVE LN-SUB TO W-DCP-SUB (W-DCP-INDX) MOVE H-DCP-STAGE TO W-DCP-STAGE (W-DCP-INDX) MOVE ZERO TO W-DCP-COIN1 (W-DCP-INDX) MOVE ZERO TO W-DCP-WGNAT (W-DCP-INDX) MOVE H-NEW-COIN TO W-DCP-COIN2 (W-DCP-INDX) MOVE OPPS-SRVC-IND (LN-SUB) TO W-DCP-SRVC-IND (W-DCP-INDX). 6450-ADJ-PROC-COIN-EXIT. EXIT. 6455-SEARCH-KEY. SET W-DCP-INDX TO 1. SEARCH W-DCP-ENTRY VARYING W-DCP-INDX AT END PERFORM 6460-ADD-ENTRY THRU 6460-ADD-ENTRY-EXIT WHEN W-DCP-STAGE (W-DCP-INDX) = H-DCP-STAGE PERFORM 6465-UPDATE-ENTRY THRU 6465-UPDATE-ENTRY-EXIT. 6455-SEARCH-KEY-EXIT. EXIT. 6460-ADD-ENTRY. ADD 1 TO W-DCP-MAX. SET W-DCP-INDX TO W-DCP-MAX. PERFORM 6475-STAGE-DCP-ENTRY THRU 6475-STAGE-DCP-ENTRY-EXIT UNTIL W-DCP-INDX = 1 OR H-DCP-STAGE NOT < W-DCP-STAGE (W-DCP-INDX - 1). IF OPPS-SRVC-IND (LN-SUB) = ' G' OR ' K' MOVE ZERO TO W-DCP-SUB (W-DCP-INDX) MOVE H-DCP-STAGE TO W-DCP-STAGE (W-DCP-INDX) MOVE ZERO TO W-DCP-COIN1 (W-DCP-INDX) MOVE ZERO TO W-DCP-WGNAT (W-DCP-INDX) MOVE H-NEW-COIN TO W-DCP-COIN2 (W-DCP-INDX) MOVE ' X' TO W-DCP-SRVC-IND (W-DCP-INDX) ELSE MOVE LN-SUB TO W-DCP-SUB (W-DCP-INDX) MOVE H-DCP-STAGE TO W-DCP-STAGE (W-DCP-INDX) MOVE H-NEW-COIN TO W-DCP-COIN1 (W-DCP-INDX) MOVE H-NEW-WGNAT TO W-DCP-WGNAT (W-DCP-INDX) MOVE ZERO TO W-DCP-COIN2 (W-DCP-INDX) MOVE OPPS-SRVC-IND (LN-SUB) TO W-DCP-SRVC-IND (W-DCP-INDX). 6460-ADD-ENTRY-EXIT. EXIT. 6465-UPDATE-ENTRY. IF OPPS-SRVC-IND (LN-SUB) = ' G' OR ' K' ADD H-NEW-COIN TO W-DCP-COIN2 (W-DCP-INDX) ELSE IF W-DCP-SRVC-IND (W-DCP-INDX) = ' X' PERFORM 6485-REPLACE-TYPE1 THRU 6485-REPLACE-TYPE1-EXIT ELSE PERFORM 6480-RANK-COIN THRU 6480-RANK-COIN-EXIT. 6465-UPDATE-ENTRY-EXIT. EXIT. 6475-STAGE-DCP-ENTRY. MOVE W-DCP-ENTRY (W-DCP-INDX - 1) TO W-DCP-ENTRY (W-DCP-INDX). SET W-DCP-INDX DOWN BY 1. 6475-STAGE-DCP-ENTRY-EXIT. EXIT. 6480-RANK-COIN. IF H-NEW-WGNAT > W-DCP-WGNAT (W-DCP-INDX) MOVE LN-SUB TO W-DCP-SUB (W-DCP-INDX) MOVE H-NEW-COIN TO W-DCP-COIN1 (W-DCP-INDX) MOVE H-NEW-WGNAT TO W-DCP-WGNAT (W-DCP-INDX) MOVE OPPS-SRVC-IND (LN-SUB) TO W-DCP-SRVC-IND (W-DCP-INDX). 6480-RANK-COIN-EXIT. EXIT. 6485-REPLACE-TYPE1. MOVE LN-SUB TO W-DCP-SUB (W-DCP-INDX) MOVE H-NEW-COIN TO W-DCP-COIN1 (W-DCP-INDX) MOVE H-NEW-WGNAT TO W-DCP-WGNAT (W-DCP-INDX) MOVE OPPS-SRVC-IND (LN-SUB) TO W-DCP-SRVC-IND (W-DCP-INDX). 6485-REPLACE-TYPE1-EXIT. EXIT. 6500-ADJ-CHRGS. ***************************************************** ** NEW LOGIC INSERTED FOR WEB USE ONLY * ***************************************************** IF ((OPPS-SRVC-IND (LN-SUB) = ' T') OR ((OPPS-SRVC-IND (LN-SUB) = ' S') AND (OPPS-HCPCS (LN-SUB) > '09999' AND OPPS-HCPCS (LN-SUB) < '70000'))) AND (W-SUB-CHRG (W-LP-INDX) < 1.01) MOVE 'Y' TO ST0-FLAG. IF ((OPPS-SRVC-IND (LN-SUB) = ' T') OR ((OPPS-SRVC-IND (LN-SUB) = ' S') AND (OPPS-HCPCS (LN-SUB) > '09999' AND OPPS-HCPCS (LN-SUB) < '70000'))) AND (OPPS-PKG-FLAG (LN-SUB) = '0' OR '3') COMPUTE H-TOT-ST-CHRG = W-SUB-CHRG (W-LP-INDX) + H-TOT-ST-CHRG COMPUTE H-TOT-ST-PYMT = H-LITEM-PYMT + H-TOT-ST-PYMT. IF (OPPS-SRVC-IND (LN-SUB) = ' S' OR ' T' OR ' V' OR ' X' OR ' P') AND (OPPS-PKG-FLAG (LN-SUB) = '0' OR '3') COMPUTE H-TOT-STVX-PYMT = H-LITEM-PYMT + H-TOT-STVX-PYMT. 6500-ADJ-CHRGS-EXIT. EXIT. *************************************************************** * 1. APPLY DEDUCTIBLE TO HIGHEST NATIONAL COINSURANCE AMOUNT * * - DESCENDING UNTIL DEDUCTIBLE = 0. * * 2. CALCULATE THE STANDARD LINE PRICE * * (APC PAYMENT * WAGE INDEX * SERVICE UNITS * * * DISCOUNT FACTOR) * * - WAGE ADJUST 60% OF THE APC PAYMENT ONLY * * 3. ADD LINE PRICE TO OUTLIER HOLD AREA. * * * * 4. CALCULATE THE LINE PRICE FOR DESIGNATED DEVICES * * AND DRUGS * * * * 08/07/2009 - MOVED 6560-CALC-BENE-DEDUCT PERFORM FROM * * 6550-SCH-ADJ TO THIS PARAGRAPH FOR SI SVTPX * * * *************************************************************** 6550-CALC-STANDARD. ********************************************************** 00000100 * COMMENT: * 00000200 * THE S,V,T,P & X ARE WAGE ADJUSTED ITEMS * 00000300 ********************************************************** 00000600 MOVE 0 TO H-BLOOD-FRACTION. COMPUTE H-MAX-COIN ROUNDED = (H-IP-LIMIT * W-SRVC-UNITS (W-LP-INDX) * W-DISC-RATE (W-LP-INDX)). IF OPPS-PYMT-ADJ-FLAG (LN-SUB) = ' 7' PERFORM 6550-DEVICE-REDUC THRU 6550-DEVICE-REDUC-EXIT. IF OPPS-SRVC-IND (LN-SUB) = ' S' OR ' V' OR ' T' OR ' P' OR ' X' THEN PERFORM 6550-SCH-ADJ THRU 6550-SCH-ADJ-EXIT PERFORM 6560-CALC-BENE-DEDUCT THRU 6560-CALC-BENE-DEDUCT-EXIT ELSE IF OPPS-SRVC-IND (LN-SUB) = ' H' THEN IF OPPS-PYMT-IND (LN-SUB) = ' 6' THEN PERFORM 6555-CALC-H-STANDARD THRU 6555-CALC-H-STANDARD-EXIT PERFORM 6560-CALC-BENE-DEDUCT THRU 6560-CALC-BENE-DEDUCT-EXIT ELSE MOVE 44 TO A-RETURN-CODE (LN-SUB) GO TO 6550-CALC-STANDARD-EXIT END-IF ELSE IF OPPS-SRVC-IND (LN-SUB) = ' G' OR ' K' THEN IF OPPS-PYMT-IND (LN-SUB) = ' 1' OR ' 5' OR ' 7' THEN MOVE 0 TO H-BLOOD-FRACTION PERFORM 6550-CALC-GJK THRU 6550-CALC-GJK-EXIT PERFORM 6560-CALC-BENE-DEDUCT THRU 6560-CALC-BENE-DEDUCT-EXIT ELSE MOVE 41 TO A-RETURN-CODE (LN-SUB) GO TO 6550-CALC-STANDARD-EXIT END-IF END-IF. * * THE FOLLOWING SEARCH IS AN APC TABLE SEARCH TO SEE IF PRESENT * IF H-LITEM-PYMT > 0 IF L-SERVICE-FROM-DATE < 20070701 PERFORM 6550-PD-AT-CST-JAN07 THRU 6550-PD-AT-CST-JAN07-EXIT ELSE PERFORM 6550-PD-AT-CST-JUL07 THRU 6550-PD-AT-CST-JUL07-EXIT END-IF ELSE NEXT SENTENCE. IF H-MIN-COIN > 0 IF OPPS-SRVC-IND (LN-SUB) = ' G' OR ' H' OR ' K' COMPUTE H-MIN-COIN ROUNDED = H-MIN-COIN * (W-SRVC-UNITS (W-LP-INDX) - (W-SRVC-UNITS (W-LP-INDX) * H-BLOOD-FRACTION)) * W-DISC-RATE (W-LP-INDX) ELSE IF OPPS-APC (LN-SUB) = '0158' OR '0159' COMPUTE H-MIN-COIN ROUNDED = H-LITEM-PYMT * .25 ELSE COMPUTE H-MIN-COIN ROUNDED = H-LITEM-PYMT * .2 END-IF END-IF END-IF. MOVE W-RED-COIN (W-LP-INDX) TO H-RED-COIN. IF (H-RED-COIN > 0 AND < H-MIN-COIN) MOVE H-MIN-COIN TO H-RED-COIN ELSE IF H-RED-COIN < H-NAT-COIN AND > H-MIN-COIN AND > H-MAX-COIN COMPUTE H-LITEM-REIM = H-LITEM-REIM + (H-RED-COIN - H-MAX-COIN) END-IF END-IF. IF H-NAT-COIN > H-MAX-COIN AND H-RED-COIN = 0 THEN COMPUTE H-LITEM-REIM = H-LITEM-REIM + (H-NAT-COIN - H-MAX-COIN) MOVE H-MAX-COIN TO H-NAT-COIN. 6550-CALC-STANDARD-EXIT. EXIT. 6550-PD-AT-CST-JAN07. SET PD-AT-CST-INDX7 TO 1. SEARCH PD-AT-CST-W-COIN7-ENTRY VARYING PD-AT-CST-INDX7 AT END COMPUTE H-LITEM-REIM ROUNDED = ((H-LITEM-PYMT - H-TOTAL-LN-DEDUCT) - H-LN-BLOOD-DEDUCT) * W-PPCT (W-LP-INDX) COMPUTE H-NAT-COIN = H-LITEM-PYMT - H-TOTAL-LN-DEDUCT - H-LITEM-REIM - H-LN-BLOOD-DEDUCT MOVE W-MIN-COIN (W-LP-INDX) TO H-MIN-COIN ********************************************************** 00000100 * COMMENT: * 00000200 * PD-AT-CST-CODE7 GET 20% COINSURANCE (SEE TABLE) * 00000300 ********************************************************** 00000600 WHEN OPPS-APC(LN-SUB) = PD-AT-CST-CODE7 (PD-AT-CST-INDX7) COMPUTE H-LITEM-REIM ROUNDED = ((H-LITEM-PYMT - H-TOTAL-LN-DEDUCT) - H-LN-BLOOD-DEDUCT) * .8 COMPUTE H-NAT-COIN = H-LITEM-PYMT - H-TOTAL-LN-DEDUCT - H-LITEM-REIM - H-LN-BLOOD-DEDUCT MOVE W-MIN-COIN (W-LP-INDX) TO H-MIN-COIN. 6550-PD-AT-CST-JAN07-EXIT. EXIT. 6550-PD-AT-CST-JUL07. SET PD-AT-CST-INDX7B TO 1. SEARCH PD-AT-CST-W-COIN7B-ENTRY VARYING PD-AT-CST-INDX7B AT END COMPUTE H-LITEM-REIM ROUNDED = ((H-LITEM-PYMT - H-TOTAL-LN-DEDUCT) - H-LN-BLOOD-DEDUCT) * W-PPCT (W-LP-INDX) COMPUTE H-NAT-COIN = H-LITEM-PYMT - H-TOTAL-LN-DEDUCT - H-LITEM-REIM - H-LN-BLOOD-DEDUCT MOVE W-MIN-COIN (W-LP-INDX) TO H-MIN-COIN ********************************************************** 00 * COMMENT: * 00 * PD-AT-CST-CODE7B GET 20% COINSURANCE (SEE TABLE) * 00 ********************************************************** 00 WHEN OPPS-APC(LN-SUB) = PD-AT-CST-CODE7B (PD-AT-CST-INDX7B) COMPUTE H-LITEM-REIM ROUNDED = ((H-LITEM-PYMT - H-TOTAL-LN-DEDUCT) - H-LN-BLOOD-DEDUCT) * .8 COMPUTE H-NAT-COIN = H-LITEM-PYMT - H-TOTAL-LN-DEDUCT - H-LITEM-REIM - H-LN-BLOOD-DEDUCT MOVE W-MIN-COIN (W-LP-INDX) TO H-MIN-COIN. 6550-PD-AT-CST-JUL07-EXIT. EXIT. 6550-DEVICE-REDUC. ********************************************************* * SEARCH THE DEVICE REDUCTION TABLE TO SEE IF THERE IS * * AN APC MATCH, IF SO REDUCE THE PAYMENT BECAUSE THIS IS* * A FREE OR REPLACEMENT DEVICE. * ********************************************************* SEARCH ALL DEV-RED07 AT END GO TO 6550-DEVICE-REDUC-EXIT WHEN DEV-APC7 (DEV-INDX7) = OPPS-APC (LN-SUB) PERFORM 6550-DEVICE-COMPUTE THRU 6550-DEVICE-COMPUTE-EXIT. 6550-DEVICE-REDUC-EXIT. EXIT. 6550-DEVICE-COMPUTE. ********************************************************* * IF DEVICE IS FOUND, AND REDUCTION AMOUNT IS LESS THAN * * PAYMENT AMOUNT, SUBTRACT REDUCTION AMOUNT FROM PYMNT * ********************************************************* IF W-APC-PYMT (W-LP-INDX) NUMERIC IF W-APC-PYMT (W-LP-INDX) > DEV-REDUC7 (DEV-INDX7) COMPUTE W-APC-PYMT (W-LP-INDX) = (W-APC-PYMT (W-LP-INDX) - DEV-REDUC7 (DEV-INDX7)). 6550-DEVICE-COMPUTE-EXIT. EXIT. *************************************************************** * * * CALCULATE WAGE ADJUSTED LINE ITEM PAYMENT WITH RURAL * * SOLE COMMUNITY HOSPITAL (SCH) ADJUSTMENT WHEN APPLICABLE * * * * FOR LINES WITH A SI OF S, V, T, P, X, OR R * * * *************************************************************** * * * THE SCH ADJUSTMENT IS MADE WHEN THE FOLLOWING IS TRUE: * * EITHER THE L-PSF-GEO-CBSA OR THE L-PSF-WI-CBSA MUST BE A * * VALUE OF ' 01' THRU ' 99' AND THE L-PSF-PROV-TYPE * * MUST BE A '16' OR '17' OR '21' OR '22'. * * * * 08/07/2009 - REVISED LOGIC TO ACCOMODATE BLOOD LINES * * 05/09/2011 - REVISED LOGIC TO EXCLUDE BILL TYPE 14X FROM * * RECEIVING THE SCH ADD-ON * * * *************************************************************** 6550-SCH-ADJ. MOVE L-PSF-GEO-CBSA TO GEO-CBSA-FLAG. MOVE L-PSF-WI-CBSA TO WI-CBSA-FLAG. *************************************************************** * CALCULATE THE SCH PAYMENT * * - FOR SCHS = APC OR BLOOD APC PAYMENT ADJUSTED BY 7.1% * * - FOR NON-SCHS = UNADJUSTED APC OR BLOOD APC PAYMENT * *************************************************************** IF ((RURAL-GEO OR RURAL-WI) AND (L-PSF-PROV-TYPE = '16' OR '17' OR '21' OR '22') AND (BILL14X-FLAG = 'N')) *-------------------------------------------------------------* * SCH, BLOOD DEDUCTIBLE HCPCS LINE - ADDED 08/07/2009 * *-------------------------------------------------------------* IF OPPS-SRVC-IND (LN-SUB) = ' K' AND OPPS-HCPCS(LN-SUB) = ('P9010' OR 'P9016' OR 'P9021' OR 'P9022' OR 'P9038' OR 'P9039' OR 'P9040' OR 'P9051' OR 'P9054' OR 'P9056' OR 'P9057' OR 'P9058') AND OPPS-PYMT-ADJ-FLAG (LN-SUB) = (' 5' OR ' 6') COMPUTE H-SCH-PYMT ROUNDED = (W-BD-APC-PYMT (W-BD-INDX) * 1.071) *-------------------------------------------------------------* * SCH, NOT A LINE WITH A BLOOD DEDUCTIBLE HCPCS * *-------------------------------------------------------------* ELSE COMPUTE H-SCH-PYMT ROUNDED = (W-APC-PYMT (W-LP-INDX) * 1.071) END-IF *-------------------------------------------------------------* * NON-SCH, BLOOD DEDUCTIBLE HCPCS LINE * *-------------------------------------------------------------* ELSE IF OPPS-SRVC-IND (LN-SUB) = ' K' AND OPPS-HCPCS(LN-SUB) = ('P9010' OR 'P9016' OR 'P9021' OR 'P9022' OR 'P9038' OR 'P9039' OR 'P9040' OR 'P9051' OR 'P9054' OR 'P9056' OR 'P9057' OR 'P9058') AND OPPS-PYMT-ADJ-FLAG (LN-SUB) = (' 5' OR ' 6') MOVE W-BD-APC-PYMT (W-BD-INDX) TO H-SCH-PYMT *-------------------------------------------------------------* * NON-SCH, NOT A LINE WITH A BLOOD DEDUCTIBLE HCPCS * *-------------------------------------------------------------* ELSE MOVE W-APC-PYMT (W-LP-INDX) TO H-SCH-PYMT END-IF END-IF. *************************************************************** * CALCULATE THE LINE ITEM PAYMENT * *************************************************************** *-------------------------------------------------------------* * SI = K LINES (BLOOD) ARE NOT WAGE-ADJUSTED * *-------------------------------------------------------------* IF OPPS-SRVC-IND (LN-SUB) = ' K' IF OPPS-HCPCS(LN-SUB) = ('P9010' OR 'P9016' OR 'P9021' OR 'P9022' OR 'P9038' OR 'P9039' OR 'P9040' OR 'P9051' OR 'P9054' OR 'P9056' OR 'P9057' OR 'P9058') AND OPPS-PYMT-ADJ-FLAG (LN-SUB) = (' 5' OR ' 6') COMPUTE H-LITEM-PYMT ROUNDED = H-SCH-PYMT * W-BD-SRVC-UNITS (W-BD-INDX) * W-BD-DISC-RATE (W-BD-INDX) ELSE COMPUTE H-LITEM-PYMT ROUNDED = H-SCH-PYMT * W-SRVC-UNITS (W-LP-INDX) * W-DISC-RATE (W-LP-INDX) END-IF *-------------------------------------------------------------* * SI = S, V, T, P, OR X LINES ARE WAGE-ADJUSTED (60%) * *-------------------------------------------------------------* ELSE COMPUTE H-LITEM-PYMT ROUNDED = (((H-SCH-PYMT * .60) * W-WINX1 (W-LP-INDX)) + (H-SCH-PYMT * .40)) * W-SRVC-UNITS (W-LP-INDX) * W-DISC-RATE (W-LP-INDX) END-IF. 6550-SCH-ADJ-EXIT. EXIT. *************************************************************** * * * 1. CALCULATE LINE ITEM PAYMENT FOR SERVICE INDICATOR * * TYPES G OR K. * * 2. EFFECTIVE 01/01/2003 REMOVE PRO RATA REDUCTION FOR * * ALL SERVICE INDICATOR 'G' PAYMENTS * * * * 08/07/2009 - REVISED LOGIC TO FORCE ALL BLOOD LINES TO * * PARAGRAPH 6550-SCH-ADJ; THIS ALLOWS ALL BLOOD * * LINES WITH A SCH PROVIDER TO RECEIVE THE SCH * * ADJ. EFFECTIVE OCTOBER 2009. * * * *************************************************************** 6550-CALC-GJK. *-------------------------------------------------------------* ** * SEARCH BLOOD HCPCS TABLE TO IDENTIFY LINES WITH BLOOD HCPCS * ** * ADDED 08/07/2009 * ** *-------------------------------------------------------------* *** MOVE 'N' TO W-BLD-HCPCS-FLAG. SET WBLH-INDX TO 1. SEARCH WBLHCPCS-ENTRY VARYING WBLH-INDX AT END MOVE 'N' TO W-BLD-HCPCS-FLAG WHEN W-2005-2008-BLOOD-HCPCS (WBLH-INDX) = OPPS-HCPCS (LN-SUB) MOVE 'Y' TO W-BLD-HCPCS-FLAG. *-------------------------------------------------------------* ** * CALCULATE LINE ITEM PAYMENT & BLOOD DEDUCTIBLE FOR BLOOD * ** * LINE WITH A HCPCS SUBJECT TO THE BLOOD DEDUTIBLE * ** * 08/07/2009 - ADDED PERFORM 6550-SCH-ADJ & INSERTED BLOOD * * DEDUCTIBLE CALCULATION & INCREMENT * *-------------------------------------------------------------* *** IF (OPPS-HCPCS(LN-SUB) = ('P9010' OR 'P9016' OR 'P9021' OR 'P9022' OR 'P9038' OR 'P9039' OR 'P9040' OR 'P9051' OR 'P9054' OR 'P9056' OR 'P9057' OR 'P9058') AND OPPS-PYMT-ADJ-FLAG (LN-SUB) = (' 5' OR ' 6')) PERFORM 6550-SET-BLOOD-FRACTION THRU 6550-SET-BLOOD-FRACTION-EXIT PERFORM 6550-ADJ-BLOOD-COST THRU 6550-ADJ-BLOOD-COST-EXIT PERFORM 6550-SCH-ADJ THRU 6550-SCH-ADJ-EXIT COMPUTE H-LN-BLOOD-DEDUCT ROUNDED = H-LITEM-PYMT * H-BLOOD-FRACTION SET W-BD-INDX UP BY 1 *-------------------------------------------------------------* ** * CALCULATE LINE ITEM PAYMENT FOR BLOOD LINE WITH A HCPCS * ** * NOT SUBJECT TO THE BLOOD DEDUCTIBLE , BUT PAF = 5 OR 6 * ** * 08/07/2009 - ADDED BLOOD HCPCS CHECK, AND * * ADDED PERFORM 6550-SCH-ADJ * *-------------------------------------------------------------* *** ELSE IF W-BLD-HCPCS-FLAG = 'Y' AND OPPS-PYMT-ADJ-FLAG (LN-SUB) = (' 5' OR ' 6') PERFORM 6550-ADJ-PLATE-COST THRU 6550-ADJ-PLATE-COST-EXIT PERFORM 6550-SCH-ADJ THRU 6550-SCH-ADJ-EXIT *-------------------------------------------------------------* ** * CALCULATE LINE ITEM PAYMENT FOR BLOOD LINE WITH A HCPCS * ** * NOT SUBJECT TO THE BLOOD DEDUCTIBLE AND PAF NOT = 5 OR 6 * ** * 08/07/2009 - ADDED THIS NEW CONDITION * *-------------------------------------------------------------* *** ELSE IF W-BLD-HCPCS-FLAG = 'Y' PERFORM 6550-SCH-ADJ THRU 6550-SCH-ADJ-EXIT *-------------------------------------------------------------* ** * CALCULATE LINE ITEM PAYMENT FOR NON-BLOOD LINE * ** * (DRUGS & BIOLOGICALS) * *-------------------------------------------------------------* *** ELSE COMPUTE H-LITEM-PYMT ROUNDED = W-APC-PYMT (W-LP-INDX) * W-SRVC-UNITS (W-LP-INDX) * W-DISC-RATE (W-LP-INDX) END-IF END-IF END-IF. 6550-CALC-GJK-EXIT. EXIT. 6550-SET-BLOOD-FRACTION. MOVE W-BD-SUB (W-BD-INDX) TO LN-SUB. IF OPPS-PYMT-ADJ-FLAG (LN-SUB) = ' 5' IF H-BENE-PINTS-USED > 0 IF W-BD-SRVC-UNITS (W-BD-INDX) <= H-BENE-PINTS-USED MOVE 1 TO H-BLOOD-FRACTION COMPUTE H-BENE-PINTS-USED = H-BENE-PINTS-USED - W-BD-SRVC-UNITS (W-BD-INDX) ELSE IF W-BD-SRVC-UNITS (W-BD-INDX) > H-BENE-PINTS-USED COMPUTE H-BLOOD-FRACTION = H-BENE-PINTS-USED / W-BD-SRVC-UNITS (W-BD-INDX) MOVE 0 TO H-BENE-PINTS-USED ELSE MOVE 0 TO H-BLOOD-FRACTION ELSE MOVE 0 TO H-BLOOD-FRACTION ELSE MOVE 0 TO H-BLOOD-FRACTION. 6550-SET-BLOOD-FRACTION-EXIT. EXIT. 6550-ADJ-BLOOD-COST. MOVE W-BD-SUB (W-BD-INDX) TO LN-SUB. IF OPPS-PYMT-ADJ-FLAG (LN-SUB) = ' 5' COMPUTE W-BD-APC-PYMT (W-BD-INDX) = W-BD-APC-PYMT (W-BD-INDX) * H-38X-39X-RATE. IF OPPS-PYMT-ADJ-FLAG (LN-SUB) = ' 6' COMPUTE W-BD-APC-PYMT (W-BD-INDX) = W-BD-APC-PYMT (W-BD-INDX) * (1 - H-38X-39X-RATE). 6550-ADJ-BLOOD-COST-EXIT. EXIT. 6550-ADJ-PLATE-COST. IF OPPS-PYMT-ADJ-FLAG (LN-SUB) = ' 5' COMPUTE W-APC-PYMT (W-LP-INDX) = W-APC-PYMT (W-LP-INDX) * H-38X-39X-RATE. IF OPPS-PYMT-ADJ-FLAG (LN-SUB) = ' 6' COMPUTE W-APC-PYMT (W-LP-INDX) = W-APC-PYMT (W-LP-INDX) * (1 - H-38X-39X-RATE). COMPUTE H-LITEM-PYMT ROUNDED = W-APC-PYMT (W-LP-INDX) * W-SRVC-UNITS (W-LP-INDX) * W-DISC-RATE (W-LP-INDX). 6550-ADJ-PLATE-COST-EXIT. EXIT. *************************************************************** * 1. CALCULATE LINE ITEM PAYMENT FOR SERVICE INDICATOR * * TYPE H. * * 2. EFFECTIVE 04/01/2002 A PRO RATA REDUCTION APPLIES TO * * ALL SERVICE INDICATOR 'H' PAYMENTS (CURRENTLY .689) * *************************************************************** ********************************************************** 00000100 * COMMENT: * 00000200 * H = DEVICE * 00000300 ********************************************************** 00000600 6555-CALC-H-TOT. MOVE W-LP-SUB (W-LP-INDX) TO LN-SUB. MOVE OPPS-SUB-CHRG (LN-SUB) TO H-SUB-CHRG. IF OPPS-SRVC-IND (LN-SUB) = ' H' IF OPPS-PYMT-IND (LN-SUB) = ' 6' COMPUTE H-TOT-H-CHRG = (H-TOT-H-CHRG + H-SUB-CHRG) ELSE NEXT SENTENCE ELSE NEXT SENTENCE. 6555-CALC-H-TOT-EXIT. EXIT. 6555-CALC-H-STANDARD. MOVE OPPS-SUB-CHRG (LN-SUB) TO H-SUB-CHRG. COMPUTE T-LITEM-PYMT ROUNDED = (H-SUB-CHRG * L-PSF-OPCOST-RATIO). *********************************************** * C-FLAG MEANS THERE IS A DEVICE ON THE CLAIM * *********************************************** IF (C-FLAG = 'Y') IF (H-TOT-OFF-UNITS > H-TOT-HTD-UNITS) COMPUTE H-TOTAL-WAOFF ROUNDED = (((H-TOTAL-OFFSET * .60) * A-WINX) + (H-TOTAL-OFFSET * .40)) * (H-TOT-HTD-UNITS / H-TOT-OFF-UNITS) PERFORM 6700-CALC-H-OFFSET THRU 6700-CALC-H-OFFSET-EXIT ELSE COMPUTE H-TOTAL-WAOFF ROUNDED = ((H-TOTAL-OFFSET * .60) * A-WINX) + (H-TOTAL-OFFSET * .40) PERFORM 6700-CALC-H-OFFSET THRU 6700-CALC-H-OFFSET-EXIT ELSE NEXT SENTENCE. IF T-LITEM-PYMT < 0 THEN MOVE 0 TO H-LITEM-PYMT ELSE MOVE T-LITEM-PYMT TO H-LITEM-PYMT. 6555-CALC-H-STANDARD-EXIT. EXIT. 6560-CALC-BENE-DEDUCT. IF OPPS-PYMT-ADJ-FLAG (LN-SUB) = ' 4' GO TO 6560-CALC-BENE-DEDUCT-EXIT. IF H-BENE-DEDUCT > 0 THEN COMPUTE H-LN-BLD-PYMT = H-LITEM-PYMT - H-LN-BLOOD-DEDUCT IF H-BENE-DEDUCT <= H-LN-BLD-PYMT THEN MOVE H-BENE-DEDUCT TO H-TOTAL-LN-DEDUCT MOVE 0 TO H-BENE-DEDUCT ELSE COMPUTE H-BENE-DEDUCT = H-BENE-DEDUCT - H-LN-BLD-PYMT MOVE H-LN-BLD-PYMT TO H-TOTAL-LN-DEDUCT MOVE 20 TO A-RETURN-CODE (LN-SUB) END-IF END-IF. 6560-CALC-BENE-DEDUCT-EXIT. EXIT. ********************************************************************* ** - NEW FOR JANUARY 2004 ** ** - CHECK >= 20040101 AND SRVC-IND = 'K' ** ** - DISCONTINUE OUTLIER PROCESS ** ********************************************************************* 6600-ADJ-CHRG-OUTL. MOVE W-LP-SUB (W-LP-INDX) TO LN-SUB. ********************************************************************* ** - NEW FOR JANUARY 2005 ** ** - TURN ON OUTLIER PROCESS FOR SPECIFIED K TYPE APCS ** ** - CHECK >= 20070101 AND SRVC-IND = 'K' ** ** ********************************************************************* * * BRACHYTHERAPY BACKED OUT FROM RELEASE V200711 TO V200712. * * IF OPPS-SRVC-IND (LN-SUB) = ' K' * IF (OPPS-APC (LN-SUB) = '1716' OR '1717' OR * '1718' OR '1719' OR '1720' OR '2616' OR '2632' OR * '2633' OR '2634' OR '2635' OR '2636' OR '2637') * NEXT SENTENCE * ELSE * GO TO 6600-ADJ-CHRG-OUTL-EXIT * ELSE * NEXT SENTENCE. IF (OPPS-SRVC-IND (LN-SUB) = ' G' OR ' H' OR ' N') OR (OPPS-PKG-FLAG (LN-SUB) = '4') GO TO 6600-ADJ-CHRG-OUTL-EXIT. ****************************************************************** ** IF BLOOD CODE, INCLUDE IN OUTLIER CALCULATION * ****************************************************************** ** 05/12/2009 - ALTERED LOGIC TO ALLOW ALL BLOOD LINES (WITH A * ** ** STATUS INDICATOR = ' K') TO ENTER OUTLIER LOGIC * ** ** (PREVIOUSLY ONLY BLOOD DEDUCTIBLE LINES ALLOWED) * ** ********************************************************************* MOVE 'N' TO W-BLD-HCPCS-FLAG. SET WBLH-INDX TO 1. SEARCH WBLHCPCS-ENTRY VARYING WBLH-INDX AT END MOVE 'N' TO W-BLD-HCPCS-FLAG WHEN W-2005-2008-BLOOD-HCPCS (WBLH-INDX) = OPPS-HCPCS (LN-SUB) MOVE 'Y' TO W-BLD-HCPCS-FLAG. IF OPPS-SRVC-IND (LN-SUB) = ' K' IF W-BLD-HCPCS-FLAG = 'Y' NEXT SENTENCE ELSE GO TO 6600-ADJ-CHRG-OUTL-EXIT ELSE NEXT SENTENCE. *----------------------------------------------------------* * CODE COMMENTED OUT 05/12/2009 & REPLACED WITH CODE ABOVE * *----------------------------------------------------------* * IF OPPS-SRVC-IND (LN-SUB) = ' K' * IF (OPPS-PYMT-ADJ-FLAG (LN-SUB) = ' 5' OR ' 6') * NEXT SENTENCE * ELSE * GO TO 6600-ADJ-CHRG-OUTL-EXIT * ELSE * NEXT SENTENCE. ***************************************************** ** NEW LOGIC INSERTED FOR WEB USE ONLY * ***************************************************** IF (ST0-FLAG = 'Y') AND ((OPPS-SRVC-IND (LN-SUB) = ' T' ) OR ((OPPS-SRVC-IND (LN-SUB) = ' S') AND (OPPS-HCPCS (LN-SUB) > '09999' AND OPPS-HCPCS (LN-SUB) < '70000'))) AND (H-TOT-ST-PYMT > 0) COMPUTE H-CHRG-RATE ROUNDED = (A-LITEM-PYMT (LN-SUB) / H-TOT-ST-PYMT) COMPUTE W-SUB-CHRG (W-LP-INDX) ROUNDED = (H-CHRG-RATE * H-TOT-ST-CHRG) ELSE IF (N-FLAG = 'Y' AND ST0-FLAG = 'N') AND ((OPPS-SRVC-IND (LN-SUB) = ' S' OR ' T' OR ' V' OR ' X' OR ' P') AND (OPPS-PKG-FLAG (LN-SUB) = '0' OR '3')) AND (H-TOT-STVX-PYMT > 0) COMPUTE H-CHRG-RATE ROUNDED = (A-LITEM-PYMT (LN-SUB) / H-TOT-STVX-PYMT) COMPUTE H-SUB-CHRG ROUNDED = (H-CHRG-RATE * H-TOT-N-CHRG) COMPUTE W-SUB-CHRG (W-LP-INDX) ROUNDED = W-SUB-CHRG (W-LP-INDX) + H-SUB-CHRG. IF (N-FLAG = 'Y' AND ST0-FLAG = 'Y') AND ((OPPS-SRVC-IND (LN-SUB) = ' S' OR ' T' OR ' V' OR ' X' OR ' P') AND (OPPS-PKG-FLAG (LN-SUB) = '0' OR '3')) AND (H-TOT-STVX-PYMT > 0) COMPUTE H-CHRG-RATE ROUNDED = (A-LITEM-PYMT (LN-SUB) / H-TOT-STVX-PYMT) COMPUTE H-SUB-CHRG ROUNDED = (H-CHRG-RATE * H-TOT-N-CHRG) COMPUTE W-SUB-CHRG (W-LP-INDX) ROUNDED = W-SUB-CHRG (W-LP-INDX) + H-SUB-CHRG. ********************************************************************* ** - NEW FOR JANUARY 2005 ** ** - PROVIDER RANGE FOR CMHC ** ** - COMPUTE H-LITEM-OUTL-PYMT USING NEW FORMULA ** ** - THIS IS THE OUTLIER THRESHOLD AMOUNT ** ********************************************************************* MOVE 1.75 TO H-OUTLIER-FACTOR. MOVE .50 TO H-OUTLIER-PCT. COMPUTE H-COST ROUNDED = W-SUB-CHRG (W-LP-INDX) * L-PSF-OPCOST-RATIO. COMPUTE H-APC-ADJ-PYMT ROUNDED = H-OUTLIER-FACTOR * A-LITEM-PYMT (LN-SUB). IF (L-PSF-PROV-3456 >= '1400' AND L-PSF-PROV-3456 <= '1499') OR (L-PSF-PROV-3456 >= '4600' AND L-PSF-PROV-3456 <= '4799') OR (L-PSF-PROV-3456 >= '4900' AND L-PSF-PROV-3456 <= '4999') MOVE 3.4 TO H-OUTLIER-FACTOR COMPUTE H-LITEM-OUTL-PYMT ROUNDED = (H-COST - (H-OUTLIER-FACTOR * A-LITEM-PYMT (LN-SUB))) * H-OUTLIER-PCT ELSE IF (H-COST > H-APC-ADJ-PYMT) AND (H-COST > A-LITEM-PYMT (LN-SUB) + 1825) COMPUTE H-LITEM-OUTL-PYMT ROUNDED = (H-COST - H-APC-ADJ-PYMT) * H-OUTLIER-PCT ELSE MOVE ZERO TO H-LITEM-OUTL-PYMT. IF H-LITEM-OUTL-PYMT > 0 COMPUTE H-OUTLIER-PYMT = H-OUTLIER-PYMT + H-LITEM-OUTL-PYMT. IF OPPS-LITEM-ACT-FLAG (LN-SUB) = '4' COMPUTE H-OUTLIER-PYMT = H-OUTLIER-PYMT - H-LITEM-OUTL-PYMT MOVE 0 TO H-LITEM-OUTL-PYMT. 6600-ADJ-CHRG-OUTL-EXIT. EXIT. *************************************************************** * 1. RE-CALCULATE LINE ITEM PAYMENT FOR SERVICE INDICATOR * * TYPE H. * * 2. SUBTRACT WAGE ADJUSTED OFFSET AMOUNT FROM SI TYPE 'H' * * WITH HCPCS CODE BEGINNING WITH 'C' * * 2. EFFECTIVE 04/01/2002 * *************************************************************** 6700-CALC-H-OFFSET. IF H-TOT-H-CHRG > 0 COMPUTE H-OFF-RATE ROUNDED = H-SUB-CHRG / H-TOT-H-CHRG COMPUTE T-LITEM-PYMT ROUNDED = T-LITEM-PYMT - (H-TOTAL-WAOFF * H-OFF-RATE) ELSE NEXT SENTENCE. IF T-LITEM-PYMT < 0 MOVE 0 TO T-LITEM-PYMT. 6700-CALC-H-OFFSET-EXIT. EXIT. 6800-ADJ-STV-REIM. IF W-DCP-CODE (W-DCP-INDX) = 1 PERFORM 6810-PROCESS-TYPE1 THRU 6810-PROCESS-TYPE1-EXIT ELSE PERFORM 6840-PROCESS-TYPE2 THRU 6840-PROCESS-TYPE2-EXIT. 6800-ADJ-STV-REIM-EXIT. EXIT. 6810-PROCESS-TYPE1. IF W-DCP-COIN2 (W-DCP-INDX) > 0 MOVE W-DCP-DOS (W-DCP-INDX) TO H-DCP-DOS MOVE W-DCP-WGNAT (W-DCP-INDX) TO H-TOTAL COMPUTE H-RATIO = (H-IP-LIMIT - W-DCP-WGNAT (W-DCP-INDX)) / W-DCP-COIN2 (W-DCP-INDX) IF H-RATIO < 0 MOVE 0 TO H-RATIO. IF H-RATIO > 1 MOVE 1 TO H-RATIO. 6810-PROCESS-TYPE1-EXIT. EXIT. 6840-PROCESS-TYPE2. IF W-DCP-DOS (W-DCP-INDX) = H-DCP-DOS MOVE W-DCP-SUB (W-DCP-INDX) TO LN-SUB COMPUTE H-SHIFT = W-DCP-COIN2 (W-DCP-INDX) * (1 - H-RATIO) COMPUTE H-TOTAL = A-ADJ-COIN (LN-SUB) + H-TOTAL - H-SHIFT IF H-TOTAL > H-IP-LIMIT COMPUTE H-SHIFT = H-SHIFT + H-TOTAL - H-IP-LIMIT END-IF COMPUTE A-ADJ-COIN (LN-SUB) = A-ADJ-COIN (LN-SUB) - H-SHIFT COMPUTE A-LITEM-REIM (LN-SUB) = A-LITEM-REIM (LN-SUB) + H-SHIFT MOVE 22 TO A-RETURN-CODE (LN-SUB) END-IF. 6840-PROCESS-TYPE2-EXIT. EXIT. *************************************************************** * 1. MOVE TOTAL CLAIM CHARGE AMOUNT. * * 2. MOVE TOTAL CLAIM PAYMENT AMOUNT. * * 3. MOVE TOTAL CLAIM BLOOD PINTS USED. * * 4. CALCULATE CLAIM LEVEL OUTLIER AMOUNT. * *************************************************************** 6900-END-PRICE-RTN. MOVE H-TOT-CHRG TO A-TOT-CLM-CHRG. MOVE H-TOT-PYMT TO A-TOT-CLM-PYMT. COMPUTE A-BLOOD-PINTS-USED = H-BENE-BLOOD-PINTS - H-BENE-PINTS-USED. IF H-OUTLIER-PYMT > 0 MOVE H-OUTLIER-PYMT TO A-OUTLIER-PYMT. 6900-END-PRICE-RTN-EXIT. EXIT. ****************************************************************** ****************************************************************** *** *** ** ** ** OUTPATIENT PROSPECTIVE PAYMENT SYSTEM PRICER ** ** -------------------------------------------- ** ** SECTION 7000 FOR CALENDAR YEAR 2008 PROCESSING ** ** SERVICE FROM DATES: 1/1/2008 - 12/31/2008 ** ** ** *** *** ****************************************************************** ****************************************************************** ****************************************************************** * * * PRICING PROCESS OVERVIEW * * ------------------------ * * * * 1. GET RATES & OTHER INFORMATION FOR THE CLAIM * * 2. VALIDATE CLAIM * * 3. VALIDATE SERVICE LINES (INCLUDING DATA FROM THE OCE) * * 4. GET RATES & OTHER INFORMATION FOR THE SERVICE LINES * * 5. ACCUMULATE NON-PRIME LINE CHARGES FOR COMPOSITE APCS * * 6. ACCUMULATE PACKAGED MENTAL HEALTH CHARGES * * 7. ORDER THE SERVICE LINES IN THE SEQUENCE IN WHICH * * DEDUCTIBLES WILL BE APPLIED * * 8. ORDER BLOOD LINES IN THE SEQUENCE IN WHICH DEDUCTIBLES * * WILL BE APPLIED * * 9. CALCULATE SERVICE LINE PAYMENTS * * 10. CALCULATE DEDUCTIBLE AMOUNT APPLIED TO EACH SERVICE LINE * * 11. CALCULATE BLOOD DEDUCTIBLE AMOUNT APPLIED TO EACH BLOOD * * DEDUCTIBLE LINE * * 12. CALCULATE BENEFICIARY MAXIMUM (IP LIMIT), NATIONAL, * * MINIMUM, & REDUCED COINSURANCE FOR EACH SERVICE LINE * * 13. CALCULATE REIMBURSEMENT FOR EACH SERVICE LINE * * 14. ADJUST LINE CHARGES FOR ARTIFICAL, PACKAGED, COMPOSITE, * * AND MENTAL HEALTH CHARGES OF APPLICABLE PROCEDURES. ALSO, * * ADJUST LINE CHARGES AND PAYMENTS FOR PASS-THROUGH DEVICES * * FOR ELIGIBLE PROCEDURES. ALL ADJUSTMENTS ARE DONE FOR * * OUTLIER DETERMINATION ONLY. * * 15. CALCULATE OUTLIER PAYMENT FOR ELIGIBLE SERVICE LINES * * 16. APPLY THE DAILY INPATIENT LIMIT IN CALCULATING THE * * COINSURANCE TO BE PAID BY THE BENEFICIARY FOR DRUG LINES; * * ADD ANY COINSURANCE AMOUNT THAT EXCEEDS THE INPATIENT * * LIMIT TO THE DRUG LINE'S REIMBURSEMENT * * 17. ACCUMULATE CLAIM TOTALS * * 18. MOVE FINAL SERVICE LINE AMOUNTS TO AREA TO BE PASSED BACK * * * ****************************************************************** 7000-PROCESS-MAIN-NEW. ***************************************************************** * * * STEP 1 - INITIALIZE & SET WORKING-STORAGE VARIABLES, ASSIGN * * ------ CBSA & WAGE INDEX, PERFORM CLAIM DATE EDITS, SET * * INPATIENT DAILY COINSURANCE LIMIT (SET ANNUALLY) * * * ***************************************************************** PERFORM 7100-INIT THRU 7100-INIT-EXIT. *--------------------------------------------------------* * SET ERROR CODE IF THE WAGE INDEX = 0 * *--------------------------------------------------------* IF H-WINX1 = 0 AND A-CLM-RTN-CODE = 01 MOVE 51 TO A-CLM-RTN-CODE. *--------------------------------------------------------* * IF THE CLAIM HAS ERROR(S), STOP PROCESSING * *--------------------------------------------------------* IF A-CLM-RTN-CODE >= 50 GOBACK. *--------------------------------------------------------* * MOVE WAGE INDEX TO VARIABLE TO BE PASSED BACK * *--------------------------------------------------------* MOVE H-WINX1 TO A-WINX. ***************************************************************** * * * STEP 2 - SET CLAIM FLAGS WHEN CERTAIN CODES ARE FOUND * * ------ (LOOP THROUGH THE CLAIM) * * * * - APC33-FLAG - PARTIAL HOSPITALIZATION CLAIM * * - C1820-OFFSET-FLAG - DEVICE OFFSET CLAIM * * - APC34-FLAG - MENTAL HEALTH CLAIM * * - PTD-FLAG - PASS-THROUGH DEVICE(S) ON CLAIM * * * ***************************************************************** PERFORM 7125-INIT THRU 7125-INIT-EXIT VARYING LN-SUB FROM 1 BY 1 UNTIL LN-SUB > OPPS-LINE-CNT. ***************************************************************** * * * STEP 3 - VALIDATE CLAIM LINES, CALCULATE LINE DISCOUNTS & * * ------ OFFSETS, ACCUMULATE CLAIM TOTALS, SET FLAGS, * * POPULATE COINSURANCE & BLOOD DEDUCTIBLE TABLES * * WITH VALID SERVICE LINES, POPULATE COMPOSITE APC * * TABLE WITH NON-PRIME COMPOSITE LINE CHARGES, * * CALCULATE TOTAL PACKAGED MENTAL HEALTH CHARGES, * * AND CREATE PASS-THROUGH DEVICE TABLE * * (LOOP THROUGH THE CLAIM) * * * ***************************************************************** MOVE 0 TO W-DCP-MAX W-BLD-MAX W-CMP-MAX W-PTD-MAX W-NUCMED-MAX. PERFORM 7150-INIT THRU 7150-INIT-EXIT VARYING LN-SUB FROM 1 BY 1 UNTIL LN-SUB > OPPS-LINE-CNT. *--------------------------------------------------------* * CALCULATE RATIO OF BLOOD PRODUCT CHARGES TO TOTAL * * BLOOD CHARGES (PRODUCT & STORAGE/PROCESSING) * *--------------------------------------------------------* IF H-TOT-38X-39X > 0 COMPUTE H-38X-39X-RATE ROUNDED = H-TOT-38X / H-TOT-38X-39X. ***************************************************************** * * * STEP 4 - ACCUMULATE TOTAL CLAIM CHARGES FROM DEVICE LINES * * ------ (FOR DEVICES, SERVICE INDICATOR = H) * * (LOOP THROUGH THE COINSURANCE DEDUCTIBLE TABLE) * * * ***************************************************************** MOVE 0 TO W-DCP-MAX. PERFORM 7555-CALC-H-TOT THRU 7555-CALC-H-TOT-EXIT VARYING W-LP-INDX FROM 1 BY 1 UNTIL W-LP-INDX > W-LNC-MAX. ***************************************************************** * * * STEP 5 - CALCULATE LINE PAYMENTS, DEDUCTIBLES, COINSURANCE, * * ------ & REIMBURSEMENT, ACCUMULATE CLAIM TOTALS, POPULATE * * DRUG COINSURANCE TABLE, POPULATE PASS-THROUGH * * DEVICE TABLE WITH ELIGIBLE PROCEDURE DATA AND * * DEVICE LINE ITEM PAYMENT, AND MOVE LINE ITEM * * VALUES TO VARIABLES TO BE PASSED BACK * * (LOOP THROUGH THE COINSURANCE DEDUCTIBLE TABLE) * * * ***************************************************************** *--------------------------------------------------------* * POINT TO 1ST RECORD IN THE BLOOD DEDUCTIBLE TABLE * *--------------------------------------------------------* SET W-BD-INDX TO 1. *--------------------------------------------------------* * CLEAR THE DRUG COINSURANCE TABLE * *--------------------------------------------------------* MOVE 0 TO W-DCP-MAX. PERFORM 7400-CALCULATE THRU 7400-CALCULATE-EXIT VARYING W-LP-INDX FROM 1 BY 1 UNTIL W-LP-INDX > W-LNC-MAX. ***************************************************************** * * * STEP 6 - ADJUST PROCEDURE LINE CHARGES FOR ARTIFICIAL * * ------ CHARGES, PACKAGING, COMPOSITES, MENTAL HEALTH, AND * * PASS-THROUGH DEVICES, AND CALCULATE OUTLIER * * PAYMENTS * * (LOOP THROUGH THE COINSURANCE DEDUCTIBLE TABLE) * * * ***************************************************************** PERFORM 7600-ADJ-CHRG-OUTL THRU 7600-ADJ-CHRG-OUTL-EXIT VARYING W-LP-INDX FROM 1 BY 1 UNTIL W-LP-INDX > W-LNC-MAX ***************************************************************** * * * STEP 7 - CALCULATE THE COINSURANCE & REIMBURSEMENT AMOUNTS * * ------ FOR STATUS INDICATOR G & K LINES. THE DAILY INPA- * * TIENT COINSURANCE LIMIT IS APPLIED USING THE WAGE * * ADJUSTED COINSURANCE OF EACH DAY'S MOST EXPENSIVE * * PROCEDURE OR VISIT. * * (LOOP THROUGH THE DRUG COINSURANCE TABLE) * * * ***************************************************************** IF GJK-FLAG = 'Y' PERFORM 7800-ADJ-STV-REIM THRU 7800-ADJ-STV-REIM-EXIT VARYING W-DCP-INDX FROM 1 BY 1 UNTIL W-DCP-INDX > W-DCP-MAX ELSE NEXT SENTENCE. ***************************************************************** * * * STEP 8 - MOVE CLAIM TOTAL CHARGES, PAYMENTS, BLOOD PINTS * * ------ USED, AND OUTLIER PAYMENTS TO VARIABLES TO BE * * PASSED BACK. CALCULATE BLOOD PINTS USED. * * * ***************************************************************** PERFORM 7900-END-PRICE-RTN THRU 7900-END-PRICE-RTN-EXIT. 7000-PROCESS-MAIN-NEW-EXIT. EXIT. *************************************************************** * * * INITIALIZE WORKING STORAGE HOLD AREAS AND ADDITIONAL * * VARIABLES TO BE PASSED BACK TO THE STANDARD SYSTEM, * * ASSIGN CLAIM CBSA AND WAGE INDEX, & PERFORM DATE EDITS * * * * ** CHANGE EVERY JANUARY: * * - INPATIENT DAILY COINSURANCE LIMIT (H-IP-LIMIT) * * - CAL-VERSION * * * *************************************************************** * * * ERROR RETURN CODES: * * ------------------- * * - IF PROVIDER SPECIFIC FILE WAGE INDEX RECLASSIFICATION * * CODE INVALID OR MISSING * * - MOVE '52' TO CLAIM LEVEL RETURN CODE * * - DISCONTINUE CLAIM PROCESSING * * - IF SERVICE FROM DATE NOT NUMERIC OR < 20000801 * * - MOVE '53' TO CLAIM LEVEL RETURN CODE * * - DISCONTINUE CLAIM PROCESSING * * - IF SERVICE FROM DATE < PROVIDER EFFECTIVE DATE * * - MOVE '54' TO CLAIM LEVEL RETURN CODE * * - DISCONTINUE CLAIM PROCESSING * * - IF SERVICE FROM DATE > PROVIDER TERMINATION DATE * * - MOVE '54' TO CLAIM LEVEL RETURN CODE * * - DISCONTINUE CLAIM PROCESSING * * * *************************************************************** 7100-INIT. *-------------------------------------------------------------* * INITIALIZE CLAIM RETURN CODE (01 = CLAIM PROCESSED) * *-------------------------------------------------------------* MOVE 01 TO A-CLM-RTN-CODE. *-------------------------------------------------------------* * INITIALIZE CLAIM AND LINE VARIABLES * *-------------------------------------------------------------* * 11/05/2007 - PHP-HCPCS-FLAG & MH-HCPCS-FLAG ADDED * * 11/06/2007 - BRACHY-APC-FLAG ADDED * * 11/13/2007 - BLD-DEDUC-HCPCS-FLAG ADDED * * 11/28/2007 - APC34-FLAG ADDED * * 12/27/2007 - RADIOPH-APC-FLAG ADDED * * 02/11/2008 - PTD-FLAG, PTD-LINE-FLAG, PTD-PROC-FLAG ADDED * * 05/12/2009 - W-BLD-HCPCS-FLAG, W-APC34-CNT ADDED * *-------------------------------------------------------------* MOVE 'N' TO APC33-FLAG GJK-FLAG ST0-FLAG N-FLAG C-FLAG C1820-OFFSET-FLAG PHP-HCPCS-FLAG MH-HCPCS-FLAG BRACHY-APC-FLAG BLD-DEDUC-HCPCS-FLAG APC34-FLAG RADIOPH-APC-FLAG PTD-FLAG PTD-LINE-FLAG PTD-PROC-FLAG W-BLD-HCPCS-FLAG. MOVE SPACE TO A-MSA A-CBSA BILL14X-FLAG. MOVE ZERO TO A-OUTLIER-PYMT A-TOTAL-CLM-DEDUCT A-TOT-CLM-CHRG A-TOT-CLM-PYMT A-BLOOD-DEDUCT-DUE A-BLOOD-PINTS-USED A-WINX W-LNC-MAX W-APC34-CNT. INITIALIZE H-ADDITIONAL-VARIABLES. INITIALIZE LINE-HOLD-ITEMS. INITIALIZE T-LITEM-PYMT. *-------------------------------------------------------------* * VALIDATE CLAIM & PSF DATES * *-------------------------------------------------------------* IF L-SERVICE-FROM-DATE NOT NUMERIC MOVE 53 TO A-CLM-RTN-CODE GO TO 7100-INIT-EXIT ELSE IF L-SERVICE-FROM-DATE < L-PSF-EFFDT MOVE 54 TO A-CLM-RTN-CODE GO TO 7100-INIT-EXIT ELSE IF L-PSF-TERMDT > 0 IF L-SERVICE-FROM-DATE > L-PSF-TERMDT MOVE 54 TO A-CLM-RTN-CODE GO TO 7100-INIT-EXIT END-IF END-IF. *-------------------------------------------------------------* * UPDATE CAL-VERSION EVERY JANUARY * *-------------------------------------------------------------* MOVE CAL-VERSION7 TO A-CALC-VERS. *-------------------------------------------------------------* * RECEIVE BENEFICIARY SPECIFIC ITEMS FROM THE OCE * *-------------------------------------------------------------* MOVE BENE-DEDUCT TO H-BENE-DEDUCT. MOVE BENE-BLOOD-PINTS TO H-BENE-BLOOD-PINTS H-BENE-PINTS-USED. *-------------------------------------------------------------* * GET TO PROPER APC DATE BY SERVICE DATE (STARTING AT THE * * LATEST EFFECTIVE DATE IN THE APC DATE TABLE) * *-------------------------------------------------------------* MOVE WAD-MAX TO WAD-SUB. PERFORM UNTIL L-SERVICE-FROM-DATE NOT < WAD-DATE (WAD-SUB) SUBTRACT 1 FROM WAD-SUB END-PERFORM. *-------------------------------------------------------------* * DETERMINE WHICH CBSA TO USE & WHETHER TO USE THE SPECIAL * * WAGE INDEX IN THE PSF, AND SET THE INPATIENT DAILY * * COINSURANCE LIMIT (IN 2 PLACES; CHANGE EVERY JANUARY) * *-------------------------------------------------------------* IF L-PSF-SPEC-PYMT-IND = 'Y' MOVE L-PSF-WI-CBSA TO H-PSF-CBSA ELSE IF L-PSF-SPEC-PYMT-IND = ' ' MOVE L-PSF-GEO-CBSA TO H-PSF-CBSA ELSE IF L-PSF-SPEC-PYMT-IND = '1' OR '2' MOVE L-PSF-GEO-CBSA TO H-PSF-CBSA A-CBSA MOVE L-PSF-SPEC-WGIDX TO H-WINX1 MOVE 1024 TO H-IP-LIMIT GO TO 7100-INIT-EXIT ELSE MOVE 52 TO A-CLM-RTN-CODE GO TO 7100-INIT-EXIT. IF H-PSF-CBSA = SPACE MOVE 52 TO A-CLM-RTN-CODE GO TO 7100-INIT-EXIT. MOVE 1024 TO H-IP-LIMIT. *-------------------------------------------------------------* * APPLY WAGE INDEX FLOOR POLICY * * UPDATE WITH NEW FLOOR PARAGRAPH EVERY JANUARY * *-------------------------------------------------------------* PERFORM 7120-FLOOR-2008 THRU 7120-FLOOR-2008-EXIT. *-------------------------------------------------------------* * APPLY SECTION 401 WAGE INDEX POLICY * * UPDATE WITH NEW SECTION 401 PARAGRAPH EVERY JANUARY * *-------------------------------------------------------------* PERFORM 7120-SEC401-2008 THRU 7120-SEC401-2008-EXIT. *-------------------------------------------------------------* * GET THE CBSA WAGE INDEX VALUE (IF NOT ALREADY OVERRIDDEN * * BY THE PSF SPECIAL WAGE INDEX VALUE) * *-------------------------------------------------------------* MOVE H-PSF-CBSA TO A-CBSA. IF H-WINX1 = 0 PERFORM 7200-CALC-WAGEINDX THRU 7200-CALC-WAGEINDX-EXIT. 7100-INIT-EXIT. EXIT. *************************************************************** * * * NEW CY 2008 FLOOR FOR CBSA WAGE INDEX * * IPPS PRICER PGM FLOORS TAKEN FROM: IPDRV084 * * * *************************************************************** * * * SYNC ALL OF THE FOLLOWING WITH INPATIENT. * * SEE IPPS PRICER MAINTAINER. * * * * * SPECIAL NOTES * * * ------------- * * 1) INPATIENT MOVES 'N' TO P-NEW-CBSA-SPEC-PAY-IND * * OPPS MOVES ' ' TO L-PSF-SPEC-PYMT-IND * * * * 2) INPATIENT CHECKS P-NEW-CBSA-SPEC-PAY-IND = 'Y' * * OPPS CHECKS L-PSF-SPEC-PYMT-IND = 'Y' * * * * 3) INPATIENT CHECKS VALUE OF HOLD-PROV-CBSA * * OPPS CHECKS VALUE OF H-PSF-CBSA * * * * 4) INPATIENT MOVES THE STATE CBSA TO HOLD-PROV-CBSA * * OPPS MOVES THE STATE CBSA TO H-PSF-CBSA * * * * 5) INPATIENT CHECKS P-NEW-STATE * * OPPS CHECKS L-PSF-PROV-ST * * * * 6) ADD SINGLE QUOTES AROUND L-PSF-PROV-ST VALUES * * * * * * BE SURE TO MAKE THESE SIX CHANGES EVERY JANUARY * * * *************************************************************** 7120-FLOOR-2008. 274000 IF H-PSF-CBSA = ' 39' 274100 AND L-PSF-SPEC-PYMT-IND = 'Y' 274200 AND L-PSF-PROV-ST = '33' 274300 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 274400 MOVE ' 33' TO H-PSF-CBSA. 274500 274600 IF H-PSF-CBSA = ' 39' 274700 AND L-PSF-SPEC-PYMT-IND = 'Y' 274800 AND L-PSF-PROV-ST = '39' 274900 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 275000 MOVE ' 39' TO H-PSF-CBSA. 275100 275200 IF H-PSF-CBSA = '10900' 275300 AND L-PSF-PROV-ST = '31' 275400 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 275500 MOVE ' 31' TO H-PSF-CBSA. 275600 275700 IF H-PSF-CBSA = '19060' 275800 AND L-PSF-PROV-ST = '21' 275900 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 276000 MOVE ' 21' TO H-PSF-CBSA. 276100 276200 IF H-PSF-CBSA = '21780' 276300 AND L-PSF-PROV-ST = '15' 276400 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 276500 MOVE ' 15' TO H-PSF-CBSA. 276600 276700 IF H-PSF-CBSA = '21780' 276800 AND L-PSF-SPEC-PYMT-IND = 'Y' 276900 AND L-PSF-PROV-ST = '15' 277000 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 277100 MOVE ' 15' TO H-PSF-CBSA. 277200 277300 IF H-PSF-CBSA = '22020' 277400 AND L-PSF-PROV-ST = '24' 277500 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 277600 MOVE ' 24' TO H-PSF-CBSA. 277700 277800 IF H-PSF-CBSA = '24220' 277900 AND L-PSF-PROV-ST = '24' 278000 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 278100 MOVE ' 24' TO H-PSF-CBSA. 278200 278300 IF H-PSF-CBSA = '24580' 278400 AND L-PSF-SPEC-PYMT-IND = 'Y' 278500 AND L-PSF-PROV-ST = '52' 278600 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 278700 MOVE ' 52' TO H-PSF-CBSA. 278800 278900 IF H-PSF-CBSA = '25540' 279000 AND L-PSF-SPEC-PYMT-IND = 'Y' 279100 AND L-PSF-PROV-ST = '07' 279200 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 279300 MOVE ' 07' TO H-PSF-CBSA. 279400 279500 IF H-PSF-CBSA = '28420' 279600 AND L-PSF-SPEC-PYMT-IND = 'Y' 279700 AND L-PSF-PROV-ST = '50' 279800 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 279900 MOVE ' 50' TO H-PSF-CBSA. 280000 280100 IF H-PSF-CBSA = '28700' 280200 AND L-PSF-PROV-ST = '44' 280300 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 280400 MOVE ' 44' TO H-PSF-CBSA. 280500 280600 IF H-PSF-CBSA = '28700' 280700 AND L-PSF-PROV-ST = '49' 280800 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 280900 MOVE ' 49' TO H-PSF-CBSA. 281000 281100 IF H-PSF-CBSA = '30300' 281200 AND L-PSF-PROV-ST = '50' 281300 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 281400 MOVE ' 50' TO H-PSF-CBSA. 281500 281600 IF H-PSF-CBSA = '35084' 281700 AND L-PSF-SPEC-PYMT-IND = 'Y' 281800 AND L-PSF-PROV-ST = '31' 281900 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 282000 MOVE ' 31' TO H-PSF-CBSA. 282100 282200 IF H-PSF-CBSA = '37620' 282300 AND L-PSF-PROV-ST = '36' 282400 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 282500 MOVE ' 36' TO H-PSF-CBSA. 282600 282700 IF H-PSF-CBSA = '37964' 282800 AND L-PSF-SPEC-PYMT-IND = 'Y' 282900 AND L-PSF-PROV-ST = '31' 283000 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 283100 MOVE ' 31' TO H-PSF-CBSA. 283200 283300 IF H-PSF-CBSA = '38300' 283400 AND L-PSF-SPEC-PYMT-IND = 'Y' 283500 AND L-PSF-PROV-ST = '36' 283600 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 283700 MOVE ' 36' TO H-PSF-CBSA. 283800 283900 IF H-PSF-CBSA = '45500' 284000 AND L-PSF-PROV-ST = '45' 284100 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 284200 MOVE ' 45' TO H-PSF-CBSA. 284300 284400 IF H-PSF-CBSA = '48260' 284500 AND L-PSF-PROV-ST = '36' 284600 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 284700 MOVE ' 36' TO H-PSF-CBSA. 284800 284900 IF H-PSF-CBSA = '48540' 285000 AND L-PSF-PROV-ST = '36' 285100 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 285200 MOVE ' 36' TO H-PSF-CBSA. 285300 285400 IF H-PSF-CBSA = '48540' 285500 AND L-PSF-PROV-ST = '51' 285600 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 285700 MOVE ' 51' TO H-PSF-CBSA. 285800 285900 IF H-PSF-CBSA = '48864' 286000 AND L-PSF-PROV-ST = '31' 286100 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 286200 MOVE ' 31' TO H-PSF-CBSA. 286300 286400 IF H-PSF-CBSA = '48864' 286500 AND L-PSF-SPEC-PYMT-IND = 'Y' 286600 AND L-PSF-PROV-ST = '31' 286700 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 286800 MOVE ' 31' TO H-PSF-CBSA. 7120-FLOOR-2008-EXIT. EXIT. *************************************************************** * * * NEW CY 2008 SECTION 401 HOSPITALS * * IPPS PRICER PGM SECTION 401S TAKEN FROM: IPDRV084 * * * *************************************************************** * * * SYNC ALL OF THE FOLLOWING WITH INPATIENT. * * SEE IPPS PRICER MAINTAINER. * * * * * SPECIAL NOTES * * * ------------- * * 1) INPATIENT CHECKS P-NEW-PROVIDER-NO * * OPPS CHECKS L-PSF-PROV-OSCAR * * * * 2) INPATIENT MOVES THE STATE CBSA TO HOLD-PROV-CBSA * * AND P-NEW-CBSA-STAND-AMT-LOC * * OPPS MOVES THE STATE CBSA TO H-PSF-CBSA ONLY * * * * 3) DELETE THE P-NEW-CBSA-STAND-AMT-LOC LINES * * * * BE SURE TO MAKE THESE THREE CHANGES EVERY JANUARY * * * *-------------------------------------------------------------* * * * NOTE: PROVIDER 250126 REMOVED FROM THIS LIST PER * * THE OCT 2007 IPPS CORRECTION NOTICE (11/1/2007) * * * *************************************************************** 7120-SEC401-2008. 353900 354000 IF (L-PSF-PROV-OSCAR = '050192' OR 354100 '050528' OR '050618') 354200 MOVE ' 05' TO H-PSF-CBSA. 354400 354500 IF (L-PSF-PROV-OSCAR = '100134') 354600 MOVE ' 10' TO H-PSF-CBSA. 354800 354900 IF (L-PSF-PROV-OSCAR = '170137') 355000 MOVE ' 17' TO H-PSF-CBSA. 355200 355300 IF (L-PSF-PROV-OSCAR = '230051' OR '230078') 355400 MOVE ' 23' TO H-PSF-CBSA. 355600 355700 IF (L-PSF-PROV-OSCAR = '250017') 355800 MOVE ' 25' TO H-PSF-CBSA. 356000 356100 IF (L-PSF-PROV-OSCAR = '260006' OR '260195') 356200 MOVE ' 26' TO H-PSF-CBSA. 356400 356500 IF (L-PSF-PROV-OSCAR = '330044' OR '330268') 356600 MOVE ' 33' TO H-PSF-CBSA. 356800 356900 IF (L-PSF-PROV-OSCAR = '360125') 357000 MOVE ' 36' TO H-PSF-CBSA. 357200 357300 IF (L-PSF-PROV-OSCAR = '370054') 357400 MOVE ' 37' TO H-PSF-CBSA. 357600 357700 IF (L-PSF-PROV-OSCAR = '380040') 357800 MOVE ' 38' TO H-PSF-CBSA. 358000 358100 IF (L-PSF-PROV-OSCAR = '390130' OR '390183' OR 358200 '390185' OR '390201') 358300 MOVE ' 39' TO H-PSF-CBSA. 358500 358600 IF (L-PSF-PROV-OSCAR = '440135') 358700 MOVE ' 44' TO H-PSF-CBSA. 358900 359000 IF (L-PSF-PROV-OSCAR = '450052' OR '450078' OR 359100 '450243' OR '450348') 359200 MOVE ' 45' TO H-PSF-CBSA. 359400 359500 IF (L-PSF-PROV-OSCAR = '500148') 359600 MOVE ' 50' TO H-PSF-CBSA. 7120-SEC401-2008-EXIT. EXIT. *************************************************************** * * * LOOP THROUGH ALL CLAIM LINES TO FIND AN APC / HCPCS * * * * - SET FLAG IF APC = 0033 (FOR PARITAL HOSPITALIZATION) * * - SET FLAG IF HCPCS = C1820 (FOR DEVICE OFFSETS) * * - SET FLAG IF APC = 0034 (FOR MENTAL HEALTH CHARGES) * * (NEW FOR CY 2008 - ADDED 11/28/2007) * * - SET FLAG IF PASS-THROUGH DEVICE(S) ON CLAIM * * (NEW FOR CY 2008 - ADDED 02/11/2008) * * * * 5/12/2009 - ADDED COUNTER FOR APC 34 LINES (W-APC34-CNT) * * FOR REVISED MENTAL HEALTH COMPOSITE LOGIC * * * *************************************************************** 7125-INIT. IF OPPS-APC (LN-SUB) = '0033' MOVE 'Y' TO APC33-FLAG. IF OPPS-APC (LN-SUB) = '0034' MOVE 'Y' TO APC34-FLAG ADD 1 TO W-APC34-CNT. IF OPPS-HCPCS (LN-SUB) = 'C1820' MOVE 'Y' TO C1820-OFFSET-FLAG. *-------------------------------------------------------------* * FLAG CLAIM WHEN AT LEAST ONE LINE IS A PASS-THROUGH DEVICE * *-------------------------------------------------------------* PERFORM 7665-SET-PTD-LINE-FLAG THRU 7665-SET-PTD-LINE-FLAG-EXIT. IF PTD-LINE-FLAG = 'Y' MOVE 'Y' TO PTD-FLAG END-IF. *-------------------------------------------------------------* * FLAG CLAIM WHEN ALL LINES HAVE A HCPCS BETWEEN 80000-89999 * * INCLUSIVE (LAB CODES), INDICATES BILL TYPE 14X * * 05/09/2011 - LOGIC ADDED * *-------------------------------------------------------------* IF (OPPS-HCPCS (LN-SUB) >= '80000' AND <= '89999') IF BILL14X-FLAG NOT = 'N' MOVE 'Y' TO BILL14X-FLAG END-IF ELSE MOVE 'N' TO BILL14X-FLAG END-IF. 7125-INIT-EXIT. EXIT. *************************************************************** * * * VALIDATE CLAIM LINES, CALCULATE LINE DISCOUNTS & OFFSETS, * * ACCUMULATE CLAIM TOTALS, SET FLAGS, POPULATE COINSURANCE & * * BLOOD DEDUCTIBLE TABLES WITH VALID SERVICE LINES, POPULATE * * COMPOSITE APC TABLE WITH NON-PRIME COMPOSITE LINE CHARGES, * * AND CALCULATE TOTAL PACKAGED MENTAL HEALTH CHARGES. * * CREATE PASS-THROUGH DEVICE TABLE (NEW FOR CY 2008 QTR 2). * * * * ** UPDATE PARTIAL HOSPITALIZATION (PHP) & MENTAL HEALTH * * (MH) TABLE REFERENCES EVERY JANUARY * * * *************************************************************** * * * VALIDATION RULES & RETURN CODES: * * -------------------------------- * * * * 1. VERIFY THE SERVICE INDICATOR PASSED BY THE OCE * * - IF INVALID SET RETURN CODE TO '40' * * - DISCONTINUE LINE PROCESSING * * - IF VALID SET RETURN CODE TO '01' * * - CONTINUE LINE PROCESSING * * 2. PROCESS LINES AND LOAD WORK TABLE ACCORDING TO PRICE * * RANKING * * 3. CHECK OCE EDIT INDICATORS AND SET RETURN CODES IF * * INDICATORS ARE INVALID. * * - VALID RETURN CODES FOR EDIT INDICATORS * * - '41' - SERVICE INDICATOR INVALID FOR OPPS PRICER * * - '42' - APC = '00000' OR (PACKAGING FLAG = 1, 2,OR 4)* * - '43' - PAYMENT INDICATOR NOT = TO 1 OR 5 THRU 9 * * - '44' - SERVICE INDICATOR = 'H' BUT PAYMENT * * INDICATOR NOT = TO 6 * * - '45' - PACKAGING FLAG NOT = TO 0, 1, 2, 3, OR 4 * * - '46' - (LINE ITEM DENIAL/REJECT FLAG NOT = TO 0 * * OR LINE ITEM DENIAL/REJECT FLAG = TO 1 * * AND (NOT A PARTIAL HOSPITALIZATION OR * * MENTAL HEALTH HCPCS)) * * OR LINE ITEM ACTION FLAG NOT = TO 1 * * - '47' - LINE ITEM ACTION FLAG = 2 OR 3 * * - '48' - PAYMENT ADJUSTMENT FLAG NOT VALID * * - '49' - SITE OF SERVICE FLAG NOT = TO 0 * * - OR (APC 0033 IS NOT ON THE CLAIM * * AND SERVICE INDICATOR = 'P' * * OR PARTIAL HOSPITALIZATION HCPCS) * * 4. IF OCE INDICATORS ARE VALID, SEARCH APC TABLE * * - IF MISSING, DELETED OR INVALID APC * * - SET RETURN CODE TO '30' * * - DISCONTINUE LINE PROCESSING * * * *************************************************************** 7150-INIT. *************************************************************** * INITIALIZE LINE RETURN CODE TO VALID VALUE * *************************************************************** MOVE 01 TO A-RETURN-CODE (LN-SUB). *************************************************************** * OVERRIDE SERVICE UNITS FOR APC 0339 - EFFECTIVE 04/01/2002 * *************************************************************** IF OPPS-APC (LN-SUB) = '0339' MOVE 1 TO OPPS-SRVC-UNITS (LN-SUB). *************************************************************** * CALCULATE DISCOUNT RATE (FOR REDUCED COIN & OFFSET CALCS) * *************************************************************** MOVE OPPS-SRVC-UNITS (LN-SUB) TO H-SRVC-UNITS. PERFORM 7250-CALC-DISCOUNT THRU 7250-CALC-DISCOUNT-EXIT. IF A-RETURN-CODE (LN-SUB) = 42 GO TO 7150-INIT-EXIT. *************************************************************** * ACCUMULATE TOTAL CLAIM DEVICE SERVICE UNITS -AND- * * FLAG CLAIMS THAT HAVE AT LEAST ONE DEVICE LINE * * - SI = H IDENTIFIES DEVICE LINES * * - EFFECTIVE AS OF 04-01-2002 * *************************************************************** IF OPPS-SRVC-IND (LN-SUB) = ' H' MOVE 'Y' TO C-FLAG COMPUTE H-TOT-HTD-UNITS = H-TOT-HTD-UNITS + H-SRVC-UNITS. *************************************************************** * ACCUMULATE CLAIM TOTAL OFFSET AMOUNT & OFFSET UNITS * * WHEN HCPCS C1820 IS ON THE CLAIM * *-------------------------------------------------------------* * - HCPCS C1820 EXPIRES FROM PASS-THRU PMT 01-01-2008. THERE * * ARE NO OFFSET DEVICES FOR CY 2008; LOGIC RETAINED & ALL * * OFFSET AMOUNTS IN OFFSET TABLE SET TO $0. * *************************************************************** IF C1820-OFFSET-FLAG = 'Y' PERFORM 7160-TOTAL-OFFSET THRU 7160-TOTAL-OFFSET-EXIT. *************************************************************** * SET AND INTIALIZE LINE SPECIFIC DATA ITEMS * *************************************************************** *-------------------------------------------------------------* * SET COIN & BLOOD DEDUCTIBLE TABLES UP FOR CURRENT LINE * *-------------------------------------------------------------* SET W-LP-INDX TO LN-SUB. SET W-BD-INDX TO LN-SUB. INITIALIZE W-LP-ENTRY (W-LP-INDX). INITIALIZE W-BD-ENTRY (W-BD-INDX). *-------------------------------------------------------------* * INITIALIZE LINE ITEM VARIABLES TO BE PASSED BACK * *-------------------------------------------------------------* MOVE ZERO TO A-LITEM-PYMT (LN-SUB) A-LITEM-REIM (LN-SUB) A-ADJ-COIN (LN-SUB) A-RED-COIN (LN-SUB) A-TOTAL-LN-DEDUCT (LN-SUB) A-BLOOD-LN-DEDUCT (LN-SUB). *-------------------------------------------------------------* * INITIALIZE LINE FLAGS * *-------------------------------------------------------------* * 11/05/2007 - PHP-HCPCS-FLAG & MH-HCPCS-FLAG ADDED * *-------------------------------------------------------------* MOVE 'N' TO PHP-HCPCS-FLAG MH-HCPCS-FLAG. *************************************************************** * SEARCH PARTIAL HOSPITALIZATION (PHP) TABLE FOR LINE HCPCS * * (LOGIC NEW FOR CY2008; ADDED 11/5/2007) * *************************************************************** SEARCH ALL PHP-ENTRY8 AT END MOVE 'N' TO PHP-HCPCS-FLAG WHEN PHP-HCPCS8 (PHP-INDX8) = OPPS-HCPCS (LN-SUB) MOVE 'Y' TO PHP-HCPCS-FLAG. *************************************************************** * SEARCH MENTAL HEALTH (MH) TABLE FOR LINE HCPCS * * (LOGIC NEW FOR CY2008; ADDED 11/5/2007) * *************************************************************** SEARCH ALL MH-ENTRY8 AT END MOVE 'N' TO MH-HCPCS-FLAG WHEN MH-HCPCS8 (MH-INDX8) = OPPS-HCPCS (LN-SUB) MOVE 'Y' TO MH-HCPCS-FLAG. *************************************************************** * POPULATE PASS-THROUGH DEVICE TABLE W/ PASS-THROUGH * * DEVICE LINE DATA * *************************************************************** IF A-RETURN-CODE (LN-SUB) = 01 AND PTD-FLAG = 'Y' AND OPPS-SRVC-IND (LN-SUB) = ' H' PERFORM 7665-SET-PTD-LINE-FLAG THRU 7665-SET-PTD-LINE-FLAG-EXIT IF PTD-LINE-FLAG = 'Y' MOVE OPPS-HCPCS (LN-SUB) TO W-PTD-LINE-HCPCS PERFORM 7390-PASS-THRU-DEVICES THRU 7390-PASS-THRU-DEVICES-EXIT END-IF END-IF. *************************************************************** * * * ** CHECK LINE OCE VALUES FOR VALIDITY ** * * * *************************************************************** *************************************************************** * IDENTIFY ALL VALID SERVICE INDICATORS (SI) & RETURN * * ERROR CODE 40 IF THE SI IS INVALID. * *************************************************************** IF NOT (OPPS-SRVC-IND (LN-SUB) = ' A' OR ' B' OR ' C' OR ' E' OR ' F' OR ' G' OR ' H' OR ' K' OR ' L' OR ' N' OR ' P' OR ' S' OR ' T' OR ' V' OR ' X' OR ' W' OR ' Y' OR ' Z' OR ' M') THEN MOVE 40 TO A-RETURN-CODE (LN-SUB) GO TO 7150-INIT-EXIT ELSE MOVE 01 TO A-RETURN-CODE (LN-SUB). *************************************************************** * IDENTIFY SERVICE INDICATORS (SI) NOT VALID FOR THE OPPS * * PRICER & RETURN ERROR CODE 41 IF THE SI IS INVALID * * FOR THE OPPS PRICER. * *************************************************************** IF OPPS-SRVC-IND (LN-SUB) = ' A' OR ' B' OR ' C' OR ' E' OR ' F' OR ' L' OR ' W' OR ' Y' OR ' Z' OR ' M' MOVE 41 TO A-RETURN-CODE (LN-SUB) GO TO 7150-INIT-EXIT. *************************************************************** ** ** ** NOTE: ERROR CODES FOR THE VALIDATION RULES BELOW ARE ** ** ASSIGNED IN THE ELSE STATMENTS AFTER THE APC ** ** TABLE SEARCH. ** ** ** *************************************************************** *************************************************************** * IDENTIFY VALID PAYMENT INDICATORS & RETURN ERROR CODE 43 * * IF THE PAYMENT INDICATOR IS INVALID. * *************************************************************** IF OPPS-PYMT-IND (LN-SUB) = ' 1' OR ' 5' OR ' 6' OR ' 7' OR ' 8' OR ' 9' *************************************************************** * IDENTIFY VALID PACKAGING FLAGS & RETURN ERROR CODE 45 * * IF THE PACKAGING FLAG IS INVALID. * *************************************************************** IF OPPS-PKG-FLAG (LN-SUB) = '0' OR '1' OR '2' OR '3' OR '4' *************************************************************** * IDENTIFY VALID LINE ITEM DENIAL OR REJECTION (D/R) FLAGS * * AND VALID D/R FLAG-HCPCS COMBINATIONS & RETURN ERROR CODE * * 46 IF THE D/R FLAG OR D/R FLAG-HCPCS COMBO IS INVALID. * *-------------------------------------------------------------* * 11/6/2007 - CHANGED PHP/MENTAL HEALTH CODES LISTED FROM * * APCS TO HCPCS (VIA TABLE SEARCH) FOR CY 2008 * *************************************************************** *--------------------------------------------------------* * LINE IS NOT DENIED OR REJECTED * *--------------------------------------------------------* IF ( OPPS-LITEM-DR-FLAG (LN-SUB) = '0' OR *--------------------------------------------------------* * LINE IS DENIED OR REJECTED AND HAS A PHP OR MH HCPCS * *--------------------------------------------------------* OPPS-LITEM-DR-FLAG (LN-SUB) = '1' AND ( PHP-HCPCS-FLAG = 'Y' OR MH-HCPCS-FLAG = 'Y' ) ) OR *--------------------------------------------------------* * LINE ITEM DENIAL/REJECTION CODE IS IGNORED * *--------------------------------------------------------* ( OPPS-LITEM-ACT-FLAG (LN-SUB) = '1' ) *************************************************************** * IDENTIFY INVALID LINE ITEM ACTION FLAGS & RETURN ERROR * * CODE 47 IF THE LINE ITEM ACTION FLAG IS INVALID. * *************************************************************** IF NOT (OPPS-LITEM-ACT-FLAG (LN-SUB) EQUAL '2' OR '3') *************************************************************** * IDENTIFY VALID PAYMENT ADJUSTMENT FLAGS (PAF) & RETURN * * ERROR CODE 48 IF THE PAF IS INVALID. * *-------------------------------------------------------------* * 10/31/2007 - ADDED ' 8' AS A VALID PAF FOR CY 2008 * * 12/06/2007 - ADDED PAFS 91 - 99 FOR COMPOSITES FOR CY 2008 * *************************************************************** IF OPPS-PYMT-ADJ-FLAG (LN-SUB) = ' 0' OR ' 1' OR ' 2' OR ' 3' OR ' 4' OR ' 5' OR ' 6' OR ' 7' OR ' 8' OR '91' OR '92' OR '93' OR '94' OR '95' OR '96' OR '97' OR '98' OR '99' *************************************************************** * IDENTIFY VALID SITE OF SERVICE (SOS) FLAG AND CASES * * WHERE THE SOS FLAG IS IGNORED & RETURN ERROR CODE 49 IF * * THE SOS FLAG IS INVALID AND NOT IGNORED. * * NOTE: PHP = PARTIAL HOSPITALIZATION * * WHEN SI = 'P', APC 0033 IS ON THE CURRENT LINE * *-------------------------------------------------------------* * 11/6/2007 - CHANGED PHP HEALTH CODES LISTED FROM * * APCS TO HCPCS (VIA TABLE SEARCH) FOR CY 2008 * *************************************************************** *-------------------------------------------------------------* * LINE SOS FLAG IS VALID * *-------------------------------------------------------------* IF (OPPS-SITE-SRVC-FLAG (LN-SUB) = '0') OR *-------------------------------------------------------------* * LINE SOS FLAG INVALID & APC 33 ON CLAIM - CHECK FURTHER * *-------------------------------------------------------------* ( (APC33-FLAG = 'Y') AND *-------------------------------------------------------------* * LINE SOS FLAG INVALID, APC 33 ON CLAIM, & LINE APC = 33 * *-------------------------------------------------------------* ( (OPPS-SRVC-IND (LN-SUB) = ' P') OR *-------------------------------------------------------------* * LINE SOS FLAG INVALID, APC 33 ON CLAIM, & LINE PHP HCPCS * *-------------------------------------------------------------* (PHP-HCPCS-FLAG = 'Y') ) ) *************************************************************** * * * ** ACCUMULATE TOTAL CHARGES OF ALL LINES THAT PASS ** * * ** VALIDATION RULES ** * * * *************************************************************** MOVE OPPS-SUB-CHRG (LN-SUB) TO H-SUB-CHRG COMPUTE H-TOT-CHRG = H-TOT-CHRG + H-SUB-CHRG *-------------------------------------------------------------* * EXCLUDE LINES THAT RECEIVE EXTERNAL LINE ITEM ADJ. * *-------------------------------------------------------------* IF OPPS-LITEM-ACT-FLAG (LN-SUB) = '4' COMPUTE H-TOT-CHRG = H-TOT-CHRG - H-SUB-CHRG END-IF *-------------------------------------------------------------* * ACCUMULATE PACKAGED LINE TOTAL CHARGES & SET CLAIM N-FLAG * * EXCLUDE PACKAGED COMPOSITE & MENTAL HEALTH (MH) LINES * *-------------------------------------------------------------* * 11/28/2007 - LOGIC ADDED TO EXCLUDE COMPOSITE & MENTAL * * HEALTH LINES (APC34-FLAG INDICATES MH) * * 08/08/2008 - LOGIC CORRECTED TO ADD CHARGES OF PACKAGED * * LINES WITH A PACKAGING FLAG OF '1' OR '4' TO * * THE CLAIM'S TOTAL DISTRIBUTED PACKAGED * * CHARGES WHEN A CLAIM HAS APC 34 (MENTAL * * HEALTH) ON IT - EFFECTIVE RETROCTIVE TO * * JANUARY 1, 2008. * *-------------------------------------------------------------* IF (OPPS-PKG-FLAG (LN-SUB) = '1' OR '2' OR '4') AND NOT (OPPS-PYMT-ADJ-FLAG (LN-SUB) = '91' OR '92' OR '93' OR '94' OR '95' OR '96' OR '97' OR '98' OR '99') AND NOT (APC34-FLAG = 'Y' AND OPPS-PKG-FLAG (LN-SUB) = '2') COMPUTE H-TOT-N-CHRG = H-SUB-CHRG + H-TOT-N-CHRG MOVE 'Y' TO N-FLAG END-IF *-------------------------------------------------------------* * ACCUMULATE PACKAGED MENTAL HEALTH LINE CHARGES * *-------------------------------------------------------------* * 11/28/2007 - LOGIC ADDED FOR CY 2008 * *-------------------------------------------------------------* IF (APC34-FLAG = 'Y') AND (OPPS-SRVC-IND (LN-SUB) = ' N') AND (OPPS-PKG-FLAG (LN-SUB) = '2') COMPUTE H-TOT-MH-CHRG = H-SUB-CHRG + H-TOT-MH-CHRG END-IF *-------------------------------------------------------------* * ACCUMULATE NON-PRIME COMPOSITE APC CHARGES FOR EACH * * COMPOSITE APC USING PACKAGED LINES WITH A PAF = 91 - 99 * * (POPULATE COMPOSITE TABLE) * *-------------------------------------------------------------* * 11/28/2007 - LOGIC ADDED FOR CY 2008 * *-------------------------------------------------------------* IF (OPPS-PYMT-ADJ-FLAG (LN-SUB) = '91' OR '92' OR '93' OR '94' OR '95' OR '96' OR '97' OR '98' OR '99') AND (OPPS-SRVC-IND (LN-SUB) = ' N') PERFORM 7170-COMPOSITES THRU 7170-COMPOSITES-EXIT END-IF *-------------------------------------------------------------* * RETURN ERROR CODE WHEN PACKAGED LINE OR LINE APC = 0000 * *-------------------------------------------------------------* IF (OPPS-APC (LN-SUB) = '0000') OR (OPPS-PKG-FLAG (LN-SUB) = '1' OR '2' OR '4') MOVE 42 TO A-RETURN-CODE (LN-SUB) GO TO 7150-INIT-EXIT END-IF *************************************************************** * * * ** LOOK-UP LINE APC IN APC TABLE FOR ALL LINES THAT ** * * ** PASS VALIDATION RULES ** * * * *************************************************************** SEARCH ALL WAA-ENTRY AT END MOVE 30 TO A-RETURN-CODE (LN-SUB) GO TO 7150-INIT-EXIT WHEN WAA-APC (WAA-INDX) = OPPS-GRP (LN-SUB) *-------------------------------------------------------------* * START SEARCH AT THE APC'S MOST CURRENT RECORD * *-------------------------------------------------------------* MOVE WAA-PTR (WAA-INDX) TO W-SUB2 *-------------------------------------------------------------* * GET APC DATA FROM THE REC WITH THE CORRECT EFFECTIVE DATE * *-------------------------------------------------------------* PERFORM 7175-APC-LOOKUP *************************************************************** * * * ** RETURN ERROR CODE AND STOP PROCESSING LINES ** * * ** THAT FAIL OCE VALIDATION RULES ** * * * *************************************************************** ELSE MOVE 49 TO A-RETURN-CODE (LN-SUB) GO TO 7150-INIT-EXIT ELSE MOVE 48 TO A-RETURN-CODE (LN-SUB) GO TO 7150-INIT-EXIT ELSE MOVE 47 TO A-RETURN-CODE (LN-SUB) GO TO 7150-INIT-EXIT ELSE MOVE 46 TO A-RETURN-CODE (LN-SUB) GO TO 7150-INIT-EXIT ELSE MOVE 45 TO A-RETURN-CODE (LN-SUB) GO TO 7150-INIT-EXIT ELSE MOVE 43 TO A-RETURN-CODE (LN-SUB) GO TO 7150-INIT-EXIT. *************************************************************** * PROCESS BLOOD DEDUCTIBLE (EFFECTIVE AS OF 07-01-2005) * * - TOTAL BLOOD CODE CHARGES WHEN PAF = '5' OR '6' * * 5: BLOOD/BLOOD PRODUCT USED IN BLOOD DEDUC CALC * * 6: BLOOD PROCESS/STORAGE (LABOR) NOT SBJ TO BLD DEDUC * *************************************************************** IF OPPS-PYMT-ADJ-FLAG (LN-SUB) = ' 5' COMPUTE H-TOT-38X = OPPS-SUB-CHRG (LN-SUB) + H-TOT-38X. IF OPPS-PYMT-ADJ-FLAG (LN-SUB) = ' 5' OR ' 6' COMPUTE H-TOT-38X-39X = OPPS-SUB-CHRG (LN-SUB) + H-TOT-38X-39X. *************************************************************** * POPULATE COINSURANCE DEDUCTIBLE TABLE W/ ALL VALID LINES * * ORDERED LOWEST TO HIGHEST RANK FROM APC TABLE * *************************************************************** IF A-RETURN-CODE (LN-SUB) = 01 PERFORM 7300-COIN-DEDUCT THRU 7300-COIN-DEDUCT-EXIT. *************************************************************** * POPULATE BLOOD DEDUCTIBLE TABLE W/ BLOOD DEDUC LINES * * ORDERED EARLIEST TO LATEST DATE OF SERVICE AND THEN * * LOWEST TO HIGHEST RANK FROM BLOOD DEDUCTIBLE TABLE * * (APPLIES WHEN HCPCS IS IN BLOOD DEDUCTIBLE RANKING TABLE) * * * * 05/11/2009 - ADDED THE REQUIREMENT PAF = 5 OR 6 TO BLOOD * * DEDUCTIBLE LOGIC TO CORRECT PRICING ERROR. * * FIX EFFECTIVE RETROACTIVE TO 01/01/2008. * *************************************************************** IF A-RETURN-CODE (LN-SUB) = 01 SET W8BD-INDX TO 1 SEARCH W8BD-ENTRY VARYING W8BD-INDX AT END GO TO 7150-INIT-EXIT WHEN W-2008-BLOOD-HCPCS (W8BD-INDX) = OPPS-HCPCS (LN-SUB) IF OPPS-PYMT-ADJ-FLAG (LN-SUB) = (' 5' OR ' 6') MOVE W-2008-BLOOD-RANK (W8BD-INDX) TO H-BLOOD-RANK MOVE OPPS-LITEM-DOS (LN-SUB) TO H-BLD-DOS PERFORM 7375-BLOOD-DEDUCT THRU 7375-BLOOD-DEDUCT-EXIT END-IF. 7150-INIT-EXIT. EXIT. *************************************************************** * * * ACCUMULATE CLAIM TOTAL OFFSET AMT FROM CY 2008 OFFSET TABLE * * FOR PASS-THRU ITEMS * * * *************************************************************** * * * - SEARCH TABLE OPPSOF08 FOR LINE APC. * * - CALCULATE TOTAL OFFSET & TOTAL OFFSET UNITS IF APC * * OFFSET AMOUNT IN TABLE NOT EQUAL TO 0. * * * NOTE: C1820 EXPIRES FROM PASS-THRU PAYMENT IN 2008. * * ALL OFFSET AMOUNTS IN THE 2008 TABLE = $0. * * THIS LOGIC KEPT FOR FUTURE OFFSET CODES. * * * * EFFECTIVE AS OF 01-01-2003 * * - CONTINUE FOR 01-01-2004 * * - CONTINUE FOR 01-01-2005 * * - CONTINUE FOR 01-01-2006 * * - CONTINUE FOR 01-01-2007 * * - CONTINUE FOR 01-01-2008 (ALL OFFSETS IN TBL = $0) * * - CONTINUE FOR 01-01-2009 (ALL OFFSETS IN TBL = $0) * * * *************************************************************** 7160-TOTAL-OFFSET. MOVE OPPS-GRP (LN-SUB) TO W-OFF-APC. SEARCH ALL WOO-ENTRY8 AT END GO TO 7160-TOTAL-OFFSET-EXIT WHEN WOO-APC8 (WOO-INDX8) = W-OFF-APC PERFORM 7161-TOTAL-OFFSET-AMT THRU 7161-TOTAL-OFFSET-AMT-EXIT. 7160-TOTAL-OFFSET-EXIT. EXIT. *************************************************************** * * * ACCUMULATE CLAIM TOTAL OFFSET AND OFFSET UNITS * * * *************************************************************** 7161-TOTAL-OFFSET-AMT. IF WOO-OFFSET8 (WOO-INDX8) EQUAL 0 GO TO 7161-TOTAL-OFFSET-AMT-EXIT. COMPUTE H-TOTAL-OFFSET = H-TOTAL-OFFSET + (WOO-OFFSET8 (WOO-INDX8) * H-DISC-RATE * H-SRVC-UNITS). COMPUTE H-TOT-OFF-UNITS = H-TOT-OFF-UNITS + H-SRVC-UNITS. IF H-TOTAL-OFFSET < 0 MOVE 0 TO H-TOTAL-OFFSET. 7161-TOTAL-OFFSET-AMT-EXIT. EXIT. *************************************************************** * * * ACCUMULATE NON-PRIME COMPOSITE APC CHARGES FOR EACH * * COMPOSITE APC USING PACKAGED LINES WITH A PAF = 91 - 99 * * & POPULATE COMPOSITE APC TABLE * * * *************************************************************** * * * ORDER SERVICE LINES BY PAYMENT ADJUSTMENT FLAG (PAF) - * * LOWEST TO HIGHEST FLAG VALUE (91 - 99) * * * * EACH NON-PRIME COMPOSITE PACKAGED LINE'S CHARGES ARE ADDED * * TO THE TOTAL NON-PRIME CHARGES FOR EACH PAF, WHICH * * CORRESPONDS TO THE PRIME LINE'S APC. THESE CHARGES ARE * * LATER ADDED TO THE PRIME LINE'S CHARGES TO CALCULATE THE * * OUTLIER PAYMENT. * * * * 11/28/2007 - LOGIC ADDED FOR CY 2008 * * * *************************************************************** 7170-COMPOSITES. *-------------------------------------------------------------* * GET THE LINE'S PAYMENT ADJUSTMENT FLAG FOR TABLE SEARCH * *-------------------------------------------------------------* MOVE OPPS-PYMT-ADJ-FLAG (LN-SUB) TO H-CMP-PAF. *-------------------------------------------------------------* * ADD OR UPDATE COMPOSITE APC TABLE ENTRY FOR THE PAF * *-------------------------------------------------------------* PERFORM 7171-SEARCH-PAF THRU 7171-SEARCH-PAF-EXIT. 7170-COMPOSITES-EXIT. EXIT. *************************************************************** * * * DETERMINE WHETHER A NEW COMPOSITE APC TABLE RECORD SHOULD * * BE ADDED OR IF AN EXISITING RECORD NEEDS TO BE UPDATED * * * *************************************************************** 7171-SEARCH-PAF. *-------------------------------------------------------------* * SEARCH COMPOSITE APC TABLE STARTING AT ENTRY #1 * *-------------------------------------------------------------* SET W-CMP-INDX TO 1. SEARCH W-CMP-ENTRY VARYING W-CMP-INDX *-------------------------------------------------------------* * IF THE SERVICE LINE'S PAYMENT ADJUSTMENT FLAG IS NOT * * ALREADY IN THE TABLE, ADD IT * *-------------------------------------------------------------* AT END PERFORM 7172-ADD-ENTRY THRU 7172-ADD-ENTRY-EXIT *-------------------------------------------------------------* * IF THE SERVICE LINE'S PAYMENT ADJUSTMENT FLAG IS ALREADY IN * * THE TABLE, UPDATE THE ENTRY * *-------------------------------------------------------------* WHEN W-CMP-PAF (W-CMP-INDX) = H-CMP-PAF PERFORM 7173-UPDATE-ENTRY THRU 7173-UPDATE-ENTRY-EXIT. 7171-SEARCH-PAF-EXIT. EXIT. *************************************************************** * * * INSERT THE NEW COMPOSITE APC RECORD IN THE CORRECT POSITION * * (LOWEST TO HIGHEST PAF) OF THE COMPOSITE APC TABLE * * * *************************************************************** 7172-ADD-ENTRY. *-------------------------------------------------------------* * INCREASE THE TOTAL NUMBER OF TABLE RECORDS FOR NEW ENTRY * *-------------------------------------------------------------* ADD 1 TO W-CMP-MAX. *-------------------------------------------------------------* * MOVE TO THE NEW ENTRY POSITION (EMPTY RECORD) * *-------------------------------------------------------------* SET W-CMP-INDX TO W-CMP-MAX. *-------------------------------------------------------------* * DETERMINE WHERE THE NEW COMPOSITE APC ENTRY FOR THE CURRENT * * SERVICE LINE SHOULD BE ENTERED INTO THE TABLE ACCORDING TO * * ITS PAYMENT ADJUSTMENT FLAG (PAF) - LOWEST TO HIGHEST PAF. * *-------------------------------------------------------------* PERFORM 7174-STAGE-CMP-ENTRY THRU 7174-STAGE-CMP-ENTRY-EXIT UNTIL W-CMP-INDX = 1 OR H-CMP-PAF NOT < W-CMP-PAF (W-CMP-INDX - 1). *-------------------------------------------------------------* * POPULATE THE EMPTY RECORD WITH THE NEW SERVICE LINE'S DATA * *-------------------------------------------------------------* MOVE H-CMP-PAF TO W-CMP-PAF (W-CMP-INDX). MOVE H-SUB-CHRG TO W-CMP-TOT-SUB-CHRG (W-CMP-INDX). 7172-ADD-ENTRY-EXIT. EXIT. *************************************************************** * * * UPDATE THE EXISTING COMPOSITE APC RECORD WITH THE SAME * * PAYMENT ADJUSTMENT FLAG OF THE CURRENT SERVICE LINE * * * *************************************************************** 7173-UPDATE-ENTRY. *-------------------------------------------------------------* * ACCUMULATE THE PAF'S TOTAL NON-PRIME SUBMITTED CHARGES * *-------------------------------------------------------------* ADD H-SUB-CHRG TO W-CMP-TOT-SUB-CHRG (W-CMP-INDX). 7173-UPDATE-ENTRY-EXIT. EXIT. *************************************************************** * * * MOVE THE EXISTING COMPOSITE APC RECORD WITH A HIGHER PAF * * UP ONE RECORD POSITION AND SET THE EMPTY RECORD FOR THE * * NEW ENTRY'S INDEX TO THE NEXT LOWER RECORD POSITION. * * * *************************************************************** 7174-STAGE-CMP-ENTRY. MOVE W-CMP-ENTRY (W-CMP-INDX - 1) TO W-CMP-ENTRY (W-CMP-INDX). SET W-CMP-INDX DOWN BY 1. 7174-STAGE-CMP-ENTRY-EXIT. EXIT. *************************************************************** * * * LOCATE THE APC RECORD WITH THE APPROPRIATE EFFECTIVE DATE * * - MOVE APC DATA TO HOLD AREA FOR PROCESSING WHEN FOUND * * - ADJUST TOTAL CHARGES FOR DELETED APCS & RETURN ERROR * * - RETURN ERROR WHEN USABLE EFFECTIVE DATE NOT FOUND * * * *************************************************************** 7175-APC-LOOKUP. *************************************************************** * APC RECORD EFFECTIVE DATE IS BEFORE OR ON THE LATEST * * EFFECTIVE DATE THE CLAIM CAN USE (SEARCH STARTS AT THE * * MOST CURRENT RECORD FOR THE APC) * *************************************************************** IF WAR-DTCD (W-SUB2) NOT > WAD-DTCD (WAD-SUB) *-------------------------------------------------------------* * APC RECORD EFFECTIVE DATE CORRECT, APC DELETED - ERROR * *-------------------------------------------------------------* IF WAR-RATEX (W-SUB2) = 'DELETED' MOVE 30 TO A-RETURN-CODE (LN-SUB) COMPUTE H-TOT-CHRG = H-TOT-CHRG - H-SUB-CHRG *-------------------------------------------------------------* * APC RECORD EFFECTIVE DATE CORRECT, APC ACTIVE - ACCEPT REC * *-------------------------------------------------------------* ELSE MOVE WAR-RATE (W-SUB2) TO H-APC-PYMT MOVE WAR-RANK (W-SUB2) TO H-RANK MOVE WAR-MINC (W-SUB2) TO H-MIN-COIN MOVE WAR-COIN (W-SUB2) TO H-NAT-COIN MOVE WAR-PPCT (W-SUB2) TO H-PPCT *************************************************************** * APC RECORD EFFECTIVE DATE IS AFTER THE LATEST EFFECTIVE * * DATE THE CLAIM CAN USE. GO TO THE PREVIOUS RECORD IN THE * * APC TABLE. * *************************************************************** ELSE SUBTRACT 1 FROM W-SUB2 *-------------------------------------------------------------* * PREVIOUS REC BELONGS TO THE LINE APC, TEST EFFECTIVE DATE * *-------------------------------------------------------------* IF W-SUB2 > WAA-PTR (WAA-INDX - 1) GO TO 7175-APC-LOOKUP *-------------------------------------------------------------* * THERE IS NO RECORD FOR THE LINE APC WITH AN ACCEPTABLE * * EFFECTIVE DATE FOR THE LINE. RETURN ZEROS. * *-------------------------------------------------------------* ELSE MOVE 0 TO H-APC-PYMT H-RANK H-MIN-COIN H-NAT-COIN H-PPCT. 7175-APC-LOOKUP-EXIT. EXIT. *************************************************************** * * * DELETED CODE: * * IF DATE OF SERVICE BETWEEN 12/31/2002 AND 04/01/2003 * * IF HCPCS CODE = C9114 OR C9115 ADJUST PAYMENT AND * * COINSURANCE AMOUNTS - LOGIC REMOVED FOR 20050101 * * * *************************************************************** *************************************************************** * * * SEARCH WAGE INDEX TABLE FOR THE CBSA IN THE PROVIDER * * SPECIFIC FILE (PSF) * * * *************************************************************** * * * IF CBSA NOT LOCATED * * - SET CLAIM RETURN CODE TO '50' * * - DISCONTINUE CLAIM PROCESSING * * IF WAGE INDEX EQUALS ZERO * * - SET CLAIM RETURN CODE TO '51' * * - DISCONTINUE CLAIM PROCESSING * * * *************************************************************** 7200-CALC-WAGEINDX. *************************************************************** * STARTING AT THE LAST DATE IN THE TABLE, SEARCH WAGE INDEX * * DATE TABLE FOR THE MOST CURRENT EFFECTIVE DATE THAT CAN BE * * USED BY THE CLAIM * *************************************************************** MOVE WCD-MAX TO WCD-SUB. PERFORM UNTIL L-SERVICE-FROM-DATE NOT < WCD-DATE (WCD-SUB) SUBTRACT 1 FROM WCD-SUB END-PERFORM. *************************************************************** * SEARCH CBSA TABLE FOR THE PSF CBSA * *************************************************************** SEARCH ALL WCM-ENTRY *-------------------------------------------------------------* * PSF CBSA NOT FOUND IN CBSA TABLE, RETURN ERROR * *-------------------------------------------------------------* AT END MOVE 50 TO A-CLM-RTN-CODE GO TO 7200-CALC-WAGEINDX-EXIT *-------------------------------------------------------------* * PSF CBSA FOUND IN CBSA TABLE * *-------------------------------------------------------------* WHEN WCM-CBSA (WCM-INDX) = H-PSF-CBSA *-------------------------------------------------------------* * START SEARCH AT THE MOST CURRENT RECORD FOR THE CBSA * *-------------------------------------------------------------* MOVE WCM-PTR (WCM-INDX) TO W-SUB3 *-------------------------------------------------------------* * GET WAGE INDEX FROM THE REC W/ THE CORRECT EFFECTIVE DATE * *-------------------------------------------------------------* PERFORM 7210-WAGE-LOOKUP. *************************************************************** * RETURN ERROR IF WAGE INDEX = 0 * *************************************************************** IF H-WINX1 = 0 THEN MOVE 51 TO A-CLM-RTN-CODE. 7200-CALC-WAGEINDX-EXIT. EXIT. *************************************************************** * * * LOCATE THE CBSA RECORD WITH THE APPROPRIATE EFFECTIVE DATE * * WHEN FOUND, SELECT THE APPLICABLE WAGE INDEX VALUE * * * *************************************************************** 7210-WAGE-LOOKUP. *************************************************************** * WAGE INDEX RECORD EFFECTIVE DATE IS BEFORE OR ON THE * * LATEST EFFECTIVE DATE THE CLAIM CAN USE - CORRECT * * (SEARCH STARTS AT THE MOST CURRENT RECORD FOR THE CBSA) * *************************************************************** IF WCW-DTCD (W-SUB3) NOT > WCD-DTCD (WCD-SUB) *-------------------------------------------------------------* * THIS PROVIDER HAS RECLASSIFIED, USE THE WAGE INDEX IN THE * * SECOND COLUMN FOR RECLASSIFYING PROVIDERS. * *-------------------------------------------------------------* IF L-PSF-SPEC-PYMT-IND = 'Y' MOVE WCW-WINX2 (W-SUB3) TO H-WINX1 *-------------------------------------------------------------* * THIS PROVIDER HAS NOT RECLASSIFIED, USE THE WAGE INDEX IN * * THE FIRST COLUMN FOR AREA PROVIDERS. * *-------------------------------------------------------------* ELSE MOVE WCW-WINX1 (W-SUB3) TO H-WINX1 *************************************************************** * WAGE INDEX RECORD EFFECTIVE DATE IS AFTER LATEST EFFECTIVE * * DATE THE CLAIM CAN USE. GO TO THE PREVIOUS RECORD IN THE * * CBSA WAGE INDEX TABLE. * *************************************************************** ELSE SUBTRACT 1 FROM W-SUB3 *-------------------------------------------------------------* * PREVIOUS REC BELONGS TO THE PSF CBSA, TEST EFFECTIVE DATE * *-------------------------------------------------------------* IF W-SUB3 > WCM-PTR (WCM-INDX - 1) GO TO 7210-WAGE-LOOKUP *-------------------------------------------------------------* * THERE IS NO RECORD FOR THE PSF CBSA WITH AN ACCEPTABLE * * EFFECTIVE DATE FOR THE LINE. RETURN ZERO. * *-------------------------------------------------------------* ELSE MOVE 0 TO H-WINX1. 7210-WAGE-LOOKUP-EXIT. EXIT. *************************************************************** * * * CALCULATE DISCOUNT RATE BASED ON THE DISCOUNT * * FACTOR PASSED BY THE OCE: VALUES 1 - 9 * * * * IF MISSING OR INVALID DISCOUNT FACTOR * * - SET RETURN CODE TO '38' * * - DISCONTINUE LINE PROCESSING * * * *************************************************************** * * * 11/1/2007 - NEW DISCOUNT INDICATOR 9 ADDED FOR CY 2008 * * * *************************************************************** 7250-CALC-DISCOUNT. IF (H-SRVC-UNITS = 0 AND OPPS-APC (LN-SUB) = '0000') MOVE 42 TO A-RETURN-CODE (LN-SUB) GO TO 7250-CALC-DISCOUNT-EXIT ELSE IF (H-SRVC-UNITS = 0 AND OPPS-APC (LN-SUB) > '0000') MOVE 1 TO H-SRVC-UNITS. IF OPPS-DISC-FACT (LN-SUB) = 1 THEN MOVE 1 TO H-DISC-RATE ELSE IF OPPS-DISC-FACT (LN-SUB) = 2 THEN COMPUTE H-DISC-RATE = (1 + DISC-FRACTION * (H-SRVC-UNITS - 1)) / H-SRVC-UNITS ELSE IF OPPS-DISC-FACT (LN-SUB) = 3 THEN COMPUTE H-DISC-RATE = TERM-PROC-DISC / H-SRVC-UNITS ELSE IF OPPS-DISC-FACT (LN-SUB) = 4 THEN COMPUTE H-DISC-RATE = (1 + DISC-FRACTION) / H-SRVC-UNITS ELSE IF OPPS-DISC-FACT (LN-SUB) = 5 THEN COMPUTE H-DISC-RATE = DISC-FRACTION ELSE IF OPPS-DISC-FACT (LN-SUB) = 6 THEN COMPUTE H-DISC-RATE = (TERM-PROC-DISC * DISC-FRACTION) / H-SRVC-UNITS ELSE IF OPPS-DISC-FACT (LN-SUB) = 7 THEN COMPUTE H-DISC-RATE = (DISC-FRACTION * (1 + DISC-FRACTION) / H-SRVC-UNITS) ELSE IF OPPS-DISC-FACT (LN-SUB) = 8 THEN MOVE 2 TO H-DISC-RATE ELSE IF OPPS-DISC-FACT (LN-SUB) = 9 THEN COMPUTE H-DISC-RATE = 1 / H-SRVC-UNITS ELSE MOVE 38 TO A-RETURN-CODE (LN-SUB). 7250-CALC-DISCOUNT-EXIT. EXIT. *************************************************************** * * * POPULATE COINSURANCE DEDUCTIBLE TABLE WITH SERVICE LINES * * * *************************************************************** * * * ORDER SERVICES LINES BY THE DEDUCTIBLE SEQUENCE - * * LOWEST TO HIGHEST APC RANK FROM APC TABLE * * * * DEDUCTIBLE WILL BE TAKEN FROM OPPS SERVICES FIRST, * * THEN FROM ANY OTHER TYPES OF SERVICES FROM THE CLAIM. * * ALL VALID SERVICE LINES APPEAR IN THIS TABLE IN THE * * ORDER OF THEIR RANK FROM LOWEST TO HIGHEST. * * - THE LOWER THE RANK, THE HIGHER % THE NATIONAL * * UNADJUSTED COINSURANCE IS OF THE APC PAYMENT RATE * * - MOVE ALL LINE PRICING VARIABLES TO STAGING AREA * * (NEW COINSURANCE DEDUCTIBLE TABLE RECORD) * * * * NOTE: THE PURPOSE OF APC RANKING IS TO ENSURE THAT THE * * BENEFICIARY DEDUCTIBLE GOES TOWARD LINES WITH * * HIGHER COINSURANCE %S FIRST. THIS RESULTS IN THE * * BENEFICIARY PAYING LESS TOTAL COINSURANCE FOR THE * * CLAIM. * * * *************************************************************** 7300-COIN-DEDUCT. *-------------------------------------------------------------* * ADD 1 TO THE TOTAL TABLE RECORDS FOR THE NEW ENTRY * *-------------------------------------------------------------* ADD 1 TO W-LNC-MAX. *-------------------------------------------------------------* * MOVE TO THE NEW ENTRY POSITION (EMPTY RECORD) * *-------------------------------------------------------------* SET W-LP-INDX TO W-LNC-MAX. *-------------------------------------------------------------* * DETERMINE WHERE THE NEW SERVICE LINE SHOULD BE ENTERED INTO * * THE TABLE ACCORDING TO ITS RANK AND THE RANK OF THE RECORDS * * ALREADY IN THE TABLE - LOWEST TO HIGHEST RANK. * *-------------------------------------------------------------* PERFORM 7350-STAGE-ENTRY THRU 7350-STAGE-ENTRY-EXIT UNTIL W-LP-INDX = 1 OR H-RANK NOT < W-RANK (W-LP-INDX - 1). *-------------------------------------------------------------* * POPULATE THE EMPTY RECORD WITH THE NEW SERVICE LINE'S DATA * *-------------------------------------------------------------* MOVE LN-SUB TO W-LP-SUB (W-LP-INDX). MOVE H-NAT-COIN TO W-NAT-COIN (W-LP-INDX). MOVE H-MIN-COIN TO W-MIN-COIN (W-LP-INDX). MOVE H-SUB-CHRG TO W-SUB-CHRG (W-LP-INDX). MOVE H-APC-PYMT TO W-APC-PYMT (W-LP-INDX). MOVE H-WINX1 TO W-WINX1 (W-LP-INDX). MOVE H-RANK TO W-RANK (W-LP-INDX). MOVE H-PPCT TO W-PPCT (W-LP-INDX). MOVE H-DISC-RATE TO W-DISC-RATE (W-LP-INDX). *-------------------------------------------------------------* * PARTIAL HOSPITALIZATION LINES RECEIVE 1 SERVICE UNIT * *-------------------------------------------------------------* IF OPPS-SRVC-IND (LN-SUB) = ' P' THEN MOVE 1 TO W-SRVC-UNITS (W-LP-INDX) *-------------------------------------------------------------* * NON-PARTIAL HOSPITALIZATION LINES RECEIVE INPUT SVC UNITS * *-------------------------------------------------------------* ELSE MOVE H-SRVC-UNITS TO W-SRVC-UNITS (W-LP-INDX). *-------------------------------------------------------------* * SEARCH PROVIDER SPECIFIC FILE FOR THE LINE APC. * * IF FOUND, CALCULATE THE REDUCED COINSURANCE AMOUNT FOR * * THE LINE, ENTER IT INTO THE NEW COIN DEDUC TABLE REC, & * * RETURN CODE 25 * *-------------------------------------------------------------* MOVE 0 TO W-RED-COIN (W-LP-INDX). PERFORM VARYING PS-SUB FROM 1 BY 1 UNTIL PS-SUB > L-PSF-APC-LINE-CNT IF L-PSF-APC (PS-SUB) = OPPS-APC (LN-SUB) COMPUTE W-RED-COIN (W-LP-INDX) ROUNDED = L-PSF-RED-COIN (PS-SUB) * H-SRVC-UNITS * H-DISC-RATE MOVE 25 TO A-RETURN-CODE (LN-SUB) MOVE L-PSF-APC-LINE-CNT TO PS-SUB END-IF END-PERFORM. 7300-COIN-DEDUCT-EXIT. EXIT. *************************************************************** * * * MOVE THE EXISTING COINSURANCE DEDUCTIBLE RECORD WITH A * * HIGHER RANK UP ONE RECORD POSITION AND SET THE INDEX OF * * THE EMPTY RECORD FOR THE NEW ENTRY TO THE NEXT LOWER * * RECORD POSITION. * * * *************************************************************** 7350-STAGE-ENTRY. MOVE W-LP-ENTRY (W-LP-INDX - 1) TO W-LP-ENTRY (W-LP-INDX). SET W-LP-INDX DOWN BY 1. 7350-STAGE-ENTRY-EXIT. EXIT. *************************************************************** * * * POPULATE BLOOD DEDUCTIBLE TABLE WITH SERVICE LINES * * THAT HAVE A BLOOD DEDUCTIBLE HCPCS * * * *************************************************************** * * * ORDER SERVICES LINES BY DEDUCTIBLE SEQUENCE - * * 1. EARLIEST TO LATEST DATE OF SERVICE * * 2. LOWEST TO HIGHEST BLOOD RANK FROM BLOOD DEDUC TABLE * * * * DEDUCTIBLES WILL PAID FOR LINES IN THE ORDER OF DATE OF * * SERVICE (EARLIEST TO LATEST) AND THEN BY COST (LEAST TO * * MOST EXPENSIVE). ONLY VALID LINES WITH A HCPCS IN THE * * BLOOD DEDUCTIBLE RANKING TABLE APPEAR IN THIS TABLE. * * - BLOOD RANK OF 1 IS ASSIGNED TO THE LEAST EXPENSIVE * * BLOOD CODE * * - MOVE ALL LINE PRICING VARIABLES TO STAGING AREA * * (NEW BLOOD DEDUCTIBLE TABLE RECORD) * * * * NOTE: THE PURPOSE OF BLOOD LINE RANKING IS TO ENSURE * * THAT THE BENEFICIARY PAYS DEDUCTIBLES FOR THE * * THREE LEAST EXPENSIVE BLOOD PRODUCTS. * * * *************************************************************** 7375-BLOOD-DEDUCT. *-------------------------------------------------------------* * ADD 1 TO THE TOTAL TABLE RECORDS FOR THE NEW ENTRY * *-------------------------------------------------------------* ADD 1 TO W-BLD-MAX. *-------------------------------------------------------------* * MOVE TO THE NEW ENTRY POSITION (EMPTY RECORD) * *-------------------------------------------------------------* SET W-BD-INDX TO W-BLD-MAX. *-------------------------------------------------------------* * DETERMINE WHERE THE NEW SERVICE LINE SHOULD BE ENTERED INTO * * THE TABLE ACCORDING TO ITS RANK AND THE RANK OF THE RECORDS * * ALREADY IN THE TABLE - LOWEST TO HIGHEST RANK. * * (RANK IS THE DATE OF SERVICE & BLOOD RANK) * *-------------------------------------------------------------* PERFORM 7385-STAGE-ENTRY THRU 7385-STAGE-ENTRY-EXIT UNTIL W-BD-INDX = 1 OR H-BLD-RNK NOT < W-BD-RNK (W-BD-INDX - 1). *-------------------------------------------------------------* * POPULATE THE EMPTY RECORD WITH THE NEW SERVICE LINE'S DATA * *-------------------------------------------------------------* MOVE LN-SUB TO W-BD-SUB (W-BD-INDX). MOVE H-NAT-COIN TO W-BD-NAT-COIN (W-BD-INDX). MOVE H-MIN-COIN TO W-BD-MIN-COIN (W-BD-INDX). MOVE H-SUB-CHRG TO W-BD-SUB-CHRG (W-BD-INDX). MOVE H-APC-PYMT TO W-BD-APC-PYMT (W-BD-INDX). MOVE H-WINX1 TO W-BD-WINX1 (W-BD-INDX). MOVE H-BLOOD-RANK TO W-BD-RANK (W-BD-INDX). MOVE H-BLD-DOS TO W-BD-DOS (W-BD-INDX). MOVE H-PPCT TO W-BD-PPCT (W-BD-INDX). MOVE H-DISC-RATE TO W-BD-DISC-RATE (W-BD-INDX). MOVE H-SRVC-UNITS TO W-BD-SRVC-UNITS (W-BD-INDX). *-------------------------------------------------------------* * SEARCH PROVIDER SPECIFIC FILE FOR THE LINE APC. * * IF FOUND, CALCULATE THE REDUCED COINSURANCE AMOUNT FOR * * THE LINE, ENTER IT INTO THE NEW COIN DEDUC TABLE REC, & * * RETURN CODE 25 * *-------------------------------------------------------------* MOVE 0 TO W-BD-RED-COIN (W-BD-INDX). PERFORM VARYING PS-SUB FROM 1 BY 1 UNTIL PS-SUB > L-PSF-APC-LINE-CNT IF L-PSF-APC (PS-SUB) = OPPS-APC (LN-SUB) COMPUTE W-BD-RED-COIN (W-BD-INDX) ROUNDED = L-PSF-RED-COIN (PS-SUB) * H-SRVC-UNITS * H-DISC-RATE MOVE 25 TO A-RETURN-CODE (LN-SUB) MOVE L-PSF-APC-LINE-CNT TO PS-SUB END-IF END-PERFORM. 7375-BLOOD-DEDUCT-EXIT. EXIT. *************************************************************** * * * MOVE THE EXISTING BLOOD DEDUCTIBLE RECORD WITH A * * HIGHER RANK UP ONE RECORD POSITION AND SET THE INDEX OF * * THE EMPTY RECORD FOR THE NEW ENTRY TO THE NEXT LOWER * * RECORD POSITION. * * * *************************************************************** 7385-STAGE-ENTRY. MOVE W-BD-ENTRY (W-BD-INDX - 1) TO W-BD-ENTRY (W-BD-INDX). SET W-BD-INDX DOWN BY 1. 7385-STAGE-ENTRY-EXIT. EXIT. *************************************************************** * * * POPULATE PASS-THROUGH DEVICE TABLE * * (IMPLEMENTED IN APRIL 2008 PRICER) * * * *************************************************************** * * * ORDER RECORDS AS FOLLOWS - * * 1. HCPCS, ASCENDING * * 2. LOWEST TO HIGHEST LINE SUBSCRIPT * * * * 02/11/2008 - LOGIC ADDED FOR CY 2008, QTR 2 * * * *************************************************************** 7390-PASS-THRU-DEVICES. *-------------------------------------------------------------* * ADD 1 TO THE TOTAL TABLE RECORDS FOR THE NEW ENTRY * *-------------------------------------------------------------* ADD 1 TO W-PTD-MAX. *-------------------------------------------------------------* * MOVE TO THE NEW ENTRY POSITION (EMPTY RECORD) * *-------------------------------------------------------------* SET W-PTD-INDX TO W-PTD-MAX. INITIALIZE W-PTD-ENTRY (W-PTD-INDX). *-------------------------------------------------------------* * DETERMINE WHERE THE NEW RECORD SHOULD BE ENTERED INTO THE * * TABLE ACCORDING TO ITS HCPCS AND THE HCPCS OF THE RECORDS * * ALREADY IN THE TABLE - LOWEST TO HIGHEST HCPCS * *-------------------------------------------------------------* PERFORM 7391-STAGE-ENTRY THRU 7391-STAGE-ENTRY-EXIT UNTIL W-PTD-INDX = 1 OR W-PTD-LINE-HCPCS NOT < W-PTD-HCPCS (W-PTD-INDX - 1). *-------------------------------------------------------------* * POPULATE THE EMPTY RECORD WITH THE NEW SERVICE LINE'S DATA * *-------------------------------------------------------------* MOVE OPPS-HCPCS (LN-SUB) TO W-PTD-HCPCS (W-PTD-INDX). MOVE LN-SUB TO W-PTD-SUB (W-PTD-INDX). MOVE OPPS-SUB-CHRG (LN-SUB) TO W-PTD-SUB-CHRG (W-PTD-INDX). 7390-PASS-THRU-DEVICES-EXIT. EXIT. *************************************************************** * * * MOVE THE EXISTING PASS-THROUGH DEVICE RECORD WITH A * * HIGHER HCPCS UP ONE RECORD POSITION AND SET THE INDEX OF * * THE EMPTY RECORD FOR THE NEW ENTRY TO THE NEXT LOWER * * RECORD POSITION. * * * *************************************************************** 7391-STAGE-ENTRY. MOVE W-PTD-ENTRY (W-PTD-INDX - 1) TO W-PTD-ENTRY (W-PTD-INDX). SET W-PTD-INDX DOWN BY 1. 7391-STAGE-ENTRY-EXIT. EXIT. *************************************************************** * * * UPDATE PASS-THROUGH DEVICE TABLE WITH PROCEDURE DATA * * (IMPLEMENTED IN APRIL 2008 PRICER) * * * *************************************************************** * * * 02/11/2008 - LOGIC ADDED FOR CY 2008, QTR 2 * * * *************************************************************** 7392-PASS-THRU-DEV-PROCS. *-------------------------------------------------------------* * LOOP THROUGH ELIGIBLE PROCEDURE'S PASS-THROUGH DEVICE TABLE * *-------------------------------------------------------------* PERFORM 7393-PERFORM-SEARCH THRU 7393-PERFORM-SEARCH-EXIT VARYING W-PTD-PROC-SUB FROM 1 BY 1 UNTIL W-PTD-PROC-SUB > W-PTD-CNT. 7392-PASS-THRU-DEV-PROCS-EXIT. EXIT. *************************************************************** * * * SEARCH FOR THE PASS-THROUGH DEVICE FOR WHICH THE PROCEDURE * * IS ELIGIBLE IN THE TABLE * * * *************************************************************** 7393-PERFORM-SEARCH. *-------------------------------------------------------------* * SEARCH PTD TABLE STARTING AT ENTRY #1 FOR ALL OCCURANCES * * OF THE PASS-THRU DEVICE HCPCS IN THE PASS-THRU DEVICE TABLE.* * THIS IS DONE FOR ALL PASS-THROUGH DEVICES THE PROCEDURE IS * * ELIGIBLE FOR. * *-------------------------------------------------------------* MOVE 'N' TO W-END-OF-PTD-TBL. IF W-PTD-PROC-HCPCS (W-PTD-PROC-SUB) NOT = ' ' SET W-PTD-INDX TO 1 PERFORM 7394-SEARCH-PTD-HCPCS THRU 7394-SEARCH-PTD-HCPCS-EXIT UNTIL W-END-OF-PTD-TBL = 'Y' END-IF. 7393-PERFORM-SEARCH-EXIT. EXIT. *************************************************************** * * * SEARCH FOR THE PASS-THROUGH DEVICE FOR WHICH THE PROCEDURE * * IS ELIGIBLE IN THE TABLE * * * *************************************************************** 7394-SEARCH-PTD-HCPCS. MOVE 'N' TO W-END-OF-PTD-TBL. *-------------------------------------------------------------* * SEARCH PASS-THROUGH DEVICE TABLE * *-------------------------------------------------------------* SEARCH W-PTD-ENTRY VARYING W-PTD-INDX *-------------------------------------------------------------* * IF THERE ARE NO MORE OCCURANCES OF THE PASS-THROUGH DEVICE, * * STOP THE SEARCH AND INDICATE END OF FILE * *-------------------------------------------------------------* AT END MOVE 'Y' TO W-END-OF-PTD-TBL GO TO 7394-SEARCH-PTD-HCPCS-EXIT *-------------------------------------------------------------* * IF THE PASS-THROUGH DEVICE IS FOUND, INDICATE NOT END OF * * FILE AND UPDATE THE DEVICE'S RECORD WITH THE PROCEDURE DATA * *-------------------------------------------------------------* WHEN W-PTD-HCPCS (W-PTD-INDX) = W-PTD-PROC-HCPCS (W-PTD-PROC-SUB) MOVE 'N' TO W-END-OF-PTD-TBL PERFORM 7395-UPDATE-ENTRY THRU 7395-UPDATE-ENTRY-EXIT SET W-PTD-INDX UP BY 1 END-SEARCH. 7394-SEARCH-PTD-HCPCS-EXIT. EXIT. *************************************************************** * * * UPDATE THE EXISTING PASS-THROUGH DEVICE RECORD WITH THE * * CURRENT ELIGIBLE PROCEDURE'S DATA * * * *************************************************************** 7395-UPDATE-ENTRY. *-------------------------------------------------------------* * UPDATE PASS-THROUGH DEVICE RECORD * *-------------------------------------------------------------* ADD 1 TO W-PTD-PROC-CNT (W-PTD-INDX). ADD OPPS-SRVC-UNITS (LN-SUB) TO W-PTD-TOTAL-PROC-UNITS (W-PTD-INDX). 7395-UPDATE-ENTRY-EXIT. EXIT. *************************************************************** * * * CALCULATE LINE PYMNTS, DEDUCTIBLES, REIM., & COINSURANCE, * * ACCUMULATE CLAIM TOTALS, POPULATE DRUG DEDUCTIBLE TABLE, * * UPDATE PASS-THROUGH DEVICE TABLE WITH PROCEDURE & DEVICE * * LINE DATA, MOVE LINE VALUES TO VARIABLES TO BE PASSED BACK * * * *************************************************************** * * * LOOP THROUGH THE COINSURANCE DEDUCTIBLE TABLE TO DO THE * * FOLLOWING FOR EACH SERVICE LINE: * * * * - CHECK ALL APPROPRIATE FLAGS AND INDICATORS FROM OCE * * - SET RETURN CODES TO INDICATE ERRORS OR STATUS * * '20' - LINE PROCESSED BUT PAYMENT = 0, * * BENE DEDUCTIBLE => ADJUSTED PAYMENT * * - CALCULATE & ACCUMULATE LINE AND CLAIM LEVEL ITEMS * * - POPULATE DRUG COINSURANCE TABLE * * - MOVE LINE VARIABLE VALUES TO VARIABLES TO BE PASSED BACK * * * *************************************************************** 7400-CALCULATE. *-------------------------------------------------------------* * SET THE SERVICE LINE SUBSCRIPT TO THE CLAIM SERVICE LINE # * * ASSOCIATED WITH THE COINSURANCE DEDUCTIBLE TABLE RECORD * *-------------------------------------------------------------* MOVE W-LP-SUB (W-LP-INDX) TO LN-SUB. *-------------------------------------------------------------* * STOP PROCESSING LINE IF ERROR CODE * *-------------------------------------------------------------* IF A-RETURN-CODE (LN-SUB) > 25 GO TO 7400-CALCULATE-EXIT. *-------------------------------------------------------------* * CALCULATE THE FOLLOWING FOR VALID LINES IN THE COINSURANCE * * DEDUCTIBLE TABLE WITH A PAYABLE STATUS: * * - LINE ITEM PAYMENT (BASED ON LINE SERVICE INDICATOR) * * - BENEFICIARY DEDUCTIBLE (IN ORDER OF APC RANK) * * - MINIMUM, MAXIMUM, AND REDUCED COINSURANCE AMOUNTS * * - LINE ITEM REIMBURSEMENT IF MAX COIN LIMIT EXCEEDED * *-------------------------------------------------------------* IF OPPS-PYMT-IND (LN-SUB) = ' 1' OR ' 5' OR ' 6' OR ' 7' OR ' 8' PERFORM 7550-CALC-STANDARD THRU 7550-CALC-STANDARD-EXIT ELSE GO TO 7400-CALCULATE-EXIT. *-------------------------------------------------------------* * POPULATE DRG COINSURANCE TABLE FOR LATER PROCESSING * * - ENFORCE INPATIENT COINSURANCE LIMIT * * - SET GJK-FLAG WHEN SERVICE = G OR K * *-------------------------------------------------------------* IF (A-RETURN-CODE (LN-SUB) < 30) PERFORM 7450-ADJ-PROC-COIN THRU 7450-ADJ-PROC-COIN-EXIT ELSE NEXT SENTENCE. *-------------------------------------------------------------* * FLAG CLAIMS WITH ARTIFICIAL CHARGES AND TOTAL PAYMENTS & * * CHARGES FOR ARTIFICIAL CHARGE AND PACKAGING PROCESSING * *-------------------------------------------------------------* PERFORM 7500-ADJ-CHRGS THRU 7500-ADJ-CHRGS-EXIT. *-------------------------------------------------------------* * UPDATE PASS-THROUGH DEVICE TABLE W/ ELIGIBLE PROCEDURE * * LINE DATA * * EFFECTIVE CY 2008 QTR 2, LOGIC ADDED 02/12/2008 * *-------------------------------------------------------------* IF A-RETURN-CODE (LN-SUB) < 30 AND PTD-FLAG = 'Y' AND OPPS-SRVC-IND (LN-SUB) = ' S' OR ' T' OR ' V' OR ' X' PERFORM 7670-SET-PTD-PROC-FLAG THRU 7670-SET-PTD-PROC-FLAG-EXIT IF PTD-PROC-FLAG = 'Y' PERFORM 7392-PASS-THRU-DEV-PROCS THRU 7392-PASS-THRU-DEV-PROCS-EXIT END-IF END-IF. *-------------------------------------------------------------* * ACCUMULATE CLAIM TOTALS USING DATA FROM THE CURRENT VALID * * SERVICE LINE (IN THE COINSURANCE DEDUCTIBLE TABLE) * *-------------------------------------------------------------* IF A-RETURN-CODE (LN-SUB) < 30 COMPUTE A-TOTAL-CLM-DEDUCT = H-TOTAL-LN-DEDUCT + A-TOTAL-CLM-DEDUCT COMPUTE H-TOT-PYMT = H-TOT-PYMT + H-LITEM-PYMT COMPUTE A-BLOOD-DEDUCT-DUE = A-BLOOD-DEDUCT-DUE + H-LN-BLOOD-DEDUCT *-------------------------------------------------------------* * MOVE LINE VALUES TO VARIABLES TO BE PASSED BACK * * - THE LINE REIM. & ADJ-COIN IS ADJUSTED LATER (IF NEEDED) * * FOR THE INPATIENT DAILY LIMIT IN 7840-PROCESS-TYPE2 * *-------------------------------------------------------------* MOVE H-LITEM-PYMT TO A-LITEM-PYMT (LN-SUB) MOVE H-LITEM-REIM TO A-LITEM-REIM (LN-SUB) MOVE H-TOTAL-LN-DEDUCT TO A-TOTAL-LN-DEDUCT (LN-SUB) MOVE H-LN-BLOOD-DEDUCT TO A-BLOOD-LN-DEDUCT (LN-SUB) MOVE H-NAT-COIN TO A-ADJ-COIN (LN-SUB) MOVE H-RED-COIN TO A-RED-COIN (LN-SUB) IF H-RED-COIN > H-NAT-COIN MOVE H-NAT-COIN TO A-RED-COIN (LN-SUB) END-IF IF OPPS-LITEM-ACT-FLAG (LN-SUB) = '4' MOVE 0 TO A-LITEM-PYMT (LN-SUB) MOVE 0 TO A-LITEM-REIM (LN-SUB) COMPUTE H-TOT-PYMT = H-TOT-PYMT - H-LITEM-PYMT END-IF END-IF. *-------------------------------------------------------------* * INITIALIZE LINE VARIABLES FOR THE NEXT SERVICE LINE IN THE * * COINSURANCE DEDUCTIBLE TABLE * *-------------------------------------------------------------* MOVE ZERO TO LINE-HOLD-ITEMS. 7400-CALCULATE-EXIT. EXIT. *************************************************************** * * * POPULATE DRUG COINSURANCE ROLL-UP TABLE WITH THE * * COINSURANCE AMOUNTS OF SERVICE LINES IN THE COINSURANCE * * DEDUCTIBLE TABLE * * * *************************************************************** * * * ORDER LINES BY: * * 1. DATE OF SERVICE (EARLIEST TO LATEST) * * 2. DCP-CODE - TYPE OF ENTRY BASED ON SERVICE INDICATOR * * DCP-CODE OF 1: DAY SUMMARY * * DCP-CODE OF 2: DRUG / BLOOD LINE * * THERE IS ONE TYPE 1 RECORD PER DAY; THERE MAY BE MULTIPLE * * TYPE 2 RECORDS PER DAY - ONE FOR EVERY DRUG LINE * * ("DRUG" REFERS TO ANY SI = G OR K LINE FOR SIMPLICITY) * * * * DRUG COINSURANCE RECORD COMBINATIONS: * * - TYPE 1, COIN1 = 0, COIN2 > 0, & SI = X => * * DRUG(S) ADMINISTERED INDEPENDENT OF A PROCEDURE VISIT * * ON THE DATE OF SERVICE * * - TYPE 1, COIN1 > 0, COIN2 = 0, & SI = S, V, OR T => * * PROCEDURE / VISIT WITH NO DRUG(S) ADMINISTERED ON THE * * DATE OF SERVICE * * - TYPE 1, COIN1 > 0, COIN2 > 0, & SI = S, V, OR T => * * PROCEDURE / VISIT WITH DRUG(S) ADMINISTERED ON THE * * DATE OF SERVICE * * - TYPE 2, COIN1 = 0, COIN2 > 0, & SI = G OR K => * * DRUG ADMINSTERED ON THE DATE OF SERVICE * * * *************************************************************** 7450-ADJ-PROC-COIN. *************************************************************** * MOVE LINE DATE OF SERVICE TO DATE OF SERVICE HOLD AREA * *************************************************************** MOVE OPPS-LITEM-DOS (LN-SUB) TO H-DCP-DOS. *************************************************************** * * * PROCESS SI = S, T, OR V LINES (PROCEDURE OR VISIT) * * * *************************************************************** IF OPPS-SRVC-IND (LN-SUB) = ' S' OR ' T' OR ' V' *-------------------------------------------------------------* * CALCULATE WAGE ADJUSTED LINE NATIONAL COINSURANCE AMOUNT * *-------------------------------------------------------------* COMPUTE H-NEW-WGNAT ROUNDED = W-NAT-COIN (W-LP-INDX) * (.6 * W-WINX1 (W-LP-INDX) + .4) *-------------------------------------------------------------* * ENFORCE INPATIENT LIMIT ON NATIONAL COINSURANCE AMOUNT * *-------------------------------------------------------------* IF H-NEW-WGNAT > H-IP-LIMIT MOVE H-IP-LIMIT TO H-NEW-WGNAT END-IF *-------------------------------------------------------------* * CALCULATE LINE NEW COINSURANCE AMOUNT (ACTUAL COIN DUE) * *-------------------------------------------------------------* COMPUTE H-NEW-COIN = H-LITEM-PYMT - H-TOTAL-LN-DEDUCT - H-LITEM-REIM - H-LN-BLOOD-DEDUCT *-------------------------------------------------------------* * INDICATE TYPE 1 RECORD (ONE TYPE 1 RECORD PER DAY) * *-------------------------------------------------------------* MOVE 1 TO H-DCP-CODE *-------------------------------------------------------------* * ADD OR UPDATE DRUG COINSURANCE TABLE ENTRY FOR THE DOS * *-------------------------------------------------------------* PERFORM 7455-SEARCH-KEY THRU 7455-SEARCH-KEY-EXIT *************************************************************** * * * PROCESS SI = G OR K LINES ("DRUG") * * * *************************************************************** ELSE IF OPPS-SRVC-IND (LN-SUB) = ' G' OR ' K' *-------------------------------------------------------------* * CALCULATE LINE NEW COINSURANCE AMOUNT (ACTUAL COIN DUE) * *-------------------------------------------------------------* COMPUTE H-NEW-COIN = H-LITEM-PYMT - H-TOTAL-LN-DEDUCT - H-LITEM-REIM - H-LN-BLOOD-DEDUCT *-------------------------------------------------------------* * SET GJK-FLAG TO INDICATE "DRUG" LINE * *-------------------------------------------------------------* MOVE 'Y' TO GJK-FLAG *-------------------------------------------------------------* * INDICATE TYPE 1 RECORD (ONE TYPE 1 RECORD PER DAY) * *-------------------------------------------------------------* MOVE 1 TO H-DCP-CODE *-------------------------------------------------------------* * ADD OR UPDATE DRUG COINSURANCE TABLE ENTRY FOR THE DOS * *-------------------------------------------------------------* PERFORM 7455-SEARCH-KEY THRU 7455-SEARCH-KEY-EXIT *-------------------------------------------------------------* * INDICATE TYPE 2 RECORD (ONE TYPE 2 REC FOR EVERY DRUG LINE) * *-------------------------------------------------------------* MOVE 2 TO H-DCP-CODE *-------------------------------------------------------------* * INCREASE THE TOTAL NUMBER OF TABLE RECORDS FOR NEW ENTRY * *-------------------------------------------------------------* ADD 1 TO W-DCP-MAX *-------------------------------------------------------------* * MOVE TO THE NEW ENTRY POSITION (EMPTY RECORD) * * A NEW TYPE 2 RECORD ENTRY IS CREATED FOR EVERY SI = G OR K * * SERVICE LINE REGARDLESS OF THE DATE OF SERVICE * *-------------------------------------------------------------* SET W-DCP-INDX TO W-DCP-MAX *-------------------------------------------------------------* * DETERMINE WHERE THE NEW DRUG / DEVICE COINSURANCE ENTRY * * FOR THE CURRENT SERVICE LINE SHOULD BE ENTERED INTO THE * * TABLE ACCORDING TO ITS DATE OF SERVICE AND RECORD TYPE * * COMBO KEY - LOWEST TO HIGHEST KEY. (RECORD TYPE 2 ONLY) * *-------------------------------------------------------------* PERFORM 7475-STAGE-DCP-ENTRY THRU 7475-STAGE-DCP-ENTRY-EXIT UNTIL W-DCP-INDX = 1 OR H-DCP-STAGE NOT < W-DCP-STAGE (W-DCP-INDX - 1) *-------------------------------------------------------------* * POPULATE THE EMPTY RECORD WITH THE NEW SERVICE LINE'S DATA * * RECORD TYPE 2, "DRUG" * *-------------------------------------------------------------* MOVE LN-SUB TO W-DCP-SUB (W-DCP-INDX) MOVE H-DCP-STAGE TO W-DCP-STAGE (W-DCP-INDX) MOVE ZERO TO W-DCP-COIN1 (W-DCP-INDX) MOVE ZERO TO W-DCP-WGNAT (W-DCP-INDX) MOVE H-NEW-COIN TO W-DCP-COIN2 (W-DCP-INDX) MOVE OPPS-SRVC-IND (LN-SUB) TO W-DCP-SRVC-IND (W-DCP-INDX). 7450-ADJ-PROC-COIN-EXIT. EXIT. *************************************************************** * * * DETERMINE WHETHER A NEW DRUG/DEVICE COINSURANCE TABLE * * RECORD SHOULD BE ADDED OR IF AN EXISITING RECORD NEEDS TO * * BE UPDATED * * * * (RECORD KEY IS DATE OF SERVICE & RECORD TYPE) * * * *************************************************************** 7455-SEARCH-KEY. *-------------------------------------------------------------* * SEARCH DRUG/DEVICE COINSURANCE TABLE STARTING AT ENTRY #1 * *-------------------------------------------------------------* SET W-DCP-INDX TO 1. SEARCH W-DCP-ENTRY VARYING W-DCP-INDX *-------------------------------------------------------------* * IF THE SERVICE LINE'S DATE OF SERVICE AND RECORD TYPE COMBO * * IS NOT ALREADY IN THE TABLE, ADD IT * *-------------------------------------------------------------* AT END PERFORM 7460-ADD-ENTRY THRU 7460-ADD-ENTRY-EXIT *-------------------------------------------------------------* * IF THE SERVICE LINE'S DATE OF SERVICE AND RECORD TYPE COMBO * * IS ALREADY IN THE TABLE, UPDATE THE ENTRY * *-------------------------------------------------------------* WHEN W-DCP-STAGE (W-DCP-INDX) = H-DCP-STAGE PERFORM 7465-UPDATE-ENTRY THRU 7465-UPDATE-ENTRY-EXIT. 7455-SEARCH-KEY-EXIT. EXIT. *************************************************************** * * * INSERT THE NEW COINSURANCE RECORD INTO THE CORRECT POSITION * * (LOWEST TO HIGHEST DATE OF SERVICE - RECORD TYPR COMBO) OF * * THE DRUG / DEVICE COINSURANCE TABLE * * (ONLY PROCESSES TYPE 1 RECORDS) * * * *************************************************************** 7460-ADD-ENTRY. *-------------------------------------------------------------* * INCREASE THE TOTAL NUMBER OF TABLE RECORDS FOR NEW ENTRY * *-------------------------------------------------------------* ADD 1 TO W-DCP-MAX. *-------------------------------------------------------------* * MOVE TO THE NEW ENTRY POSITION (EMPTY RECORD) * *-------------------------------------------------------------* SET W-DCP-INDX TO W-DCP-MAX. *-------------------------------------------------------------* * DETERMINE WHERE THE NEW DRUG / DEVICE COINSURANCE ENTRY * * FOR THE CURRENT SERVICE LINE SHOULD BE ENTERED INTO THE * * TABLE ACCORDING TO ITS DATE OF SERVICE AND RECORD TYPE * * COMBO KEY - LOWEST TO HIGHEST KEY. (TYPE 1 RECORDS ONLY) * *-------------------------------------------------------------* PERFORM 7475-STAGE-DCP-ENTRY THRU 7475-STAGE-DCP-ENTRY-EXIT UNTIL W-DCP-INDX = 1 OR H-DCP-STAGE NOT < W-DCP-STAGE (W-DCP-INDX - 1). *-------------------------------------------------------------* * POPULATE THE EMPTY RECORD WITH THE NEW SERVICE LINE'S DATA * * RECORD TYPE 1, "DRUG" * *-------------------------------------------------------------* IF OPPS-SRVC-IND (LN-SUB) = ' G' OR ' K' MOVE ZERO TO W-DCP-SUB (W-DCP-INDX) MOVE H-DCP-STAGE TO W-DCP-STAGE (W-DCP-INDX) MOVE ZERO TO W-DCP-COIN1 (W-DCP-INDX) MOVE ZERO TO W-DCP-WGNAT (W-DCP-INDX) MOVE H-NEW-COIN TO W-DCP-COIN2 (W-DCP-INDX) MOVE ' X' TO W-DCP-SRVC-IND (W-DCP-INDX) *-------------------------------------------------------------* * POPULATE THE EMPTY RECORD WITH THE NEW SERVICE LINE'S DATA * * RECORD TYPE 1, PROCEDURE OR VISIT * *-------------------------------------------------------------* ELSE MOVE LN-SUB TO W-DCP-SUB (W-DCP-INDX) MOVE H-DCP-STAGE TO W-DCP-STAGE (W-DCP-INDX) MOVE H-NEW-COIN TO W-DCP-COIN1 (W-DCP-INDX) MOVE H-NEW-WGNAT TO W-DCP-WGNAT (W-DCP-INDX) MOVE ZERO TO W-DCP-COIN2 (W-DCP-INDX) MOVE OPPS-SRVC-IND (LN-SUB) TO W-DCP-SRVC-IND (W-DCP-INDX). 7460-ADD-ENTRY-EXIT. EXIT. *************************************************************** * * * UPDATE THE EXISTING DRUG COINSURANCE RECORD WITH THE SAME * * DATE OF SERVICE AND RECORD TYPE OF THE CURRENT SERVICE LINE * * (ONLY PROCESSES TYPE 1 RECORDS) * * * *************************************************************** 7465-UPDATE-ENTRY. *-------------------------------------------------------------* * FOR "DRUG" LINES - ACCUMULATE DAY'S TOTAL "DRUG" COIN DUE * *-------------------------------------------------------------* IF OPPS-SRVC-IND (LN-SUB) = ' G' OR ' K' ADD H-NEW-COIN TO W-DCP-COIN2 (W-DCP-INDX) *-------------------------------------------------------------* * FOR PROCEDURE & VISIT LINES - WHEN THE EXISITING RECORD WAS * * WAS INITIALLY CREATED FOR A "DRUG" LINE, UPDATE THE RECORD * *-------------------------------------------------------------* ELSE IF W-DCP-SRVC-IND (W-DCP-INDX) = ' X' PERFORM 7485-REPLACE-TYPE1 THRU 7485-REPLACE-TYPE1-EXIT *-------------------------------------------------------------* * FOR PROCEDURE & VISIT LINES - WHEN THE EXISTING RECORD HAS * * DATA FROM ANOTHER PROCEDURE / VISIT, ENSURE THE PROC/VISIT * * WITH THE HIGHEST WAGE ADJUSTED NATIONAL COIN IS IN THE TBL * *-------------------------------------------------------------* ELSE PERFORM 7480-RANK-COIN THRU 7480-RANK-COIN-EXIT. 7465-UPDATE-ENTRY-EXIT. EXIT. *************************************************************** * * * MOVE THE EXISTING DRUG COINSURANCE RECORD WITH A HIGHER * * RANK UP ONE RECORD POSITION AND SET THE INDEX OF THE EMPTY * * RECORD FOR THE NEW ENTRY TO THE NEXT LOWER RECORD POSITION. * * * *************************************************************** 7475-STAGE-DCP-ENTRY. MOVE W-DCP-ENTRY (W-DCP-INDX - 1) TO W-DCP-ENTRY (W-DCP-INDX). SET W-DCP-INDX DOWN BY 1. 7475-STAGE-DCP-ENTRY-EXIT. EXIT. *************************************************************** * * * ENSURE THAT THE PROCEDURE/VISIT WITH THE HIGHEST WAGE ADJ. * * NATIONAL COINSURANCE AMOUNT IS IN THE TABLE WHEN THERE ARE * * MULTIPLE PROCEDURES/VISITS ON THE SAME DATE OF SERVICE. * * ONLY ONE PROCEDURE/VISIT'S DATA PER DAY APPEARS IN THE TBL. * * (ONLY PROCESSES TYPE 1 RECORDS) * * * *************************************************************** 7480-RANK-COIN. IF H-NEW-WGNAT > W-DCP-WGNAT (W-DCP-INDX) MOVE LN-SUB TO W-DCP-SUB (W-DCP-INDX) MOVE H-NEW-COIN TO W-DCP-COIN1 (W-DCP-INDX) MOVE H-NEW-WGNAT TO W-DCP-WGNAT (W-DCP-INDX) MOVE OPPS-SRVC-IND (LN-SUB) TO W-DCP-SRVC-IND (W-DCP-INDX). 7480-RANK-COIN-EXIT. EXIT. *************************************************************** * * * ENTER VALUES FROM THE CURRENT SI = S, V, OR T SERVICE LINE * * INTO AN EXISITING RECORD THAT WAS FORMERLY AN SI = G OR K * * ONLY ENTRY. * * - SERVICE LINE REFERENCES CURRENT PROCEDURE / VISIT LINE * * - COIN1 = PROCEDURE / VISIT LINE NEW COINSURANCE AMOUNT * * - COIN2 = DRUG / BLOOD LINE NEW COINSURANCE AMOUNT(S) * * - WAGE ADJUSTED NATIONAL COIN OF CURRENT LINE ENTERED * * - SERVICE INDICATOR = SI OF CURRENT LINE (S, V, OR T) * * * *************************************************************** 7485-REPLACE-TYPE1. MOVE LN-SUB TO W-DCP-SUB (W-DCP-INDX) MOVE H-NEW-COIN TO W-DCP-COIN1 (W-DCP-INDX) MOVE H-NEW-WGNAT TO W-DCP-WGNAT (W-DCP-INDX) MOVE OPPS-SRVC-IND (LN-SUB) TO W-DCP-SRVC-IND (W-DCP-INDX). 7485-REPLACE-TYPE1-EXIT. EXIT. *************************************************************** * * * IDENTIFY CLAIMS THAT HAVE SIGNIFICANT PROCEDURE (SURGERY) * * LINE(S) WITH ARTIFICIAL CHARGES FOR FURTHER PROCESSING, * * ACCUMULATE TOTAL CLAIM PAYMENTS AND CHARGES FOR SIGNIFICANT * * PROCEDURE LINES, AND ACCUMULATE TOTAL CLAIM CHARGES OF ALL * * SEPARATELY PAYABLE LINES. (THE FLAG AND CLAIM TOTALS ARE * * USED IN PARAGRAPH 7600-ADJ-CHRG-OUTL.) * * * *************************************************************** 7500-ADJ-CHRGS. *************************************************************** ** NEW LOGIC INSERTED FOR WEB USE ONLY * *************************************************************** *-------------------------------------------------------------* * FLAG CLAIM WHEN A SIGNIFICANT PROCEDURE LINE HAS ARTIFICIAL * * CHARGES ($1 OR LESS) - FLAGS ENTIRE CLAIM * *-------------------------------------------------------------* * NOTE: LINES WITH CHARGES < $1.01 ARE FIXED BY FISS BEFORE * * ENTERING THE PRICER. THEREFORE, THIS LOGIC IS NO * * LONGER NECESSARY. THIS LOGIC WAS NECESSARY BEFORE * * FISS IMPLEMENTED THE FIX. * *-------------------------------------------------------------* IF ((OPPS-SRVC-IND (LN-SUB) = ' T') OR ((OPPS-SRVC-IND (LN-SUB) = ' S') AND (OPPS-HCPCS (LN-SUB) > '09999' AND OPPS-HCPCS (LN-SUB) < '70000'))) AND (W-SUB-CHRG (W-LP-INDX) < 1.01) MOVE 'Y' TO ST0-FLAG. *-------------------------------------------------------------* * ACCUMULATE TOTAL CLAIM CHARGES AND PAYMENTS FROM UNPACKAGED * * SIGNIFICANT PROCEDURE (SURGERY) LINES * *-------------------------------------------------------------* IF ((OPPS-SRVC-IND (LN-SUB) = ' T') OR ((OPPS-SRVC-IND (LN-SUB) = ' S') AND (OPPS-HCPCS (LN-SUB) > '09999' AND OPPS-HCPCS (LN-SUB) < '70000'))) AND (OPPS-PKG-FLAG (LN-SUB) = '0' OR '3') COMPUTE H-TOT-ST-CHRG = W-SUB-CHRG (W-LP-INDX) + H-TOT-ST-CHRG COMPUTE H-TOT-ST-PYMT = H-LITEM-PYMT + H-TOT-ST-PYMT. *-------------------------------------------------------------* * ACCUMULATE TOTAL CLAIM PAYMENTS FROM UNPACKAGED SEPARATELY * * PAYABLE LINES (FOR PACKAGING LATER) * *-------------------------------------------------------------* IF (OPPS-SRVC-IND (LN-SUB) = ' S' OR ' T' OR ' V' OR ' X' OR ' P') AND (OPPS-PKG-FLAG (LN-SUB) = '0' OR '3') COMPUTE H-TOT-STVX-PYMT = H-LITEM-PYMT + H-TOT-STVX-PYMT. 7500-ADJ-CHRGS-EXIT. EXIT. *************************************************************** * * * CALCULATE THE FOLLOWING FOR VALID LINES IN THE COINSURANCE * * DEDUCTIBLE TABLE WITH A PAYABLE STATUS: * * - LINE ITEM PAYMENT (BASED ON LINE SERVICE INDICATOR) * * - BENEFICIARY DEDUCTIBLE (IN ORDER OF APC RANK) * * - MINIMUM, MAXIMUM, AND REDUCED COINSURANCE AMOUNTS * * * *************************************************************** * * * 1. CALCULATE STANDARD LINE ITEM PAYMENT (LINE PRICE) * * (APC PAYMENT * WAGE INDEX * SERVICE UNITS * * * DISCOUNT FACTOR) * * WAGE ADJUST 60% OF THE APC PAYMENT FOR SI = S, V, T, P, * * OR X LINES, THESE ARE ELIGIBLE FOR THE SCH ADJUSTMENT * * 2. APPLY DEDUCTIBLE TO HIGHEST NATIONAL COINSURANCE AMOUNT * * DESCENDING UNTIL DEDUCTIBLE = 0. * * 3. ADD LINE PRICE TO OUTLIER HOLD AREA * * 4. CALCULATE THE LINE PRICE FOR DESIGNATED DEVICES * * AND DRUGS * * 5. CALCULATE DEVICE REDUCTIONS * * * *************************************************************** 7550-CALC-STANDARD. *************************************************************** * INITIALIZE & SET LINE VARIABLES AND FLAGS * *************************************************************** *-------------------------------------------------------------* * INITIALIZE VARIABLE FOR LINES ELIGIBLE FOR BLOOD DEDUCTIBLE * *-------------------------------------------------------------* MOVE 0 TO H-BLOOD-FRACTION. *-------------------------------------------------------------* * FLAG LINE IF THE LINE APC IS A BRACHYTHERAPY APC * * ** NEW LIST EVERY JANUARY ** * *-------------------------------------------------------------* * 11/13/2007 - BRACHY APC CHECK ADDED * * 12/28/2007 - LOGIC MOVED HERE * *-------------------------------------------------------------* PERFORM 7650-SET-BRACHY-APC-FLAG THRU 7650-SET-BRACHY-APC-FLAG-EXIT. *-------------------------------------------------------------* * FLAG LINE IF THE LINE HCPCS IS A BLOOD DEDUCTIBLE HCPCS * * ** NEW LIST EVERY JANUARY ** * *-------------------------------------------------------------* * 11/13/2007 - HCPCS LIST MOVED FROM 7550-CALC-GJK TO HERE * * 12/04/2007 - LIST MOVED TO 7655-SET-BD-HCPCS-FLAG * * 12/28/2007 - LOGIC MOVED HERE * *-------------------------------------------------------------* PERFORM 7655-SET-BD-HCPCS-FLAG THRU 7655-SET-BD-HCPCS-FLAG-EXIT. *-------------------------------------------------------------* * FLAG LINE IF THE LINE APC IS A RADIOPHARM APC * * ** NEW LIST EVERY JANUARY ** * *-------------------------------------------------------------* * 12/27/2007 - RADIOPHARM APC CHECK ADDED * * 12/28/2007 - LOGIC MOVED HERE * *-------------------------------------------------------------* PERFORM 7660-SET-RADIOPH-APC-FLAG THRU 7660-SET-RADIOPH-APC-FLAG-EXIT. *************************************************************** * CALCULATE MAXIMUM COINSURANCE AMOUNT (INPATIENT LIMIT) * *************************************************************** COMPUTE H-MAX-COIN ROUNDED = (H-IP-LIMIT * W-SRVC-UNITS (W-LP-INDX) * W-DISC-RATE (W-LP-INDX)). *************************************************************** * CALCULATE FULL AND PARTIAL CREDIT DEVICE REDUCTIONS AND * * REDUCE THE APC PAYMENT BY THE REDUCTION AMOUNT * * PAYMENT ADJUSTMENT FLAGS: 7 = FULL, 8 = PARTIAL CREDIT * *-------------------------------------------------------------* * 11/1/2007 - PYMT ADJ FLAG 8 ADDED FOR PARTIAL CREDIT * * DEDUCTIONS - NEW FOR CY 2008 * *************************************************************** IF OPPS-PYMT-ADJ-FLAG (LN-SUB) = ' 7' OR ' 8' PERFORM 7550-DEVICE-REDUC THRU 7550-DEVICE-REDUC-EXIT. *************************************************************** * CALCULATE PAYMENT FOR SI = S, V, T, P, OR X LINES * * THE APC PAYMENT IS 60% WAGE ADJUSTED * *-------------------------------------------------------------* * 11/13/2007 - ADDED PERFORM 7560-CALC-BENE-DEDUCT * * (REMOVED FROM PARAGRAPH 7550-SCH-ADJ) * *************************************************************** IF (OPPS-SRVC-IND (LN-SUB) = ' S' OR ' V' OR ' T' OR ' P' OR ' X') THEN PERFORM 7550-SCH-ADJ THRU 7550-SCH-ADJ-EXIT PERFORM 7560-CALC-BENE-DEDUCT THRU 7560-CALC-BENE-DEDUCT-EXIT *************************************************************** * CALCULATE PAYMENT FOR SI = H (DEVICE) LINES, PAYMENT IND. * * SHOULD BE 6 FOR THESE LINES (BASED ON CHARGE ADJ. TO COST) * * RETURN ERROR CODE 44 IF THIS IS NOT THE CASE * *************************************************************** ELSE IF OPPS-SRVC-IND (LN-SUB) = ' H' THEN IF OPPS-PYMT-IND (LN-SUB) = ' 6' THEN PERFORM 7555-CALC-H-STANDARD THRU 7555-CALC-H-STANDARD-EXIT PERFORM 7560-CALC-BENE-DEDUCT THRU 7560-CALC-BENE-DEDUCT-EXIT ELSE MOVE 44 TO A-RETURN-CODE (LN-SUB) GO TO 7550-CALC-STANDARD-EXIT END-IF *************************************************************** * CALCULATE PAYMENT FOR SI = G AND K LINES; THE PAYMENT IND. * * SHOULD BE 1, 5, OR 7 FOR THESE LINES (PAY STANDARD AMOUNT) * * RETURN ERROR CODE 41 IF INVALID SI - PYMT IND. COMBO * *-------------------------------------------------------------* * 12/31/2007 - REMOVED REDUNDANT H-BLOOD-FRAC. INITIALIZATION * *************************************************************** ELSE IF OPPS-SRVC-IND (LN-SUB) = ' G' OR ' K' THEN IF OPPS-PYMT-IND (LN-SUB) = ' 1' OR ' 5' OR ' 7' THEN PERFORM 7550-CALC-GJK THRU 7550-CALC-GJK-EXIT PERFORM 7560-CALC-BENE-DEDUCT THRU 7560-CALC-BENE-DEDUCT-EXIT ELSE MOVE 41 TO A-RETURN-CODE (LN-SUB) GO TO 7550-CALC-STANDARD-EXIT END-IF END-IF END-IF END-IF. *************************************************************** * CALCULATE LINE REIMBURSEMENT * *-------------------------------------------------------------* * 11/01/2007 - PERFORMS FOR PARAGRAPHS 7550-PD-AT-CST-JAN07 * * AND 7550-PD-AT-CST-JUL07 WERE DELETED (THE PARAGRAPHS * * WERE ALSO DELETED). THERE IS NO PAID AT COST TABLE FOR * * 2008. UNDER THE ORIGINAL 2008 LEGISLATION, DIAGNOSIS * * RADIOPHARM LINES WERE PACKAGED (SI=' N') AND THERAPEUTIC * * RADIOPHARM AND BRACHYTHERAPY LINES WERE SEPARATELY * * PAYABLE (SI=' K'). THEREFORE, PAID AT COST LOGIC WAS NOT * * NEEDED. * * * * 12/06/2007 - LINE REIMBURSEMENT AND NATIONAL COINSURANCE * * CALCULATIONS, AND MINIMUM COINSURANCE MOVE INSERTED * * (TAKEN FROM 6550-PD-AT-CST-JAN07). * * * * 12/27/2007 - PAID AT COST LOGIC REINSTATED FOR RADIOPHARM * * AND BRACHYTHERAPY LINES WITH A STATUS INDICATOR = ' H'. * * PAID AT COST LOGIC REVISED: NO TABLE OR TABLE SEARCH; * * FLAGS ARE USED INSTEAD. (REINSTATEMENT IS DUE TO A * * CHANGE IN LEGISLATION; ALL RADIO. & BRACHY SI = ' H'.) * * * * 05/14/2008 - PAID AT COST LOGIC NO LONGER APPLIED TO * * RADIOPHARM AND BRACHYTHERAPY LINES AS OF JULY 1, 2008. * * THESE LINES ARE ASSIGNED A SI OF ' K' EFFECTIVE JULY 1, * * 2008, SO THEY WILL AUTOMATICALLY BY-PASS THE LOGIC AND * * RECEIVE THE STANDARD REIM. PAID AT COST LOGIC RETAINED * * FOR PREVIOUS QUARTERS (JANUARY 1 - JUNE 30, 2008). * * * * 08/07/2008 - DUE TO LEGISLATION, THERAPEUTIC RADIOPHARMS & * * BRACHYTHERAPY SOURCE'S SI CHANGED FROM 'K' BACK TO 'H'; * * THEY CONTINUE TO BE PAID AT COST (EFFECTIVE 7/1/2008) * * * *************************************************************** *-------------------------------------------------------------* * PAID AT COST LINE REIMBURSEMENT CALCULATION (REIM = 80%) * *-------------------------------------------------------------* IF OPPS-SRVC-IND (LN-SUB) = ' H' AND (BRACHY-APC-FLAG = 'Y' OR RADIOPH-APC-FLAG = 'Y') COMPUTE H-LITEM-REIM ROUNDED = ((H-LITEM-PYMT - H-TOTAL-LN-DEDUCT) - H-LN-BLOOD-DEDUCT) * .8 *-------------------------------------------------------------* * STANDARD LINE REIMBURSEMENT CALCULATION * *-------------------------------------------------------------* ELSE COMPUTE H-LITEM-REIM ROUNDED = ((H-LITEM-PYMT - H-TOTAL-LN-DEDUCT) - H-LN-BLOOD-DEDUCT) * W-PPCT (W-LP-INDX) END-IF. *************************************************************** * CALCULATE NATIONAL COINSURANCE * *-------------------------------------------------------------* * 12/6/2007 - LOGIC ADDED (TAKEN FROM 6550-PD-AT-CST-JAN07) * *************************************************************** COMPUTE H-NAT-COIN = H-LITEM-PYMT - H-TOTAL-LN-DEDUCT - H-LITEM-REIM - H-LN-BLOOD-DEDUCT. *************************************************************** * ADJUST MINIMUM COINSURANCE AMOUNT * * (REPLACES WHAT WAS IN THE APC TABLE IF > 0) * *************************************************************** MOVE W-MIN-COIN (W-LP-INDX) TO H-MIN-COIN. IF H-MIN-COIN > 0 *-------------------------------------------------------------* * DRUGS, DEVICES, BRACHYTHERAPY, THERAP. RADIO, & BLOOD * *-------------------------------------------------------------* IF OPPS-SRVC-IND (LN-SUB) = ' G' OR ' H' OR ' K' COMPUTE H-MIN-COIN ROUNDED = H-MIN-COIN * (W-SRVC-UNITS (W-LP-INDX) - (W-SRVC-UNITS (W-LP-INDX) * H-BLOOD-FRACTION)) * W-DISC-RATE (W-LP-INDX) *-------------------------------------------------------------* * APCS 0158 & 0159'S MIN COINSURANCE = 25% OF LINE PMT * *-------------------------------------------------------------* ELSE IF OPPS-APC (LN-SUB) = '0158' OR '0159' COMPUTE H-MIN-COIN ROUNDED = H-LITEM-PYMT * .25 *-------------------------------------------------------------* * OTHER SERVICE TYPES AND APCS' MIN COIN = 20% OF LINE PMT * *-------------------------------------------------------------* ELSE COMPUTE H-MIN-COIN ROUNDED = H-LITEM-PYMT * .2 END-IF END-IF END-IF. *************************************************************** * ADJUST REDUCED COINSURANCE WHEN NECESSARY & ADJUST CLAIM * * TOTAL LINE ITEM REIMBURSEMENT WHEN THE REDUCED AND/OR * * NATIONAL COINSURANCE AMOUNTS EXCEED THE MAXIMUM COINSURANCE * * (PROVIDER MAY ELECT TO REDUCE COINSURANCE) * *************************************************************** MOVE W-RED-COIN (W-LP-INDX) TO H-RED-COIN. IF (H-RED-COIN > 0 AND < H-MIN-COIN) MOVE H-MIN-COIN TO H-RED-COIN ELSE IF H-RED-COIN < H-NAT-COIN AND > H-MIN-COIN AND > H-MAX-COIN COMPUTE H-LITEM-REIM = H-LITEM-REIM + (H-RED-COIN - H-MAX-COIN) END-IF END-IF. IF H-NAT-COIN > H-MAX-COIN AND H-RED-COIN = 0 THEN COMPUTE H-LITEM-REIM = H-LITEM-REIM + (H-NAT-COIN - H-MAX-COIN) MOVE H-MAX-COIN TO H-NAT-COIN. 7550-CALC-STANDARD-EXIT. EXIT. *************************************************************** * * * DELETED CODE: * * PAID AT COST WITH COINSURANCE TABLE SEARCH REMOVED * * 11/1/2007 FOR CY 2008. THERE IS NO NEW PAID AT COST * * TABLE FOR 2008. PARAGRAPHS REMOVED: * * - 7550-PD-AT-CST-JAN07, * * - 7550-PD-AT-CST-JAN07-EXIT, * * - 7550-PD-AT-CST-JUL07, * * - 7550-PD-AT-CST-JUL07-EXIT. * * * *************************************************************** *************************************************************** * * * DEVICE REDUCTION PROCESSING * * * *************************************************************** * * * SEARCH THE DEVICE REDUCTION TABLE TO SEE IF THERE IS AN APC * * MATCH; IF SO, REDUCE THE PYMT BY THE REDUCTION AMOUNT * * BECAUSE THIS IS A FREE OR REPLACEMENT DEVICE -OR- A PARTIAL * * CREDIT DEVICE. * * * * * BE SURE TO UPDATE THE TABLE REFERENCES EACH YEAR * * * * *-------------------------------------------------------------* * * * 11/1/2007 - PARTIAL CREDIT DEVICE PROCESSING ADDED * * NEW FOR CY 2008 * * * *************************************************************** 7550-DEVICE-REDUC. SEARCH ALL DEV-RED08 AT END GO TO 7550-DEVICE-REDUC-EXIT WHEN DEV-APC8 (DEV-INDX8) = OPPS-APC (LN-SUB) PERFORM 7550-DEVICE-COMPUTE THRU 7550-DEVICE-COMPUTE-EXIT. 7550-DEVICE-REDUC-EXIT. EXIT. *************************************************************** * * * IF THE DEVICE IS FOUND, AND REDUCTION AMOUNT IS LESS THAN * * PAYMENT AMOUNT, SUBTRACT REDUCTION AMOUNT FROM THE PAYMENT * * * * * BE SURE TO UPDATE THE TABLE REFERENCES EACH YEAR * * * * *-------------------------------------------------------------* * * * 11/1/2007 - PARTIAL CREDIT DEVICE PROCESSING ADDED * * NEW FOR CY 2008 * * * *************************************************************** 7550-DEVICE-COMPUTE. *-------------------------------------------------------------* * PROCESS FULL DEVICE REDUCTION (PAF = 7) * *-------------------------------------------------------------* IF OPPS-PYMT-ADJ-FLAG (LN-SUB) = ' 7' IF W-APC-PYMT (W-LP-INDX) NUMERIC IF W-APC-PYMT (W-LP-INDX) > DEV-REDUC8 (DEV-INDX8) COMPUTE W-APC-PYMT (W-LP-INDX) = (W-APC-PYMT (W-LP-INDX) - DEV-REDUC8 (DEV-INDX8)). *-------------------------------------------------------------* * PROCESS PARTIAL CREDIT DEVICE REDUCTION (PAF = 8) * *-------------------------------------------------------------* IF OPPS-PYMT-ADJ-FLAG (LN-SUB) = ' 8' IF W-APC-PYMT (W-LP-INDX) NUMERIC IF W-APC-PYMT (W-LP-INDX) > (DEV-REDUC8 (DEV-INDX8) / 2) COMPUTE W-APC-PYMT (W-LP-INDX) = (W-APC-PYMT (W-LP-INDX) - (DEV-REDUC8 (DEV-INDX8) / 2)). 7550-DEVICE-COMPUTE-EXIT. EXIT. *************************************************************** * * * CALCULATE LINE ITEM PAYMENT WITH SOLE COMMUNITY HOSPITAL * * (SCH) ADJUSTMENT WHEN APPLICABLE * * * * FOR LINES WITH AN SI OF S, V, T, P, OR X -AND- * * BRACHYTHERAPY & BLOOD LINES WITH AN SI OF K * * * *************************************************************** * * * THE SCH ADJUSTMENT IS MADE WHEN THE FOLLOWING IS TRUE: * * EITHER THE L-PSF-GEO-CBSA OR THE L-PSF-WI-CBSA MUST BE A * * VALUE OF ' 01' THRU ' 99' AND THE L-PSF-PROV-TYPE * * MUST BE A '16' OR '17' OR '21' OR '22'. * * * * EACH YEAR, CHECK WHETHER THE SCH ADJUSTMENT HARDCODED BELOW * * HAS CHANGED. * * CYS 2006 - 2008: SCH ADJ = 7.1% (1.071) * * * * * * 11/08/2007 - PROCESSING FOR BRACHY & BLOOD CODES WITH AN SI * * = K ADDED FOR CY 2008 * * 11/13/2007 - PROCESSING FOR BRACHY & BLOOD CODES REVISED. * * BLD-DEDUC-HCPCS-FLAG ADDED TO LOGIC. * * 11/13/2007 - PARAGRAPH 7560-CALC-BENE-DEDUCT PERFORM * * DELETED & MOVED TO PAR. 7550-CALC-STANDARD * * 05/14/2008 - BRACHYTHERAPY LINES PROCESSED IN THIS * * PARAGRAPH STARTING 7/1/2008 BECAUSE SI CHANGED * * TO ' K' ON THIS DATE. * * 08/07/2008 - DUE TO LEGISLATION, THERAPEUTIC RADIOPHARMS & * * BRACHYTHERAPY SOURCE'S SI CHANGED FROM 'K' * * BACK TO 'H' EFFECTIVE 7/1/2008; THESE LINES * * ARE NOT YET PROCESSED IN THIS PARAGRAPH * * 08/07/2009 - REVISED LOGIC TO ACCOMODATE NON-BLOOD * * DEDUCTIBLE BLOOD LINES & REVISED DEFINITION * * OR A BLOOD DEDUCTIBLE LINE * * 05/09/2011 - REVISED LOGIC TO EXCLUDE BILL TYPE 14X FROM * * RECEIVING THE SCH ADD-ON * * * *************************************************************** 7550-SCH-ADJ. MOVE L-PSF-GEO-CBSA TO GEO-CBSA-FLAG. MOVE L-PSF-WI-CBSA TO WI-CBSA-FLAG. *************************************************************** * CALCULATE THE SCH PAYMENT * * - FOR SCHS = APC OR BLOOD APC PAYMENT ADJUSTED BY 7.1% * * - FOR NON-SCHS = UNADJUSTED APC OR BLOOD APC PAYMENT * *************************************************************** IF ((RURAL-GEO OR RURAL-WI) AND (L-PSF-PROV-TYPE = '16' OR '17' OR '21' OR '22') AND (BILL14X-FLAG = 'N')) *-------------------------------------------------------------* * SCH, BLOOD DEDUCTIBLE HCPCS LINE * * 08/07/2009 - ADDED PAF = 5 OR 6 * *-------------------------------------------------------------* IF OPPS-SRVC-IND (LN-SUB) = ' K' AND BLD-DEDUC-HCPCS-FLAG = 'Y' AND OPPS-PYMT-ADJ-FLAG (LN-SUB) = (' 5' OR ' 6') COMPUTE H-SCH-PYMT ROUNDED = (W-BD-APC-PYMT (W-BD-INDX) * 1.071) *-------------------------------------------------------------* * SCH, NOT A LINE WITH A BLOOD DEDUCTIBLE HCPCS * *-------------------------------------------------------------* ELSE COMPUTE H-SCH-PYMT ROUNDED = (W-APC-PYMT (W-LP-INDX) * 1.071) END-IF *-------------------------------------------------------------* * NON-SCH, BLOOD DEDUCTIBLE HCPCS LINE * * 08/07/2009 - ADDED PAF = 5 OR 6 * *-------------------------------------------------------------* ELSE IF OPPS-SRVC-IND (LN-SUB) = ' K' AND BLD-DEDUC-HCPCS-FLAG = 'Y' AND OPPS-PYMT-ADJ-FLAG (LN-SUB) = (' 5' OR ' 6') MOVE W-BD-APC-PYMT (W-BD-INDX) TO H-SCH-PYMT *-------------------------------------------------------------* * NON-SCH, NOT A LINE WITH A BLOOD DEDUCTIBLE HCPCS * *-------------------------------------------------------------* ELSE MOVE W-APC-PYMT (W-LP-INDX) TO H-SCH-PYMT END-IF END-IF. *************************************************************** * CALCULATE THE LINE ITEM PAYMENT * *************************************************************** *-------------------------------------------------------------* * SI = K LINES (BLOOD & BRACHY) ARE NOT WAGE-ADJUSTED * *-------------------------------------------------------------* IF OPPS-SRVC-IND (LN-SUB) = ' K' *-------------------------------------------------------------* * SI = K LINE & LINE HAS A BLOOD DEDUCTIBLE HCPCS * * 08/07/2009 - ADDED PAF = 5 OR 6 * *-------------------------------------------------------------* IF BLD-DEDUC-HCPCS-FLAG = 'Y' AND OPPS-PYMT-ADJ-FLAG (LN-SUB) = (' 5' OR ' 6') COMPUTE H-LITEM-PYMT ROUNDED = H-SCH-PYMT * W-BD-SRVC-UNITS (W-BD-INDX) * W-BD-DISC-RATE (W-BD-INDX) *-------------------------------------------------------------* * SI = K LINE & LINE DOES NOT HAVE A BLOOD DEDUCTIBLE HCPCS * *-------------------------------------------------------------* ELSE COMPUTE H-LITEM-PYMT ROUNDED = H-SCH-PYMT * W-SRVC-UNITS (W-LP-INDX) * W-DISC-RATE (W-LP-INDX) END-IF *-------------------------------------------------------------* * SI = S, V, T, P, OR X LINES ARE WAGE-ADJUSTED (60%) * *-------------------------------------------------------------* ELSE COMPUTE H-LITEM-PYMT ROUNDED = (((H-SCH-PYMT * .60) * W-WINX1 (W-LP-INDX)) + (H-SCH-PYMT * .40)) * W-SRVC-UNITS (W-LP-INDX) * W-DISC-RATE (W-LP-INDX) END-IF. 7550-SCH-ADJ-EXIT. EXIT. *************************************************************** * * * CALCULATE THE FOLLOWING FOR VALID SI = G OR K LINES: * * - APC PAYMENT FOR BLOOD LINES * * - BLOOD SPECIFIC ITEMS FOR BLOOD LINES * * - LINE ITEM PMT FOR ALL SI = G OR K LINES * * SCH ADJUSTMENT APPLIED TO ELIGIBLE BLOOD & BRACHY LINES * * - BLOOD DEDUCTIBLE FOR BLOOD DEDUCTIBLE HCPCS LINES * * * *************************************************************** * * * - EFFECTIVE 01/01/2003, REMOVE PRO RATA REDUCTION FOR * * ALL SERVICE INDICATOR 'G' PAYMENTS. * * - 11/13/2007 - LINE ITEM PAYMENTS FOR BLOOD AND BRACHY * * LINES ARE CALCULATED IN PARAGRAPH 7550-SCH-ADJ TO APPLY * * THE SOLE COMMUNITY HOSPITAL (SCH) ADJUSTMENT WHEN * * APPLICABLE * * - 12/31/2007 - BRACHYTHERAPY & RADIOPHARM LINES' STATUS * * INDICATOR CHANGED BACK TO 'H' TEMPORARILY; THESE LINES * * WILL NOT ENTER THIS PARAGRAPH NOR PARAGRAPH 7550-SCH-ADJ * * UNTIL THEIR STATUS INDICATOR IS CHANGED BACK TO 'K' * * - 05/14/2008 - BRACHYTHERAPY & RADIOPHARM LINES' SI CHANGED * * TO ' K' EFFECTIVE 7/1/2008. THESE LINES ARE PROCESSED * * IN THIS PARAGRAPH STARTING 7/1/2008. * * - 08/07/2008 - DUE TO LEGISLATION, THERAPEUTIC RADIOPHARMS * * & BRACHYTHERAPY SOURCE'S SI CHANGED FROM 'K' BACK TO 'H' * * EFFECTIVE 7/1/2008; THESE LINES ARE NOT YET PROCESSED IN * * THIS PARAGRAPH. * * - 08/07/2009 - REVISED LOGIC TO FORCE ALL BLOOD LINES TO * * PARAGRAPH 6550-SCH-ADJ; THIS ALLOWS ALL BLOOD LINES WITH * * A SCH PROVIDER TO RECEIVE THE SCH ADJ. EFF. OCTOBER 2009 * * * *************************************************************** 7550-CALC-GJK. *************************************************************** ** * SEARCH BLOOD HCPCS TABLE TO IDENTIFY LINES WITH BLOOD HCPCS * ** * ADDED 08/07/2009 * ** *************************************************************** *** MOVE 'N' TO W-BLD-HCPCS-FLAG. SET WBLH-INDX TO 1. SEARCH WBLHCPCS-ENTRY VARYING WBLH-INDX AT END MOVE 'N' TO W-BLD-HCPCS-FLAG WHEN W-2005-2008-BLOOD-HCPCS (WBLH-INDX) = OPPS-HCPCS (LN-SUB) MOVE 'Y' TO W-BLD-HCPCS-FLAG. *************************************************************** * * * CALCULATE LINE ITEM PAYMENT & BLOOD DEDUCTIBLE FOR BLOOD * * LINE WITH A HCPCS SUBJECT TO THE BLOOD DEDUCTIBLE (BD) * * * * (BLOOD DEDUCTIBLE LINES ARE PROCESSED IN THE ORDER THEY * * APPEAR IN THE BLOOD DEDUCTIBLE TABLE - EARLIEST TO LATEST * * DATE, LEAST TO MOST EXPENSIVE PAYMENT RATE. THE CURRENT * * COINSURANCE DEDUCTIBLE TABLE LINE BEING PROCESSED DOES NOT * * NECESSARILY CORRESPOND TO THE BLOOD DEDUCTIBLE LINE * * PROCESSED IN THE LOGIC BELOW.) * * * *************************************************************** IF BLD-DEDUC-HCPCS-FLAG = 'Y' AND OPPS-PYMT-ADJ-FLAG (LN-SUB) = (' 5' OR ' 6') *-------------------------------------------------------------* * CALCULATE BLOOD FRACTION & BLOOD PINTS USED * *-------------------------------------------------------------* PERFORM 7550-SET-BLOOD-FRACTION THRU 7550-SET-BLOOD-FRACTION-EXIT *-------------------------------------------------------------* * ADJUST BLOOD APC PAYMENT BY BLOOD PRODUCT OR LABOR RATE * *-------------------------------------------------------------* PERFORM 7550-ADJ-BLOOD-COST THRU 7550-ADJ-BLOOD-COST-EXIT *-------------------------------------------------------------* * CALCULATE LINE ITEM PAYMENT W/ SCH ADJUSTMENT IF APPLICABLE * *-------------------------------------------------------------* * 11/14/2007 - 7550-SCH-ADJ PERFORM ADDED; LINE ITEM PAYMENT * * CALCULATION REMOVED FROM THIS SECTION * *-------------------------------------------------------------* PERFORM 7550-SCH-ADJ THRU 7550-SCH-ADJ-EXIT *-------------------------------------------------------------* * CALCULATE BLOOD DEDUCTIBLE (BD) - H-BLOOD-FRACTION IS THE * * FRACTION OF THE CURRENT LINE'S PINTS COVERED BY THE BD * *-------------------------------------------------------------* COMPUTE H-LN-BLOOD-DEDUCT ROUNDED = H-LITEM-PYMT * H-BLOOD-FRACTION *-------------------------------------------------------------* * POINT TO NEXT BLOOD DEDUCTIBLE RECORD FOR NEXT BD LINE * *-------------------------------------------------------------* SET W-BD-INDX UP BY 1 *************************************************************** * * * CALCULATE LINE ITEM PAYMENT FOR BLOOD LINE WITH A HCPCS NOT * * SUBJECT TO THE BLOOD DEDUCTIBLE, BUT PAF = 5 OR 6 * * (BLOOD PROCESSING AND PRODUCT BILLED TOGETHER) * * * *************************************************************** ELSE IF W-BLD-HCPCS-FLAG = 'Y' AND OPPS-PYMT-ADJ-FLAG (LN-SUB) = (' 5' OR ' 6') *-------------------------------------------------------------* * ADJUST APC PAYMENT BY BLOOD PRODUCT OR LABOR RATE * *-------------------------------------------------------------* * 11/13/2007 - LINE ITEM PMT NO LONGER CALCULATED IN * * 7550-ADJ-PLATE-COST, BUT IN 7550-SCH-ADJ * *-------------------------------------------------------------* PERFORM 7550-ADJ-PLATE-COST THRU 7550-ADJ-PLATE-COST-EXIT *-------------------------------------------------------------* * CALCULATE LINE ITEM PAYMENT W/ SCH ADJUSTMENT IF APPLICABLE * *-------------------------------------------------------------* * 11/14/2007 - 7550-SCH-ADJ PERFORM ADDED; LINE ITEM PAYMENT * * CALCULATION REMOVED FROM THIS SECTION * *-------------------------------------------------------------* PERFORM 7550-SCH-ADJ THRU 7550-SCH-ADJ-EXIT *************************************************************** * * * CALCULATE LINE ITEM PAYMENT FOR BLOOD LINE WITH A HCPCS NOT * * SUBJECT TO THE BLOOD DEDUCTIBLE AND PAF NOT EQUAL TO 5 OR 6 * * (ONLY BLOOD PRODUCT BILLED) * * NEW CONDITION ADDED 08/07/2009 * * * *************************************************************** ELSE IF W-BLD-HCPCS-FLAG = 'Y' *-------------------------------------------------------------* * CALCULATE LINE ITEM PAYMENT W/ SCH ADJUSTMENT IF APPLICABLE * *-------------------------------------------------------------* * 12/05/2008 - 7550-SCH-ADJ PERFORM ADDED FOR BLOOD LINES * * CALCULATION REMOVED FROM THIS SECTION * *-------------------------------------------------------------* PERFORM 7550-SCH-ADJ THRU 7550-SCH-ADJ-EXIT *************************************************************** * * * CALCULATE LINE ITEM PAYMENT FOR NON-BLOOD G/K LINE * * * *************************************************************** ELSE *-------------------------------------------------------------* * FOR BRACHYS, CALC. LINE ITEM PMT W/ SCH ADJ. IF APPLICABLE * *-------------------------------------------------------------* * 11/14/2007 - 7550-SCH-ADJ PERFORM ADDED FOR BRACHYS * *-------------------------------------------------------------* IF BRACHY-APC-FLAG = 'Y' PERFORM 7550-SCH-ADJ THRU 7550-SCH-ADJ-EXIT *-------------------------------------------------------------* * CALCULATE LINE ITEM PAYMENT FOR NON-BRACHY, NON-BLOOD LINES * *-------------------------------------------------------------* ELSE COMPUTE H-LITEM-PYMT ROUNDED = W-APC-PYMT (W-LP-INDX) * W-SRVC-UNITS (W-LP-INDX) * W-DISC-RATE (W-LP-INDX) END-IF END-IF END-IF END-IF. 7550-CALC-GJK-EXIT. EXIT. *************************************************************** * * * DETERMINE THE FRACTION OF THE BLOOD LINE'S PAYMENT THAT * * WILL BE COVERED BY THE THE BENEFICIARY'S BLOOD DEDUCTIBLE * * FOR LINES WITH A HCPCS IN THE BLOOD DEDUCTIBLE LIST * * * * THE BENEFICIARY PAYS A BLOOD DEDUCTIBLE FOR THE FIRST * * 3 CHEAPEST BLOOD PINTS. MEDICARE COVERS ANY ADDITIONAL * * PINTS USED BY THE BENEFICIARY. * * * *************************************************************** 7550-SET-BLOOD-FRACTION. *-------------------------------------------------------------* * NAVIGATE TO SERVICE LINE ASSOCIATED WITH THE BLOOD ENTRY * *-------------------------------------------------------------* MOVE W-BD-SUB (W-BD-INDX) TO LN-SUB. *-------------------------------------------------------------* * BLOOD/BLOOD PRODUCT LINE * *-------------------------------------------------------------* IF OPPS-PYMT-ADJ-FLAG (LN-SUB) = ' 5' IF H-BENE-PINTS-USED > 0 *-------------------------------------------------------------* * BENEFICIARY HAS ENOUGH PINTS TO COVER ALL BLOOD LINE UNITS * * - BLOOD DEDUCTIBLE WILL COVER THE ENTIRE PYMNT (FRAC. = 1) * * - CALCULATE THE NUMBER OF DEDUCTIBLE PINTS BENE HAS LEFT * *-------------------------------------------------------------* IF W-BD-SRVC-UNITS (W-BD-INDX) <= H-BENE-PINTS-USED MOVE 1 TO H-BLOOD-FRACTION COMPUTE H-BENE-PINTS-USED = H-BENE-PINTS-USED - W-BD-SRVC-UNITS (W-BD-INDX) *-------------------------------------------------------------* * BENE. DOESN'T HAVE ENOUGH PINTS TO COVER ENTIRE BLOOD LINE * * - BLOOD DEDUCTIBLE WILL COVER A FRACTION OF THE PAYMENT * * (ACCORDING TO THE % OF PINTS COVERED) * * - BENEFICIARY HAS NO DEDUCTIBLE PINTS LEFT (PINTS = 0) * *-------------------------------------------------------------* ELSE IF W-BD-SRVC-UNITS (W-BD-INDX) > H-BENE-PINTS-USED COMPUTE H-BLOOD-FRACTION = H-BENE-PINTS-USED / W-BD-SRVC-UNITS (W-BD-INDX) MOVE 0 TO H-BENE-PINTS-USED ELSE MOVE 0 TO H-BLOOD-FRACTION *-------------------------------------------------------------* * BENEFICIARY HAS NO BLOOD DEDUCTIBLE PINTS LEFT * * THERE IS NO BLOOD DEDUCTIBLE * *-------------------------------------------------------------* ELSE MOVE 0 TO H-BLOOD-FRACTION *-------------------------------------------------------------* * BLOOD PROCESS/STORAGE LINE (PAF = 6) * * THERE IS NO BLOOD DEDUCTIBLE * *-------------------------------------------------------------* ELSE MOVE 0 TO H-BLOOD-FRACTION. 7550-SET-BLOOD-FRACTION-EXIT. EXIT. *************************************************************** * * * ADJUST APC PAYMENT BY BLOOD PRODUCT OR LABOR RATE TO * * CALCULATE THE BLOOD APC PAYMENT FOR LINES WITH A HCPCS * * IN THE BLOOD DEDUCTIBLE LIST * * * * THE RATE OF BLOOD TO BLOOD LABOR IS THE CLAIM AVERAGE. * * THE BLOOD LINE IS PAID ONLY THE PORTION OF THE APC * * PAYMENT THAT IS INDICATED BY THE PYMNT ADJUSTMENT FLAG. * * * *************************************************************** 7550-ADJ-BLOOD-COST. MOVE W-BD-SUB (W-BD-INDX) TO LN-SUB. *-------------------------------------------------------------* * CALCULATE BLOOD APC PAYMENT FOR BLOOD/BLOOD PRODUCT LINE * *-------------------------------------------------------------* IF OPPS-PYMT-ADJ-FLAG (LN-SUB) = ' 5' COMPUTE W-BD-APC-PYMT (W-BD-INDX) = W-BD-APC-PYMT (W-BD-INDX) * H-38X-39X-RATE. *-------------------------------------------------------------* * CALCULATE BLOOD APC PAYMENT FOR BLOOD PROCESS/STORAGE LINE * *-------------------------------------------------------------* IF OPPS-PYMT-ADJ-FLAG (LN-SUB) = ' 6' COMPUTE W-BD-APC-PYMT (W-BD-INDX) = W-BD-APC-PYMT (W-BD-INDX) * (1 - H-38X-39X-RATE). 7550-ADJ-BLOOD-COST-EXIT. EXIT. *************************************************************** * * * ADJUST APC PAYMENT BY BLOOD PRODUCT OR LABOR RATE TO * * CALCULATE THE BLOOD APC PAYMENT FOR BLOOD LINES WITH A * * HCPCS NOT IN THE BLOOD DEDUCTIBLE LIST * * * * THE RATE OF BLOOD TO BLOOD LABOR IS THE CLAIM AVERAGE. * * THE BLOOD LINE IS PAID ONLY THE PORTION OF THE APC * * PAYMENT THAT IS INDICATED BY THE PYMNT ADJUSTMENT FLAG. * * * *************************************************************** * * * 11/13/2007 - REMOVED LINE ITEM PAYMENT CALCULATION FROM * * THIS PARAGRAPH, NOW PERFORMED IN * * 7550-SCH-ADJ (CALLED FROM 7550-CALC-GJK) * * * *************************************************************** 7550-ADJ-PLATE-COST. *-------------------------------------------------------------* * CALCULATE BLOOD APC PAYMENT FOR BLOOD/BLOOD PRODUCT LINE * *-------------------------------------------------------------* IF OPPS-PYMT-ADJ-FLAG (LN-SUB) = ' 5' COMPUTE W-APC-PYMT (W-LP-INDX) = W-APC-PYMT (W-LP-INDX) * H-38X-39X-RATE. *-------------------------------------------------------------* * CALCULATE BLOOD APC PAYMENT FOR BLOOD PROCESS/STORAGE LINE * *-------------------------------------------------------------* IF OPPS-PYMT-ADJ-FLAG (LN-SUB) = ' 6' COMPUTE W-APC-PYMT (W-LP-INDX) = W-APC-PYMT (W-LP-INDX) * (1 - H-38X-39X-RATE). 7550-ADJ-PLATE-COST-EXIT. EXIT. *************************************************************** * * * ACCUMULATE TOTAL CLAIM CHARGES FROM DEVICE LINES * * * * EFFECTIVE 04/01/2002 A PRO RATA REDUCTION APPLIES TO ALL * * ALL SERVICE INDICATOR 'H' PAYMENTS (CURRENTLY .689) * * * * SERVICE INDICATOR OF 'H' = PASS-THROUGH DEVICE LINE * * * *************************************************************** 7555-CALC-H-TOT. *-------------------------------------------------------------* * SET THE SERVICE LINE SUBSCRIPT TO THE CLAIM SERVICE LINE * * ASSOCIATED WITH THE COINSURANCE DEDUCTIBLE TABLE RECORD * *-------------------------------------------------------------* MOVE W-LP-SUB (W-LP-INDX) TO LN-SUB. *-------------------------------------------------------------* * ACCUMULATE TOTAL CLAIM DEVICE CHARGES FOR DEVICE LINES * *-------------------------------------------------------------* MOVE OPPS-SUB-CHRG (LN-SUB) TO H-SUB-CHRG. IF OPPS-SRVC-IND (LN-SUB) = ' H' IF OPPS-PYMT-IND (LN-SUB) = ' 6' COMPUTE H-TOT-H-CHRG = (H-TOT-H-CHRG + H-SUB-CHRG) ELSE NEXT SENTENCE ELSE NEXT SENTENCE. 7555-CALC-H-TOT-EXIT. EXIT. *************************************************************** * * * CALCULATE PAYMENT FOR DEVICE LINES * * (PAYMENT BASED ON CHARGE ADJUSTED TO COST) * * UPDATE PASS-THROUGH DEVICE TABLE * * * *************************************************************** 7555-CALC-H-STANDARD. *-------------------------------------------------------------* * SET LINE ITEM PAYMENT TO LINE COST * *-------------------------------------------------------------* MOVE OPPS-SUB-CHRG (LN-SUB) TO H-SUB-CHRG. COMPUTE T-LITEM-PYMT ROUNDED = (H-SUB-CHRG * L-PSF-OPCOST-RATIO). *-------------------------------------------------------------* * WAGE ADJUST 60% OF THE CLAIM TOTAL DEVICE OFFSET AMOUNT * * (OFFSET AMOUNTS ARE COSTS, NOT CHARGES) * * (C-FLAG = Y MEANS THERE IS A DEVICE ON THE CLAIM) * *-------------------------------------------------------------* IF (C-FLAG = 'Y') *-------------------------------------------------------------* * OTHER LINES ON THE CLAIM BESIDES DEVICE LINES ARE OFFSET; * * CALCULATE DEVICE PORTION OF THE TOTAL WAGE ADJUSTED OFFSET * *-------------------------------------------------------------* IF (H-TOT-OFF-UNITS > H-TOT-HTD-UNITS) COMPUTE H-TOTAL-WAOFF ROUNDED = (((H-TOTAL-OFFSET * .60) * A-WINX) + (H-TOTAL-OFFSET * .40)) * (H-TOT-HTD-UNITS / H-TOT-OFF-UNITS) PERFORM 7700-CALC-H-OFFSET THRU 7700-CALC-H-OFFSET-EXIT ELSE *-------------------------------------------------------------* * ONLY DEVICE LINES ON THE CLAIM ARE OFFSET; * * WAGE ADJUST THE TOTAL CLAIM OFFSET AMOUNT * *-------------------------------------------------------------* COMPUTE H-TOTAL-WAOFF ROUNDED = ((H-TOTAL-OFFSET * .60) * A-WINX) + (H-TOTAL-OFFSET * .40) PERFORM 7700-CALC-H-OFFSET THRU 7700-CALC-H-OFFSET-EXIT *-------------------------------------------------------------* * THERE IS NO DEVICE ON THE CLAIM * *-------------------------------------------------------------* ELSE NEXT SENTENCE. IF T-LITEM-PYMT < 0 THEN MOVE 0 TO H-LITEM-PYMT ELSE MOVE T-LITEM-PYMT TO H-LITEM-PYMT. *-------------------------------------------------------------* * UPDATE PASS-THROUGH DEVICE TABLE WITH LINE ITEM PAYMENT OF * * DEVICE LINE (CHARGES CONVERTED TO COST LESS APPLICABLE * * OFFSET AMOUNT) * * WHEN PTD-FLAG = 'Y', A PASS-THROUGH DEVICE IS ON THE CLAIM * *-------------------------------------------------------------* IF PTD-FLAG = 'Y' PERFORM 7557-LOAD-PTD-LINE-PYMT THRU 7557-LOAD-PTD-LINE-PYMT-EXIT END-IF. 7555-CALC-H-STANDARD-EXIT. EXIT. *************************************************************** * * * UPDATE PASS-THROUGH DEVICE TABLE WITH CHARGES FOR THE * * DEVICE LINE (LINE ITEM PAYMENT LESS OFFSET CONVERTED TO * * CHARGES) * * * *************************************************************** 7557-LOAD-PTD-LINE-PYMT. *-------------------------------------------------------------* * SEARCH PTD TABLE STARTING AT ENTRY #1 FOR THE RECORD THAT * * CORRESPONDS TO THE CURRENT SERVICE LINE * *-------------------------------------------------------------* SET W-PTD-INDX TO 1. SEARCH W-PTD-ENTRY VARYING W-PTD-INDX *-------------------------------------------------------------* * IF THE SERVICE LINE'S PAYMENT ADJUSTMENT FLAG IS NOT * * ALREADY IN THE TABLE, ADD IT * *-------------------------------------------------------------* AT END GO TO 7557-LOAD-PTD-LINE-PYMT-EXIT *-------------------------------------------------------------* * IF THE LINE'S HCPCS IS IN THE TABLE, CALCULATE THE LINE'S * * CHARGES AND PLACE INTO TABLE (FOR H LINES, THE PAYMENT IS * * CONVERTED TO COST AND OFFSET. HERE, THE PAYMENT IS * * CONVERTED BACK INTO CHARGES BY DIVIDING IT BY THE COST TO * * CHARGE RATIO.) * *-------------------------------------------------------------* WHEN W-PTD-SUB (W-PTD-INDX) = LN-SUB MOVE H-LITEM-PYMT TO W-PTD-LITEM-PYMT (W-PTD-INDX) END-SEARCH. 7557-LOAD-PTD-LINE-PYMT-EXIT. EXIT. *************************************************************** * * * CALCULATE THE BENEFICIARY DEDUCTIBLE AMOUNT THAT WILL BE * * APPLIED TO THE SERVICE LINES IN THE DEDUCTIBLE TABLE * * * * (THE DEDUCTIBLE IS APPLIED TO THE LOWEST TO HIGHEST RANKED * * APCS. THE LOWER THE RANK, THE HIGHER THE COINSURANCE %. * * THE TOTAL CLAIM BENEFICIARY COINSURANCE AMOUNT IS CHEAPER * * WHEN THE DEDUCTIBLE IS APPLIED IN THIS ORDER.) * * * *************************************************************** 7560-CALC-BENE-DEDUCT. *-------------------------------------------------------------* * DO NOT CALCULATE DEDUCTIBLE FOR LINES WHERE A DEDUCTIBLE IS * * NOT APPLICABLE * *-------------------------------------------------------------* IF OPPS-PYMT-ADJ-FLAG (LN-SUB) = ' 4' GO TO 7560-CALC-BENE-DEDUCT-EXIT. *-------------------------------------------------------------* * BENEFICIARY HAS NOT MET HIS/HER DEDUCTIBLE LIMIT. * * CALCULATE THE "LINE BLOOD PAYMENT" * *-------------------------------------------------------------* IF H-BENE-DEDUCT > 0 THEN COMPUTE H-LN-BLD-PYMT = H-LITEM-PYMT - H-LN-BLOOD-DEDUCT *-------------------------------------------------------------* * BENEFICIARY'S DEDUCTIBLE DOES NOT COVER OR JUST COVERS THE * * ENTIRE LINE BLOOD PAYMENT: * * - BENEFICIARY'S REMAINING DEDUCTIBLE AMT APPLIED TO LINE * * - BENEFICIARY HAS REACHED HIS/HER DEDUCTIBLE LIMIT * *-------------------------------------------------------------* IF H-BENE-DEDUCT <= H-LN-BLD-PYMT THEN MOVE H-BENE-DEDUCT TO H-TOTAL-LN-DEDUCT MOVE 0 TO H-BENE-DEDUCT *-------------------------------------------------------------* * BENEFICIARY'S DEDUCTIBLE MORE THAN COVERS THE LINE BLOOD * * PAYMENT, DO THE FOLLOWING: * * - CALCULATE THE BENEFICIARY'S REMAINING DEDUCTIBLE AMOUNT * * AFTER PAYING FOR CURRENT SERVICE LINE * * - MEDICARE LINE PAYMENT = 0 * *-------------------------------------------------------------* ELSE COMPUTE H-BENE-DEDUCT = H-BENE-DEDUCT - H-LN-BLD-PYMT MOVE H-LN-BLD-PYMT TO H-TOTAL-LN-DEDUCT MOVE 20 TO A-RETURN-CODE (LN-SUB) END-IF END-IF. 7560-CALC-BENE-DEDUCT-EXIT. EXIT. *************************************************************** * * * CALCULATE OUTLIER PAYMENT * * ** CHANGE OUTLIER THRESHOLD EVERY JANUARY (HARD-CODED) ** * * * *************************************************************** * * * LOOP THROUGH THE COINSURANCE DEDUCTIBLE TABLE TO DO THE * * FOLLOWING FOR EACH SERVICE LINE: * * * * - DETERMINE IF THE LINE IS ELIGIBLE FOR AN OUTLIER PAYMENT * * - ADJUST CHARGES FOR LINES WITH ARTIFICIAL CHARGES ON CLAIM * * - DISTRIBUTE TOTAL CLAIM PACKAGED LINE CHARGES TO NON- * * PACKAGED PAYABLE LINES * * - ADJUST CHARGES OF PRIME CODE COMPOSITE APC LINES * * - ADJUST CHARGES OF MENTAL HEALTH LINES (APC = 34) * * - CALCULATE THE LINE OUTLIER PAYMENT FOR ELIGIBLE LINES * * * * * * NOTES: * * ------ * * - NEW FOR JANUARY 2004: * * - CHECK >= 20040101 AND SRVC-IND = 'K' * * - DISCONTINUE OUTLIER PROCESS * * * * - NEW FOR JANUARY 2008: * * - REVISED LOGIC FOR DETERMINING WHICH LINES WITH SRVC-IND * * = 'K' ARE ELIGIBLE FOR AN OUTLIER PAYMENT. THIS WAS * * NECESSARY B/C SOME RADIOPHARMS & ALL BRACHYTHERAPIES * * SRVC-IND = 'K' STARTING CY 2008. * * - PER LEGISLATION, BRACHYTHERAPY & RADIOPARM LINES' * * STATUS INDICATOR CHANGED BACK TO ' H' FOR CY 2008 QTR 1 * * ' K' LOGIC RETAINED B/C IT WILL NOT AFFECT PAYMENTS TO * * BRACHYTHERAPY OR RADIOPHARM LINES * * - COMPOSITE APC AND MENTAL HEALTH LINE CHARGE CALCS * * * * - NEW FOR APRIL 2008: ADD CHARGES AND PAYMENTS OF * * - PASS-THROUGH DEVICES TO THE CHARGES AND PAYMENTS OF * * PROCEDURES ELIGIBLE FOR THE DEVICES * * - A-LITEM-PYMT MOVED TO H-LITEM-PYMT-OUTL B/C PAYMENTS * * ARE ADJUSTED FOR PASS-THROUGH DEVICES FOR OUTLIER * * DETERMINATION ONLY * * * * - NEW FOR JULY 2008: BRACHYTHERAPY AND THERAPEUTIC * * RADIOPHARM LINES' SI CHANGED TO ' K'. BRACHYTHERAPY * * LINES ARE NOW ELIGIBLE FOR AN OUTLIER PAYMENT. * * * * - JULY 2008: DUE TO LEGISLATION, THERAPEUTIC RADIOPHARMS * * & BRACHYTHERAPY SOURCE'S SI CHANGED FROM 'K' BACK TO 'H' * * EFFECTIVE 7/1/2008; THESE LINES ARE NOT YET ELIGIBLE FOR * * AN OUTLIER PAYMENT. * * * *************************************************************** 7600-ADJ-CHRG-OUTL. *-------------------------------------------------------------* * GO TO SERVICE LINE ASSOCIATED WITH THE CURRENT COINSURANCE * * DEDUCTIBLE TABLE RECORD * *-------------------------------------------------------------* MOVE W-LP-SUB (W-LP-INDX) TO LN-SUB. *-------------------------------------------------------------* * DETERMINE WHETHER THE CURRENT LINE'S APC IS A BRACHY APC * * * UPDATE LIST OF BRACHYTHERAPY APCS EVERY JANUARY * *-------------------------------------------------------------* PERFORM 7650-SET-BRACHY-APC-FLAG THRU 7650-SET-BRACHY-APC-FLAG-EXIT. *-------------------------------------------------------------* * LINES WITH SERVICE INDICATOR OF 'K' THAT DO NOT HAVE * * A BRACHYTHERAPY APC AND DO NOT HAVE A BLOOD HCPCS * * BYPASS OUTLIER CALCULATION (THERAPEUTIC RADIOPHARMS) * *-------------------------------------------------------------* * 11/6/2007 - NEW LOGIC ADDED * * 02/9/2009 - THIS LOGIC EXCLUDES ALL BLOOD LINES FROM * * THE OUTLIER PAYMENT LOGIC * * 5/12/2009 - ALTERED LOGIC TO ALLOW ALL BLOOD LINES (WITH * ** * STATUS INDICATOR = K) TO ENTER OUTLIER LOGIC * ** *-------------------------------------------------------------* *** MOVE 'N' TO W-BLD-HCPCS-FLAG. SET WBLH-INDX TO 1. SEARCH WBLHCPCS-ENTRY VARYING WBLH-INDX AT END MOVE 'N' TO W-BLD-HCPCS-FLAG WHEN W-2005-2008-BLOOD-HCPCS (WBLH-INDX) = OPPS-HCPCS (LN-SUB) MOVE 'Y' TO W-BLD-HCPCS-FLAG. IF OPPS-SRVC-IND (LN-SUB) = ' K' AND ( (BRACHY-APC-FLAG = 'N') AND (W-BLD-HCPCS-FLAG = 'N') ) GO TO 7600-ADJ-CHRG-OUTL-EXIT END-IF. *----------------------------------------------------------* * CODE COMMENTED OUT 05/12/2009 & REPLACED WITH CODE ABOVE * *----------------------------------------------------------* * IF OPPS-SRVC-IND (LN-SUB) = ' K' AND * ( (BRACHY-APC-FLAG = 'N') AND * (OPPS-PYMT-ADJ-FLAG (LN-SUB) NOT = ' 5' OR ' 6') ) * GO TO 7600-ADJ-CHRG-OUTL-EXIT * END-IF. *-------------------------------------------------------------* * LINES WITH SERVICE INDICATORS NOT ELIGIBLE FOR AN OUTLIER * * PAYMENT AND LINES PACKAGED AS PART OF DRUG ADMINISTRATION * * APC PAYMENT BYPASS OUTLIER CALCULATION * * (DRUGS, DEVICES, & PACKAGED SERVICES) * *-------------------------------------------------------------* IF (OPPS-SRVC-IND (LN-SUB) = ' G' OR ' H' OR ' N') OR (OPPS-PKG-FLAG (LN-SUB) = '4') GO TO 7600-ADJ-CHRG-OUTL-EXIT. *-------------------------------------------------------------* * DISTRIBUTE TOTAL CLAIM PROCEDURE CHARGES TO PROCEDURE LINES * * IN PROPORTION TO THE PROCEDURE LINES' PAYMENTS WHEN THERE * * ARE ARTIFICIAL PROCEDURE CHARGES (< $1.01) ON THE CLAIM. * * (DISTRIBUTED CHARGES REPLACE BILLED CHARGES) * *-------------------------------------------------------------* * NOTE: LINES WITH CHARGES < $1.01 ARE FIXED BY FISS BEFORE * * ENTERING THE PRICER. THEREFORE, THIS LOGIC IS NO * * LONGER NECESSARY. THIS LOGIC WAS NECESSARY BEFORE * * FISS IMPLEMENTED THE FIX. * *-------------------------------------------------------------* IF (ST0-FLAG = 'Y') AND ((OPPS-SRVC-IND (LN-SUB) = ' T') OR ((OPPS-SRVC-IND (LN-SUB) = ' S') AND (OPPS-HCPCS (LN-SUB) > '09999' AND OPPS-HCPCS (LN-SUB) < '70000'))) AND (H-TOT-ST-PYMT > 0) COMPUTE H-CHRG-RATE ROUNDED = (A-LITEM-PYMT (LN-SUB) / H-TOT-ST-PYMT) COMPUTE W-SUB-CHRG (W-LP-INDX) ROUNDED = (H-CHRG-RATE * H-TOT-ST-CHRG) *-------------------------------------------------------------* * DISTRIBUTE TOTAL CLAIM PACKAGED LINE CHARGES TO SEPARATELY * * PAYABLE LINES IN PROPORTION TO THEIR PAYMENTS WHEN THERE * * ARE NO ARTIFICIAL PROCEDURE CHARGES (< $1.01) ON THE CLAIM. * * (DISTRIBUTED CHARGES ARE ADDED TO THE BILLED CHARGES) * *-------------------------------------------------------------* ELSE IF (N-FLAG = 'Y' AND ST0-FLAG = 'N') AND ((OPPS-SRVC-IND (LN-SUB) = ' S' OR ' T' OR ' V' OR ' X' OR ' P') AND (OPPS-PKG-FLAG (LN-SUB) = '0' OR '3')) AND (H-TOT-STVX-PYMT > 0) COMPUTE H-CHRG-RATE ROUNDED = (A-LITEM-PYMT (LN-SUB) / H-TOT-STVX-PYMT) COMPUTE H-SUB-CHRG ROUNDED = (H-CHRG-RATE * H-TOT-N-CHRG) COMPUTE W-SUB-CHRG (W-LP-INDX) ROUNDED = W-SUB-CHRG (W-LP-INDX) + H-SUB-CHRG. *-------------------------------------------------------------* * DISTRIBUTE TOTAL CLAIM PACKAGED LINE CHARGES TO SEPARATELY * * PAYABLE LINES IN PROPORTION TO THEIR PAYMENTS WHEN THERE * * ARE ARTIFICIAL PROCEDURE CHARGES (< $1.01) ON THE CLAIM. * * (DISTRIBUTED CHARGES ARE ADDED TO THE BILLED CHARGES) * *-------------------------------------------------------------* * NOTE: LINES WITH CHARGES < $1.01 ARE FIXED BY FISS BEFORE * * ENTERING THE PRICER. THEREFORE, THIS LOGIC IS NO * * LONGER NECESSARY. THIS LOGIC WAS NECESSARY BEFORE * * FISS IMPLEMENTED THE FIX. * *-------------------------------------------------------------* IF (N-FLAG = 'Y' AND ST0-FLAG = 'Y') AND ((OPPS-SRVC-IND (LN-SUB) = ' S' OR ' T' OR ' V' OR ' X' OR ' P') AND (OPPS-PKG-FLAG (LN-SUB) = '0' OR '3')) AND (H-TOT-STVX-PYMT > 0) COMPUTE H-CHRG-RATE ROUNDED = (A-LITEM-PYMT (LN-SUB) / H-TOT-STVX-PYMT) COMPUTE H-SUB-CHRG ROUNDED = (H-CHRG-RATE * H-TOT-N-CHRG) COMPUTE W-SUB-CHRG (W-LP-INDX) ROUNDED = W-SUB-CHRG (W-LP-INDX) + H-SUB-CHRG. *************************************************************** * CALCULATE COMPOSITE APC CHARGES FOR PRIME CODE LINES * * * * THE CHARGES OF ALL PACKAGED LINES WITH A PAYMENT ADJUSTMENT * * FLAG THAT INDICATES THE LINE IS A PART OF A COMPOSITE APC * * (VALUES 91 - 99 INCLUSIVE) ARE ACCUMULATED BY PAYMENT * * ADJUSTMENT FLAG AND ADDED TO THE CORRESPONDING PRIME CODE * * LINE. * *-------------------------------------------------------------* * 11/29/2007 - LOGIC ADDED FOR CY 2008 * * 12/14/2008 - ROUNDED W-SUB-CHRG WHEN ADDING COMPOSITES * *************************************************************** *-------------------------------------------------------------* * PAYMENT ADJUSTMENT FLAG INDICATES COMPOSITE APC * *-------------------------------------------------------------* IF (OPPS-PYMT-ADJ-FLAG (LN-SUB) = '91' OR '92' OR '93' OR '94' OR '95' OR '96' OR '97' OR '98' OR '99') *-------------------------------------------------------------* * SEARCH COMPOSITE APC TABLE STARTING AT ENTRY #1 * *-------------------------------------------------------------* MOVE OPPS-PYMT-ADJ-FLAG (LN-SUB) TO H-CMP-PAF SET W-CMP-INDX TO 1 SEARCH W-CMP-ENTRY VARYING W-CMP-INDX *-------------------------------------------------------------* * SERVICE LINE'S PAYMENT ADJUSTMENT FLAG NOT IN TABLE * *-------------------------------------------------------------* AT END ADD 0 TO W-SUB-CHRG (W-LP-INDX) *-------------------------------------------------------------* * SERVICE LINE'S PAYMENT ADJUSTMENT FLAG IS IN TABLE, * * ADD THE PACKAGED SUBMITTED CHARGES TO THE LINE'S CHARGES * *-------------------------------------------------------------* WHEN W-CMP-PAF (W-CMP-INDX) = H-CMP-PAF COMPUTE W-SUB-CHRG (W-LP-INDX) ROUNDED = W-SUB-CHRG (W-LP-INDX) + W-CMP-TOT-SUB-CHRG (W-CMP-INDX) END-IF. *************************************************************** * CALCULATE TOTAL MENTAL HEALTH CHARGES FOR APC 34 LINES * * * * THE CHARGES OF PACKAGED LINES WITH A PACKAGING FLAG OF '2' * * ON A CLAIM WITH APC 34 (MENTAL HEALTH APC) ARE ACCUMULATED * * AND ADDED TO THE SEPARATELY PAYABLE APC 34 LINE'S CHARGES. * *-------------------------------------------------------------* * 11/29/2007 - LOGIC ADDED FOR CY 2008 * * 05/12/2009 - REVISED LOGIC TO DISTRIBUTE TOTAL PACKAGED * * MENTAL HEALTH CHARGES EVENLY ACROSS PAYABLE * * APC 34 LINES * *************************************************************** IF APC34-FLAG = 'Y' AND OPPS-APC (LN-SUB) = '0034' COMPUTE W-SUB-CHRG (W-LP-INDX) ROUNDED = W-SUB-CHRG (W-LP-INDX) + (H-TOT-MH-CHRG / W-APC34-CNT) END-IF. *************************************************************** * MOVE LINE PAYMENTS TO HOLD FIELD BECAUSE PAYMENTS MAY BE * * ADJUSTED FOR PASS-THROUGH DEVICES - ADDED 02/14/2008 * *************************************************************** MOVE ZEROS TO H-LITEM-PYMT-OUTL. MOVE A-LITEM-PYMT (LN-SUB) TO H-LITEM-PYMT-OUTL. *************************************************************** * CALCULATE TOTAL CHARGES AND PAYMENTS FOR PROCEDURE LINES * * ELIGIBLE FOR PASS-THROUGH DEVICE(S) * * * * THE CHARGES AND LINE PAYMENTS OF PASS-THROUGH DEVICE LINES * * ARE ADDED TO THE CHARGES AND PAYMENTS OF ALL PROCEDURES * * ELIGIBLE TO BE BILLED WITH THE PASS-THROUGH DEVICE. * * (PTD-FLAG = 'Y' INDICATES THERE IS AT LEAST ONE * * PASS-THROUGH DEVICE ON THE CLAIM) * *-------------------------------------------------------------* * 02/12/2008 - LOGIC ADDED FOR CY 2008 QTR 2 * *************************************************************** IF (PTD-FLAG = 'Y') AND (OPPS-SRVC-IND (LN-SUB) = ' S' OR ' T' OR ' V' OR ' X') *-------------------------------------------------------------* * DETERMINE WHETHER THE LINE IS ELIGIBLE FOR A PT DEVICE * *-------------------------------------------------------------* PERFORM 7670-SET-PTD-PROC-FLAG THRU 7670-SET-PTD-PROC-FLAG-EXIT *-------------------------------------------------------------* * PROCEDURE IS ELIGIBLE FOR A PASS-THROUGH DEVICE * *-------------------------------------------------------------* IF PTD-FLAG = 'Y' *-------------------------------------------------------------* * LOOP THROUGH ELIGIBLE PROCEDURE'S PASS-THROUGH DEVICE TABLE * * GET THE PASS-THROUGH DEVICE HCPCS(S) FOR WHICH THE * * PROCEDURE IS ELIGIBLE & UPDATE PROCEDURE CHARGES & PAYMENTS * *-------------------------------------------------------------* PERFORM 7610-PERFORM-SEARCH THRU 7610-PERFORM-SEARCH-EXIT VARYING W-PTD-PROC-SUB FROM 1 BY 1 UNTIL W-PTD-PROC-SUB > W-PTD-CNT END-IF END-IF. *************************************************************** * CALCULATE THE OUTLIER PAYMENT FOR ELIGIBLE LINES * * * * -NEW FOR JANUARY 2005 * * - PROVIDER RANGE FOR CMHC * * - COMPUTE H-LITEM-OUTL-PYMT USING NEW FORMULA * * - CHANGE OUTLIER THRESHOLD AMOUNT EVERY JANUARY * * * * -NEW FOR APRIL 2008 * * - A-LITEM-PYMT (LN-SUB) CHANGED TO H-LITEM-PYMT-OUTL B/C * * PAYMENTS ARE NOW ADJUSTED FOR OUTLIER DETERMINATION * * * *************************************************************** MOVE 1.75 TO H-OUTLIER-FACTOR. MOVE .50 TO H-OUTLIER-PCT. COMPUTE H-COST ROUNDED = W-SUB-CHRG (W-LP-INDX) * L-PSF-OPCOST-RATIO. COMPUTE H-APC-ADJ-PYMT ROUNDED = H-OUTLIER-FACTOR * H-LITEM-PYMT-OUTL. *-------------------------------------------------------------* * IDENTIFY COMMUNITY MENTAL HEALTH CENTER (CMHC) PROVIDERS * * FOR CMHCS, INCREASE OUTLIER FACTOR & CALC LINE OUTLIER PMT * *-------------------------------------------------------------* IF (L-PSF-PROV-3456 >= '1400' AND L-PSF-PROV-3456 <= '1499') OR (L-PSF-PROV-3456 >= '4600' AND L-PSF-PROV-3456 <= '4799') OR (L-PSF-PROV-3456 >= '4900' AND L-PSF-PROV-3456 <= '4999') MOVE 3.4 TO H-OUTLIER-FACTOR COMPUTE H-LITEM-OUTL-PYMT ROUNDED = (H-COST - (H-OUTLIER-FACTOR * H-LITEM-PYMT-OUTL)) * H-OUTLIER-PCT *-------------------------------------------------------------* * FOR NON-CMHC PROVIDERS, LINE'S OUTLIER ELIGIBILITY & * * CALCULATE OUTLIER PAYMENT IF ELIGIBLE * * ** UPDATE THE LITERAL NUMBER BELOW EACH JANUARY ** * *-------------------------------------------------------------* ELSE IF (H-COST > H-APC-ADJ-PYMT) AND (H-COST > H-LITEM-PYMT-OUTL + 1575) COMPUTE H-LITEM-OUTL-PYMT ROUNDED = (H-COST - H-APC-ADJ-PYMT) * H-OUTLIER-PCT ELSE MOVE ZERO TO H-LITEM-OUTL-PYMT. *-------------------------------------------------------------* * ACCUMULATE TOTAL CLAIM OUTLIER PAYMENTS * *-------------------------------------------------------------* IF H-LITEM-OUTL-PYMT > 0 COMPUTE H-OUTLIER-PYMT = H-OUTLIER-PYMT + H-LITEM-OUTL-PYMT. *-------------------------------------------------------------* * LINES THAT RECEIVE AN EXTERNAL ADJUSTMENT ARE NOT ELIGIBLE * * FOR AN OUTLIER PAYMENT - ZERO OUT PAYMENT & REMOVE FROM * * CLAIM TOTAL * *-------------------------------------------------------------* IF OPPS-LITEM-ACT-FLAG (LN-SUB) = '4' COMPUTE H-OUTLIER-PYMT = H-OUTLIER-PYMT - H-LITEM-OUTL-PYMT MOVE 0 TO H-LITEM-OUTL-PYMT. 7600-ADJ-CHRG-OUTL-EXIT. EXIT. *************************************************************** * * * SEARCH THE PASS-THROUGH DEVICE TABLE FOR THE PASS-THROUGH * * DEVICE(S) THE PROCEDURE IS ELIGIBLE FOR * * * *************************************************************** 7610-PERFORM-SEARCH. *-------------------------------------------------------------* * SEARCH PTD TABLE STARTING AT ENTRY #1 FOR ALL OCCURANCES * * OF THE PASS-THRU DEVICE HCPCS IN THE PASS-THRU DEVICE TABLE.* * THIS IS DONE FOR ALL PASS-THROUGH DEVICES THE PROCEDURE IS * * ELIGIBLE FOR. * *-------------------------------------------------------------* MOVE 'N' TO W-END-OF-PTD-TBL. IF W-PTD-PROC-HCPCS (W-PTD-PROC-SUB) NOT = ' ' SET W-PTD-INDX TO 1 PERFORM 7611-SEARCH-PTD-HCPCS THRU 7611-SEARCH-PTD-HCPCS-EXIT UNTIL W-END-OF-PTD-TBL = 'Y' END-IF. 7610-PERFORM-SEARCH-EXIT. EXIT. *************************************************************** * * * SEARCH FOR THE PASS-THROUGH DEVICE FOR WHICH THE PROCEDURE * * IS ELIGIBLE IN THE TABLE & UPDATE PROCEDURE LINE PAYMENTS * * AND CHARGES * * * *************************************************************** 7611-SEARCH-PTD-HCPCS. MOVE 'N' TO W-END-OF-PTD-TBL. *-------------------------------------------------------------* * SEARCH PASS-THROUGH DEVICE TABLE * *-------------------------------------------------------------* SEARCH W-PTD-ENTRY VARYING W-PTD-INDX *-------------------------------------------------------------* * IF THERE ARE NO MORE OCCURANCES OF THE PASS-THROUGH DEVICE, * * STOP THE SEARCH AND INDICATE END OF FILE * *-------------------------------------------------------------* AT END MOVE 'Y' TO W-END-OF-PTD-TBL GO TO 7611-SEARCH-PTD-HCPCS-EXIT *-------------------------------------------------------------* * IF THE PASS-THROUGH DEVICE IS FOUND, INDICATE NOT END OF * * FILE AND UPDATE THE PROCEDURE'S CHARGES AND PAYMENTS * *-------------------------------------------------------------* WHEN W-PTD-HCPCS (W-PTD-INDX) = W-PTD-PROC-HCPCS (W-PTD-PROC-SUB) MOVE 'N' TO W-END-OF-PTD-TBL PERFORM 7612-UPDATE-PTD-PROC THRU 7612-UPDATE-PTD-PROC-EXIT SET W-PTD-INDX UP BY 1 END-SEARCH. *-------------------------------------------------------------* * SET UP FOR NEXT PASS-THROUGH DEVICE RECORD * *-------------------------------------------------------------* MOVE ZEROS TO H-PTD-UNIT-RATE H-PTD-SUB-CHRG H-PTD-LITEM-PYMT. 7611-SEARCH-PTD-HCPCS-EXIT. EXIT. *************************************************************** * * * UPDATE THE PROCEDURE LINE'S PAYMENTS AND CHARGES WITH THE * * PASS-THROUGH DEVICE'S PAYMENTS AND CHARGES (IN PROPORTION * * TO THE PROCEDURE'S UNITS IF OTHER PROCEDURES ARE ELIGIBLE * * FOR THE PASS-THROUGH DEVICE AS WELL) * * * *************************************************************** 7612-UPDATE-PTD-PROC. *-------------------------------------------------------------* * DETERMINE PROPORTION OF CHARGES & PAYMENTS PROCEDURE LINE * * WILL RECEIVE BASED ON ITS NUMBER OF UNITS * *-------------------------------------------------------------* IF W-PTD-TOTAL-PROC-UNITS (W-PTD-INDX) NOT = 0 COMPUTE H-PTD-UNIT-RATE ROUNDED = OPPS-SRVC-UNITS (LN-SUB) / W-PTD-TOTAL-PROC-UNITS (W-PTD-INDX) ELSE MOVE 0 TO H-PTD-UNIT-RATE END-IF. *-------------------------------------------------------------* * CALCULATE THE AMOUNT OF PASS-THROUGH DEVICE CHARGES TO BE * * ADDED TO THE PROCEDURE'S CHARGES IN PROPORTION TO UNITS * *-------------------------------------------------------------* COMPUTE H-PTD-SUB-CHRG ROUNDED = W-PTD-SUB-CHRG (W-PTD-INDX) * H-PTD-UNIT-RATE. *-------------------------------------------------------------* * ADD PASS-THROUGH DEVICE CHARGES TO PROCEDURE LINE CHARGES * *-------------------------------------------------------------* COMPUTE W-SUB-CHRG (W-LP-INDX) ROUNDED = W-SUB-CHRG (W-LP-INDX) + H-PTD-SUB-CHRG. *-------------------------------------------------------------* * CALCULATE THE AMOUNT OF PASS-THROUGH DEVICE PAYMENTS TO BE * * ADDED TO THE PROCEDURE'S PAYMENTS IN PROPORTION TO UNITS * *-------------------------------------------------------------* COMPUTE H-PTD-LITEM-PYMT ROUNDED = W-PTD-LITEM-PYMT (W-PTD-INDX) * H-PTD-UNIT-RATE. *-------------------------------------------------------------* * ADD PASS-THROUGH DEVICE PAYMENT TO PROCEDURE LINE PAYMENT * *-------------------------------------------------------------* COMPUTE H-LITEM-PYMT-OUTL ROUNDED = H-LITEM-PYMT-OUTL + H-PTD-LITEM-PYMT. 7612-UPDATE-PTD-PROC-EXIT. EXIT. *************************************************************** * * * DETERMINE WHETHER THE CURRENT APC IS A BRACHYTHERAPY APC * * - IF SO, SET BRACHY-APC-FLAG = 'Y' * * - THIS FLAG IS USED IN PARAGRAPHS 7600-ADJ-CHRG-OUTL & * * 7550-CALC-GJK TO PROCESS BRACHYS * * ** UPDATE THIS LIST EVERY JANUARY * * (CODE NEW FOR CY2008; ADDED 11/6/2007) * * * *************************************************************** 7650-SET-BRACHY-APC-FLAG. MOVE 'N' TO BRACHY-APC-FLAG. IF OPPS-APC (LN-SUB) = ('2632' OR '1716' OR '1717' OR '1719' OR '2616' OR '2634' OR '2635' OR '2636' OR '2638' OR '2639' OR '2640' OR '2641' OR '2642' OR '2643' OR '2698' OR '2699') MOVE 'Y' TO BRACHY-APC-FLAG END-IF. 7650-SET-BRACHY-APC-FLAG-EXIT. EXIT. *************************************************************** * * * DETERMINE WHETHER THE CURRENT HCPCS IS A BLOOD DEDUCTIBLE * * HCPCS * * - IF SO, SET BLD-DEDUC-HCPCS-FLAG = 'Y' * * - THIS FLAG IS USED IN PARAGRAPHS 7550-CALC-GJK & * * 7550-SCH-ADJ TO PROCESS BLOOD DEDUCTIBLE LINES * * ** UPDATE THIS LIST EVERY JANUARY * * (CODE NEW FOR CY2008; ADDED 12/4/2007) * * * *************************************************************** 7655-SET-BD-HCPCS-FLAG. MOVE 'N' TO BLD-DEDUC-HCPCS-FLAG. IF OPPS-HCPCS(LN-SUB) = ('P9010' OR 'P9016' OR 'P9021' OR 'P9022' OR 'P9038' OR 'P9039' OR 'P9040' OR 'P9051' OR 'P9054' OR 'P9056' OR 'P9057' OR 'P9058' ) MOVE 'Y' TO BLD-DEDUC-HCPCS-FLAG END-IF. 7655-SET-BD-HCPCS-FLAG-EXIT. EXIT. *************************************************************** * * * DETERMINE WHETHER THE CURRENT APC IS A RADIOPHARM APC * * - IF SO, SET RADIOPH-APC-FLAG = 'Y' * * - THIS FLAG IS USED IN PARAGRAPH 7550-CALC-STANDARD * * TO PROCESS RADIOPHARM LINES * * ** UPDATE THIS LIST EVERY JANUARY * * (CODE NEW FOR CY2008; ADDED 12/27/2007) * * * *************************************************************** 7660-SET-RADIOPH-APC-FLAG. MOVE 'N' TO RADIOPH-APC-FLAG. IF OPPS-APC (LN-SUB) = ('1064' OR '1150' OR '1643' OR '1645' OR '1675' OR '1676' OR '0701' OR '0702') MOVE 'Y' TO RADIOPH-APC-FLAG END-IF. 7660-SET-RADIOPH-APC-FLAG-EXIT. EXIT. *************************************************************** * * * DETERMINE WHETHER THE CURRENT HCPCS IS A PASS-THROUGH * * DEVICE HCPCS * * - IF SO, SET PTD-LINE-FLAG = 'Y' * * - THIS FLAG IS USED IN THE PASS-THROUGH DEVICE LOGIC * * TO POPULATE THE PASS-THROUGH-DEVICE TABLE * * ** UPDATE THIS LIST EVERY QUARTER * * (CODE NEW FOR CY2008 QTR 2; ADDED 02/11/2008) * * * *************************************************************** 7665-SET-PTD-LINE-FLAG. MOVE 'N' TO PTD-LINE-FLAG. *---------------------------------------------------------* * ONLY CLAIMS WITH A DATE OF SERVICE ON OR AFTER * * APRIL 1, 2008 ARE ELIGIBLE * *---------------------------------------------------------* IF OPPS-LITEM-DOS (LN-SUB) >= 20080401 IF OPPS-HCPCS (LN-SUB) = ('C1821' OR 'L8690') MOVE 'Y' TO PTD-LINE-FLAG END-IF END-IF. 7665-SET-PTD-LINE-FLAG-EXIT. EXIT. *************************************************************** * * * DETERMINE WHETHER THE CURRENT HCPCS IS A PROCEDURE * * ELIGIBLE FOR A PASS-THROUGH DEVICE * * - IF SO, SET PTD-PROC-FLAG = 'Y' * * - THIS FLAG IS USED IN THE PASS-THROUGH DEVICE LOGIC * * ** UPDATE THIS LIST EVERY QUARTER * * (CODE NEW FOR CY2008 QTR 2; ADDED 02/11/2008) * * * *************************************************************** 7670-SET-PTD-PROC-FLAG. MOVE 'N' TO PTD-PROC-FLAG. *---------------------------------------------------------* * ONLY CLAIMS WITH A DATE OF SERVICE ON OR AFTER * * APRIL 1, 2008 ARE ELIGIBLE * *---------------------------------------------------------* IF OPPS-LITEM-DOS (LN-SUB) >= 20080401 *---------------------------------------------------------* * SPECIFY NUMBER OF ENTRIES (# OF PT DEVICES FROM POLICY)* *---------------------------------------------------------* MOVE 2 TO W-PTD-CNT *---------------------------------------------------------* * INITIALIZE PROCEDURE'S PTD HCPCS TABLE TO SPACES * *---------------------------------------------------------* PERFORM VARYING W-PTD-PROC-SUB FROM 1 BY 1 UNTIL W-PTD-PROC-SUB > W-PTD-CNT MOVE SPACES TO W-PTD-PROC-HCPCS (W-PTD-PROC-SUB) END-PERFORM *---------------------------------------------------------* * PROCEDURES ELIGIBLE FOR PASS-THROUGH DEVICE 1 * *---------------------------------------------------------* IF OPPS-HCPCS (LN-SUB) = ('0171T' OR '0172T') MOVE 'Y' TO PTD-PROC-FLAG MOVE 1 TO W-PTD-PROC-SUB MOVE 'C1821' TO W-PTD-PROC-HCPCS (W-PTD-PROC-SUB) END-IF *---------------------------------------------------------* * PROCEDURES ELIGIBLE FOR PASS-THROUGH DEVICE 2 * *---------------------------------------------------------* IF OPPS-HCPCS (LN-SUB) = ('69714' OR '69715' OR '69717' OR '69718') MOVE 'Y' TO PTD-PROC-FLAG MOVE 2 TO W-PTD-PROC-SUB MOVE 'L8690' TO W-PTD-PROC-HCPCS (W-PTD-PROC-SUB) END-IF END-IF. 7670-SET-PTD-PROC-FLAG-EXIT. EXIT. *************************************************************** * * * REDUCE LINE ITEM PAYMENTS OF DEVICE LINES (SI = H) BY THE * * WAGE ADJUSTED DEVICE OFFSET AMOUNT WHEN THERE ARE DEVICE * * OFFSETS ON THE CLAIM (PASS-THROUGH DEVICES) * * * *************************************************************** * * * 1. RE-CALCULATE LINE ITEM PAYMENT FOR SERVICE INDICATOR * * TYPE H * * 2. SUBTRACT WAGE ADJUSTED OFFSET AMOUNT FROM SI TYPE 'H' * * WITH HCPCS CODE BEGINNING WITH 'C' * * ** EFFECTIVE 04/01/2002 * * * *************************************************************** 7700-CALC-H-OFFSET. *-------------------------------------------------------------* * REDUCE EACH DEVICE LINE'S PAYMENT BY THE WAGE ADJUSTED * * OFFSET AMOUNT IN PROPORTION TO THE DEVICE LINE'S CHARGES * *-------------------------------------------------------------* IF H-TOT-H-CHRG > 0 COMPUTE H-OFF-RATE ROUNDED = H-SUB-CHRG / H-TOT-H-CHRG COMPUTE T-LITEM-PYMT ROUNDED = T-LITEM-PYMT - (H-TOTAL-WAOFF * H-OFF-RATE) ELSE NEXT SENTENCE. IF T-LITEM-PYMT < 0 MOVE 0 TO T-LITEM-PYMT. 7700-CALC-H-OFFSET-EXIT. EXIT. *************************************************************** * * * PROCESS DRUG COINSURANCE TABLE RECORDS * * * *************************************************************** * * * ADJUST THE "DRUG" LINE COINSURANCE WHEN THE PROCEDURE * * COINSURANCE AMOUNTS PLUS THE "DRUG" COINSURANCE AMOUNT(S) * * BILLED ON THE SAME DAY EXCEED THE DAILY INPATIENT * * COINSURANCE LIMIT. * * * *************************************************************** 7800-ADJ-STV-REIM. IF W-DCP-CODE (W-DCP-INDX) = 1 PERFORM 7810-PROCESS-TYPE1 THRU 7810-PROCESS-TYPE1-EXIT ELSE PERFORM 7840-PROCESS-TYPE2 THRU 7840-PROCESS-TYPE2-EXIT. 7800-ADJ-STV-REIM-EXIT. EXIT. *************************************************************** * * * FOR DAYS OF SERVICE WITH "DRUG" COINSURANCE, DETERMINE THE * * % OF TOTAL "DRUG" COINSURANCE THAT CAN BE PAID IN ADDITION * * TO THE DAY'S MOST EXPENSIVE PROCEDURE/VISIT WAGE ADJUSTED * * COINSURANCE WHILE KEEPING WITHIN THE INPATIENT DAILY * * COINSURANCE LIMIT. * * * * WHEN H-RATIO = 0, NONE OF THE DRUG COINSURANCE CAN BE PAID * * WHEN H-RATIO = 1, ALL OF THE DRUG COINSURANCE CAN BE PAID * * * * BY USING THE DAY'S MOST EXPENSIVE PROCEDURE/VIST WAGE * * ADJUSTED COINSURANCE, THE BENEFICIARY RECEIVES THE * * GREATEST BENEFIT FROM THE INPATIENT LIMITATION PROVISION. * * * *************************************************************** 7810-PROCESS-TYPE1. *-------------------------------------------------------------* * DRUGS WERE ADMINISTERED ON THE DAY * *-------------------------------------------------------------* IF W-DCP-COIN2 (W-DCP-INDX) > 0 *-------------------------------------------------------------* * GET DATE OF SERVICE & WAGE ADJUSTED COINSURANCE OF THE * * DAY'S MOST EXPENSIVE PROCEDURE/VISIT * *-------------------------------------------------------------* MOVE W-DCP-DOS (W-DCP-INDX) TO H-DCP-DOS MOVE W-DCP-WGNAT (W-DCP-INDX) TO H-TOTAL *-------------------------------------------------------------* * CALCULATE THE % OF THE DAY'S TOTAL DRUG COIN THAT CAN BE * * PAID IN ADDITION TO THE PROCEDURE/VISIT COIN WITHIN THE * * INPATIENT LIMIT * *-------------------------------------------------------------* COMPUTE H-RATIO = (H-IP-LIMIT - W-DCP-WGNAT (W-DCP-INDX)) / W-DCP-COIN2 (W-DCP-INDX) *-------------------------------------------------------------* * NONE OF THE DAY'S DRUG COIN CAN BE PAID B/C THE PROCEDURE/ * * VISIT COIN > INPATIENT COIN LIMIT * *-------------------------------------------------------------* IF H-RATIO < 0 MOVE 0 TO H-RATIO. *-------------------------------------------------------------* * THE DAY'S TOTAL DRUG COINSURANCE CAN BE PAID WITHIN THE * * INPATIENT COIN LIMIT * *-------------------------------------------------------------* IF H-RATIO > 1 MOVE 1 TO H-RATIO. 7810-PROCESS-TYPE1-EXIT. EXIT. *************************************************************** * * * REDUCE THE "DRUG" LINE'S NATIONAL COINSURANCE AMOUNT AND * * ADD THE REDUCTION AMOUNT TO THE LINE'S REIMBURSEMENT * * AMOUNT WHEN THE INPATIENT LIMIT IS EXCEEDED * * * *************************************************************** 7840-PROCESS-TYPE2. *-------------------------------------------------------------* * CURRENT TYPE 2 DRUG COIN REC HAS SAME DATE OF SERVICE AS * * THE LAST TYPE 1 RECORD PROCESSED * *-------------------------------------------------------------* IF W-DCP-DOS (W-DCP-INDX) = H-DCP-DOS *-------------------------------------------------------------* * GO TO SERVICE LINE THAT CORRESPONDS TO THE DRUG COIN RECORD * *-------------------------------------------------------------* MOVE W-DCP-SUB (W-DCP-INDX) TO LN-SUB *-------------------------------------------------------------* * CALCULATE ACTUAL COIN AMT TO BE REIMBURSED DUE TO IP LIMIT * *-------------------------------------------------------------* COMPUTE H-SHIFT = W-DCP-COIN2 (W-DCP-INDX) * (1 - H-RATIO) *-------------------------------------------------------------* * ACCUMULATE THE TOTAL NATIONAL COIN DUE FOR THE DAY * * (LESS ACTUAL COIN AMT TO BE REIMBURSED DUE TO IP LIMIT) * *-------------------------------------------------------------* COMPUTE H-TOTAL = A-ADJ-COIN (LN-SUB) + H-TOTAL - H-SHIFT *-------------------------------------------------------------* * DETERMINE HOW MUCH THE DAY'S TOTAL NATIONAL COIN DUE * * EXCEEDS THE DAILY INPATIENT LIMIT (IF IT EXCEEDS THE LIMIT) * *-------------------------------------------------------------* * OCCURS WHEN THE NATIONAL COIN OF THIS LINE AND/OR PREVIOUS * * LINES FROM THE SAME DAY IS GREATER THAN THE ACTUAL COIN DUE * * & PUSHES THE DAILY TOTAL OVER THE INPATIENT LIMIT * *-------------------------------------------------------------* IF H-TOTAL > H-IP-LIMIT COMPUTE H-SHIFT = H-SHIFT + H-TOTAL - H-IP-LIMIT END-IF *-------------------------------------------------------------* * CALCULATE THE ADJUSTED NATIONAL COIN FOR THE DRUG LINE BY * * DEDUCTING THE AMT THAT EXCEEDS THE INPATIENT LIMIT * *-------------------------------------------------------------* COMPUTE A-ADJ-COIN (LN-SUB) = A-ADJ-COIN (LN-SUB) - H-SHIFT *-------------------------------------------------------------* * ADD DRUG COIN AMT THAT EXCEEDS IP LIMIT TO LINE REIM AMT * * SET RETURN CODE TO INDICATE DAILY COINSURANCE LIMITATION * *-------------------------------------------------------------* COMPUTE A-LITEM-REIM (LN-SUB) = A-LITEM-REIM (LN-SUB) + H-SHIFT MOVE 22 TO A-RETURN-CODE (LN-SUB) END-IF. 7840-PROCESS-TYPE2-EXIT. EXIT. *************************************************************** * * * END OF CLAIM PROCESSING * * * * 1. MOVE TOTAL CLAIM CHARGE AMOUNT. * * 2. MOVE TOTAL CLAIM PAYMENT AMOUNT. * * 3. MOVE TOTAL CLAIM BLOOD PINTS USED. * * 4. CALCULATE CLAIM LEVEL OUTLIER AMOUNT. * * * *************************************************************** 7900-END-PRICE-RTN. MOVE H-TOT-CHRG TO A-TOT-CLM-CHRG. MOVE H-TOT-PYMT TO A-TOT-CLM-PYMT. *-------------------------------------------------------------* * NUMBER OF BLOOD PINTS USED FOR BLOOD DEDUCTIBLES ON CLAIM = * * INITIAL NUMBER OF BLOOD PINTS ALLOWED FOR DEDUCTIBLES - * * BLOOD PINTS STILL LEFT AFTER PROCESSING BLOOD DEDUCTIBLES * *-------------------------------------------------------------* COMPUTE A-BLOOD-PINTS-USED = H-BENE-BLOOD-PINTS - H-BENE-PINTS-USED. IF H-OUTLIER-PYMT > 0 MOVE H-OUTLIER-PYMT TO A-OUTLIER-PYMT. 7900-END-PRICE-RTN-EXIT. EXIT. ****************************************************************** ****************************************************************** *** *** ** ** ** OUTPATIENT PROSPECTIVE PAYMENT SYSTEM PRICER ** ** -------------------------------------------- ** ** SECTION 8000 FOR CALENDAR YEAR 2009 PROCESSING ** ** SERVICE FROM DATES: 1/1/2009 - 12/31/2009 ** ** ** *** *** ****************************************************************** ****************************************************************** ****************************************************************** * * * PRICING PROCESS OVERVIEW * * ------------------------ * * * * 1. GET RATES & OTHER INFORMATION FOR THE CLAIM * * 2. VALIDATE CLAIM * * 3. VALIDATE SERVICE LINES (INCLUDING DATA FROM THE OCE) * * 4. GET RATES & OTHER INFORMATION FOR THE SERVICE LINES * * 5. ACCUMULATE NON-PRIME LINE CHARGES FOR COMPOSITE APCS * * 6. ACCUMULATE PACKAGED MENTAL HEALTH CHARGES * * 7. ORDER THE SERVICE LINES IN THE SEQUENCE IN WHICH * * DEDUCTIBLES WILL BE APPLIED * * 8. ORDER BLOOD LINES IN THE SEQUENCE IN WHICH DEDUCTIBLES * * WILL BE APPLIED * * 9. CALCULATE SERVICE LINE PAYMENTS * * 10. CALCULATE DEDUCTIBLE AMOUNT APPLIED TO EACH SERVICE LINE * * 11. CALCULATE BLOOD DEDUCTIBLE AMOUNT APPLIED TO EACH BLOOD * * DEDUCTIBLE LINE * * 12. CALCULATE BENEFICIARY MAXIMUM (IP LIMIT), NATIONAL, * * MINIMUM, & REDUCED COINSURANCE FOR EACH SERVICE LINE * * 13. CALCULATE REIMBURSEMENT FOR EACH SERVICE LINE * * 14. ADJUST LINE CHARGES FOR ARTIFICAL, PACKAGED, COMPOSITE, * * AND MENTAL HEALTH CHARGES OF APPLICABLE PROCEDURES. ALSO, * * ADJUST LINE CHARGES AND PAYMENTS FOR PASS-THROUGH DEVICES * * FOR ELIGIBLE PROCEDURES. ALL ADJUSTMENTS ARE DONE FOR * * OUTLIER DETERMINATION ONLY. * * 15. CALCULATE OUTLIER PAYMENT FOR ELIGIBLE SERVICE LINES * * 16. APPLY THE DAILY INPATIENT LIMIT IN CALCULATING THE * * COINSURANCE TO BE PAID BY THE BENEFICIARY FOR DRUG LINES; * * ADD ANY COINSURANCE AMOUNT THAT EXCEEDS THE INPATIENT * * LIMIT TO THE DRUG LINE'S REIMBURSEMENT * * 17. ACCUMULATE CLAIM TOTALS * * 18. MOVE FINAL SERVICE LINE AMOUNTS TO AREA TO BE PASSED BACK * * * ****************************************************************** 8000-PROCESS-MAIN-NEW. ***************************************************************** * * * STEP 1 - INITIALIZE & SET WORKING-STORAGE VARIABLES, ASSIGN * * ------ CBSA & WAGE INDEX, PERFORM CLAIM DATE EDITS, SET * * INPATIENT DAILY COINSURANCE LIMIT (SET ANNUALLY) * * * ***************************************************************** PERFORM 8100-INIT THRU 8100-INIT-EXIT. *--------------------------------------------------------* * SET ERROR CODE IF THE WAGE INDEX = 0 * *--------------------------------------------------------* IF H-WINX1 = 0 AND A-CLM-RTN-CODE = 01 MOVE 51 TO A-CLM-RTN-CODE. *--------------------------------------------------------* * IF THE CLAIM HAS ERROR(S), STOP PROCESSING * *--------------------------------------------------------* IF A-CLM-RTN-CODE >= 50 GOBACK. *--------------------------------------------------------* * MOVE WAGE INDEX TO VARIABLE TO BE PASSED BACK * *--------------------------------------------------------* MOVE H-WINX1 TO A-WINX. ***************************************************************** * * * STEP 2 - SET CLAIM FLAGS WHEN CERTAIN CODES ARE FOUND * * ------ (LOOP THROUGH THE CLAIM) * * * * - PHP-APC-FLAG - PARTIAL HOSPITALIZATION CLAIM (0172 & 0173)* * - APC34-FLAG - MENTAL HEALTH CLAIM * * - PTD-FLAG - PASS-THROUGH DEVICE(S) ON CLAIM * * - PTRADIO-CLAIM-FLAG - PASS-THROUGH RADIOPAHARM(S) ON CLAIM * * * * - DISABLED CY 2009: C1820-OFFSET-FLAG - DEVICE OFFSET CLAIM * * * ***************************************************************** PERFORM 8125-INIT THRU 8125-INIT-EXIT VARYING LN-SUB FROM 1 BY 1 UNTIL LN-SUB > OPPS-LINE-CNT. ***************************************************************** * * * STEP 3 - VALIDATE CLAIM LINES, CALCULATE LINE DISCOUNTS & * * ------ OFFSETS, ACCUMULATE CLAIM TOTALS, SET FLAGS, * * POPULATE COINSURANCE & BLOOD DEDUCTIBLE TABLES * * WITH VALID SERVICE LINES, POPULATE COMPOSITE APC * * TABLE WITH NON-PRIME COMPOSITE LINE CHARGES, * * CALCULATE TOTAL PACKAGED MENTAL HEALTH CHARGES, * * CREATE PASS-THROUGH DEVICE TABLE, AND CREATE * * CREATE NUCLEAR MEDICINE APC TABLE FOR PASS-THROUGH * * RADIOPHARMACEUTICAL OFFSET * * (LOOP THROUGH THE CLAIM) * * * ***************************************************************** *--------------------------------------------------------* * EMPTY TABLES FOR NEW CLAIM * *--------------------------------------------------------* MOVE 0 TO W-DCP-MAX W-BLD-MAX W-CMP-MAX W-PTD-MAX W-NUCMED-MAX. PERFORM 8150-INIT THRU 8150-INIT-EXIT VARYING LN-SUB FROM 1 BY 1 UNTIL LN-SUB > OPPS-LINE-CNT. *--------------------------------------------------------* * CALCULATE RATIO OF BLOOD PRODUCT CHARGES TO TOTAL * * BLOOD CHARGES (PRODUCT & STORAGE/PROCESSING) * *--------------------------------------------------------* IF H-TOT-38X-39X > 0 COMPUTE H-38X-39X-RATE ROUNDED = H-TOT-38X / H-TOT-38X-39X. *--------------------------------------------------------* * CALCULATE TOTAL OFFSET AMT FOR PT RADIOPHARM LINE(S) * * (# OF UNITS SUMMED LIMITED TO THE LESSER OF THE # OF * * PT RADIOPHARM HCPCS & THE # OF NUCLEAR MEDICINE UNITS)* *--------------------------------------------------------* IF W-NUCMED-MAX > 0 SET W-NUCMED-INDX TO 1 PERFORM UNTIL (W-NUCMED-INDX > W-NUCMED-MAX) OR (W-NUCMED-INDX > H-PTRADIO-HCPCS-CNT) COMPUTE H-NUCMED-TOT-OFFSET ROUNDED = H-NUCMED-TOT-OFFSET + W-NUCMED-WAGE-ADJ-OFFSET (W-NUCMED-INDX) SET W-NUCMED-INDX UP BY 1 END-PERFORM END-IF. ***************************************************************** * * * STEP 4 - ACCUMULATE TOTAL CLAIM CHARGES FROM DEVICE LINES * * ------ (FOR DEVICES, SERVICE INDICATOR = H) * * (LOOP THROUGH THE COINSURANCE DEDUCTIBLE TABLE) * * * ***************************************************************** MOVE 0 TO W-DCP-MAX. PERFORM 8555-CALC-H-TOT THRU 8555-CALC-H-TOT-EXIT VARYING W-LP-INDX FROM 1 BY 1 UNTIL W-LP-INDX > W-LNC-MAX. ***************************************************************** * * * STEP 5 - CALCULATE LINE PAYMENTS, DEDUCTIBLES, COINSURANCE, * * ------ & REIMBURSEMENT, ACCUMULATE CLAIM TOTALS, POPULATE * * DRUG COINSURANCE TABLE, POPULATE PASS-THROUGH * * DEVICE TABLE WITH ELIGIBLE PROCEDURE DATA AND * * DEVICE LINE ITEM PAYMENT, AND MOVE LINE ITEM * * VALUES TO VARIABLES TO BE PASSED BACK * * (LOOP THROUGH THE COINSURANCE DEDUCTIBLE TABLE) * * * ***************************************************************** *--------------------------------------------------------* * POINT TO 1ST RECORD IN THE BLOOD DEDUCTIBLE TABLE * *--------------------------------------------------------* SET W-BD-INDX TO 1. *--------------------------------------------------------* * CLEAR THE DRUG COINSURANCE TABLE * *--------------------------------------------------------* MOVE 0 TO W-DCP-MAX. PERFORM 8400-CALCULATE THRU 8400-CALCULATE-EXIT VARYING W-LP-INDX FROM 1 BY 1 UNTIL W-LP-INDX > W-LNC-MAX. ***************************************************************** * * * STEP 6 - ADJUST PROCEDURE LINE CHARGES FOR ARTIFICIAL * * ------ CHARGES, PACKAGING, COMPOSITES, MENTAL HEALTH, AND * * PASS-THROUGH DEVICES, AND CALCULATE OUTLIER * * PAYMENTS * * (LOOP THROUGH THE COINSURANCE DEDUCTIBLE TABLE) * * * ***************************************************************** PERFORM 8600-ADJ-CHRG-OUTL THRU 8600-ADJ-CHRG-OUTL-EXIT VARYING W-LP-INDX FROM 1 BY 1 UNTIL W-LP-INDX > W-LNC-MAX ***************************************************************** * * * STEP 7 - CALCULATE THE COINSURANCE & REIMBURSEMENT AMOUNTS * * ------ FOR STATUS INDICATOR G & K LINES. THE DAILY INPA- * * TIENT COINSURANCE LIMIT IS APPLIED USING THE WAGE * * ADJUSTED COINSURANCE OF EACH DAY'S MOST EXPENSIVE * * PROCEDURE OR VISIT. * * (LOOP THROUGH THE DRUG COINSURANCE TABLE) * * * ***************************************************************** IF GJK-FLAG = 'Y' PERFORM 8800-ADJ-STV-REIM THRU 8800-ADJ-STV-REIM-EXIT VARYING W-DCP-INDX FROM 1 BY 1 UNTIL W-DCP-INDX > W-DCP-MAX ELSE NEXT SENTENCE. ***************************************************************** * * * STEP 8 - MOVE CLAIM TOTAL CHARGES, PAYMENTS, BLOOD PINTS * * ------ USED, AND OUTLIER PAYMENTS TO VARIABLES TO BE * * PASSED BACK. CALCULATE BLOOD PINTS USED. * * * ***************************************************************** PERFORM 8900-END-PRICE-RTN THRU 8900-END-PRICE-RTN-EXIT. 8000-PROCESS-MAIN-NEW-EXIT. EXIT. *************************************************************** * * * INITIALIZE WORKING STORAGE HOLD AREAS AND ADDITIONAL * * VARIABLES TO BE PASSED BACK TO THE STANDARD SYSTEM, * * ASSIGN CLAIM CBSA AND WAGE INDEX, & PERFORM DATE EDITS * * * * ** CHANGE EVERY JANUARY: * * - INPATIENT DAILY COINSURANCE LIMIT (H-IP-LIMIT) * * - CAL-VERSION * * * *************************************************************** * * * ERROR RETURN CODES: * * ------------------- * * - IF PROVIDER SPECIFIC FILE WAGE INDEX RECLASSIFICATION * * CODE INVALID OR MISSING * * - MOVE '52' TO CLAIM LEVEL RETURN CODE * * - DISCONTINUE CLAIM PROCESSING * * - IF SERVICE FROM DATE NOT NUMERIC OR < 20000801 * * - MOVE '53' TO CLAIM LEVEL RETURN CODE * * - DISCONTINUE CLAIM PROCESSING * * - IF SERVICE FROM DATE < PROVIDER EFFECTIVE DATE * * - MOVE '54' TO CLAIM LEVEL RETURN CODE * * - DISCONTINUE CLAIM PROCESSING * * - IF SERVICE FROM DATE > PROVIDER TERMINATION DATE * * - MOVE '54' TO CLAIM LEVEL RETURN CODE * * - DISCONTINUE CLAIM PROCESSING * * * *************************************************************** 8100-INIT. *-------------------------------------------------------------* * INITIALIZE CLAIM RETURN CODE (01 = CLAIM PROCESSED) * *-------------------------------------------------------------* MOVE 01 TO A-CLM-RTN-CODE. *-------------------------------------------------------------* * INITIALIZE CLAIM AND LINE VARIABLES * *-------------------------------------------------------------* * 11/05/2007 - PHP-HCPCS-FLAG & MH-HCPCS-FLAG ADDED * * 11/06/2007 - BRACHY-APC-FLAG ADDED * * 11/13/2007 - BLD-DEDUC-HCPCS-FLAG ADDED * * 11/28/2007 - APC34-FLAG ADDED * * 12/27/2007 - RADIOPH-APC-FLAG ADDED * * 02/11/2008 - PTD-FLAG, PTD-LINE-FLAG, PTD-PROC-FLAG ADDED * * 11/03/2008 - APC33-FLAG REPLACED BY PHP-APC-FLAG * * 11/12/2008 - BRACHY-APC-FLAG REMOVED, NOT USED FOR CY 2009 * * 02/09/2009 - PTRADIO-CLAIM-FLAG, PTRADIO-LINE-FLAG ADDED * *-------------------------------------------------------------* MOVE 'N' TO PHP-APC-FLAG GJK-FLAG ST0-FLAG N-FLAG C-FLAG C1820-OFFSET-FLAG PHP-HCPCS-FLAG MH-HCPCS-FLAG APC34-FLAG RADIOPH-APC-FLAG PTD-FLAG PTD-LINE-FLAG PTD-PROC-FLAG BLD-DEDUC-HCPCS-FLAG PTRADIO-CLAIM-FLAG PTRADIO-LINE-FLAG. MOVE SPACE TO A-MSA A-CBSA BILL14X-FLAG. MOVE ZERO TO A-OUTLIER-PYMT A-TOTAL-CLM-DEDUCT A-TOT-CLM-CHRG A-TOT-CLM-PYMT A-BLOOD-DEDUCT-DUE A-BLOOD-PINTS-USED A-WINX W-LNC-MAX. INITIALIZE H-ADDITIONAL-VARIABLES. INITIALIZE LINE-HOLD-ITEMS. INITIALIZE T-LITEM-PYMT. *-------------------------------------------------------------* * VALIDATE CLAIM & PSF DATES * *-------------------------------------------------------------* IF L-SERVICE-FROM-DATE NOT NUMERIC MOVE 53 TO A-CLM-RTN-CODE GO TO 8100-INIT-EXIT ELSE IF L-SERVICE-FROM-DATE < L-PSF-EFFDT MOVE 54 TO A-CLM-RTN-CODE GO TO 8100-INIT-EXIT ELSE IF L-PSF-TERMDT > 0 IF L-SERVICE-FROM-DATE > L-PSF-TERMDT MOVE 54 TO A-CLM-RTN-CODE GO TO 8100-INIT-EXIT END-IF END-IF. *-------------------------------------------------------------* * UPDATE CAL-VERSION EVERY JANUARY * *-------------------------------------------------------------* MOVE CAL-VERSION8 TO A-CALC-VERS. *-------------------------------------------------------------* * RECEIVE BENEFICIARY SPECIFIC ITEMS FROM THE OCE * *-------------------------------------------------------------* MOVE BENE-DEDUCT TO H-BENE-DEDUCT. MOVE BENE-BLOOD-PINTS TO H-BENE-BLOOD-PINTS H-BENE-PINTS-USED. *-------------------------------------------------------------* * GET TO PROPER APC DATE BY SERVICE DATE (STARTING AT THE * * LATEST EFFECTIVE DATE IN THE APC DATE TABLE) * *-------------------------------------------------------------* MOVE WAD-MAX TO WAD-SUB. PERFORM UNTIL L-SERVICE-FROM-DATE NOT < WAD-DATE (WAD-SUB) SUBTRACT 1 FROM WAD-SUB END-PERFORM. *-------------------------------------------------------------* * DETERMINE WHICH CBSA TO USE & WHETHER TO USE THE SPECIAL * * WAGE INDEX IN THE PSF, AND SET THE INPATIENT DAILY * * COINSURANCE LIMIT (IN 2 PLACES; CHANGE EVERY JANUARY) * *-------------------------------------------------------------* IF L-PSF-SPEC-PYMT-IND = 'Y' MOVE L-PSF-WI-CBSA TO H-PSF-CBSA ELSE IF L-PSF-SPEC-PYMT-IND = ' ' MOVE L-PSF-GEO-CBSA TO H-PSF-CBSA ELSE IF L-PSF-SPEC-PYMT-IND = '1' OR '2' MOVE L-PSF-GEO-CBSA TO H-PSF-CBSA A-CBSA MOVE L-PSF-SPEC-WGIDX TO H-WINX1 MOVE 1068 TO H-IP-LIMIT GO TO 8100-INIT-EXIT ELSE MOVE 52 TO A-CLM-RTN-CODE GO TO 8100-INIT-EXIT. IF H-PSF-CBSA = SPACE MOVE 52 TO A-CLM-RTN-CODE GO TO 8100-INIT-EXIT. MOVE 1068 TO H-IP-LIMIT. *-------------------------------------------------------------* * APPLY WAGE INDEX FLOOR POLICY * * UPDATE WITH NEW FLOOR PARAGRAPH EVERY JANUARY * *-------------------------------------------------------------* PERFORM 8120-FLOOR-2009 THRU 8120-FLOOR-2009-EXIT. *-------------------------------------------------------------* * APPLY SECTION 401 WAGE INDEX POLICY * * UPDATE WITH NEW SECTION 401 PARAGRAPH EVERY JANUARY * *-------------------------------------------------------------* PERFORM 8120-SEC401-2009 THRU 8120-SEC401-2009-EXIT. *-------------------------------------------------------------* * GET THE CBSA WAGE INDEX VALUE (IF NOT ALREADY OVERRIDDEN * * BY THE PSF SPECIAL WAGE INDEX VALUE) * *-------------------------------------------------------------* MOVE H-PSF-CBSA TO A-CBSA. IF H-WINX1 = 0 PERFORM 8200-CALC-WAGEINDX THRU 8200-CALC-WAGEINDX-EXIT. 8100-INIT-EXIT. EXIT. *************************************************************** * * * NEW CY 2009 FLOOR FOR CBSA WAGE INDEX * * IPPS PRICER PGM FLOORS TAKEN FROM: IPDRV094 * * * *************************************************************** * * * SYNC ALL OF THE FOLLOWING WITH INPATIENT. * * SEE IPPS PRICER MAINTAINER. * * * * * SPECIAL NOTES * * * ------------- * * 1) INPATIENT MOVES 'N' TO P-NEW-CBSA-SPEC-PAY-IND * * OPPS MOVES ' ' TO L-PSF-SPEC-PYMT-IND * * * * 2) INPATIENT CHECKS P-NEW-CBSA-SPEC-PAY-IND = 'Y' * * OPPS CHECKS L-PSF-SPEC-PYMT-IND = 'Y' * * * * 3) INPATIENT CHECKS VALUE OF HOLD-PROV-CBSA * * OPPS CHECKS VALUE OF H-PSF-CBSA * * * * 4) INPATIENT MOVES THE STATE CBSA TO HOLD-PROV-CBSA * * OPPS MOVES THE STATE CBSA TO H-PSF-CBSA * * * * 5) INPATIENT CHECKS P-NEW-STATE * * OPPS CHECKS L-PSF-PROV-ST * * * * 6) ADD SINGLE QUOTES AROUND L-PSF-PROV-ST VALUES * * * * * * BE SURE TO MAKE THESE SIX CHANGES EVERY JANUARY * * * *************************************************************** 8120-FLOOR-2009. 292000 IF H-PSF-CBSA = ' 04' 292100 AND L-PSF-SPEC-PYMT-IND = 'Y' 292200 AND L-PSF-PROV-ST = '04' 292300 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 292400 MOVE ' 04' TO H-PSF-CBSA. 292500 292600 IF H-PSF-CBSA = ' 04' 292700 AND L-PSF-SPEC-PYMT-IND = 'Y' 292800 AND L-PSF-PROV-ST = '19' 292900 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 293000 MOVE ' 19' TO H-PSF-CBSA. 293100 293200 IF H-PSF-CBSA = ' 14' 293300 AND L-PSF-SPEC-PYMT-IND = 'Y' 293400 AND L-PSF-PROV-ST = '14' 293500 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 293600 MOVE ' 14' TO H-PSF-CBSA. 293700 293800 IF H-PSF-CBSA = ' 14' 293900 AND L-PSF-SPEC-PYMT-IND = 'Y' 294000 AND L-PSF-PROV-ST = '26' 294100 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 294200 MOVE ' 26' TO H-PSF-CBSA. 294300 294400 IF H-PSF-CBSA = '10900' 294500 AND L-PSF-PROV-ST = '31' 294600 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 294700 MOVE ' 31' TO H-PSF-CBSA. 294800 294900 IF H-PSF-CBSA = '19340' 295000 AND L-PSF-PROV-ST = '16' 295100 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 295200 MOVE ' 16' TO H-PSF-CBSA. 295300 295400 IF H-PSF-CBSA = '21780' 295500 AND L-PSF-SPEC-PYMT-IND = 'Y' 295600 AND L-PSF-PROV-ST = '15' 295700 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 295800 MOVE ' 15' TO H-PSF-CBSA. 295900 296000 IF H-PSF-CBSA = '22020' 296100 AND L-PSF-SPEC-PYMT-IND = 'Y' 296200 AND L-PSF-PROV-ST = '43' 296300 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 296400 MOVE ' 43' TO H-PSF-CBSA. 296500 296600 IF H-PSF-CBSA = '22900' 296700 AND L-PSF-PROV-ST = '37' 296800 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 296900 MOVE ' 37' TO H-PSF-CBSA. 297000 297100 IF H-PSF-CBSA = '24580' 297200 AND L-PSF-SPEC-PYMT-IND = 'Y' 297300 AND L-PSF-PROV-ST = '52' 297400 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 297500 MOVE ' 52' TO H-PSF-CBSA. 297600 297700 IF H-PSF-CBSA = '25540' 297800 AND L-PSF-SPEC-PYMT-IND = 'Y' 297900 AND L-PSF-PROV-ST = '07' 298000 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 298100 MOVE ' 07' TO H-PSF-CBSA. 298200 298300 IF H-PSF-CBSA = '28420' 298400 AND L-PSF-SPEC-PYMT-IND = 'Y' 298500 AND L-PSF-PROV-ST = '50' 298600 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 298700 MOVE ' 50' TO H-PSF-CBSA. 298800 298900 IF H-PSF-CBSA = '28700' 299000 AND L-PSF-PROV-ST = '44' 299100 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 299200 MOVE ' 44' TO H-PSF-CBSA. 299300 299400 IF H-PSF-CBSA = '28700' 299500 AND L-PSF-PROV-ST = '49' 299600 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 299700 MOVE ' 49' TO H-PSF-CBSA. 299800 299900 IF H-PSF-CBSA = '28700' 300000 AND L-PSF-SPEC-PYMT-IND = 'Y' 300100 AND L-PSF-PROV-ST = '18' 300200 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 300300 MOVE ' 18' TO H-PSF-CBSA. 300400 300500 IF H-PSF-CBSA = '28700' 300600 AND L-PSF-SPEC-PYMT-IND = 'Y' 300700 AND L-PSF-PROV-ST = '44' 300800 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 300900 MOVE ' 44' TO H-PSF-CBSA. 301000 301100 IF H-PSF-CBSA = '28940' 301200 AND L-PSF-SPEC-PYMT-IND = 'Y' 301300 AND L-PSF-PROV-ST = '18' 301400 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 301500 MOVE ' 18' TO H-PSF-CBSA. 301600 301700 IF H-PSF-CBSA = '28940' 301800 AND L-PSF-SPEC-PYMT-IND = 'Y' 301900 AND L-PSF-PROV-ST = '44' 302000 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 302100 MOVE ' 44' TO H-PSF-CBSA. 302200 302300 IF H-PSF-CBSA = '34820' 302400 AND L-PSF-SPEC-PYMT-IND = 'Y' 302500 AND L-PSF-PROV-ST = '34' 302600 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 302700 MOVE ' 34' TO H-PSF-CBSA. 302800 302900 IF H-PSF-CBSA = '34820' 303000 AND L-PSF-SPEC-PYMT-IND = 'Y' 303100 AND L-PSF-PROV-ST = '42' 303200 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 303300 MOVE ' 42' TO H-PSF-CBSA. 303400 303500 IF H-PSF-CBSA = '37620' 303600 AND L-PSF-PROV-ST = '36' 303700 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 303800 MOVE ' 36' TO H-PSF-CBSA. 303900 304000 IF H-PSF-CBSA = '37964' 304100 AND L-PSF-SPEC-PYMT-IND = 'Y' 304200 AND L-PSF-PROV-ST = '31' 304300 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 304400 MOVE ' 31' TO H-PSF-CBSA. 304500 304600 IF H-PSF-CBSA = '38340' 304700 AND L-PSF-SPEC-PYMT-IND = 'Y' 304800 AND L-PSF-PROV-ST = '47' 304900 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 305000 MOVE ' 47' TO H-PSF-CBSA. 305100 305200 IF H-PSF-CBSA = '41620' 305300 AND L-PSF-SPEC-PYMT-IND = 'Y' 305400 AND L-PSF-PROV-ST = '29' 305500 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 305600 MOVE ' 29' TO H-PSF-CBSA. 305700 305800 IF H-PSF-CBSA = '43580' 305900 AND L-PSF-PROV-ST = '16' 306000 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 306100 MOVE ' 16' TO H-PSF-CBSA. 306200 306300 IF H-PSF-CBSA = '48540' 306400 AND L-PSF-PROV-ST = '36' 306500 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 306600 MOVE ' 36' TO H-PSF-CBSA. 306700 306800 IF H-PSF-CBSA = '48540' 306900 AND L-PSF-PROV-ST = '51' 307000 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 307100 MOVE ' 51' TO H-PSF-CBSA. 307200 307300 IF H-PSF-CBSA = '48864' 307400 AND L-PSF-PROV-ST = '31' 307500 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 307600 MOVE ' 31' TO H-PSF-CBSA. 307700 307800 IF H-PSF-CBSA = '48864' 307900 AND L-PSF-SPEC-PYMT-IND = 'Y' 308000 AND L-PSF-PROV-ST = '31' 308100 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 308200 MOVE ' 31' TO H-PSF-CBSA. 308300 308400 IF H-PSF-CBSA = '19060' 308500 AND L-PSF-PROV-ST = '21' 308600 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 308700 MOVE ' 21' TO H-PSF-CBSA. 308800 308900 IF H-PSF-CBSA = '19060' 309000 AND L-PSF-PROV-ST = '51' 309100 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 309200 MOVE ' 51' TO H-PSF-CBSA. 309300 309400 IF H-PSF-CBSA = '22020' 309500 AND L-PSF-PROV-ST = '24' 309600 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 309700 MOVE ' 24' TO H-PSF-CBSA. 309800 309900 IF H-PSF-CBSA = '24220' 310000 AND L-PSF-PROV-ST = '24' 310100 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 310200 MOVE ' 24' TO H-PSF-CBSA. 310300 310400 IF H-PSF-CBSA = '30300' 310500 AND L-PSF-PROV-ST = '50' 310600 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 310700 MOVE ' 50' TO H-PSF-CBSA. 310800 310900 IF H-PSF-CBSA = '48260' 311000 AND L-PSF-PROV-ST = '36' 311100 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 311200 MOVE ' 36' TO H-PSF-CBSA. 8120-FLOOR-2009-EXIT. EXIT. *************************************************************** * * * NEW CY 2009 SECTION 401 HOSPITALS * * IPPS PRICER PGM SECTION 401S TAKEN FROM: IPDRV094 * * * *************************************************************** * * * SYNC ALL OF THE FOLLOWING WITH INPATIENT. * * SEE IPPS PRICER MAINTAINER. * * * * * SPECIAL NOTES * * * ------------- * * 1) INPATIENT CHECKS P-NEW-PROVIDER-NO * * OPPS CHECKS L-PSF-PROV-OSCAR * * * * 2) INPATIENT MOVES THE STATE CBSA TO HOLD-PROV-CBSA * * AND P-NEW-CBSA-STAND-AMT-LOC * * OPPS MOVES THE STATE CBSA TO H-PSF-CBSA ONLY * * * * 3) DELETE THE P-NEW-CBSA-STAND-AMT-LOC LINES * * * * BE SURE TO MAKE THESE THREE CHANGES EVERY JANUARY * * * *************************************************************** 8120-SEC401-2009. 385200 385300 IF (L-PSF-PROV-OSCAR = '040118') 385400 MOVE ' 04' TO H-PSF-CBSA. 385600 385700 IF (L-PSF-PROV-OSCAR = '234202' OR 385800 '329008' OR '040140') 385900 MOVE ' 05' TO H-PSF-CBSA. 386100 386200 IF (L-PSF-PROV-OSCAR = '070004' OR 386300 '070036') 386400 MOVE ' 07' TO H-PSF-CBSA. 386600 386700 IF (L-PSF-PROV-OSCAR = '100048' OR 386800 '100118' OR '100134') 386900 MOVE ' 10' TO H-PSF-CBSA. 387100 387200 IF (L-PSF-PROV-OSCAR = '140167') 387300 MOVE ' 14' TO H-PSF-CBSA. 387500 387600 IF (L-PSF-PROV-OSCAR = '170137') 387700 MOVE ' 17' TO H-PSF-CBSA. 387900 388000 IF (L-PSF-PROV-OSCAR = '180038') 388100 MOVE ' 18' TO H-PSF-CBSA. 388300 388400 IF (L-PSF-PROV-OSCAR = '220051') 388500 MOVE ' 22' TO H-PSF-CBSA. 388700 388800 IF (L-PSF-PROV-OSCAR = '230078') 388900 MOVE ' 23' TO H-PSF-CBSA. 389100 389200 IF (L-PSF-PROV-OSCAR = '250017') 389300 MOVE ' 25' TO H-PSF-CBSA. 389500 389600 IF (L-PSF-PROV-OSCAR = '260006' OR '260047' OR '260195') 389700 MOVE ' 26' TO H-PSF-CBSA. 389900 390000 IF (L-PSF-PROV-OSCAR = '330235' OR '330268') 390100 MOVE ' 33' TO H-PSF-CBSA. 390300 390400 IF (L-PSF-PROV-OSCAR = '360125') 390500 MOVE ' 36' TO H-PSF-CBSA. 390700 390800 IF (L-PSF-PROV-OSCAR = '370054') 390900 MOVE ' 37' TO H-PSF-CBSA. 391100 391200 IF (L-PSF-PROV-OSCAR = '380040') 391300 MOVE ' 38' TO H-PSF-CBSA. 391500 391600 IF (L-PSF-PROV-OSCAR = '390130' OR '390183' OR 391700 '390233') 391800 MOVE ' 39' TO H-PSF-CBSA. 392000 392100 IF (L-PSF-PROV-OSCAR = '440135') 392200 MOVE ' 44' TO H-PSF-CBSA. 392400 392500 IF (L-PSF-PROV-OSCAR = '450052' OR '450078' OR 392600 '450243' OR '450348') 392700 MOVE ' 45' TO H-PSF-CBSA. 392900 393000 IF (L-PSF-PROV-OSCAR = '490116') 393100 MOVE ' 49' TO H-PSF-CBSA. 393300 393400 IF (L-PSF-PROV-OSCAR = '500148') 393500 MOVE ' 50' TO H-PSF-CBSA. 8120-SEC401-2009-EXIT. EXIT. *************************************************************** * * * LOOP THROUGH ALL CLAIM LINES TO FIND AN APC / HCPCS * * * * - SET FLAG IF APC = 0172/0173 (FOR PARITAL HOSPITALIZATION)* * - SET FLAG IF APC = 0034 (FOR MENTAL HEALTH CHARGES) * * (NEW FOR CY 2008 - ADDED 11/28/2007) * * - SET FLAG IF PASS-THROUGH DEVICE(S) ON CLAIM * * (NEW FOR CY 2008 - ADDED 02/11/2008) * * - SET FLAG IF PASS-THROUGH RADIOPHARMS(S) ON CLAIM * * (NEW FOR APRIL CY 2009 - ADDED 02/10/2009) * * * * - DISABLED: SET FLAG IF HCPCS = C1820 (FOR DEVICE OFFSETS) * * * *-------------------------------------------------------------* * * * 11/03/2008 - CHANGED PARTIAL HOSPITALIZATION HCPCS FROM * * 0033 TO 0172 & 0173 FOR CY 2009 * * * * 11/12/2008 - HCPCS C1820 EXPIRED FROM PASS-THROUGH STATUS * * DECEMBER 2007, OFFSET FLAG LOGIC DISABLED * * * *************************************************************** 8125-INIT. *-------------------------------------------------------------* * FLAG CLAIM WHEN AT LEAST 1 LINE HAS A PHP APC * *-------------------------------------------------------------* IF OPPS-APC (LN-SUB) = '0172' OR OPPS-APC (LN-SUB) = '0173' MOVE 'Y' TO PHP-APC-FLAG. *-------------------------------------------------------------* * FLAG CLAIM WHEN AT LEAST 1 LINE HAS APC 0034 * *-------------------------------------------------------------* IF OPPS-APC (LN-SUB) = '0034' MOVE 'Y' TO APC34-FLAG. *-------------------------------------------------------------* * FOR CY 2009, NO HCPCS HAVE PASS-THROUGH STATUS * *-------------------------------------------------------------* * IF OPPS-HCPCS (LN-SUB) = 'C1820' * MOVE 'Y' TO C1820-OFFSET-FLAG. *-------------------------------------------------------------* * FLAG CLAIM WHEN AT LEAST ONE LINE IS A PASS-THROUGH DEVICE * *-------------------------------------------------------------* PERFORM 8665-SET-PTD-LINE-FLAG THRU 8665-SET-PTD-LINE-FLAG-EXIT. IF PTD-LINE-FLAG = 'Y' MOVE 'Y' TO PTD-FLAG END-IF. *-------------------------------------------------------------* * FLAG CLAIM WHEN AT LEAST 1 LINE IS PASS-THROUGH RADIOPHARM * * AND ACCUMULATE TOTAL PT RADIOPHARM LINES & CHARGES * *-------------------------------------------------------------* PERFORM 8680-SET-PTRADIO-LINE-FLAG THRU 8680-SET-PTRADIO-LINE-FL-EXIT. IF PTRADIO-LINE-FLAG = 'Y' MOVE 'Y' TO PTRADIO-CLAIM-FLAG ADD 1 TO H-PTRADIO-HCPCS-CNT MOVE OPPS-SUB-CHRG (LN-SUB) TO H-SUB-CHRG COMPUTE H-PTRADIO-TOT-CHRGS ROUNDED = H-PTRADIO-TOT-CHRGS + H-SUB-CHRG END-IF. *-------------------------------------------------------------* * FLAG CLAIM WHEN ALL LINES HAVE A HCPCS BETWEEN 80000-89999 * * INCLUSIVE (LAB CODES), INDICATES BILL TYPE 14X * * 05/09/2011 - LOGIC ADDED * *-------------------------------------------------------------* IF (OPPS-HCPCS (LN-SUB) >= '80000' AND <= '89999') IF BILL14X-FLAG NOT = 'N' MOVE 'Y' TO BILL14X-FLAG END-IF ELSE MOVE 'N' TO BILL14X-FLAG END-IF. 8125-INIT-EXIT. EXIT. *************************************************************** * * * VALIDATE CLAIM LINES, CALCULATE LINE DISCOUNTS & OFFSETS, * * ACCUMULATE CLAIM TOTALS, SET FLAGS, POPULATE COINSURANCE & * * BLOOD DEDUCTIBLE TABLES WITH VALID SERVICE LINES, POPULATE * * COMPOSITE APC TABLE WITH NON-PRIME COMPOSITE LINE CHARGES, * * AND CALCULATE TOTAL PACKAGED MENTAL HEALTH CHARGES. * * CREATE PASS-THROUGH DEVICE TABLE (NEW FOR CY 2008 QTR 2). * * * * ** UPDATE PARTIAL HOSPITALIZATION (PHP) & MENTAL HEALTH * * (MH) TABLE REFERENCES EVERY JANUARY * * * *************************************************************** * * * VALIDATION RULES & RETURN CODES: * * -------------------------------- * * * * 1. VERIFY THE SERVICE INDICATOR PASSED BY THE OCE * * - IF INVALID SET RETURN CODE TO '40' * * - DISCONTINUE LINE PROCESSING * * - IF VALID SET RETURN CODE TO '01' * * - CONTINUE LINE PROCESSING * * 2. PROCESS LINES AND LOAD WORK TABLE ACCORDING TO PRICE * * RANKING * * 3. CHECK OCE EDIT INDICATORS AND SET RETURN CODES IF * * INDICATORS ARE INVALID. * * - VALID RETURN CODES FOR EDIT INDICATORS * * - '41' - SERVICE INDICATOR INVALID FOR OPPS PRICER * * - '42' - APC = '00000' OR (PACKAGING FLAG = 1, 2,OR 4)* * - '43' - PAYMENT INDICATOR NOT = TO 1 OR 5 THRU 9 * * - '44' - SERVICE INDICATOR = 'H' BUT PAYMENT * * INDICATOR NOT = TO 6 * * - '45' - PACKAGING FLAG NOT = TO 0, 1, 2, 3, OR 4 * * - '46' - (LINE ITEM DENIAL/REJECT FLAG NOT = TO 0 * * OR LINE ITEM DENIAL/REJECT FLAG = TO 1 * * AND (NOT A PARTIAL HOSPITALIZATION OR * * MENTAL HEALTH HCPCS)) * * OR LINE ITEM ACTION FLAG NOT = TO 1 * * - '47' - LINE ITEM ACTION FLAG = 2 OR 3 * * - '48' - PAYMENT ADJUSTMENT FLAG NOT VALID * * - '49' - SITE OF SERVICE FLAG NOT = TO 0 * * - OR (PARTIAL HOSP. APC IS NOT ON THE CLAIM * * AND SERVICE INDICATOR = 'P' * * OR PARTIAL HOSPITALIZATION HCPCS) * * 4. IF OCE INDICATORS ARE VALID, SEARCH APC TABLE * * - IF MISSING, DELETED OR INVALID APC * * - SET RETURN CODE TO '30' * * - DISCONTINUE LINE PROCESSING * * * *************************************************************** 8150-INIT. *************************************************************** * INITIALIZE LINE RETURN CODE TO VALID VALUE * *************************************************************** MOVE 01 TO A-RETURN-CODE (LN-SUB). *************************************************************** * OVERRIDE SERVICE UNITS FOR APC 0339 - EFFECTIVE 04/01/2002 * *************************************************************** IF OPPS-APC (LN-SUB) = '0339' MOVE 1 TO OPPS-SRVC-UNITS (LN-SUB). *************************************************************** * CALCULATE DISCOUNT RATE (FOR REDUCED COIN & OFFSET CALCS) * *************************************************************** MOVE OPPS-SRVC-UNITS (LN-SUB) TO H-SRVC-UNITS. PERFORM 8250-CALC-DISCOUNT THRU 8250-CALC-DISCOUNT-EXIT. IF A-RETURN-CODE (LN-SUB) = 42 GO TO 8150-INIT-EXIT. *************************************************************** * FLAG LINE IF THE LINE APC IS A RADIOPHARM APC * * ** NEW LIST EVERY JANUARY ** * *************************************************************** * 11/13/2008 - LOGIC ADDED B/C THERAP. RADIO. LINES MUST BE * * EXCLUDED FROM SI=H DEVICE UNIT CALCULATION * *-------------------------------------------------------------* PERFORM 8660-SET-RADIOPH-APC-FLAG THRU 8660-SET-RADIOPH-APC-FLAG-EXIT. *************************************************************** * ACCUMULATE TOTAL CLAIM DEVICE SERVICE UNITS -AND- * * FLAG CLAIMS THAT HAVE AT LEAST ONE DEVICE LINE * * - SI = H IDENTIFIES DEVICE LINES * * - EFFECTIVE AS OF 04-01-2002 * *************************************************************** IF OPPS-SRVC-IND (LN-SUB) = ' H' AND RADIOPH-APC-FLAG = 'N' MOVE 'Y' TO C-FLAG COMPUTE H-TOT-HTD-UNITS = H-TOT-HTD-UNITS + H-SRVC-UNITS. *************************************************************** * ACCUMULATE CLAIM TOTAL OFFSET AMOUNT & OFFSET UNITS * * WHEN PASS-THROUGH/OFFSET DEVICE APPEARS ON THE CLAIM * *-------------------------------------------------------------* * - HCPCS C1820 EXPIRES FROM PASS-THRU PMT 01-01-2008. THERE * * ARE NO OFFSET DEVICES FOR CY 2008; LOGIC RETAINED & ALL * * OFFSET AMOUNTS IN OFFSET TABLE SET TO $0. * * - THERE ARE NO PASS-THROUGH/OFFSET DEVICES FOR CY 2009 * * C1820-OFFSET-FLAG ALWAYS = 'N', OFFSET LOGIC NOT * * NEVER PERFORMED, RETAINED FOR FUTURE USE * *************************************************************** IF C1820-OFFSET-FLAG = 'Y' PERFORM 8160-TOTAL-OFFSET THRU 8160-TOTAL-OFFSET-EXIT. *************************************************************** * CREATE NUCLEAR MEDICINE APC TABLE FOR PASS-THROUGH * * RADIOPHARM OFFSET WHEN PASS-THROUGH RADIOPHARM(S) ON CLAIM * *-------------------------------------------------------------* * - HCPCS C1820 EXPIRES FROM PASS-THRU PMT 01-01-2008. THERE * * ARE NO OFFSET DEVICES FOR CY 2008; LOGIC RETAINED & ALL * * OFFSET AMOUNTS IN OFFSET TABLE SET TO $0. * * - THERE ARE NO PASS-THROUGH/OFFSET DEVICES FOR CY 2009 * * C1820-OFFSET-FLAG ALWAYS = 'N', OFFSET LOGIC NOT * * NEVER PERFORMED, RETAINED FOR FUTURE USE * *************************************************************** IF PTRADIO-CLAIM-FLAG = 'Y' PERFORM 8165-PROCESS-NUCLEAR-MED THRU 8165-PROCESS-NUCLEAR-MED-EXIT. *************************************************************** * SET AND INTIALIZE LINE SPECIFIC DATA ITEMS * *************************************************************** *-------------------------------------------------------------* * SET COIN & BLOOD DEDUCTIBLE TABLES UP FOR CURRENT LINE * *-------------------------------------------------------------* SET W-LP-INDX TO LN-SUB. SET W-BD-INDX TO LN-SUB. INITIALIZE W-LP-ENTRY (W-LP-INDX). INITIALIZE W-BD-ENTRY (W-BD-INDX). *-------------------------------------------------------------* * INITIALIZE LINE ITEM VARIABLES TO BE PASSED BACK * *-------------------------------------------------------------* MOVE ZERO TO A-LITEM-PYMT (LN-SUB) A-LITEM-REIM (LN-SUB) A-ADJ-COIN (LN-SUB) A-RED-COIN (LN-SUB) A-TOTAL-LN-DEDUCT (LN-SUB) A-BLOOD-LN-DEDUCT (LN-SUB). *-------------------------------------------------------------* * INITIALIZE LINE FLAGS * *-------------------------------------------------------------* * 11/05/2007 - PHP-HCPCS-FLAG & MH-HCPCS-FLAG ADDED * *-------------------------------------------------------------* MOVE 'N' TO PHP-HCPCS-FLAG MH-HCPCS-FLAG. *************************************************************** * SEARCH PARTIAL HOSPITALIZATION (PHP) TABLE FOR LINE HCPCS * * (LOGIC NEW FOR CY2008; ADDED 11/5/2007) * *************************************************************** SEARCH ALL PHP-ENTRY9 AT END MOVE 'N' TO PHP-HCPCS-FLAG WHEN PHP-HCPCS9 (PHP-INDX9) = OPPS-HCPCS (LN-SUB) MOVE 'Y' TO PHP-HCPCS-FLAG. *************************************************************** * SEARCH MENTAL HEALTH (MH) TABLE FOR LINE HCPCS * * (LOGIC NEW FOR CY2008; ADDED 11/5/2007) * *************************************************************** SEARCH ALL MH-ENTRY9 AT END MOVE 'N' TO MH-HCPCS-FLAG WHEN MH-HCPCS9 (MH-INDX9) = OPPS-HCPCS (LN-SUB) MOVE 'Y' TO MH-HCPCS-FLAG. *************************************************************** * POPULATE PASS-THROUGH DEVICE TABLE W/ PASS-THROUGH * * DEVICE LINE DATA * *************************************************************** IF A-RETURN-CODE (LN-SUB) = 01 AND PTD-FLAG = 'Y' AND OPPS-SRVC-IND (LN-SUB) = ' H' AND RADIOPH-APC-FLAG = 'N' PERFORM 8665-SET-PTD-LINE-FLAG THRU 8665-SET-PTD-LINE-FLAG-EXIT IF PTD-LINE-FLAG = 'Y' MOVE OPPS-HCPCS (LN-SUB) TO W-PTD-LINE-HCPCS PERFORM 8390-PASS-THRU-DEVICES THRU 8390-PASS-THRU-DEVICES-EXIT END-IF END-IF. *************************************************************** * * * ** CHECK LINE OCE VALUES FOR VALIDITY ** * * * *************************************************************** *************************************************************** * IDENTIFY ALL VALID SERVICE INDICATORS (SI) & RETURN * * ERROR CODE 40 IF THE SI IS INVALID. * *************************************************************** IF NOT (OPPS-SRVC-IND (LN-SUB) = ' A' OR ' B' OR ' C' OR ' E' OR ' F' OR ' G' OR ' H' OR ' K' OR ' L' OR ' N' OR ' P' OR ' R' OR ' S' OR ' T' OR ' U' OR ' V' OR ' X' OR ' W' OR ' Y' OR ' Z' OR ' M') THEN MOVE 40 TO A-RETURN-CODE (LN-SUB) GO TO 8150-INIT-EXIT ELSE MOVE 01 TO A-RETURN-CODE (LN-SUB). *************************************************************** * IDENTIFY SERVICE INDICATORS (SI) NOT VALID FOR THE OPPS * * PRICER & RETURN ERROR CODE 41 IF THE SI IS INVALID * * FOR THE OPPS PRICER. * *************************************************************** IF OPPS-SRVC-IND (LN-SUB) = ' A' OR ' B' OR ' C' OR ' E' OR ' F' OR ' L' OR ' W' OR ' Y' OR ' Z' OR ' M' MOVE 41 TO A-RETURN-CODE (LN-SUB) GO TO 8150-INIT-EXIT. *************************************************************** ** ** ** NOTE: ERROR CODES FOR THE VALIDATION RULES BELOW ARE ** ** ASSIGNED IN THE ELSE STATMENTS AFTER THE APC ** ** TABLE SEARCH. ** ** ** *************************************************************** *************************************************************** * IDENTIFY VALID PAYMENT INDICATORS & RETURN ERROR CODE 43 * * IF THE PAYMENT INDICATOR IS INVALID. * *************************************************************** IF OPPS-PYMT-IND (LN-SUB) = ' 1' OR ' 5' OR ' 6' OR ' 7' OR ' 8' OR ' 9' *************************************************************** * IDENTIFY VALID PACKAGING FLAGS & RETURN ERROR CODE 45 * * IF THE PACKAGING FLAG IS INVALID. * *************************************************************** IF OPPS-PKG-FLAG (LN-SUB) = '0' OR '1' OR '2' OR '3' OR '4' *************************************************************** * IDENTIFY VALID LINE ITEM DENIAL OR REJECTION (D/R) FLAGS * * AND VALID D/R FLAG-HCPCS COMBINATIONS & RETURN ERROR CODE * * 46 IF THE D/R FLAG OR D/R FLAG-HCPCS COMBO IS INVALID. * *-------------------------------------------------------------* * 11/6/2007 - CHANGED PHP/MENTAL HEALTH CODES LISTED FROM * * APCS TO HCPCS (VIA TABLE SEARCH) FOR CY 2008 * *************************************************************** *--------------------------------------------------------* * LINE IS NOT DENIED OR REJECTED * *--------------------------------------------------------* IF ( OPPS-LITEM-DR-FLAG (LN-SUB) = '0' OR *--------------------------------------------------------* * LINE IS DENIED OR REJECTED AND HAS A PHP OR MH HCPCS * *--------------------------------------------------------* OPPS-LITEM-DR-FLAG (LN-SUB) = '1' AND ( PHP-HCPCS-FLAG = 'Y' OR MH-HCPCS-FLAG = 'Y' ) ) OR *--------------------------------------------------------* * LINE ITEM DENIAL/REJECTION CODE IS IGNORED * *--------------------------------------------------------* ( OPPS-LITEM-ACT-FLAG (LN-SUB) = '1' ) *************************************************************** * IDENTIFY INVALID LINE ITEM ACTION FLAGS & RETURN ERROR * * CODE 47 IF THE LINE ITEM ACTION FLAG IS INVALID. * *************************************************************** IF NOT (OPPS-LITEM-ACT-FLAG (LN-SUB) EQUAL '2' OR '3') *************************************************************** * IDENTIFY VALID PAYMENT ADJUSTMENT FLAGS (PAF) & RETURN * * ERROR CODE 48 IF THE PAF IS INVALID. * *-------------------------------------------------------------* * 10/31/2007 - ADDED ' 8' AS A VALID PAF FOR CY 2008 * * 12/06/2007 - ADDED PAFS 91 - 99 FOR COMPOSITES FOR CY 2008 * * 11/03/2008 - REMOVED PAFS 91 - 99 FOR COMPOSITES FOR CY 2009* *************************************************************** IF OPPS-PYMT-ADJ-FLAG (LN-SUB) = ' 0' OR ' 1' OR ' 2' OR ' 3' OR ' 4' OR ' 5' OR ' 6' OR ' 7' OR ' 8' *************************************************************** * IDENTIFY VALID SITE OF SERVICE (SOS) FLAG AND CASES * * WHERE THE SOS FLAG IS IGNORED & RETURN ERROR CODE 49 IF * * THE SOS FLAG IS INVALID AND NOT IGNORED. * * * * ** SITE OF SERVICE FLAG = PAYMENT METHOD FLAG IN OCE ** * * * * NOTE: PHP = PARTIAL HOSPITALIZATION * * WHEN SI = 'P', PHP APC IS ON THE CURRENT LINE * *-------------------------------------------------------------* * 11/06/2007 - CHANGED PHP HEALTH CODES LISTED FROM * * APCS TO HCPCS (VIA TABLE SEARCH) FOR CY 2008 * * 11/03/2008 - CHANGED PARTIAL HOSPITALIZATION APC FROM * * 0033 TO 0172 & 0173 FOR CY 2009, FLAG CHANGED * * FROM APC33-FLAG TO PHP-APC-FLAG * *************************************************************** *-------------------------------------------------------------* * LINE SOS FLAG IS VALID * *-------------------------------------------------------------* IF (OPPS-SITE-SRVC-FLAG (LN-SUB) = '0') OR *-------------------------------------------------------------* * LINE SOS FLAG INVALID & PHP APC ON CLAIM - CHECK FURTHER * *-------------------------------------------------------------* ( (PHP-APC-FLAG = 'Y') AND *-------------------------------------------------------------* * LINE SOS FLAG INVALID, PHP APC ON CLAIM, & LINE APC IS PHP* *-------------------------------------------------------------* ( (OPPS-SRVC-IND (LN-SUB) = ' P') OR *-------------------------------------------------------------* * LINE SOS FLAG INVALID, PHP APC ON CLAIM, & LINE PHP HCPCS * *-------------------------------------------------------------* (PHP-HCPCS-FLAG = 'Y') ) ) *************************************************************** * * * ** ACCUMULATE TOTAL CHARGES OF ALL LINES THAT PASS ** * * ** VALIDATION RULES ** * * * *************************************************************** MOVE OPPS-SUB-CHRG (LN-SUB) TO H-SUB-CHRG COMPUTE H-TOT-CHRG = H-TOT-CHRG + H-SUB-CHRG *-------------------------------------------------------------* * EXCLUDE LINES THAT RECEIVE EXTERNAL LINE ITEM ADJ. * *-------------------------------------------------------------* IF OPPS-LITEM-ACT-FLAG (LN-SUB) = '4' COMPUTE H-TOT-CHRG = H-TOT-CHRG - H-SUB-CHRG END-IF *-------------------------------------------------------------* * ACCUMULATE PACKAGED LINE TOTAL CHARGES & SET CLAIM N-FLAG * * EXCLUDE ALL PACKAGED COMPOSITE LINES * *-------------------------------------------------------------* * 11/28/2007 - LOGIC ADDED TO EXCLUDE COMPOSITE & MENTAL * * HEALTH LINES (APC34-FLAG INDICATES MH) * * 08/08/2008 - LOGIC CORRECTED TO ADD CHARGES OF PACKAGED * * LINES WITH A PACKAGING FLAG OF '1' OR '4' TO * * THE CLAIM'S TOTAL DISTRIBUTED PACKAGED * * CHARGES WHEN A CLAIM HAS APC 34 (MENTAL * * HEALTH) ON IT - EFFECTIVE RETROCTIVE TO * * JANUARY 1, 2008. * * 11/12/2008 - CHANGED LOGIC THAT EXCLUDES ALL COMPOSITE * * LINES & MENTAL HEALTH PKG LINES TO USE THE * * COMPOSITE ADJUSTMENT FLAG INSTEAD OF PAYMENT * * ADJUSTMENT FLAG VALUES 91 - 99 * *-------------------------------------------------------------* IF (OPPS-PKG-FLAG (LN-SUB) = '1' OR '2' OR '4') AND (OPPS-COMP-ADJ-FLAG (LN-SUB) = '00') COMPUTE H-TOT-N-CHRG = H-SUB-CHRG + H-TOT-N-CHRG MOVE 'Y' TO N-FLAG END-IF *-------------------------------------------------------------* * ACCUMULATE PACKAGED MENTAL HEALTH LINE CHARGES * *-------------------------------------------------------------* * 11/28/2007 - LOGIC ADDED FOR CY 2008 * * 11/12/2008 - LOGIC DISABLED B/C MENTAL HEALTH COMPOSITE * * LINES ARE NOW IDENTIFIED WITH THE COMPOSITE * * ADJUSTMENT FLAG JUST AS ALL OTHER COMPOSITES * * (MENTAL HEALTH COMPOSITE LINES NOW HAVE A * * PACKAGING FLAG OF '1' (CY 2009) * *-------------------------------------------------------------* * IF (APC34-FLAG = 'Y') AND * (OPPS-SRVC-IND (LN-SUB) = ' N') AND * (OPPS-PKG-FLAG (LN-SUB) = '1') * COMPUTE H-TOT-MH-CHRG = H-SUB-CHRG + * H-TOT-MH-CHRG * END-IF *-------------------------------------------------------------* * ACCUMULATE NON-PRIME (PACKAGED) COMPOSITE APC CHARGES * * FOR EACH COMPOSITE APC BY THE COMPOSITE ADJUSTMENT FLAG * * (POPULATE COMPOSITE TABLE) * *-------------------------------------------------------------* * 11/28/2007 - LOGIC ADDED FOR CY 2008 * * 11/12/2007 - LOGIC REVISED FOR CY 2009 TO IDENTIFY ALL * * COMPOSITE LINES USING THE COMPOSITE * * ADJUSTMENT FLAG INSTEAD OF PAYMENT * * ADJUSTMENT FLAG VALUES 91 - 99 * * (INCLUDES PROCESSING FOR MENTAL HEALTH * * COMPOSITES) * *-------------------------------------------------------------* IF OPPS-COMP-ADJ-FLAG (LN-SUB) NOT = "00" AND OPPS-COMP-ADJ-FLAG (LN-SUB) NOT = " " AND OPPS-SRVC-IND (LN-SUB) = ' N' PERFORM 8170-COMPOSITES THRU 8170-COMPOSITES-EXIT END-IF *-------------------------------------------------------------* * RETURN ERROR CODE WHEN PACKAGED LINE OR LINE APC = 0000 * *-------------------------------------------------------------* IF (OPPS-APC (LN-SUB) = '0000') OR (OPPS-PKG-FLAG (LN-SUB) = '1' OR '2' OR '4') MOVE 42 TO A-RETURN-CODE (LN-SUB) GO TO 8150-INIT-EXIT END-IF *************************************************************** * * * ** LOOK-UP LINE APC IN APC TABLE FOR ALL LINES THAT ** * * ** PASS VALIDATION RULES ** * * * *************************************************************** SEARCH ALL WAA-ENTRY AT END MOVE 30 TO A-RETURN-CODE (LN-SUB) GO TO 8150-INIT-EXIT WHEN WAA-APC (WAA-INDX) = OPPS-GRP (LN-SUB) *-------------------------------------------------------------* * START SEARCH AT THE APC'S MOST CURRENT RECORD * *-------------------------------------------------------------* MOVE WAA-PTR (WAA-INDX) TO W-SUB2 *-------------------------------------------------------------* * GET APC DATA FROM THE REC WITH THE CORRECT EFFECTIVE DATE * *-------------------------------------------------------------* PERFORM 8175-APC-LOOKUP *-------------------------------------------------------------* * REDUCE APC PMT BY REDUCED UPDATE RATIO WHEN APPROPRIATE * * 11/13/2009 - NEW FOR CY 2009 * *-------------------------------------------------------------* PERFORM 8180-REDUCE-APC-PYMT THRU 8180-REDUCE-APC-PYMT-EXIT *************************************************************** * * * ** RETURN ERROR CODE AND STOP PROCESSING LINES ** * * ** THAT FAIL OCE VALIDATION RULES ** * * * *************************************************************** ELSE MOVE 49 TO A-RETURN-CODE (LN-SUB) GO TO 8150-INIT-EXIT ELSE MOVE 48 TO A-RETURN-CODE (LN-SUB) GO TO 8150-INIT-EXIT ELSE MOVE 47 TO A-RETURN-CODE (LN-SUB) GO TO 8150-INIT-EXIT ELSE MOVE 46 TO A-RETURN-CODE (LN-SUB) GO TO 8150-INIT-EXIT ELSE MOVE 45 TO A-RETURN-CODE (LN-SUB) GO TO 8150-INIT-EXIT ELSE MOVE 43 TO A-RETURN-CODE (LN-SUB) GO TO 8150-INIT-EXIT. *************************************************************** * PROCESS BLOOD DEDUCTIBLE (EFFECTIVE AS OF 07-01-2005) * * - TOTAL BLOOD CODE CHARGES WHEN PAF = '5' OR '6' * * 5: BLOOD/BLOOD PRODUCT USED IN BLOOD DEDUC CALC * * 6: BLOOD PROCESS/STORAGE (LABOR) NOT SBJ TO BLD DEDUC * *************************************************************** IF OPPS-PYMT-ADJ-FLAG (LN-SUB) = ' 5' COMPUTE H-TOT-38X = OPPS-SUB-CHRG (LN-SUB) + H-TOT-38X. IF OPPS-PYMT-ADJ-FLAG (LN-SUB) = ' 5' OR ' 6' COMPUTE H-TOT-38X-39X = OPPS-SUB-CHRG (LN-SUB) + H-TOT-38X-39X. *************************************************************** * POPULATE COINSURANCE DEDUCTIBLE TABLE W/ ALL VALID LINES * * ORDERED LOWEST TO HIGHEST RANK FROM APC TABLE * *************************************************************** IF A-RETURN-CODE (LN-SUB) = 01 OR 11 PERFORM 8300-COIN-DEDUCT THRU 8300-COIN-DEDUCT-EXIT. *************************************************************** * POPULATE BLOOD DEDUCTIBLE TABLE W/ BLOOD DEDUC LINES * * ORDERED EARLIEST TO LATEST DATE OF SERVICE AND THEN * * LOWEST TO HIGHEST RANK FROM BLOOD DEDUCTIBLE TABLE * * (APPLIES WHEN HCPCS IS IN BLOOD DEDUCTIBLE RANKING TABLE) * * * * 05/11/2009 - ADDED THE REQUIREMENT PAF = 5 OR 6 TO BLOOD * * DEDUCTIBLE LOGIC TO CORRECT PRICING ERROR. * * FIX EFFECTIVE RETROACTIVE TO 01/01/2009. * *************************************************************** IF A-RETURN-CODE (LN-SUB) = 01 OR 11 SET W9BD-INDX TO 1 SEARCH W9BD-ENTRY VARYING W9BD-INDX AT END GO TO 8150-INIT-EXIT WHEN W-2009-BLOOD-HCPCS (W9BD-INDX) = OPPS-HCPCS (LN-SUB) IF OPPS-PYMT-ADJ-FLAG (LN-SUB) = (' 5' OR ' 6') MOVE W-2009-BLOOD-RANK (W9BD-INDX) TO H-BLOOD-RANK MOVE OPPS-LITEM-DOS (LN-SUB) TO H-BLD-DOS PERFORM 8375-BLOOD-DEDUCT THRU 8375-BLOOD-DEDUCT-EXIT END-IF. 8150-INIT-EXIT. EXIT. *************************************************************** * * * ACCUMULATE CLAIM TOTAL OFFSET AMT FROM CURRENT OFFSET TABLE * * FOR PASS-THRU ITEMS * * * *************************************************************** * * * - SEARCH TABLE OPPSOF08 FOR LINE APC. * * - CALCULATE TOTAL OFFSET & TOTAL OFFSET UNITS IF APC * * OFFSET AMOUNT IN TABLE NOT EQUAL TO 0. * * * NOTE: C1820 EXPIRES FROM PASS-THRU PAYMENT IN 2008. * * ALL OFFSET AMOUNTS IN THE 2008 TABLE = $0. * * THIS LOGIC KEPT FOR FUTURE OFFSET CODES. * * * * EFFECTIVE AS OF 01-01-2003 * * - CONTINUE FOR 01-01-2004 * * - CONTINUE FOR 01-01-2005 * * - CONTINUE FOR 01-01-2006 * * - CONTINUE FOR 01-01-2007 * * - CONTINUE FOR 01-01-2008 (ALL OFFSETS IN TBL = $0) * * - CONTINUE FOR 01-01-2009 (ALL OFFSETS IN TBL = $0) * * * *************************************************************** 8160-TOTAL-OFFSET. MOVE OPPS-GRP (LN-SUB) TO W-OFF-APC. SEARCH ALL WOO-ENTRY8 AT END GO TO 8160-TOTAL-OFFSET-EXIT WHEN WOO-APC8 (WOO-INDX8) = W-OFF-APC PERFORM 8161-TOTAL-OFFSET-AMT THRU 8161-TOTAL-OFFSET-AMT-EXIT. 8160-TOTAL-OFFSET-EXIT. EXIT. *************************************************************** * * * ACCUMULATE CLAIM TOTAL OFFSET AND OFFSET UNITS * * * *************************************************************** 8161-TOTAL-OFFSET-AMT. IF WOO-OFFSET8 (WOO-INDX8) EQUAL 0 GO TO 8161-TOTAL-OFFSET-AMT-EXIT. COMPUTE H-TOTAL-OFFSET = H-TOTAL-OFFSET + (WOO-OFFSET8 (WOO-INDX8) * H-DISC-RATE * H-SRVC-UNITS). COMPUTE H-TOT-OFF-UNITS = H-TOT-OFF-UNITS + H-SRVC-UNITS. IF H-TOTAL-OFFSET < 0 MOVE 0 TO H-TOTAL-OFFSET. 8161-TOTAL-OFFSET-AMT-EXIT. EXIT. *************************************************************** * * * PROCESS LINES WITH A NUCLEAR MEDICINE APC FOR THE * * PASS-THROUGH RADIOPHARM OFFSET * * * *************************************************************** * * * - SEARCH TABLE PTROFFST FOR LINE APC & LINE YEAR * * - IF FOUND, ADD A RECORD TO TABLE W-NUCMED-APC-TBL * * FOR EVERY UNIT. * * * * 02/10/2009 - LOGIC ADDED EFFECTIVE STARTING APRIL 2009 * * * *************************************************************** 8165-PROCESS-NUCLEAR-MED. *-------------------------------------------------------------* * HOLD THE LINE'S APC, UNITS, & SERVICE FROM DATE * *-------------------------------------------------------------* MOVE OPPS-GRP (LN-SUB) TO W-NUCMED-LINE-APC. MOVE OPPS-SRVC-UNITS (LN-SUB) TO W-NUCMED-UNIT-CNT. MOVE OPPS-LITEM-DOS (LN-SUB) TO W-LINE-SRVC-DATE. *-------------------------------------------------------------* * SEARCH PT RADIOPHARM OFFSET TABLE FOR THE APC & YEAR * *-------------------------------------------------------------* SET PTRO-INDX TO 1. SEARCH PTRO-ENTRY AT END GO TO 8165-PROCESS-NUCLEAR-MED-EXIT *-------------------------------------------------------------* * WHEN APC & YEAR FOUND, WAGE ADJUST OFFSET & ADD NEW RECORD * * TO NUCLEAR MEDICINE TABLE FOR EVERY UNIT * *-------------------------------------------------------------* WHEN PTRO-NUCMED-APC (PTRO-INDX) = W-NUCMED-LINE-APC AND PTRO-EFF-YEAR (PTRO-INDX) = W-LINE-SRVC-YEAR MOVE PTRO-OFFSET-AMT (PTRO-INDX) TO W-NUCMED-OFFSET COMPUTE W-NUCMED-WA-OFFSET ROUNDED = W-NUCMED-OFFSET * (.6 * H-WINX1 + .4) PERFORM 8166-LOAD-NUCMED-TABLE THRU 8166-LOAD-NUCMED-TABLE-EXIT VARYING W-NUCMED-SUB FROM 1 BY 1 UNTIL W-NUCMED-SUB > W-NUCMED-UNIT-CNT. 8165-PROCESS-NUCLEAR-MED-EXIT. EXIT. *************************************************************** * * * LOAD A NUCLEAR MEDICINE APC TABLE RECORD FOR EVERY UNIT OF * * THE NUCLEAR MEDICINE LINE AND WAGE ADJUST 60% OF THE OFFSET * * (INSERT THE NEW RECORD IN THE CORRECT TABLE POSITION - * * HIGHEST TO LOWEST OFFSET) * * * *************************************************************** 8166-LOAD-NUCMED-TABLE. *-------------------------------------------------------------* * INCREASE THE TOTAL NUMBER OF TABLE RECORDS FOR NEW ENTRY * *-------------------------------------------------------------* ADD 1 TO W-NUCMED-MAX. *-------------------------------------------------------------* * MOVE TO THE NEW (LAST) ENTRY POSITION (EMPTY RECORD) * *-------------------------------------------------------------* SET W-NUCMED-INDX TO W-NUCMED-MAX. INITIALIZE W-NUCMED-APC-ENTRY (W-NUCMED-INDX). *-------------------------------------------------------------* * DETERMINE WHERE THE NEW NUCMED APC ENTRY FOR THE CURRENT * * SERVICE LINE SHOULD BE ENTERED INTO THE TABLE ACCORDING TO * * ITS OFFSET VALUE - HIGHEST TO LOWEST OFFSET * *-------------------------------------------------------------* PERFORM 8167-STAGE-NUCMED-ENTRY THRU 8167-STAGE-NUCMED-ENTRY-EXIT UNTIL W-NUCMED-INDX = 1 OR W-NUCMED-WA-OFFSET NOT > W-NUCMED-WAGE-ADJ-OFFSET (W-NUCMED-INDX - 1) *-------------------------------------------------------------* * POPULATE THE EMPTY RECORD WITH THE NEW SERVICE LINE'S DATA * *-------------------------------------------------------------* MOVE W-NUCMED-LINE-APC TO W-NUCMED-APC (W-NUCMED-INDX). MOVE W-NUCMED-WA-OFFSET TO W-NUCMED-WAGE-ADJ-OFFSET (W-NUCMED-INDX). 8166-LOAD-NUCMED-TABLE-EXIT. EXIT. *************************************************************** * * * MOVE THE EXISTING NUCMED APC RECORD WITH A HIGHER OFFSET * * DOWN ONE RECORD POSITION AND SET THE EMPTY RECORD FOR THE * * NEW ENTRY'S INDEX TO THE NEXT HIGHER RECORD POSITION. * * * *************************************************************** 8167-STAGE-NUCMED-ENTRY. MOVE W-NUCMED-APC-ENTRY (W-NUCMED-INDX - 1) TO W-NUCMED-APC-ENTRY (W-NUCMED-INDX). SET W-NUCMED-INDX DOWN BY 1. 8167-STAGE-NUCMED-ENTRY-EXIT. EXIT. *************************************************************** * * * ACCUMULATE NON-PRIME COMPOSITE APC CHARGES FOR EACH * * COMPOSITE APC USING PACKAGED LINES WITH COMPOSITE * * ADJUSTMENT FLAG NOT = '00' & POPULATE COMPOSITE APC TABLE * * * *************************************************************** * * * ORDER SERVICE LINES BY COMPOSITE ADJUSTMENT FLAG (CAF) - * * LOWEST TO HIGHEST FLAG VALUE (01 - NN) * * * * EACH NON-PRIME COMPOSITE PACKAGED LINE'S CHARGES ARE ADDED * * TO THE TOTAL NON-PRIME CHARGES FOR EACH CAF, WHICH * * CORRESPONDS TO THE PRIME LINE'S APC. THESE CHARGES ARE * * LATER ADDED TO THE PRIME LINE'S CHARGES TO CALCULATE THE * * OUTLIER PAYMENT. * * * * 11/28/2007 - LOGIC ADDED FOR CY 2008 * * 11/12/2008 - LOGIC REVISED FOR CY 2009 TO USE THE * * COMPOSITE ADJUSTMENT FLAG INSTEAD OF THE * * PAYMENT ADJUSTMENT FLAG, VARIABLE H-CMP-CAF * * HOLDS COMPOSITE ADJUSTMENT FLAG, VARIABLE * * W-CMP-PAF RETAINED AND NOW HOLDS THE CAF * * (RETAINED TO CONTINUE USE OF EXISTING TABLE) * * * *************************************************************** 8170-COMPOSITES. *-------------------------------------------------------------* * GET THE LINE'S COMPOSITE ADJUSTMENT FLAG FOR TABLE SEARCH * *-------------------------------------------------------------* MOVE OPPS-COMP-ADJ-FLAG (LN-SUB) TO H-CMP-CAF. *-------------------------------------------------------------* * ADD OR UPDATE COMPOSITE APC TABLE ENTRY FOR THE CAF * *-------------------------------------------------------------* PERFORM 8171-SEARCH-CAF THRU 8171-SEARCH-CAF-EXIT. 8170-COMPOSITES-EXIT. EXIT. *************************************************************** * * * DETERMINE WHETHER A NEW COMPOSITE APC TABLE RECORD SHOULD * * BE ADDED OR IF AN EXISITING RECORD NEEDS TO BE UPDATED * * * *************************************************************** 8171-SEARCH-CAF. *-------------------------------------------------------------* * SEARCH COMPOSITE APC TABLE STARTING AT ENTRY #1 * *-------------------------------------------------------------* SET W-CMP-INDX TO 1. SEARCH W-CMP-ENTRY VARYING W-CMP-INDX *-------------------------------------------------------------* * IF THE SERVICE LINE'S COMPOSITE ADJUSTMENT FLAG IS NOT * * ALREADY IN THE TABLE, ADD IT * *-------------------------------------------------------------* AT END PERFORM 8172-ADD-ENTRY THRU 8172-ADD-ENTRY-EXIT *-------------------------------------------------------------* * IF THE SERVICE LINE'S COMPOSITE ADJUSTMENT FLAG IS ALREADY * * IN THE TABLE, UPDATE THE ENTRY * *-------------------------------------------------------------* WHEN W-CMP-PAF (W-CMP-INDX) = H-CMP-CAF PERFORM 8173-UPDATE-ENTRY THRU 8173-UPDATE-ENTRY-EXIT. 8171-SEARCH-CAF-EXIT. EXIT. *************************************************************** * * * INSERT THE NEW COMPOSITE APC RECORD IN THE CORRECT POSITION * * (LOWEST TO HIGHEST CAF) OF THE COMPOSITE APC TABLE * * * *************************************************************** 8172-ADD-ENTRY. *-------------------------------------------------------------* * INCREASE THE TOTAL NUMBER OF TABLE RECORDS FOR NEW ENTRY * *-------------------------------------------------------------* ADD 1 TO W-CMP-MAX. *-------------------------------------------------------------* * MOVE TO THE NEW ENTRY POSITION (EMPTY RECORD) * *-------------------------------------------------------------* SET W-CMP-INDX TO W-CMP-MAX. *-------------------------------------------------------------* * DETERMINE WHERE THE NEW COMPOSITE APC ENTRY FOR THE CURRENT * * SERVICE LINE SHOULD BE ENTERED INTO THE TABLE ACCORDING TO * * ITS COMPOSITE ADJUSTMENT FLAG (CAF) - LOWEST TO HIGHEST CAF * *-------------------------------------------------------------* PERFORM 8174-STAGE-CMP-ENTRY THRU 8174-STAGE-CMP-ENTRY-EXIT UNTIL W-CMP-INDX = 1 OR H-CMP-CAF NOT < W-CMP-PAF (W-CMP-INDX - 1). *-------------------------------------------------------------* * POPULATE THE EMPTY RECORD WITH THE NEW SERVICE LINE'S DATA * *-------------------------------------------------------------* MOVE H-CMP-CAF TO W-CMP-PAF (W-CMP-INDX). MOVE H-SUB-CHRG TO W-CMP-TOT-SUB-CHRG (W-CMP-INDX). 8172-ADD-ENTRY-EXIT. EXIT. *************************************************************** * * * UPDATE THE EXISTING COMPOSITE APC RECORD WITH THE SAME * * COMPOSITE ADJUSTMENT FLAG OF THE CURRENT SERVICE LINE * * * *************************************************************** 8173-UPDATE-ENTRY. *-------------------------------------------------------------* * ACCUMULATE THE CAF'S TOTAL NON-PRIME SUBMITTED CHARGES * *-------------------------------------------------------------* ADD H-SUB-CHRG TO W-CMP-TOT-SUB-CHRG (W-CMP-INDX). 8173-UPDATE-ENTRY-EXIT. EXIT. *************************************************************** * * * MOVE THE EXISTING COMPOSITE APC RECORD WITH A HIGHER CAF * * UP ONE RECORD POSITION AND SET THE EMPTY RECORD FOR THE * * NEW ENTRY'S INDEX TO THE NEXT LOWER RECORD POSITION. * * * *************************************************************** 8174-STAGE-CMP-ENTRY. MOVE W-CMP-ENTRY (W-CMP-INDX - 1) TO W-CMP-ENTRY (W-CMP-INDX). SET W-CMP-INDX DOWN BY 1. 8174-STAGE-CMP-ENTRY-EXIT. EXIT. *************************************************************** * * * LOCATE THE APC RECORD WITH THE APPROPRIATE EFFECTIVE DATE * * - MOVE APC DATA TO HOLD AREA FOR PROCESSING WHEN FOUND * * - ADJUST TOTAL CHARGES FOR DELETED APCS & RETURN ERROR * * - RETURN ERROR WHEN USABLE EFFECTIVE DATE NOT FOUND * * * *************************************************************** 8175-APC-LOOKUP. *************************************************************** * APC RECORD EFFECTIVE DATE IS BEFORE OR ON THE LATEST * * EFFECTIVE DATE THE CLAIM CAN USE (SEARCH STARTS AT THE * * MOST CURRENT RECORD FOR THE APC) * *************************************************************** IF WAR-DTCD (W-SUB2) NOT > WAD-DTCD (WAD-SUB) *-------------------------------------------------------------* * APC RECORD EFFECTIVE DATE CORRECT, APC DELETED - ERROR * *-------------------------------------------------------------* IF WAR-RATEX (W-SUB2) = 'DELETED' MOVE 30 TO A-RETURN-CODE (LN-SUB) COMPUTE H-TOT-CHRG = H-TOT-CHRG - H-SUB-CHRG *-------------------------------------------------------------* * APC RECORD EFFECTIVE DATE CORRECT, APC ACTIVE - ACCEPT REC * *-------------------------------------------------------------* ELSE MOVE WAR-RATE (W-SUB2) TO H-APC-PYMT MOVE WAR-RANK (W-SUB2) TO H-RANK MOVE WAR-MINC (W-SUB2) TO H-MIN-COIN MOVE WAR-COIN (W-SUB2) TO H-NAT-COIN MOVE WAR-PPCT (W-SUB2) TO H-PPCT *************************************************************** * APC RECORD EFFECTIVE DATE IS AFTER THE LATEST EFFECTIVE * * DATE THE CLAIM CAN USE. GO TO THE PREVIOUS RECORD IN THE * * APC TABLE. * *************************************************************** ELSE SUBTRACT 1 FROM W-SUB2 *-------------------------------------------------------------* * PREVIOUS REC BELONGS TO THE LINE APC, TEST EFFECTIVE DATE * *-------------------------------------------------------------* IF W-SUB2 > WAA-PTR (WAA-INDX - 1) GO TO 8175-APC-LOOKUP *-------------------------------------------------------------* * THERE IS NO RECORD FOR THE LINE APC WITH AN ACCEPTABLE * * EFFECTIVE DATE FOR THE LINE. RETURN ZEROS. * *-------------------------------------------------------------* ELSE MOVE 0 TO H-APC-PYMT H-RANK H-MIN-COIN H-NAT-COIN H-PPCT. 8175-APC-LOOKUP-EXIT. EXIT. *************************************************************** * * * LOCATE THE APC RECORD WITH THE APPROPRIATE EFFECTIVE DATE * * - MOVE APC DATA TO HOLD AREA FOR PROCESSING WHEN FOUND * * - ADJUST TOTAL CHARGES FOR DELETED APCS & RETURN ERROR * * - RETURN ERROR WHEN USABLE EFFECTIVE DATE NOT FOUND * * * *************************************************************** 8180-REDUCE-APC-PYMT. *-------------------------------------------------------------* * SPECIFY LINES ELIGIBLE FOR REDUCTION * *-------------------------------------------------------------* IF ( L-PSF-HOSP-QUAL-IND = ' ' ) AND ( (OPPS-SRVC-IND (LN-SUB) = ' P') OR (OPPS-SRVC-IND (LN-SUB) = ' R') OR (OPPS-SRVC-IND (LN-SUB) = ' S' AND NOT (OPPS-GRP (LN-SUB) >= '01491' AND OPPS-GRP (LN-SUB) <= '01537')) OR (OPPS-SRVC-IND (LN-SUB) = ' T' AND NOT (OPPS-GRP (LN-SUB) >= '01539' AND OPPS-GRP (LN-SUB) <= '01574')) OR (OPPS-SRVC-IND (LN-SUB) = ' V') OR (OPPS-SRVC-IND (LN-SUB) = ' X') ) THEN COMPUTE H-APC-PYMT ROUNDED = H-APC-PYMT * 0.981 MOVE 11 TO A-RETURN-CODE (LN-SUB) END-IF. 8180-REDUCE-APC-PYMT-EXIT. EXIT. *************************************************************** * * * DELETED CODE: * * IF DATE OF SERVICE BETWEEN 12/31/2002 AND 04/01/2003 * * IF HCPCS CODE = C9114 OR C9115 ADJUST PAYMENT AND * * COINSURANCE AMOUNTS - LOGIC REMOVED FOR 20050101 * * * *************************************************************** *************************************************************** * * * SEARCH WAGE INDEX TABLE FOR THE CBSA IN THE PROVIDER * * SPECIFIC FILE (PSF) * * * *************************************************************** * * * IF CBSA NOT LOCATED * * - SET CLAIM RETURN CODE TO '50' * * - DISCONTINUE CLAIM PROCESSING * * IF WAGE INDEX EQUALS ZERO * * - SET CLAIM RETURN CODE TO '51' * * - DISCONTINUE CLAIM PROCESSING * * * *************************************************************** 8200-CALC-WAGEINDX. *************************************************************** * STARTING AT THE LAST DATE IN THE TABLE, SEARCH WAGE INDEX * * DATE TABLE FOR THE MOST CURRENT EFFECTIVE DATE THAT CAN BE * * USED BY THE CLAIM * *************************************************************** MOVE WCD-MAX TO WCD-SUB. PERFORM UNTIL L-SERVICE-FROM-DATE NOT < WCD-DATE (WCD-SUB) SUBTRACT 1 FROM WCD-SUB END-PERFORM. *************************************************************** * SEARCH CBSA TABLE FOR THE PSF CBSA * *************************************************************** SEARCH ALL WCM-ENTRY *-------------------------------------------------------------* * PSF CBSA NOT FOUND IN CBSA TABLE, RETURN ERROR * *-------------------------------------------------------------* AT END MOVE 50 TO A-CLM-RTN-CODE GO TO 8200-CALC-WAGEINDX-EXIT *-------------------------------------------------------------* * PSF CBSA FOUND IN CBSA TABLE * *-------------------------------------------------------------* WHEN WCM-CBSA (WCM-INDX) = H-PSF-CBSA *-------------------------------------------------------------* * START SEARCH AT THE MOST CURRENT RECORD FOR THE CBSA * *-------------------------------------------------------------* MOVE WCM-PTR (WCM-INDX) TO W-SUB3 *-------------------------------------------------------------* * GET WAGE INDEX FROM THE REC W/ THE CORRECT EFFECTIVE DATE * *-------------------------------------------------------------* PERFORM 8210-WAGE-LOOKUP. *-------------------------------------------------------------* * ADJUST THE WAGE INDEX BY THE APPROPRIATE STATE SPECIFIC * * RURAL FLOOR BUDGET NEUTRALILTY FACTOR (SSRFBN) * * 11/10/2008 - NEW FOR CY 2009 * *-------------------------------------------------------------* PERFORM 8220-APPLY-SSRFBN THRU 8220-EXIT. *************************************************************** * RETURN ERROR IF WAGE INDEX = 0 OR NOT NUMERIC * *************************************************************** IF H-WINX1 = 0 OR H-WINX1 NOT NUMERIC THEN MOVE 51 TO A-CLM-RTN-CODE. 8200-CALC-WAGEINDX-EXIT. EXIT. *************************************************************** * * * LOCATE THE CBSA RECORD WITH THE APPROPRIATE EFFECTIVE DATE * * WHEN FOUND, SELECT THE APPLICABLE WAGE INDEX VALUE * * * *************************************************************** 8210-WAGE-LOOKUP. *************************************************************** * WAGE INDEX RECORD EFFECTIVE DATE IS BEFORE OR ON THE * * LATEST EFFECTIVE DATE THE CLAIM CAN USE - CORRECT * * (SEARCH STARTS AT THE MOST CURRENT RECORD FOR THE CBSA) * *************************************************************** IF WCW-DTCD (W-SUB3) NOT > WCD-DTCD (WCD-SUB) *-------------------------------------------------------------* * THIS PROVIDER HAS RECLASSIFIED, USE THE WAGE INDEX IN THE * * SECOND COLUMN FOR RECLASSIFYING PROVIDERS. * *-------------------------------------------------------------* IF L-PSF-SPEC-PYMT-IND = 'Y' MOVE WCW-WINX2 (W-SUB3) TO H-WINX1 *-------------------------------------------------------------* * THIS PROVIDER HAS NOT RECLASSIFIED, USE THE WAGE INDEX IN * * THE FIRST COLUMN FOR AREA PROVIDERS. * *-------------------------------------------------------------* ELSE MOVE WCW-WINX1 (W-SUB3) TO H-WINX1 *************************************************************** * WAGE INDEX RECORD EFFECTIVE DATE IS AFTER LATEST EFFECTIVE * * DATE THE CLAIM CAN USE. GO TO THE PREVIOUS RECORD IN THE * * CBSA WAGE INDEX TABLE. * *************************************************************** ELSE SUBTRACT 1 FROM W-SUB3 *-------------------------------------------------------------* * PREVIOUS REC BELONGS TO THE PSF CBSA, TEST EFFECTIVE DATE * *-------------------------------------------------------------* IF W-SUB3 > WCM-PTR (WCM-INDX - 1) GO TO 8210-WAGE-LOOKUP *-------------------------------------------------------------* * THERE IS NO RECORD FOR THE PSF CBSA WITH AN ACCEPTABLE * * EFFECTIVE DATE FOR THE LINE. RETURN ZERO. * *-------------------------------------------------------------* ELSE MOVE 0 TO H-WINX1. 8210-WAGE-LOOKUP-EXIT. EXIT. *************************************************************** * * * ADJUST THE WAGE INDEX BY THE STATE SPECIFIC * * RURAL FLOOR BUDGET NEUTRALITY FACTOR (SSRFBN) * * (NEW FOR CY 2009) * * * *************************************************************** 8220-APPLY-SSRFBN. *-------------------------------------------------------------* * THE PROVIDER'S STATE IS THE SSRFBN TABLE SEARCH KEY; * * SEARCH SSRFBN TABLE FOR APPROPRIATE FACTOR * *-------------------------------------------------------------* MOVE L-PSF-PROV-ST TO MES-PPS-STATE. PERFORM 8225-FIND-SSRFBN THRU 8225-EXIT. *-------------------------------------------------------------* * ADJUST THE WAGE INDEX BY THE SSRFBN FACTOR FOUND IN THE TBL * *-------------------------------------------------------------* IF H-WINX1 NOT = 0 AND H-WINX1 IS NUMERIC AND A-CLM-RTN-CODE NOT = 51 COMPUTE H-WINX1 ROUNDED = H-WINX1 * MES-SSRFBN-RATE END-IF. 8220-EXIT. EXIT. *************************************************************** * * * FIND THE STATE SPECIFIC RURAL FLOOR BUDGET * * NEUTRALITY FACTOR (SSRFBN) * * (NEW FOR CY 2009) * * * *************************************************************** 8225-FIND-SSRFBN. *----------------------------------------------------------------* * SEARCH SSRFBN STARTING WITH THE FIRST RECORD * *----------------------------------------------------------------* SET SSRFBN-IDX09 TO 1. SEARCH SSRFBN-TAB VARYING SSRFBN-IDX09 *----------------------------------------------------------------* * PROVIDER STATE NOT FOUND IN SSRFBN TABLE, ASSIGN ERROR CODE * *----------------------------------------------------------------* AT END MOVE 51 TO A-CLM-RTN-CODE GO TO 8225-EXIT *----------------------------------------------------------------* * PROVIDER STATE FOUND, CAPTURE SSRFBN FACTOR * *----------------------------------------------------------------* WHEN WK-SSRFBN-STATE(SSRFBN-IDX09) = MES-PPS-STATE MOVE WK-SSRFBN-REASON-ALL (SSRFBN-IDX09) TO MES-SSRFBN. 8225-EXIT. EXIT. *************************************************************** * * * CALCULATE DISCOUNT RATE BASED ON THE DISCOUNT * * FACTOR PASSED BY THE OCE: VALUES 1 - 9 * * * * IF MISSING OR INVALID DISCOUNT FACTOR * * - SET RETURN CODE TO '38' * * - DISCONTINUE LINE PROCESSING * * * *************************************************************** * * * 11/1/2007 - NEW DISCOUNT INDICATOR 9 ADDED FOR CY 2008 * * * *************************************************************** 8250-CALC-DISCOUNT. IF (H-SRVC-UNITS = 0 AND OPPS-APC (LN-SUB) = '0000') MOVE 42 TO A-RETURN-CODE (LN-SUB) GO TO 8250-CALC-DISCOUNT-EXIT ELSE IF (H-SRVC-UNITS = 0 AND OPPS-APC (LN-SUB) > '0000') MOVE 1 TO H-SRVC-UNITS. IF OPPS-DISC-FACT (LN-SUB) = 1 THEN MOVE 1 TO H-DISC-RATE ELSE IF OPPS-DISC-FACT (LN-SUB) = 2 THEN COMPUTE H-DISC-RATE = (1 + DISC-FRACTION * (H-SRVC-UNITS - 1)) / H-SRVC-UNITS ELSE IF OPPS-DISC-FACT (LN-SUB) = 3 THEN COMPUTE H-DISC-RATE = TERM-PROC-DISC / H-SRVC-UNITS ELSE IF OPPS-DISC-FACT (LN-SUB) = 4 THEN COMPUTE H-DISC-RATE = (1 + DISC-FRACTION) / H-SRVC-UNITS ELSE IF OPPS-DISC-FACT (LN-SUB) = 5 THEN COMPUTE H-DISC-RATE = DISC-FRACTION ELSE IF OPPS-DISC-FACT (LN-SUB) = 6 THEN COMPUTE H-DISC-RATE = (TERM-PROC-DISC * DISC-FRACTION) / H-SRVC-UNITS ELSE IF OPPS-DISC-FACT (LN-SUB) = 7 THEN COMPUTE H-DISC-RATE = (DISC-FRACTION * (1 + DISC-FRACTION) / H-SRVC-UNITS) ELSE IF OPPS-DISC-FACT (LN-SUB) = 8 THEN MOVE 2 TO H-DISC-RATE ELSE IF OPPS-DISC-FACT (LN-SUB) = 9 THEN COMPUTE H-DISC-RATE = 1 / H-SRVC-UNITS ELSE MOVE 38 TO A-RETURN-CODE (LN-SUB). 8250-CALC-DISCOUNT-EXIT. EXIT. *************************************************************** * * * POPULATE COINSURANCE DEDUCTIBLE TABLE WITH SERVICE LINES * * * *************************************************************** * * * ORDER SERVICES LINES BY THE DEDUCTIBLE SEQUENCE - * * LOWEST TO HIGHEST APC RANK FROM APC TABLE * * * * DEDUCTIBLE WILL BE TAKEN FROM OPPS SERVICES FIRST, * * THEN FROM ANY OTHER TYPES OF SERVICES FROM THE CLAIM. * * ALL VALID SERVICE LINES APPEAR IN THIS TABLE IN THE * * ORDER OF THEIR RANK FROM LOWEST TO HIGHEST. * * - THE LOWER THE RANK, THE HIGHER % THE NATIONAL * * UNADJUSTED COINSURANCE IS OF THE APC PAYMENT RATE * * - MOVE ALL LINE PRICING VARIABLES TO STAGING AREA * * (NEW COINSURANCE DEDUCTIBLE TABLE RECORD) * * * * NOTE: THE PURPOSE OF APC RANKING IS TO ENSURE THAT THE * * BENEFICIARY DEDUCTIBLE GOES TOWARD LINES WITH * * HIGHER COINSURANCE %S FIRST. THIS RESULTS IN THE * * BENEFICIARY PAYING LESS TOTAL COINSURANCE FOR THE * * CLAIM. * * * *************************************************************** 8300-COIN-DEDUCT. *-------------------------------------------------------------* * ADD 1 TO THE TOTAL TABLE RECORDS FOR THE NEW ENTRY * *-------------------------------------------------------------* ADD 1 TO W-LNC-MAX. *-------------------------------------------------------------* * MOVE TO THE NEW ENTRY POSITION (EMPTY RECORD) * *-------------------------------------------------------------* SET W-LP-INDX TO W-LNC-MAX. *-------------------------------------------------------------* * DETERMINE WHERE THE NEW SERVICE LINE SHOULD BE ENTERED INTO * * THE TABLE ACCORDING TO ITS RANK AND THE RANK OF THE RECORDS * * ALREADY IN THE TABLE - LOWEST TO HIGHEST RANK. * *-------------------------------------------------------------* PERFORM 8350-STAGE-ENTRY THRU 8350-STAGE-ENTRY-EXIT UNTIL W-LP-INDX = 1 OR H-RANK NOT < W-RANK (W-LP-INDX - 1). *-------------------------------------------------------------* * POPULATE THE EMPTY RECORD WITH THE NEW SERVICE LINE'S DATA * *-------------------------------------------------------------* MOVE LN-SUB TO W-LP-SUB (W-LP-INDX). MOVE H-NAT-COIN TO W-NAT-COIN (W-LP-INDX). MOVE H-MIN-COIN TO W-MIN-COIN (W-LP-INDX). MOVE H-SUB-CHRG TO W-SUB-CHRG (W-LP-INDX). MOVE H-APC-PYMT TO W-APC-PYMT (W-LP-INDX). MOVE H-WINX1 TO W-WINX1 (W-LP-INDX). MOVE H-RANK TO W-RANK (W-LP-INDX). MOVE H-PPCT TO W-PPCT (W-LP-INDX). MOVE H-DISC-RATE TO W-DISC-RATE (W-LP-INDX). *-------------------------------------------------------------* * PARTIAL HOSPITALIZATION LINES RECEIVE 1 SERVICE UNIT * *-------------------------------------------------------------* IF OPPS-SRVC-IND (LN-SUB) = ' P' THEN MOVE 1 TO W-SRVC-UNITS (W-LP-INDX) *-------------------------------------------------------------* * NON-PARTIAL HOSPITALIZATION LINES RECEIVE INPUT SVC UNITS * *-------------------------------------------------------------* ELSE MOVE H-SRVC-UNITS TO W-SRVC-UNITS (W-LP-INDX). *-------------------------------------------------------------* * SEARCH PROVIDER SPECIFIC FILE FOR THE LINE APC. * * IF FOUND, CALCULATE THE REDUCED COINSURANCE AMOUNT FOR * * THE LINE, ENTER IT INTO THE NEW COIN DEDUC TABLE REC, & * * RETURN CODE 25 * *-------------------------------------------------------------* MOVE 0 TO W-RED-COIN (W-LP-INDX). PERFORM VARYING PS-SUB FROM 1 BY 1 UNTIL PS-SUB > L-PSF-APC-LINE-CNT IF L-PSF-APC (PS-SUB) = OPPS-APC (LN-SUB) COMPUTE W-RED-COIN (W-LP-INDX) ROUNDED = L-PSF-RED-COIN (PS-SUB) * H-SRVC-UNITS * H-DISC-RATE MOVE 25 TO A-RETURN-CODE (LN-SUB) MOVE L-PSF-APC-LINE-CNT TO PS-SUB END-IF END-PERFORM. 8300-COIN-DEDUCT-EXIT. EXIT. *************************************************************** * * * MOVE THE EXISTING COINSURANCE DEDUCTIBLE RECORD WITH A * * HIGHER RANK UP ONE RECORD POSITION AND SET THE INDEX OF * * THE EMPTY RECORD FOR THE NEW ENTRY TO THE NEXT LOWER * * RECORD POSITION. * * * *************************************************************** 8350-STAGE-ENTRY. MOVE W-LP-ENTRY (W-LP-INDX - 1) TO W-LP-ENTRY (W-LP-INDX). SET W-LP-INDX DOWN BY 1. 8350-STAGE-ENTRY-EXIT. EXIT. *************************************************************** * * * POPULATE BLOOD DEDUCTIBLE TABLE WITH SERVICE LINES * * THAT HAVE A BLOOD DEDUCTIBLE HCPCS * * * *************************************************************** * * * ORDER SERVICES LINES BY DEDUCTIBLE SEQUENCE - * * 1. EARLIEST TO LATEST DATE OF SERVICE * * 2. LOWEST TO HIGHEST BLOOD RANK FROM BLOOD DEDUC TABLE * * * * DEDUCTIBLES WILL PAID FOR LINES IN THE ORDER OF DATE OF * * SERVICE (EARLIEST TO LATEST) AND THEN BY COST (LEAST TO * * MOST EXPENSIVE). ONLY VALID LINES WITH A HCPCS IN THE * * BLOOD DEDUCTIBLE RANKING TABLE APPEAR IN THIS TABLE. * * - BLOOD RANK OF 1 IS ASSIGNED TO THE LEAST EXPENSIVE * * BLOOD CODE * * - MOVE ALL LINE PRICING VARIABLES TO STAGING AREA * * (NEW BLOOD DEDUCTIBLE TABLE RECORD) * * * * NOTE: THE PURPOSE OF BLOOD LINE RANKING IS TO ENSURE * * THAT THE BENEFICIARY PAYS DEDUCTIBLES FOR THE * * THREE LEAST EXPENSIVE BLOOD PRODUCTS. * * * *************************************************************** 8375-BLOOD-DEDUCT. *-------------------------------------------------------------* * ADD 1 TO THE TOTAL TABLE RECORDS FOR THE NEW ENTRY * *-------------------------------------------------------------* ADD 1 TO W-BLD-MAX. *-------------------------------------------------------------* * MOVE TO THE NEW ENTRY POSITION (EMPTY RECORD) * *-------------------------------------------------------------* SET W-BD-INDX TO W-BLD-MAX. *-------------------------------------------------------------* * DETERMINE WHERE THE NEW SERVICE LINE SHOULD BE ENTERED INTO * * THE TABLE ACCORDING TO ITS RANK AND THE RANK OF THE RECORDS * * ALREADY IN THE TABLE - LOWEST TO HIGHEST RANK. * * (RANK IS THE DATE OF SERVICE & BLOOD RANK) * *-------------------------------------------------------------* PERFORM 8385-STAGE-ENTRY THRU 8385-STAGE-ENTRY-EXIT UNTIL W-BD-INDX = 1 OR H-BLD-RNK NOT < W-BD-RNK (W-BD-INDX - 1). *-------------------------------------------------------------* * POPULATE THE EMPTY RECORD WITH THE NEW SERVICE LINE'S DATA * *-------------------------------------------------------------* MOVE LN-SUB TO W-BD-SUB (W-BD-INDX). MOVE H-NAT-COIN TO W-BD-NAT-COIN (W-BD-INDX). MOVE H-MIN-COIN TO W-BD-MIN-COIN (W-BD-INDX). MOVE H-SUB-CHRG TO W-BD-SUB-CHRG (W-BD-INDX). MOVE H-APC-PYMT TO W-BD-APC-PYMT (W-BD-INDX). MOVE H-WINX1 TO W-BD-WINX1 (W-BD-INDX). MOVE H-BLOOD-RANK TO W-BD-RANK (W-BD-INDX). MOVE H-BLD-DOS TO W-BD-DOS (W-BD-INDX). MOVE H-PPCT TO W-BD-PPCT (W-BD-INDX). MOVE H-DISC-RATE TO W-BD-DISC-RATE (W-BD-INDX). MOVE H-SRVC-UNITS TO W-BD-SRVC-UNITS (W-BD-INDX). *-------------------------------------------------------------* * SEARCH PROVIDER SPECIFIC FILE FOR THE LINE APC. * * IF FOUND, CALCULATE THE REDUCED COINSURANCE AMOUNT FOR * * THE LINE, ENTER IT INTO THE NEW COIN DEDUC TABLE REC, & * * RETURN CODE 25 * *-------------------------------------------------------------* MOVE 0 TO W-BD-RED-COIN (W-BD-INDX). PERFORM VARYING PS-SUB FROM 1 BY 1 UNTIL PS-SUB > L-PSF-APC-LINE-CNT IF L-PSF-APC (PS-SUB) = OPPS-APC (LN-SUB) COMPUTE W-BD-RED-COIN (W-BD-INDX) ROUNDED = L-PSF-RED-COIN (PS-SUB) * H-SRVC-UNITS * H-DISC-RATE MOVE 25 TO A-RETURN-CODE (LN-SUB) MOVE L-PSF-APC-LINE-CNT TO PS-SUB END-IF END-PERFORM. 8375-BLOOD-DEDUCT-EXIT. EXIT. *************************************************************** * * * MOVE THE EXISTING BLOOD DEDUCTIBLE RECORD WITH A * * HIGHER RANK UP ONE RECORD POSITION AND SET THE INDEX OF * * THE EMPTY RECORD FOR THE NEW ENTRY TO THE NEXT LOWER * * RECORD POSITION. * * * *************************************************************** 8385-STAGE-ENTRY. MOVE W-BD-ENTRY (W-BD-INDX - 1) TO W-BD-ENTRY (W-BD-INDX). SET W-BD-INDX DOWN BY 1. 8385-STAGE-ENTRY-EXIT. EXIT. *************************************************************** * * * POPULATE PASS-THROUGH DEVICE TABLE * * (IMPLEMENTED IN APRIL 2008 PRICER) * * * *************************************************************** * * * ORDER RECORDS AS FOLLOWS - * * 1. HCPCS, ASCENDING * * 2. LOWEST TO HIGHEST LINE SUBSCRIPT * * * * 02/11/2008 - LOGIC ADDED FOR CY 2008, QTR 2 * * 11/12/2008 - LOGIC NOT CHANGED, NO CY 2009 PT DEVICES * * * *************************************************************** 8390-PASS-THRU-DEVICES. *-------------------------------------------------------------* * ADD 1 TO THE TOTAL TABLE RECORDS FOR THE NEW ENTRY * *-------------------------------------------------------------* ADD 1 TO W-PTD-MAX. *-------------------------------------------------------------* * MOVE TO THE NEW ENTRY POSITION (EMPTY RECORD) * *-------------------------------------------------------------* SET W-PTD-INDX TO W-PTD-MAX. INITIALIZE W-PTD-ENTRY (W-PTD-INDX). *-------------------------------------------------------------* * DETERMINE WHERE THE NEW RECORD SHOULD BE ENTERED INTO THE * * TABLE ACCORDING TO ITS HCPCS AND THE HCPCS OF THE RECORDS * * ALREADY IN THE TABLE - LOWEST TO HIGHEST HCPCS * *-------------------------------------------------------------* PERFORM 8391-STAGE-ENTRY THRU 8391-STAGE-ENTRY-EXIT UNTIL W-PTD-INDX = 1 OR W-PTD-LINE-HCPCS NOT < W-PTD-HCPCS (W-PTD-INDX - 1). *-------------------------------------------------------------* * POPULATE THE EMPTY RECORD WITH THE NEW SERVICE LINE'S DATA * *-------------------------------------------------------------* MOVE OPPS-HCPCS (LN-SUB) TO W-PTD-HCPCS (W-PTD-INDX). MOVE LN-SUB TO W-PTD-SUB (W-PTD-INDX). MOVE OPPS-SUB-CHRG (LN-SUB) TO W-PTD-SUB-CHRG (W-PTD-INDX). 8390-PASS-THRU-DEVICES-EXIT. EXIT. *************************************************************** * * * MOVE THE EXISTING PASS-THROUGH DEVICE RECORD WITH A * * HIGHER HCPCS UP ONE RECORD POSITION AND SET THE INDEX OF * * THE EMPTY RECORD FOR THE NEW ENTRY TO THE NEXT LOWER * * RECORD POSITION. * * * *************************************************************** 8391-STAGE-ENTRY. MOVE W-PTD-ENTRY (W-PTD-INDX - 1) TO W-PTD-ENTRY (W-PTD-INDX). SET W-PTD-INDX DOWN BY 1. 8391-STAGE-ENTRY-EXIT. EXIT. *************************************************************** * * * UPDATE PASS-THROUGH DEVICE TABLE WITH PROCEDURE DATA * * (IMPLEMENTED IN APRIL 2008 PRICER) * * * *************************************************************** * * * 02/11/2008 - LOGIC ADDED FOR CY 2008, QTR 2 * * * *************************************************************** 8392-PASS-THRU-DEV-PROCS. *-------------------------------------------------------------* * LOOP THROUGH ELIGIBLE PROCEDURE'S PASS-THROUGH DEVICE TABLE * *-------------------------------------------------------------* PERFORM 8393-PERFORM-SEARCH THRU 8393-PERFORM-SEARCH-EXIT VARYING W-PTD-PROC-SUB FROM 1 BY 1 UNTIL W-PTD-PROC-SUB > W-PTD-CNT. 8392-PASS-THRU-DEV-PROCS-EXIT. EXIT. *************************************************************** * * * SEARCH FOR THE PASS-THROUGH DEVICE FOR WHICH THE PROCEDURE * * IS ELIGIBLE IN THE TABLE * * * *************************************************************** 8393-PERFORM-SEARCH. *-------------------------------------------------------------* * SEARCH PTD TABLE STARTING AT ENTRY #1 FOR ALL OCCURANCES * * OF THE PASS-THRU DEVICE HCPCS IN THE PASS-THRU DEVICE TABLE.* * THIS IS DONE FOR ALL PASS-THROUGH DEVICES THE PROCEDURE IS * * ELIGIBLE FOR. * *-------------------------------------------------------------* MOVE 'N' TO W-END-OF-PTD-TBL. IF W-PTD-PROC-HCPCS (W-PTD-PROC-SUB) NOT = ' ' SET W-PTD-INDX TO 1 PERFORM 8394-SEARCH-PTD-HCPCS THRU 8394-SEARCH-PTD-HCPCS-EXIT UNTIL W-END-OF-PTD-TBL = 'Y' END-IF. 8393-PERFORM-SEARCH-EXIT. EXIT. *************************************************************** * * * SEARCH FOR THE PASS-THROUGH DEVICE FOR WHICH THE PROCEDURE * * IS ELIGIBLE IN THE TABLE * * * *************************************************************** 8394-SEARCH-PTD-HCPCS. MOVE 'N' TO W-END-OF-PTD-TBL. *-------------------------------------------------------------* * SEARCH PASS-THROUGH DEVICE TABLE * *-------------------------------------------------------------* SEARCH W-PTD-ENTRY VARYING W-PTD-INDX *-------------------------------------------------------------* * IF THERE ARE NO MORE OCCURANCES OF THE PASS-THROUGH DEVICE, * * STOP THE SEARCH AND INDICATE END OF FILE * *-------------------------------------------------------------* AT END MOVE 'Y' TO W-END-OF-PTD-TBL GO TO 8394-SEARCH-PTD-HCPCS-EXIT *-------------------------------------------------------------* * IF THE PASS-THROUGH DEVICE IS FOUND, INDICATE NOT END OF * * FILE AND UPDATE THE DEVICE'S RECORD WITH THE PROCEDURE DATA * *-------------------------------------------------------------* WHEN W-PTD-HCPCS (W-PTD-INDX) = W-PTD-PROC-HCPCS (W-PTD-PROC-SUB) MOVE 'N' TO W-END-OF-PTD-TBL PERFORM 8395-UPDATE-ENTRY THRU 8395-UPDATE-ENTRY-EXIT SET W-PTD-INDX UP BY 1 END-SEARCH. 8394-SEARCH-PTD-HCPCS-EXIT. EXIT. *************************************************************** * * * UPDATE THE EXISTING PASS-THROUGH DEVICE RECORD WITH THE * * CURRENT ELIGIBLE PROCEDURE'S DATA * * * *************************************************************** 8395-UPDATE-ENTRY. *-------------------------------------------------------------* * UPDATE PASS-THROUGH DEVICE RECORD * *-------------------------------------------------------------* ADD 1 TO W-PTD-PROC-CNT (W-PTD-INDX). ADD OPPS-SRVC-UNITS (LN-SUB) TO W-PTD-TOTAL-PROC-UNITS (W-PTD-INDX). 8395-UPDATE-ENTRY-EXIT. EXIT. *************************************************************** * * * CALCULATE LINE PYMNTS, DEDUCTIBLES, REIM., & COINSURANCE, * * ACCUMULATE CLAIM TOTALS, POPULATE DRUG DEDUCTIBLE TABLE, * * UPDATE PASS-THROUGH DEVICE TABLE WITH PROCEDURE & DEVICE * * LINE DATA, MOVE LINE VALUES TO VARIABLES TO BE PASSED BACK * * * *************************************************************** * * * LOOP THROUGH THE COINSURANCE DEDUCTIBLE TABLE TO DO THE * * FOLLOWING FOR EACH SERVICE LINE: * * * * - CHECK ALL APPROPRIATE FLAGS AND INDICATORS FROM OCE * * - SET RETURN CODES TO INDICATE ERRORS OR STATUS * * '20' - LINE PROCESSED BUT PAYMENT = 0, * * BENE DEDUCTIBLE => ADJUSTED PAYMENT * * - CALCULATE & ACCUMULATE LINE AND CLAIM LEVEL ITEMS * * - POPULATE DRUG COINSURANCE TABLE * * - MOVE LINE VARIABLE VALUES TO VARIABLES TO BE PASSED BACK * * * *************************************************************** 8400-CALCULATE. *-------------------------------------------------------------* * SET THE SERVICE LINE SUBSCRIPT TO THE CLAIM SERVICE LINE # * * ASSOCIATED WITH THE COINSURANCE DEDUCTIBLE TABLE RECORD * *-------------------------------------------------------------* MOVE W-LP-SUB (W-LP-INDX) TO LN-SUB. *-------------------------------------------------------------* * STOP PROCESSING LINE IF ERROR CODE * *-------------------------------------------------------------* IF A-RETURN-CODE (LN-SUB) > 25 GO TO 8400-CALCULATE-EXIT. *-------------------------------------------------------------* * CALCULATE THE FOLLOWING FOR VALID LINES IN THE COINSURANCE * * DEDUCTIBLE TABLE WITH A PAYABLE STATUS: * * - LINE ITEM PAYMENT (BASED ON LINE SERVICE INDICATOR) * * - BENEFICIARY DEDUCTIBLE (IN ORDER OF APC RANK) * * - MINIMUM, MAXIMUM, AND REDUCED COINSURANCE AMOUNTS * * - LINE ITEM REIMBURSEMENT IF MAX COIN LIMIT EXCEEDED * *-------------------------------------------------------------* IF OPPS-PYMT-IND (LN-SUB) = ' 1' OR ' 5' OR ' 6' OR ' 7' OR ' 8' PERFORM 8550-CALC-STANDARD THRU 8550-CALC-STANDARD-EXIT ELSE GO TO 8400-CALCULATE-EXIT. *-------------------------------------------------------------* * POPULATE DRG COINSURANCE TABLE FOR LATER PROCESSING * * - ENFORCE INPATIENT COINSURANCE LIMIT * * - SET GJK-FLAG WHEN SERVICE = G OR K * *-------------------------------------------------------------* IF (A-RETURN-CODE (LN-SUB) < 30) PERFORM 8450-ADJ-PROC-COIN THRU 8450-ADJ-PROC-COIN-EXIT ELSE NEXT SENTENCE. *-------------------------------------------------------------* * FLAG CLAIMS WITH ARTIFICIAL CHARGES AND TOTAL PAYMENTS & * * CHARGES FOR ARTIFICIAL CHARGE AND PACKAGING PROCESSING * *-------------------------------------------------------------* PERFORM 8500-ADJ-CHRGS THRU 8500-ADJ-CHRGS-EXIT. *-------------------------------------------------------------* * UPDATE PASS-THROUGH DEVICE TABLE W/ ELIGIBLE PROCEDURE * * LINE DATA * * EFFECTIVE CY 2008 QTR 2, LOGIC ADDED 02/12/2008 * *-------------------------------------------------------------* IF A-RETURN-CODE (LN-SUB) < 30 AND PTD-FLAG = 'Y' AND OPPS-SRVC-IND (LN-SUB) = ' S' OR ' T' OR ' V' OR ' X' PERFORM 8670-SET-PTD-PROC-FLAG THRU 8670-SET-PTD-PROC-FLAG-EXIT IF PTD-PROC-FLAG = 'Y' PERFORM 8392-PASS-THRU-DEV-PROCS THRU 8392-PASS-THRU-DEV-PROCS-EXIT END-IF END-IF. *-------------------------------------------------------------* * ACCUMULATE CLAIM TOTALS USING DATA FROM THE CURRENT VALID * * SERVICE LINE (IN THE COINSURANCE DEDUCTIBLE TABLE) * *-------------------------------------------------------------* IF A-RETURN-CODE (LN-SUB) < 30 COMPUTE A-TOTAL-CLM-DEDUCT = H-TOTAL-LN-DEDUCT + A-TOTAL-CLM-DEDUCT COMPUTE H-TOT-PYMT = H-TOT-PYMT + H-LITEM-PYMT COMPUTE A-BLOOD-DEDUCT-DUE = A-BLOOD-DEDUCT-DUE + H-LN-BLOOD-DEDUCT *-------------------------------------------------------------* * MOVE LINE VALUES TO VARIABLES TO BE PASSED BACK * * - THE LINE REIM. & ADJ-COIN IS ADJUSTED LATER (IF NEEDED) * * FOR THE INPATIENT DAILY LIMIT IN 8840-PROCESS-TYPE2 * *-------------------------------------------------------------* MOVE H-LITEM-PYMT TO A-LITEM-PYMT (LN-SUB) MOVE H-LITEM-REIM TO A-LITEM-REIM (LN-SUB) MOVE H-TOTAL-LN-DEDUCT TO A-TOTAL-LN-DEDUCT (LN-SUB) MOVE H-LN-BLOOD-DEDUCT TO A-BLOOD-LN-DEDUCT (LN-SUB) MOVE H-NAT-COIN TO A-ADJ-COIN (LN-SUB) MOVE H-RED-COIN TO A-RED-COIN (LN-SUB) IF H-RED-COIN > H-NAT-COIN MOVE H-NAT-COIN TO A-RED-COIN (LN-SUB) END-IF IF OPPS-LITEM-ACT-FLAG (LN-SUB) = '4' MOVE 0 TO A-LITEM-PYMT (LN-SUB) MOVE 0 TO A-LITEM-REIM (LN-SUB) COMPUTE H-TOT-PYMT = H-TOT-PYMT - H-LITEM-PYMT END-IF END-IF. *-------------------------------------------------------------* * INITIALIZE LINE VARIABLES FOR THE NEXT SERVICE LINE IN THE * * COINSURANCE DEDUCTIBLE TABLE * *-------------------------------------------------------------* MOVE ZERO TO LINE-HOLD-ITEMS. 8400-CALCULATE-EXIT. EXIT. *************************************************************** * * * POPULATE DRUG COINSURANCE ROLL-UP TABLE WITH THE * * COINSURANCE AMOUNTS OF SERVICE LINES IN THE COINSURANCE * * DEDUCTIBLE TABLE * * * *************************************************************** * * * ORDER LINES BY: * * 1. DATE OF SERVICE (EARLIEST TO LATEST) * * 2. DCP-CODE - TYPE OF ENTRY BASED ON SERVICE INDICATOR * * DCP-CODE OF 1: DAY SUMMARY * * DCP-CODE OF 2: DRUG / BLOOD LINE * * THERE IS ONE TYPE 1 RECORD PER DAY; THERE MAY BE MULTIPLE * * TYPE 2 RECORDS PER DAY - ONE FOR EVERY DRUG LINE * * ("DRUG" REFERS TO ANY SI = G OR K LINE FOR SIMPLICITY) * * * * DRUG COINSURANCE RECORD COMBINATIONS: * * - TYPE 1, COIN1 = 0, COIN2 > 0, & SI = X => * * DRUG(S) ADMINISTERED INDEPENDENT OF A PROCEDURE VISIT * * ON THE DATE OF SERVICE * * - TYPE 1, COIN1 > 0, COIN2 = 0, & SI = S, V, OR T => * * PROCEDURE / VISIT WITH NO DRUG(S) ADMINISTERED ON THE * * DATE OF SERVICE * * - TYPE 1, COIN1 > 0, COIN2 > 0, & SI = S, V, OR T => * * PROCEDURE / VISIT WITH DRUG(S) ADMINISTERED ON THE * * DATE OF SERVICE * * - TYPE 2, COIN1 = 0, COIN2 > 0, & SI = G OR K => * * DRUG ADMINSTERED ON THE DATE OF SERVICE * * * *************************************************************** 8450-ADJ-PROC-COIN. *************************************************************** * MOVE LINE DATE OF SERVICE TO DATE OF SERVICE HOLD AREA * *************************************************************** MOVE OPPS-LITEM-DOS (LN-SUB) TO H-DCP-DOS. *************************************************************** * * * PROCESS SI = S, T, OR V LINES (PROCEDURE OR VISIT) * * * *************************************************************** IF OPPS-SRVC-IND (LN-SUB) = ' S' OR ' T' OR ' V' *-------------------------------------------------------------* * CALCULATE WAGE ADJUSTED LINE NATIONAL COINSURANCE AMOUNT * *-------------------------------------------------------------* COMPUTE H-NEW-WGNAT ROUNDED = W-NAT-COIN (W-LP-INDX) * (.6 * W-WINX1 (W-LP-INDX) + .4) *-------------------------------------------------------------* * ENFORCE INPATIENT LIMIT ON NATIONAL COINSURANCE AMOUNT * *-------------------------------------------------------------* IF H-NEW-WGNAT > H-IP-LIMIT MOVE H-IP-LIMIT TO H-NEW-WGNAT END-IF *-------------------------------------------------------------* * CALCULATE LINE NEW COINSURANCE AMOUNT (ACTUAL COIN DUE) * *-------------------------------------------------------------* COMPUTE H-NEW-COIN = H-LITEM-PYMT - H-TOTAL-LN-DEDUCT - H-LITEM-REIM - H-LN-BLOOD-DEDUCT *-------------------------------------------------------------* * INDICATE TYPE 1 RECORD (ONE TYPE 1 RECORD PER DAY) * *-------------------------------------------------------------* MOVE 1 TO H-DCP-CODE *-------------------------------------------------------------* * ADD OR UPDATE DRUG COINSURANCE TABLE ENTRY FOR THE DOS * *-------------------------------------------------------------* PERFORM 8455-SEARCH-KEY THRU 8455-SEARCH-KEY-EXIT *************************************************************** * * * PROCESS SI = G, K, & R LINES ("DRUG" & BLOOD) * * * *************************************************************** ELSE IF OPPS-SRVC-IND (LN-SUB) = ' G' OR ' K' OR ' R' *-------------------------------------------------------------* * CALCULATE LINE NEW COINSURANCE AMOUNT (ACTUAL COIN DUE) * *-------------------------------------------------------------* COMPUTE H-NEW-COIN = H-LITEM-PYMT - H-TOTAL-LN-DEDUCT - H-LITEM-REIM - H-LN-BLOOD-DEDUCT *-------------------------------------------------------------* * SET GJK-FLAG TO INDICATE "DRUG" LINE * *-------------------------------------------------------------* MOVE 'Y' TO GJK-FLAG *-------------------------------------------------------------* * INDICATE TYPE 1 RECORD (ONE TYPE 1 RECORD PER DAY) * *-------------------------------------------------------------* MOVE 1 TO H-DCP-CODE *-------------------------------------------------------------* * ADD OR UPDATE DRUG COINSURANCE TABLE ENTRY FOR THE DOS * *-------------------------------------------------------------* PERFORM 8455-SEARCH-KEY THRU 8455-SEARCH-KEY-EXIT *-------------------------------------------------------------* * INDICATE TYPE 2 RECORD (ONE TYPE 2 REC FOR EVERY DRUG LINE) * *-------------------------------------------------------------* MOVE 2 TO H-DCP-CODE *-------------------------------------------------------------* * INCREASE THE TOTAL NUMBER OF TABLE RECORDS FOR NEW ENTRY * *-------------------------------------------------------------* ADD 1 TO W-DCP-MAX *-------------------------------------------------------------* * MOVE TO THE NEW ENTRY POSITION (EMPTY RECORD) * * A NEW TYPE 2 RECORD ENTRY IS CREATED FOR EVERY SI = G OR K * * SERVICE LINE REGARDLESS OF THE DATE OF SERVICE * *-------------------------------------------------------------* SET W-DCP-INDX TO W-DCP-MAX *-------------------------------------------------------------* * DETERMINE WHERE THE NEW DRUG / DEVICE COINSURANCE ENTRY * * FOR THE CURRENT SERVICE LINE SHOULD BE ENTERED INTO THE * * TABLE ACCORDING TO ITS DATE OF SERVICE AND RECORD TYPE * * COMBO KEY - LOWEST TO HIGHEST KEY. (RECORD TYPE 2 ONLY) * *-------------------------------------------------------------* PERFORM 8475-STAGE-DCP-ENTRY THRU 8475-STAGE-DCP-ENTRY-EXIT UNTIL W-DCP-INDX = 1 OR H-DCP-STAGE NOT < W-DCP-STAGE (W-DCP-INDX - 1) *-------------------------------------------------------------* * POPULATE THE EMPTY RECORD WITH THE NEW SERVICE LINE'S DATA * * RECORD TYPE 2, "DRUG" * *-------------------------------------------------------------* MOVE LN-SUB TO W-DCP-SUB (W-DCP-INDX) MOVE H-DCP-STAGE TO W-DCP-STAGE (W-DCP-INDX) MOVE ZERO TO W-DCP-COIN1 (W-DCP-INDX) MOVE ZERO TO W-DCP-WGNAT (W-DCP-INDX) MOVE H-NEW-COIN TO W-DCP-COIN2 (W-DCP-INDX) MOVE OPPS-SRVC-IND (LN-SUB) TO W-DCP-SRVC-IND (W-DCP-INDX). 8450-ADJ-PROC-COIN-EXIT. EXIT. *************************************************************** * * * DETERMINE WHETHER A NEW DRUG/DEVICE COINSURANCE TABLE * * RECORD SHOULD BE ADDED OR IF AN EXISITING RECORD NEEDS TO * * BE UPDATED * * * * (RECORD KEY IS DATE OF SERVICE & RECORD TYPE) * * * *************************************************************** 8455-SEARCH-KEY. *-------------------------------------------------------------* * SEARCH DRUG/DEVICE COINSURANCE TABLE STARTING AT ENTRY #1 * *-------------------------------------------------------------* SET W-DCP-INDX TO 1. SEARCH W-DCP-ENTRY VARYING W-DCP-INDX *-------------------------------------------------------------* * IF THE SERVICE LINE'S DATE OF SERVICE AND RECORD TYPE COMBO * * IS NOT ALREADY IN THE TABLE, ADD IT * *-------------------------------------------------------------* AT END PERFORM 8460-ADD-ENTRY THRU 8460-ADD-ENTRY-EXIT *-------------------------------------------------------------* * IF THE SERVICE LINE'S DATE OF SERVICE AND RECORD TYPE COMBO * * IS ALREADY IN THE TABLE, UPDATE THE ENTRY * *-------------------------------------------------------------* WHEN W-DCP-STAGE (W-DCP-INDX) = H-DCP-STAGE PERFORM 8465-UPDATE-ENTRY THRU 8465-UPDATE-ENTRY-EXIT. 8455-SEARCH-KEY-EXIT. EXIT. *************************************************************** * * * INSERT THE NEW COINSURANCE RECORD INTO THE CORRECT POSITION * * (LOWEST TO HIGHEST DATE OF SERVICE - RECORD TYPR COMBO) OF * * THE DRUG / DEVICE COINSURANCE TABLE * * (ONLY PROCESSES TYPE 1 RECORDS) * * * *************************************************************** 8460-ADD-ENTRY. *-------------------------------------------------------------* * INCREASE THE TOTAL NUMBER OF TABLE RECORDS FOR NEW ENTRY * *-------------------------------------------------------------* ADD 1 TO W-DCP-MAX. *-------------------------------------------------------------* * MOVE TO THE NEW ENTRY POSITION (EMPTY RECORD) * *-------------------------------------------------------------* SET W-DCP-INDX TO W-DCP-MAX. *-------------------------------------------------------------* * DETERMINE WHERE THE NEW DRUG / DEVICE COINSURANCE ENTRY * * FOR THE CURRENT SERVICE LINE SHOULD BE ENTERED INTO THE * * TABLE ACCORDING TO ITS DATE OF SERVICE AND RECORD TYPE * * COMBO KEY - LOWEST TO HIGHEST KEY. (TYPE 1 RECORDS ONLY) * *-------------------------------------------------------------* PERFORM 8475-STAGE-DCP-ENTRY THRU 8475-STAGE-DCP-ENTRY-EXIT UNTIL W-DCP-INDX = 1 OR H-DCP-STAGE NOT < W-DCP-STAGE (W-DCP-INDX - 1). *-------------------------------------------------------------* * POPULATE THE EMPTY RECORD WITH THE NEW SERVICE LINE'S DATA * * RECORD TYPE 1, "DRUG" * *-------------------------------------------------------------* IF OPPS-SRVC-IND (LN-SUB) = ' G' OR ' K' OR ' R' MOVE ZERO TO W-DCP-SUB (W-DCP-INDX) MOVE H-DCP-STAGE TO W-DCP-STAGE (W-DCP-INDX) MOVE ZERO TO W-DCP-COIN1 (W-DCP-INDX) MOVE ZERO TO W-DCP-WGNAT (W-DCP-INDX) MOVE H-NEW-COIN TO W-DCP-COIN2 (W-DCP-INDX) MOVE ' X' TO W-DCP-SRVC-IND (W-DCP-INDX) *-------------------------------------------------------------* * POPULATE THE EMPTY RECORD WITH THE NEW SERVICE LINE'S DATA * * RECORD TYPE 1, PROCEDURE OR VISIT * *-------------------------------------------------------------* ELSE MOVE LN-SUB TO W-DCP-SUB (W-DCP-INDX) MOVE H-DCP-STAGE TO W-DCP-STAGE (W-DCP-INDX) MOVE H-NEW-COIN TO W-DCP-COIN1 (W-DCP-INDX) MOVE H-NEW-WGNAT TO W-DCP-WGNAT (W-DCP-INDX) MOVE ZERO TO W-DCP-COIN2 (W-DCP-INDX) MOVE OPPS-SRVC-IND (LN-SUB) TO W-DCP-SRVC-IND (W-DCP-INDX). 8460-ADD-ENTRY-EXIT. EXIT. *************************************************************** * * * UPDATE THE EXISTING DRUG COINSURANCE RECORD WITH THE SAME * * DATE OF SERVICE AND RECORD TYPE OF THE CURRENT SERVICE LINE * * (ONLY PROCESSES TYPE 1 RECORDS) * * * *************************************************************** 8465-UPDATE-ENTRY. *-------------------------------------------------------------* * FOR "DRUG" LINES - ACCUMULATE DAY'S TOTAL "DRUG" COIN DUE * *-------------------------------------------------------------* IF OPPS-SRVC-IND (LN-SUB) = ' G' OR ' K' OR ' R' ADD H-NEW-COIN TO W-DCP-COIN2 (W-DCP-INDX) *-------------------------------------------------------------* * FOR PROCEDURE & VISIT LINES - WHEN THE EXISITING RECORD WAS * * WAS INITIALLY CREATED FOR A "DRUG" LINE, UPDATE THE RECORD * *-------------------------------------------------------------* ELSE IF W-DCP-SRVC-IND (W-DCP-INDX) = ' X' PERFORM 8485-REPLACE-TYPE1 THRU 8485-REPLACE-TYPE1-EXIT *-------------------------------------------------------------* * FOR PROCEDURE & VISIT LINES - WHEN THE EXISTING RECORD HAS * * DATA FROM ANOTHER PROCEDURE / VISIT, ENSURE THE PROC/VISIT * * WITH THE HIGHEST WAGE ADJUSTED NATIONAL COIN IS IN THE TBL * *-------------------------------------------------------------* ELSE PERFORM 8480-RANK-COIN THRU 8480-RANK-COIN-EXIT. 8465-UPDATE-ENTRY-EXIT. EXIT. *************************************************************** * * * MOVE THE EXISTING DRUG COINSURANCE RECORD WITH A HIGHER * * RANK UP ONE RECORD POSITION AND SET THE INDEX OF THE EMPTY * * RECORD FOR THE NEW ENTRY TO THE NEXT LOWER RECORD POSITION. * * * *************************************************************** 8475-STAGE-DCP-ENTRY. MOVE W-DCP-ENTRY (W-DCP-INDX - 1) TO W-DCP-ENTRY (W-DCP-INDX). SET W-DCP-INDX DOWN BY 1. 8475-STAGE-DCP-ENTRY-EXIT. EXIT. *************************************************************** * * * ENSURE THAT THE PROCEDURE/VISIT WITH THE HIGHEST WAGE ADJ. * * NATIONAL COINSURANCE AMOUNT IS IN THE TABLE WHEN THERE ARE * * MULTIPLE PROCEDURES/VISITS ON THE SAME DATE OF SERVICE. * * ONLY ONE PROCEDURE/VISIT'S DATA PER DAY APPEARS IN THE TBL. * * (ONLY PROCESSES TYPE 1 RECORDS) * * * *************************************************************** 8480-RANK-COIN. IF H-NEW-WGNAT > W-DCP-WGNAT (W-DCP-INDX) MOVE LN-SUB TO W-DCP-SUB (W-DCP-INDX) MOVE H-NEW-COIN TO W-DCP-COIN1 (W-DCP-INDX) MOVE H-NEW-WGNAT TO W-DCP-WGNAT (W-DCP-INDX) MOVE OPPS-SRVC-IND (LN-SUB) TO W-DCP-SRVC-IND (W-DCP-INDX). 8480-RANK-COIN-EXIT. EXIT. *************************************************************** * * * ENTER VALUES FROM THE CURRENT SI = S, V, OR T SERVICE LINE * * INTO AN EXISITING RECORD THAT WAS FORMERLY AN SI = G OR K * * ONLY ENTRY. * * - SERVICE LINE REFERENCES CURRENT PROCEDURE / VISIT LINE * * - COIN1 = PROCEDURE / VISIT LINE NEW COINSURANCE AMOUNT * * - COIN2 = DRUG / BLOOD LINE NEW COINSURANCE AMOUNT(S) * * - WAGE ADJUSTED NATIONAL COIN OF CURRENT LINE ENTERED * * - SERVICE INDICATOR = SI OF CURRENT LINE (S, V, OR T) * * * *************************************************************** 8485-REPLACE-TYPE1. MOVE LN-SUB TO W-DCP-SUB (W-DCP-INDX) MOVE H-NEW-COIN TO W-DCP-COIN1 (W-DCP-INDX) MOVE H-NEW-WGNAT TO W-DCP-WGNAT (W-DCP-INDX) MOVE OPPS-SRVC-IND (LN-SUB) TO W-DCP-SRVC-IND (W-DCP-INDX). 8485-REPLACE-TYPE1-EXIT. EXIT. *************************************************************** * * * IDENTIFY CLAIMS THAT HAVE SIGNIFICANT PROCEDURE (SURGERY) * * LINE(S) WITH ARTIFICIAL CHARGES FOR FURTHER PROCESSING, * * ACCUMULATE TOTAL CLAIM PAYMENTS AND CHARGES FOR SIGNIFICANT * * PROCEDURE LINES, AND ACCUMULATE TOTAL CLAIM CHARGES OF ALL * * SEPARATELY PAYABLE LINES. (THE FLAG AND CLAIM TOTALS ARE * * USED IN PARAGRAPH 8600-ADJ-CHRG-OUTL.) * * * *************************************************************** 8500-ADJ-CHRGS. *************************************************************** ** NEW LOGIC INSERTED FOR WEB USE ONLY * *************************************************************** *-------------------------------------------------------------* * FLAG CLAIM WHEN A SIGNIFICANT PROCEDURE LINE HAS ARTIFICIAL * * CHARGES ($1 OR LESS) - FLAGS ENTIRE CLAIM * *-------------------------------------------------------------* * NOTE: LINES WITH CHARGES < $1.01 ARE FIXED BY FISS BEFORE * * ENTERING THE PRICER. THEREFORE, THIS LOGIC IS NO * * LONGER NECESSARY. THIS LOGIC WAS NECESSARY BEFORE * * FISS IMPLEMENTED THE FIX. * *-------------------------------------------------------------* IF ((OPPS-SRVC-IND (LN-SUB) = ' T') OR ((OPPS-SRVC-IND (LN-SUB) = ' S') AND (OPPS-HCPCS (LN-SUB) > '09999' AND OPPS-HCPCS (LN-SUB) < '70000'))) AND (W-SUB-CHRG (W-LP-INDX) < 1.01) MOVE 'Y' TO ST0-FLAG. *-------------------------------------------------------------* * ACCUMULATE TOTAL CLAIM CHARGES AND PAYMENTS FROM UNPACKAGED * * SIGNIFICANT PROCEDURE (SURGERY) LINES * *-------------------------------------------------------------* IF ((OPPS-SRVC-IND (LN-SUB) = ' T') OR ((OPPS-SRVC-IND (LN-SUB) = ' S') AND (OPPS-HCPCS (LN-SUB) > '09999' AND OPPS-HCPCS (LN-SUB) < '70000'))) AND (OPPS-PKG-FLAG (LN-SUB) = '0' OR '3') COMPUTE H-TOT-ST-CHRG = W-SUB-CHRG (W-LP-INDX) + H-TOT-ST-CHRG COMPUTE H-TOT-ST-PYMT = H-LITEM-PYMT + H-TOT-ST-PYMT. *-------------------------------------------------------------* * ACCUMULATE TOTAL CLAIM PAYMENTS FROM UNPACKAGED SEPARATELY * * PAYABLE LINES (FOR PACKAGING LATER) * *-------------------------------------------------------------* * 12/18/2009 - ADD SI R, WHICH IS ELIGIBLE FOR OUTLIER * *-------------------------------------------------------------* IF (OPPS-SRVC-IND (LN-SUB) = ' S' OR ' T' OR ' V' OR ' X' OR ' P' OR ' R') AND (OPPS-PKG-FLAG (LN-SUB) = '0' OR '3') COMPUTE H-TOT-STVX-PYMT = H-LITEM-PYMT + H-TOT-STVX-PYMT. 8500-ADJ-CHRGS-EXIT. EXIT. *************************************************************** * * * CALCULATE THE FOLLOWING FOR VALID LINES IN THE COINSURANCE * * DEDUCTIBLE TABLE WITH A PAYABLE STATUS: * * - LINE ITEM PAYMENT (BASED ON LINE SERVICE INDICATOR) * * - BENEFICIARY DEDUCTIBLE (IN ORDER OF APC RANK) * * - MINIMUM, MAXIMUM, AND REDUCED COINSURANCE AMOUNTS * * * *************************************************************** * * * 1. CALCULATE STANDARD LINE ITEM PAYMENT (LINE PRICE) * * (APC PAYMENT * WAGE INDEX * SERVICE UNITS * * * DISCOUNT FACTOR) * * WAGE ADJUST 60% OF THE APC PAYMENT FOR SI = S, V, T, P, * * OR X LINES, THESE ARE ELIGIBLE FOR THE SCH ADJUSTMENT * * 2. APPLY DEDUCTIBLE TO HIGHEST NATIONAL COINSURANCE AMOUNT * * DESCENDING UNTIL DEDUCTIBLE = 0. * * 3. ADD LINE PRICE TO OUTLIER HOLD AREA * * 4. CALCULATE THE LINE PRICE FOR DESIGNATED DEVICES * * AND DRUGS * * 5. CALCULATE DEVICE REDUCTIONS * * * *************************************************************** 8550-CALC-STANDARD. *************************************************************** * INITIALIZE & SET LINE VARIABLES AND FLAGS * *************************************************************** *-------------------------------------------------------------* * INITIALIZE VARIABLE FOR LINES ELIGIBLE FOR BLOOD DEDUCTIBLE * *-------------------------------------------------------------* MOVE 0 TO H-BLOOD-FRACTION. *-------------------------------------------------------------* * FLAG LINE IF THE LINE APC IS A BRACHYTHERAPY APC * * ** NEW LIST EVERY JANUARY ** * *-------------------------------------------------------------* * 11/13/2007 - BRACHY APC CHECK ADDED * * 12/28/2007 - LOGIC MOVED HERE * * 11/12/2008 - LOGIC DISABLED, BRACHYTHERAPY LINES IDENTIFIED * * WITH A STATUS INDICATOR OF ' U' FOR CY 2009 * *-------------------------------------------------------------* * PERFORM 8650-SET-BRACHY-APC-FLAG * THRU 8650-SET-BRACHY-APC-FLAG-EXIT. *-------------------------------------------------------------* * FLAG LINE IF THE LINE HCPCS IS A BLOOD DEDUCTIBLE HCPCS * * ** NEW LIST EVERY JANUARY ** * *-------------------------------------------------------------* * 11/13/2007 - HCPCS LIST MOVED FROM 7550-CALC-GJK TO HERE * * 12/04/2007 - LIST MOVED TO 7655-SET-BD-HCPCS-FLAG * * 12/28/2007 - LOGIC MOVED HERE * *-------------------------------------------------------------* PERFORM 8655-SET-BD-HCPCS-FLAG THRU 8655-SET-BD-HCPCS-FLAG-EXIT. *-------------------------------------------------------------* * FLAG LINE IF THE LINE APC IS A RADIOPHARM APC * * ** NEW LIST EVERY JANUARY ** * *-------------------------------------------------------------* * 12/27/2007 - RADIOPHARM APC CHECK ADDED * * 12/28/2007 - LOGIC MOVED HERE * *-------------------------------------------------------------* PERFORM 8660-SET-RADIOPH-APC-FLAG THRU 8660-SET-RADIOPH-APC-FLAG-EXIT. *-------------------------------------------------------------* * FLAG LINE IF LINE HCPCS IS A PASS-THROUGH RADIOPHARM HCPCS * * ** QUARTERLY UPDATES TO TABLE ** * *-------------------------------------------------------------* * 02/10/2009 - PT RADIOPHARM HCPCS CHECK ADDED * *-------------------------------------------------------------* PERFORM 8680-SET-PTRADIO-LINE-FLAG THRU 8680-SET-PTRADIO-LINE-FL-EXIT. *************************************************************** * CALCULATE MAXIMUM COINSURANCE AMOUNT (INPATIENT LIMIT) * *************************************************************** COMPUTE H-MAX-COIN ROUNDED = (H-IP-LIMIT * W-SRVC-UNITS (W-LP-INDX) * W-DISC-RATE (W-LP-INDX)). *************************************************************** * CALCULATE FULL AND PARTIAL CREDIT DEVICE REDUCTIONS AND * * REDUCE THE APC PAYMENT BY THE REDUCTION AMOUNT * * PAYMENT ADJUSTMENT FLAGS: 7 = FULL, 8 = PARTIAL CREDIT * *-------------------------------------------------------------* * 11/1/2007 - PYMT ADJ FLAG 8 ADDED FOR PARTIAL CREDIT * * DEDUCTIONS - NEW FOR CY 2008 * *************************************************************** IF OPPS-PYMT-ADJ-FLAG (LN-SUB) = ' 7' OR ' 8' PERFORM 8550-DEVICE-REDUC THRU 8550-DEVICE-REDUC-EXIT. *************************************************************** * CALCULATE PAYMENT FOR SI = S, V, T, P, OR X LINES * * THE APC PAYMENT IS 60% WAGE ADJUSTED * *-------------------------------------------------------------* * 11/13/2007 - ADDED PERFORM 7560-CALC-BENE-DEDUCT * * (REMOVED FROM PARAGRAPH 7550-SCH-ADJ) * *************************************************************** IF (OPPS-SRVC-IND (LN-SUB) = ' S' OR ' V' OR ' T' OR ' P' OR ' X') THEN PERFORM 8550-SCH-ADJ THRU 8550-SCH-ADJ-EXIT PERFORM 8560-CALC-BENE-DEDUCT THRU 8560-CALC-BENE-DEDUCT-EXIT IF OPPS-SRVC-IND (LN-SUB) = ' P' THEN PERFORM 8550-PHP-PMT-FOR-OUTL THRU 8550-PHP-PMT-FOR-OUTL-EXIT END-IF *************************************************************** * CALCULATE PAYMENT FOR SI = H (DEVICE) LINES, PAYMENT IND. * * SHOULD BE 6 FOR THESE LINES (BASED ON CHARGE ADJ. TO COST) * * AND SI = U (BRACHYTHERAPY) LINES, PAYMENT ADJ. FLAG SHOULD * * BE 2 FOR THESE LINES * * RETURN ERROR CODE 44 IF THIS IS NOT THE CASE * *************************************************************** ELSE IF (OPPS-SRVC-IND (LN-SUB) = ' H' OR ' U') THEN IF (OPPS-SRVC-IND (LN-SUB) = ' H' AND OPPS-PYMT-IND (LN-SUB) = ' 6') OR (OPPS-SRVC-IND (LN-SUB) = ' U' AND OPPS-PYMT-ADJ-FLAG (LN-SUB) = ' 2') THEN PERFORM 8555-CALC-H-STANDARD THRU 8555-CALC-H-STANDARD-EXIT PERFORM 8560-CALC-BENE-DEDUCT THRU 8560-CALC-BENE-DEDUCT-EXIT ELSE MOVE 44 TO A-RETURN-CODE (LN-SUB) GO TO 8550-CALC-STANDARD-EXIT END-IF *************************************************************** * CALCULATE PAYMENT FOR SI = G, K & R LINES; THE PAYMENT IND. * * SHOULD BE 1, 5, OR 7 FOR THESE LINES (PAY STANDARD AMOUNT) * * RETURN ERROR CODE 41 IF INVALID SI - PYMT IND. COMBO * *-------------------------------------------------------------* * 12/31/2007 - REMOVED REDUNDANT H-BLOOD-FRAC. INITIALIZATION * *************************************************************** ELSE IF OPPS-SRVC-IND (LN-SUB) = ' G' OR ' K' OR ' R' THEN IF OPPS-PYMT-IND (LN-SUB) = ' 1' OR ' 5' OR ' 7' THEN PERFORM 8550-CALC-GJK THRU 8550-CALC-GJK-EXIT IF PTRADIO-LINE-FLAG = 'Y' AND H-NUCMED-TOT-OFFSET > 0 THEN PERFORM 8550-PTRADIO-OFFSET THRU 8550-PTRADIO-OFFSET-EXIT END-IF PERFORM 8560-CALC-BENE-DEDUCT THRU 8560-CALC-BENE-DEDUCT-EXIT ELSE MOVE 41 TO A-RETURN-CODE (LN-SUB) GO TO 8550-CALC-STANDARD-EXIT END-IF END-IF END-IF END-IF. *************************************************************** * CALCULATE LINE REIMBURSEMENT * *-------------------------------------------------------------* * 11/01/2007 - PERFORMS FOR PARAGRAPHS 7550-PD-AT-CST-JAN07 * * AND 7550-PD-AT-CST-JUL07 WERE DELETED (THE PARAGRAPHS * * WERE ALSO DELETED). THERE IS NO PAID AT COST TABLE FOR * * 2008. UNDER THE ORIGINAL 2008 LEGISLATION, DIAGNOSIS * * RADIOPHARM LINES WERE PACKAGED (SI=' N') AND THERAPEUTIC * * RADIOPHARM AND BRACHYTHERAPY LINES WERE SEPARATELY * * PAYABLE (SI=' K'). THEREFORE, PAID AT COST LOGIC WAS NOT * * NEEDED. * * * * 12/06/2007 - LINE REIMBURSEMENT AND NATIONAL COINSURANCE * * CALCULATIONS, AND MINIMUM COINSURANCE MOVE INSERTED * * (TAKEN FROM 6550-PD-AT-CST-JAN07). * * * * 12/27/2007 - PAID AT COST LOGIC REINSTATED FOR RADIOPHARM * * AND BRACHYTHERAPY LINES WITH A STATUS INDICATOR = ' H'. * * PAID AT COST LOGIC REVISED: NO TABLE OR TABLE SEARCH; * * FLAGS ARE USED INSTEAD. (REINSTATEMENT IS DUE TO A * * CHANGE IN LEGISLATION; ALL RADIO. & BRACHY SI = ' H'.) * * * * 05/14/2008 - PAID AT COST LOGIC NO LONGER APPLIED TO * * RADIOPHARM AND BRACHYTHERAPY LINES AS OF JULY 1, 2008. * * THESE LINES ARE ASSIGNED A SI OF ' K' EFFECTIVE JULY 1, * * 2008, SO THEY WILL AUTOMATICALLY BY-PASS THE LOGIC AND * * RECEIVE THE STANDARD REIM. PAID AT COST LOGIC RETAINED * * FOR PREVIOUS QUARTERS (JANUARY 1 - JUNE 30, 2008). * * * * 08/07/2008 - DUE TO LEGISLATION, THERAPEUTIC RADIOPHARMS & * * BRACHYTHERAPY SOURCE'S SI CHANGED FROM 'K' BACK TO 'H'; * * THEY CONTINUE TO BE PAID AT COST (EFFECTIVE 7/1/2008) * * * * 11/12/2008 - BRACHYTHERAPY SOURCE'S STATUS INDICATOR = ' U' * * EFFECTIVE 1/1/2009 * * * *************************************************************** *-------------------------------------------------------------* * PAID AT COST LINE REIMBURSEMENT CALCULATION (REIM = 80%) * * THERAPEUTIC RADIOPHARMACEUTICALS & BRACHYTHERAPY SOURCES * *-------------------------------------------------------------* IF (OPPS-SRVC-IND (LN-SUB) = ' H' AND RADIOPH-APC-FLAG = 'Y') OR (OPPS-SRVC-IND (LN-SUB) = ' U' AND OPPS-PYMT-ADJ-FLAG (LN-SUB) = ' 2') COMPUTE H-LITEM-REIM ROUNDED = ((H-LITEM-PYMT - H-TOTAL-LN-DEDUCT) - H-LN-BLOOD-DEDUCT) * .8 *-------------------------------------------------------------* * STANDARD LINE REIMBURSEMENT CALCULATION * *-------------------------------------------------------------* ELSE COMPUTE H-LITEM-REIM ROUNDED = ((H-LITEM-PYMT - H-TOTAL-LN-DEDUCT) - H-LN-BLOOD-DEDUCT) * W-PPCT (W-LP-INDX) END-IF. *************************************************************** * CALCULATE NATIONAL COINSURANCE * *-------------------------------------------------------------* * 12/6/2007 - LOGIC ADDED (TAKEN FROM 6550-PD-AT-CST-JAN07) * *************************************************************** COMPUTE H-NAT-COIN = H-LITEM-PYMT - H-TOTAL-LN-DEDUCT - H-LITEM-REIM - H-LN-BLOOD-DEDUCT. *************************************************************** * ADJUST MINIMUM COINSURANCE AMOUNT * * (REPLACES WHAT WAS IN THE APC TABLE IF > 0) * *************************************************************** MOVE W-MIN-COIN (W-LP-INDX) TO H-MIN-COIN. IF H-MIN-COIN > 0 *-------------------------------------------------------------* * DRUGS, DEVICES, BRACHYTHERAPY, THERAP. RADIO, & BLOOD * * (SI = G AND H LINES HAVE A MIN-COIN = 0, WON'T ENTER LOGIC) * *-------------------------------------------------------------* IF OPPS-SRVC-IND (LN-SUB) = ' G' OR ' H' OR ' K' OR ' R' OR ' U' COMPUTE H-MIN-COIN ROUNDED = H-MIN-COIN * (W-SRVC-UNITS (W-LP-INDX) - (W-SRVC-UNITS (W-LP-INDX) * H-BLOOD-FRACTION)) * W-DISC-RATE (W-LP-INDX) *-------------------------------------------------------------* * APCS 0158 & 0159'S MIN COINSURANCE = 25% OF LINE PMT * *-------------------------------------------------------------* ELSE IF OPPS-APC (LN-SUB) = '0158' OR '0159' COMPUTE H-MIN-COIN ROUNDED = H-LITEM-PYMT * .25 *-------------------------------------------------------------* * OTHER SERVICE TYPES AND APCS' MIN COIN = 20% OF LINE PMT * *-------------------------------------------------------------* ELSE COMPUTE H-MIN-COIN ROUNDED = H-LITEM-PYMT * .2 END-IF END-IF END-IF. *************************************************************** * ADJUST REDUCED COINSURANCE WHEN NECESSARY & ADJUST CLAIM * * TOTAL LINE ITEM REIMBURSEMENT WHEN THE REDUCED AND/OR * * NATIONAL COINSURANCE AMOUNTS EXCEED THE MAXIMUM COINSURANCE * * (PROVIDER MAY ELECT TO REDUCE COINSURANCE) * *************************************************************** MOVE W-RED-COIN (W-LP-INDX) TO H-RED-COIN. IF (H-RED-COIN > 0 AND < H-MIN-COIN) MOVE H-MIN-COIN TO H-RED-COIN ELSE IF H-RED-COIN < H-NAT-COIN AND > H-MIN-COIN AND > H-MAX-COIN COMPUTE H-LITEM-REIM = H-LITEM-REIM + (H-RED-COIN - H-MAX-COIN) END-IF END-IF. IF H-NAT-COIN > H-MAX-COIN AND H-RED-COIN = 0 THEN COMPUTE H-LITEM-REIM = H-LITEM-REIM + (H-NAT-COIN - H-MAX-COIN) MOVE H-MAX-COIN TO H-NAT-COIN. 8550-CALC-STANDARD-EXIT. EXIT. *************************************************************** * * * DELETED CODE: * * PAID AT COST WITH COINSURANCE TABLE SEARCH REMOVED * * 11/1/2007 FOR CY 2008. THERE IS NO NEW PAID AT COST * * TABLE FOR 2008. PARAGRAPHS REMOVED: * * - 7550-PD-AT-CST-JAN07, * * - 7550-PD-AT-CST-JAN07-EXIT, * * - 7550-PD-AT-CST-JUL07, * * - 7550-PD-AT-CST-JUL07-EXIT. * * * *************************************************************** *************************************************************** * * * DEVICE REDUCTION PROCESSING * * * *************************************************************** * * * SEARCH THE DEVICE REDUCTION TABLE TO SEE IF THERE IS AN APC * * MATCH; IF SO, REDUCE THE PYMT BY THE REDUCTION AMOUNT * * BECAUSE THIS IS A FREE OR REPLACEMENT DEVICE -OR- A PARTIAL * * CREDIT DEVICE. * * * * * BE SURE TO UPDATE THE TABLE REFERENCES EACH YEAR * * * * *-------------------------------------------------------------* * * * 11/1/2007 - PARTIAL CREDIT DEVICE PROCESSING ADDED * * NEW FOR CY 2008 * * * *************************************************************** 8550-DEVICE-REDUC. SEARCH ALL DEV-RED09 AT END GO TO 8550-DEVICE-REDUC-EXIT WHEN DEV-APC9 (DEV-INDX9) = OPPS-APC (LN-SUB) PERFORM 8550-DEVICE-COMPUTE THRU 8550-DEVICE-COMPUTE-EXIT. 8550-DEVICE-REDUC-EXIT. EXIT. *************************************************************** * * * IF THE DEVICE IS FOUND, AND REDUCTION AMOUNT IS LESS THAN * * PAYMENT AMOUNT, SUBTRACT REDUCTION AMOUNT FROM THE PAYMENT * * * * * BE SURE TO UPDATE THE TABLE REFERENCES EACH YEAR * * * * *-------------------------------------------------------------* * * * 11/1/2007 - PARTIAL CREDIT DEVICE PROCESSING ADDED * * NEW FOR CY 2008 * * * *************************************************************** 8550-DEVICE-COMPUTE. *-------------------------------------------------------------* * PROCESS FULL DEVICE REDUCTION (PAF = 7) * *-------------------------------------------------------------* IF OPPS-PYMT-ADJ-FLAG (LN-SUB) = ' 7' IF W-APC-PYMT (W-LP-INDX) NUMERIC IF W-APC-PYMT (W-LP-INDX) > DEV-REDUC9 (DEV-INDX9) COMPUTE W-APC-PYMT (W-LP-INDX) = (W-APC-PYMT (W-LP-INDX) - DEV-REDUC9 (DEV-INDX9)). *-------------------------------------------------------------* * PROCESS PARTIAL CREDIT DEVICE REDUCTION (PAF = 8) * *-------------------------------------------------------------* IF OPPS-PYMT-ADJ-FLAG (LN-SUB) = ' 8' IF W-APC-PYMT (W-LP-INDX) NUMERIC IF W-APC-PYMT (W-LP-INDX) > (DEV-REDUC9 (DEV-INDX9) / 2) COMPUTE W-APC-PYMT (W-LP-INDX) = (W-APC-PYMT (W-LP-INDX) - (DEV-REDUC9 (DEV-INDX9) / 2)). 8550-DEVICE-COMPUTE-EXIT. EXIT. *************************************************************** * * * CALCULATE WAGE ADJUSTED LINE ITEM PAYMENT WITH RURAL * * SOLE COMMUNITY HOSPITAL (SCH) ADJUSTMENT WHEN APPLICABLE * * * * FOR LINES WITH A SI OF S, V, T, P, X, OR R * * * *************************************************************** * * * THE SCH ADJUSTMENT IS MADE WHEN THE FOLLOWING IS TRUE: * * EITHER THE L-PSF-GEO-CBSA OR THE L-PSF-WI-CBSA MUST BE A * * VALUE OF ' 01' THRU ' 99' AND THE L-PSF-PROV-TYPE * * MUST BE A '16' OR '17' OR '21' OR '22'. * * * * EACH YEAR, CHECK WHETHER THE SCH ADJUSTMENT HARDCODED BELOW * * HAS CHANGED. * * CYS 2006 - 2009: SCH ADJ = 7.1% (1.071) * * * * * * 11/08/2007 - PROCESSING FOR BRACHY & BLOOD CODES WITH AN SI * * = K ADDED FOR CY 2008 * * 11/13/2007 - PROCESSING FOR BRACHY & BLOOD CODES REVISED. * * BLD-DEDUC-HCPCS-FLAG ADDED TO LOGIC. * * 11/13/2007 - PARAGRAPH 7560-CALC-BENE-DEDUCT PERFORM * * DELETED & MOVED TO PAR. 7550-CALC-STANDARD * * 05/14/2008 - BRACHYTHERAPY LINES PROCESSED IN THIS * * PARAGRAPH STARTING 7/1/2008 BECAUSE SI CHANGED * * TO ' K' ON THIS DATE. * * 08/07/2008 - DUE TO LEGISLATION, THERAPEUTIC RADIOPHARMS & * * BRACHYTHERAPY SOURCE'S SI CHANGED FROM 'K' * * BACK TO 'H' EFFECTIVE 7/1/2008; THESE LINES * * ARE NOT YET PROCESSED IN THIS PARAGRAPH * * 11/13/2008 - FOR CY 2009, BLOOD DEDUCTIBLE LINES (SI=R) * * ADDED TO LOGIC. BRACHY LINES NOT PROCESSED IN * * PARAGRAPH & NOW HAVE A SI = U, SI = K LOGIC * * REMOVED FROM THIS PARAGRAPH. * * 05/11/2009 - ADDED THE REQUIREMENT PAF = 5 OR 6 TO BLOOD * * DEDUCTIBLE LOGIC TO CORRECT PRICING ERROR. * * FIX EFFECTIVE RETROACTIVE TO 01/01/2009. * * 05/09/2011 - REVISED LOGIC TO EXCLUDE BILL TYPE 14X FROM * * RECEIVING THE SCH ADD-ON * * * *************************************************************** 8550-SCH-ADJ. MOVE L-PSF-GEO-CBSA TO GEO-CBSA-FLAG. MOVE L-PSF-WI-CBSA TO WI-CBSA-FLAG. *************************************************************** * CALCULATE THE SCH PAYMENT * * - FOR SCHS = APC OR BLOOD APC PAYMENT ADJUSTED BY 7.1% * * - FOR NON-SCHS = UNADJUSTED APC OR BLOOD APC PAYMENT * *************************************************************** IF ((RURAL-GEO OR RURAL-WI) AND (L-PSF-PROV-TYPE = '16' OR '17' OR '21' OR '22') AND (BILL14X-FLAG = 'N')) *-------------------------------------------------------------* * SCH, BLOOD DEDUCTIBLE HCPCS LINE * *-------------------------------------------------------------* IF OPPS-SRVC-IND (LN-SUB) = ' R' AND BLD-DEDUC-HCPCS-FLAG = 'Y' AND OPPS-PYMT-ADJ-FLAG (LN-SUB) = (' 5' OR ' 6') COMPUTE H-SCH-PYMT ROUNDED = (W-BD-APC-PYMT (W-BD-INDX) * 1.071) *-------------------------------------------------------------* * SCH, NOT A LINE WITH A BLOOD DEDUCTIBLE HCPCS * *-------------------------------------------------------------* ELSE COMPUTE H-SCH-PYMT ROUNDED = (W-APC-PYMT (W-LP-INDX) * 1.071) END-IF *-------------------------------------------------------------* * NON-SCH, BLOOD DEDUCTIBLE HCPCS LINE * *-------------------------------------------------------------* ELSE IF OPPS-SRVC-IND (LN-SUB) = ' R' AND BLD-DEDUC-HCPCS-FLAG = 'Y' AND OPPS-PYMT-ADJ-FLAG (LN-SUB) = (' 5' OR ' 6') MOVE W-BD-APC-PYMT (W-BD-INDX) TO H-SCH-PYMT *-------------------------------------------------------------* * NON-SCH, NOT A LINE WITH A BLOOD DEDUCTIBLE HCPCS * *-------------------------------------------------------------* ELSE MOVE W-APC-PYMT (W-LP-INDX) TO H-SCH-PYMT END-IF END-IF. *************************************************************** * CALCULATE THE LINE ITEM PAYMENT * *************************************************************** *-------------------------------------------------------------* * SI = R LINES (BLOOD) ARE NOT WAGE-ADJUSTED * *-------------------------------------------------------------* IF OPPS-SRVC-IND (LN-SUB) = ' R' IF BLD-DEDUC-HCPCS-FLAG = 'Y' AND OPPS-PYMT-ADJ-FLAG (LN-SUB) = (' 5' OR ' 6') COMPUTE H-LITEM-PYMT ROUNDED = H-SCH-PYMT * W-BD-SRVC-UNITS (W-BD-INDX) * W-BD-DISC-RATE (W-BD-INDX) ELSE COMPUTE H-LITEM-PYMT ROUNDED = H-SCH-PYMT * W-SRVC-UNITS (W-LP-INDX) * W-DISC-RATE (W-LP-INDX) END-IF *-------------------------------------------------------------* * SI = S, V, T, P, OR X LINES ARE WAGE-ADJUSTED (60%) * *-------------------------------------------------------------* ELSE COMPUTE H-LITEM-PYMT ROUNDED = (((H-SCH-PYMT * .60) * W-WINX1 (W-LP-INDX)) + (H-SCH-PYMT * .40)) * W-SRVC-UNITS (W-LP-INDX) * W-DISC-RATE (W-LP-INDX) END-IF. 8550-SCH-ADJ-EXIT. EXIT. *************************************************************** * * * CALCULATE WAGE ADJUSTED LINE ITEM PAYMENT WITH RURAL * * SOLE COMMUNITY HOSPITAL (SCH) ADJUSTMENT WHEN APPLICABLE * * * * FOR PARTIAL HOSPITALIZATION (PHP) "CAP" APC * * FOR USE IN THE OUTLIER CALCULATION * * (FOR SI = P LINES ONLY) * * * * ** ASK POLICY FOR THE PHP "CAP" APC ANUALLY ** * * * *-------------------------------------------------------------* * * * 11/13/2008 - THIS PARAGRAPH IS NEW FOR CY 2009, * * CY 2009 PHP "CAP" APC = 0173 * * * *************************************************************** 8550-PHP-PMT-FOR-OUTL. *-------------------------------------------------------------* * LOOK-UP PHP "CAP" APC IN THE APC TABLE, STARTING AT * * THE APC'S MOST CURRENT RECORD - RETRIEVE PAYMENT RATE * *-------------------------------------------------------------* SEARCH ALL WAA-ENTRY AT END GO TO 8550-PHP-PMT-FOR-OUTL-EXIT WHEN WAA-APC (WAA-INDX) = '00173' MOVE WAA-PTR (WAA-INDX) TO W-SUB2 PERFORM 8550-PHP-APC-LOOKUP. *-------------------------------------------------------------* * REDUCE APC PMT RATE BY REDUCED UPDATE RATIO WHEN APPROPRIATE* * 11/13/2009 - NEW FOR CY 2009 * *-------------------------------------------------------------* PERFORM 8180-REDUCE-APC-PYMT THRU 8180-REDUCE-APC-PYMT-EXIT. *-------------------------------------------------------------* * APPLY THE SCH ADJUSTMENT TO APC RATE WHEN APPLICABLE * * CY 2009 ADJ = 7.1% * *-------------------------------------------------------------* IF ((RURAL-GEO OR RURAL-WI) AND (L-PSF-PROV-TYPE = '16' OR '17' OR '21' OR '22')) COMPUTE H-APC-PYMT ROUNDED = (H-APC-PYMT * 1.071) END-IF. *-------------------------------------------------------------* * CALCULATE THE PHP "CAP" APC'S LINE PAYMENT (INCLUDES * * WAGE ADJUSTMENT AND SCH ADJUSTMENT IF APPLICABLE) * *-------------------------------------------------------------* COMPUTE H-PHP-LITEM-PYMT-OUTL ROUNDED = (((H-APC-PYMT * .60) * W-WINX1 (W-LP-INDX)) + (H-APC-PYMT * .40)) * W-SRVC-UNITS (W-LP-INDX) * W-DISC-RATE (W-LP-INDX). 8550-PHP-PMT-FOR-OUTL-EXIT. EXIT. *************************************************************** * * * LOOK-UP PHP "CAP" APC IN THE APC TABLE * * * *-------------------------------------------------------------* * * * 11/13/2008 - THIS PARAGRAPH IS NEW FOR CY 2009 * * * *************************************************************** 8550-PHP-APC-LOOKUP. *************************************************************** * APC RECORD EFFECTIVE DATE IS BEFORE OR ON THE LATEST * * EFFECTIVE DATE THE CLAIM CAN USE (SEARCH STARTS AT THE * * MOST CURRENT RECORD FOR THE APC) * *************************************************************** IF WAR-DTCD (W-SUB2) NOT > WAD-DTCD (WAD-SUB) *-------------------------------------------------------------* * APC RECORD EFFECTIVE DATE CORRECT, APC DELETED - ERROR * *-------------------------------------------------------------* IF WAR-RATEX (W-SUB2) = 'DELETED' MOVE ZEROS TO H-APC-PYMT *-------------------------------------------------------------* * APC RECORD EFFECTIVE DATE CORRECT, APC ACTIVE - ACCEPT REC * *-------------------------------------------------------------* ELSE MOVE WAR-RATE (W-SUB2) TO H-APC-PYMT *************************************************************** * APC RECORD EFFECTIVE DATE IS AFTER THE LATEST EFFECTIVE * * DATE THE CLAIM CAN USE. GO TO THE PREVIOUS RECORD IN THE * * APC TABLE. * *************************************************************** ELSE SUBTRACT 1 FROM W-SUB2 *-------------------------------------------------------------* * PREVIOUS REC BELONGS TO THE LINE APC, TEST EFFECTIVE DATE * *-------------------------------------------------------------* IF W-SUB2 > WAA-PTR (WAA-INDX - 1) GO TO 8550-PHP-APC-LOOKUP *-------------------------------------------------------------* * THERE IS NO RECORD FOR THE LINE APC WITH AN ACCEPTABLE * * EFFECTIVE DATE FOR THE LINE. RETURN ZEROS. * *-------------------------------------------------------------* ELSE MOVE 0 TO H-APC-PYMT. 8550-PHP-APC-LOOKUP-EXIT. EXIT. *************************************************************** * * * CALCULATE THE FOLLOWING FOR VALID SI = G, K & R LINES: * * - APC PAYMENT FOR BLOOD LINES (SI = R) * * - BLOOD SPECIFIC ITEMS FOR BLOOD LINES * * - LINE ITEM PMT FOR ALL SI = G OR K LINES (DRUGS & * * BIOLOGICALS) * * - SCH ADJUSTMENT APPLIED TO ELIGIBLE BLOOD LINES * * - BLOOD DEDUCTIBLE FOR BLOOD DEDUCTIBLE HCPCS LINES * * * *************************************************************** * * * - EFFECTIVE 01/01/2003, REMOVE PRO RATA REDUCTION FOR * * ALL SERVICE INDICATOR 'G' PAYMENTS. * * - 11/13/2007 - LINE ITEM PAYMENTS FOR BLOOD AND BRACHY * * LINES ARE CALCULATED IN PARAGRAPH 7550-SCH-ADJ TO APPLY * * THE SOLE COMMUNITY HOSPITAL (SCH) ADJUSTMENT WHEN * * APPLICABLE * * - 12/31/2007 - BRACHYTHERAPY & RADIOPHARM LINES' STATUS * * INDICATOR CHANGED BACK TO 'H' TEMPORARILY; THESE LINES * * WILL NOT ENTER THIS PARAGRAPH NOR PARAGRAPH 7550-SCH-ADJ * * UNTIL THEIR STATUS INDICATOR IS CHANGED BACK TO 'K' * * - 05/14/2008 - BRACHYTHERAPY & RADIOPHARM LINES' SI CHANGED * * TO ' K' EFFECTIVE 7/1/2008. THESE LINES ARE PROCESSED * * IN THIS PARAGRAPH STARTING 7/1/2008. * * - 08/07/2008 - DUE TO LEGISLATION, THERAPEUTIC RADIOPHARMS * * & BRACHYTHERAPY SOURCE'S SI CHANGED FROM 'K' BACK TO 'H' * * EFFECTIVE 7/1/2008; THESE LINES ARE NOT YET PROCESSED IN * * THIS PARAGRAPH. * * - 11/12/2008 - FOR CY 2009, BRACHYS NOT PROCESSED IN THIS * * PARAGRAPH; BRACHY LINES ASSIGNED A NEW SI OF ' U' * * - 11/13/2008 - FOR CY 2009, BLOOD DEDUCTIBLE LINES HAVE A * * SI = R * * - 12/05/2008 - MODIFIED LOGIC TO SEND BLOOD LINES WITHOUT * * A PMT ADJ FLAG = 5 OR 6 TO THE SCH ADJUSTMENT PARAGRAPH, * * INCLUDED SI = R IN THE BLOOD IDENTIFICATION LOGIC * * * *************************************************************** 8550-CALC-GJK. *************************************************************** * * * CALCULATE LINE ITEM PAYMENT & BLOOD DEDUCTIBLE FOR BLOOD * * LINE WITH A HCPCS SUBJECT TO THE BLOOD DEDUCTIBLE (BD) * * * * (BLOOD DEDUCTIBLE LINES ARE PROCESSED IN THE ORDER THEY * * APPEAR IN THE BLOOD DEDUCTIBLE TABLE - EARLIEST TO LATEST * * DATE, LEAST TO MOST EXPENSIVE PAYMENT RATE. THE CURRENT * * COINSURANCE DEDUCTIBLE TABLE LINE BEING PROCESSED DOES NOT * * NECESSARILY CORRESPOND TO THE BLOOD DEDUCTIBLE LINE * * PROCESSED IN THE LOGIC BELOW.) * * * *************************************************************** IF OPPS-SRVC-IND (LN-SUB) = ' R' AND BLD-DEDUC-HCPCS-FLAG = 'Y' AND OPPS-PYMT-ADJ-FLAG (LN-SUB) = (' 5' OR ' 6') *-------------------------------------------------------------* * CALCULATE BLOOD FRACTION & BLOOD PINTS USED * *-------------------------------------------------------------* PERFORM 8550-SET-BLOOD-FRACTION THRU 8550-SET-BLOOD-FRACTION-EXIT *-------------------------------------------------------------* * ADJUST BLOOD APC PAYMENT BY BLOOD PRODUCT OR LABOR RATE * *-------------------------------------------------------------* PERFORM 8550-ADJ-BLOOD-COST THRU 8550-ADJ-BLOOD-COST-EXIT *-------------------------------------------------------------* * CALCULATE LINE ITEM PAYMENT W/ SCH ADJUSTMENT IF APPLICABLE * *-------------------------------------------------------------* * 11/14/2007 - 7550-SCH-ADJ PERFORM ADDED; LINE ITEM PAYMENT * * CALCULATION REMOVED FROM THIS SECTION * *-------------------------------------------------------------* PERFORM 8550-SCH-ADJ THRU 8550-SCH-ADJ-EXIT *-------------------------------------------------------------* * CALCULATE BLOOD DEDUCTIBLE (BD) - H-BLOOD-FRACTION IS THE * * FRACTION OF THE CURRENT LINE'S PINTS COVERED BY THE BD * *-------------------------------------------------------------* COMPUTE H-LN-BLOOD-DEDUCT ROUNDED = H-LITEM-PYMT * H-BLOOD-FRACTION *-------------------------------------------------------------* * POINT TO NEXT BLOOD DEDUCTIBLE RECORD FOR NEXT BD LINE * *-------------------------------------------------------------* SET W-BD-INDX UP BY 1 *************************************************************** * * * CALCULATE LINE ITEM PAYMENT FOR BLOOD LINE WITH A HCPCS NOT * * SUBJECT TO THE BLOOD DEDUCTIBLE, BUT PAF = 5 OR 6 * * (BLOOD PROCESSING AND PRODUCT BILLED TOGETHER) * * * *************************************************************** ELSE IF OPPS-SRVC-IND (LN-SUB) = ' R' AND OPPS-PYMT-ADJ-FLAG (LN-SUB) = (' 5' OR ' 6') *-------------------------------------------------------------* * ADJUST APC PAYMENT BY BLOOD PRODUCT OR LABOR RATE * *-------------------------------------------------------------* * 11/13/2007 - LINE ITEM PMT NO LONGER CALCULATED IN * * 7550-ADJ-PLATE-COST, BUT IN 7550-SCH-ADJ * *-------------------------------------------------------------* PERFORM 8550-ADJ-PLATE-COST THRU 8550-ADJ-PLATE-COST-EXIT *-------------------------------------------------------------* * CALCULATE LINE ITEM PAYMENT W/ SCH ADJUSTMENT IF APPLICABLE * *-------------------------------------------------------------* * 11/14/2007 - 7550-SCH-ADJ PERFORM ADDED; LINE ITEM PAYMENT * * CALCULATION REMOVED FROM THIS SECTION * *-------------------------------------------------------------* PERFORM 8550-SCH-ADJ THRU 8550-SCH-ADJ-EXIT *************************************************************** * * * CALCULATE LINE ITEM PAYMENT FOR BLOOD LINE WITH A HCPCS NOT * * SUBJECT TO THE BLOOD DEDUCTIBLE AND PAF NOT EQUAL TO 5 OR 6 * * (ONLY BLOOD PRODUCT BILLED) * * * *************************************************************** ELSE IF OPPS-SRVC-IND (LN-SUB) = ' R' *-------------------------------------------------------------* * CALCULATE LINE ITEM PAYMENT W/ SCH ADJUSTMENT IF APPLICABLE * *-------------------------------------------------------------* * 12/05/2008 - 7550-SCH-ADJ PERFORM ADDED FOR BLOOD LINES * * CALCULATION REMOVED FROM THIS SECTION * *-------------------------------------------------------------* PERFORM 8550-SCH-ADJ THRU 8550-SCH-ADJ-EXIT *************************************************************** * * * CALCULATE LINE ITEM PAYMENT FOR DRUGS AND BIOLOGICALS * * * *************************************************************** ELSE IF OPPS-SRVC-IND (LN-SUB) = ' G' OR ' K' COMPUTE H-LITEM-PYMT ROUNDED = W-APC-PYMT (W-LP-INDX) * W-SRVC-UNITS (W-LP-INDX) * W-DISC-RATE (W-LP-INDX) END-IF END-IF END-IF END-IF. 8550-CALC-GJK-EXIT. EXIT. *************************************************************** * * * DETERMINE THE FRACTION OF THE BLOOD LINE'S PAYMENT THAT * * WILL BE COVERED BY THE THE BENEFICIARY'S BLOOD DEDUCTIBLE * * FOR LINES WITH A HCPCS IN THE BLOOD DEDUCTIBLE LIST * * * * THE BENEFICIARY PAYS A BLOOD DEDUCTIBLE FOR THE FIRST * * 3 CHEAPEST BLOOD PINTS. MEDICARE COVERS ANY ADDITIONAL * * PINTS USED BY THE BENEFICIARY. * * * *************************************************************** 8550-SET-BLOOD-FRACTION. *-------------------------------------------------------------* * NAVIGATE TO SERVICE LINE ASSOCIATED WITH THE BLOOD ENTRY * *-------------------------------------------------------------* MOVE W-BD-SUB (W-BD-INDX) TO LN-SUB. *-------------------------------------------------------------* * BLOOD/BLOOD PRODUCT LINE * *-------------------------------------------------------------* IF OPPS-PYMT-ADJ-FLAG (LN-SUB) = ' 5' IF H-BENE-PINTS-USED > 0 *-------------------------------------------------------------* * BENEFICIARY HAS ENOUGH PINTS TO COVER ALL BLOOD LINE UNITS * * - BLOOD DEDUCTIBLE WILL COVER THE ENTIRE PYMNT (FRAC. = 1) * * - CALCULATE THE NUMBER OF DEDUCTIBLE PINTS BENE HAS LEFT * *-------------------------------------------------------------* IF W-BD-SRVC-UNITS (W-BD-INDX) <= H-BENE-PINTS-USED MOVE 1 TO H-BLOOD-FRACTION COMPUTE H-BENE-PINTS-USED = H-BENE-PINTS-USED - W-BD-SRVC-UNITS (W-BD-INDX) *-------------------------------------------------------------* * BENE. DOESN'T HAVE ENOUGH PINTS TO COVER ENTIRE BLOOD LINE * * - BLOOD DEDUCTIBLE WILL COVER A FRACTION OF THE PAYMENT * * (ACCORDING TO THE % OF PINTS COVERED) * * - BENEFICIARY HAS NO DEDUCTIBLE PINTS LEFT (PINTS = 0) * *-------------------------------------------------------------* ELSE IF W-BD-SRVC-UNITS (W-BD-INDX) > H-BENE-PINTS-USED COMPUTE H-BLOOD-FRACTION = H-BENE-PINTS-USED / W-BD-SRVC-UNITS (W-BD-INDX) MOVE 0 TO H-BENE-PINTS-USED ELSE MOVE 0 TO H-BLOOD-FRACTION *-------------------------------------------------------------* * BENEFICIARY HAS NO BLOOD DEDUCTIBLE PINTS LEFT * * THERE IS NO BLOOD DEDUCTIBLE * *-------------------------------------------------------------* ELSE MOVE 0 TO H-BLOOD-FRACTION *-------------------------------------------------------------* * BLOOD PROCESS/STORAGE LINE (PAF = 6) * * THERE IS NO BLOOD DEDUCTIBLE * *-------------------------------------------------------------* ELSE MOVE 0 TO H-BLOOD-FRACTION. 8550-SET-BLOOD-FRACTION-EXIT. EXIT. *************************************************************** * * * ADJUST APC PAYMENT BY BLOOD PRODUCT OR LABOR RATE TO * * CALCULATE THE BLOOD APC PAYMENT FOR LINES WITH A HCPCS * * IN THE BLOOD DEDUCTIBLE LIST * * * * THE RATE OF BLOOD TO BLOOD LABOR IS THE CLAIM AVERAGE. * * THE BLOOD LINE IS PAID ONLY THE PORTION OF THE APC * * PAYMENT THAT IS INDICATED BY THE PYMNT ADJUSTMENT FLAG. * * * *************************************************************** 8550-ADJ-BLOOD-COST. MOVE W-BD-SUB (W-BD-INDX) TO LN-SUB. *-------------------------------------------------------------* * CALCULATE BLOOD APC PAYMENT FOR BLOOD/BLOOD PRODUCT LINE * *-------------------------------------------------------------* IF OPPS-PYMT-ADJ-FLAG (LN-SUB) = ' 5' COMPUTE W-BD-APC-PYMT (W-BD-INDX) = W-BD-APC-PYMT (W-BD-INDX) * H-38X-39X-RATE. *-------------------------------------------------------------* * CALCULATE BLOOD APC PAYMENT FOR BLOOD PROCESS/STORAGE LINE * *-------------------------------------------------------------* IF OPPS-PYMT-ADJ-FLAG (LN-SUB) = ' 6' COMPUTE W-BD-APC-PYMT (W-BD-INDX) = W-BD-APC-PYMT (W-BD-INDX) * (1 - H-38X-39X-RATE). 8550-ADJ-BLOOD-COST-EXIT. EXIT. *************************************************************** * * * ADJUST APC PAYMENT BY BLOOD PRODUCT OR LABOR RATE TO * * CALCULATE THE BLOOD APC PAYMENT FOR BLOOD LINES WITH A * * HCPCS NOT IN THE BLOOD DEDUCTIBLE LIST * * * * THE RATE OF BLOOD TO BLOOD LABOR IS THE CLAIM AVERAGE. * * THE BLOOD LINE IS PAID ONLY THE PORTION OF THE APC * * PAYMENT THAT IS INDICATED BY THE PYMNT ADJUSTMENT FLAG. * * * *************************************************************** * * * 11/13/2007 - REMOVED LINE ITEM PAYMENT CALCULATION FROM * * THIS PARAGRAPH, NOW PERFORMED IN * * 7550-SCH-ADJ (CALLED FROM 7550-CALC-GJK) * * * *************************************************************** 8550-ADJ-PLATE-COST. *-------------------------------------------------------------* * CALCULATE BLOOD APC PAYMENT FOR BLOOD/BLOOD PRODUCT LINE * *-------------------------------------------------------------* IF OPPS-PYMT-ADJ-FLAG (LN-SUB) = ' 5' COMPUTE W-APC-PYMT (W-LP-INDX) = W-APC-PYMT (W-LP-INDX) * H-38X-39X-RATE. *-------------------------------------------------------------* * CALCULATE BLOOD APC PAYMENT FOR BLOOD PROCESS/STORAGE LINE * *-------------------------------------------------------------* IF OPPS-PYMT-ADJ-FLAG (LN-SUB) = ' 6' COMPUTE W-APC-PYMT (W-LP-INDX) = W-APC-PYMT (W-LP-INDX) * (1 - H-38X-39X-RATE). 8550-ADJ-PLATE-COST-EXIT. EXIT. *************************************************************** * * * ADJUST THE PASS-THROUGH RADIOPHARM PAYMENT BY * * ITS PROPORTION OF THE NUCLEAR MEDICINE OFFSET * * * * EFFECTIVE 04/01/2009, LOGIC ADDED 02/11/2009 * * * *************************************************************** 8550-PTRADIO-OFFSET. *-------------------------------------------------------------* * CALCULATE PROPORTION OF TOTAL OFFSET TO BE APPLIED TO LINE * *-------------------------------------------------------------* * 12/20/2009 - ADDED LOGIC TO PREVENT DIVISION BY ZERO ERROR * *-------------------------------------------------------------* MOVE OPPS-SUB-CHRG (LN-SUB) TO H-SUB-CHRG. IF H-PTRADIO-TOT-CHRGS > 0 THEN COMPUTE W-PTRADIO-CHRG-RATE ROUNDED = H-SUB-CHRG / H-PTRADIO-TOT-CHRGS ELSE MOVE 0 TO W-PTRADIO-CHRG-RATE END-IF. *-------------------------------------------------------------* * CALCULATE THE OFFSET AMOUNT TO BE APPLIED TO LINE * *-------------------------------------------------------------* COMPUTE W-PTRADIO-LINE-OFFSET ROUNDED = H-NUCMED-TOT-OFFSET * W-PTRADIO-CHRG-RATE. *-------------------------------------------------------------* * SUBTRACT THE APPLICABLE OFFSET FROM THE LINE PAYMENT * *-------------------------------------------------------------* COMPUTE H-LITEM-PYMT ROUNDED = H-LITEM-PYMT - W-PTRADIO-LINE-OFFSET. 8550-PTRADIO-OFFSET-EXIT. EXIT. *************************************************************** * * * ACCUMULATE TOTAL CLAIM CHARGES FROM DEVICE LINES * * * * EFFECTIVE 04/01/2002 A PRO RATA REDUCTION APPLIES TO ALL * * ALL SERVICE INDICATOR 'H' PAYMENTS (CURRENTLY .689) * * * * SERVICE INDICATOR OF 'H' = PASS-THROUGH DEVICES, * * THERAPEUTIC RADIOPHARMS * * * *************************************************************** 8555-CALC-H-TOT. *-------------------------------------------------------------* * SET THE SERVICE LINE SUBSCRIPT TO THE CLAIM SERVICE LINE * * ASSOCIATED WITH THE COINSURANCE DEDUCTIBLE TABLE RECORD * *-------------------------------------------------------------* MOVE W-LP-SUB (W-LP-INDX) TO LN-SUB. *-------------------------------------------------------------* * ACCUMULATE TOTAL CLAIM DEVICE CHARGES FOR DEVICE LINES * *-------------------------------------------------------------* * 11/13/2008 - MODIFIED LOGIC TO PROCESS DEVICE LINES ONLY * * (EXCLUDE THERAPEUTIC RADIOPHARMS) * *-------------------------------------------------------------* MOVE OPPS-SUB-CHRG (LN-SUB) TO H-SUB-CHRG. IF OPPS-SRVC-IND (LN-SUB) = ' H' AND OPPS-PYMT-IND (LN-SUB) = ' 6' AND RADIOPH-APC-FLAG = 'N' COMPUTE H-TOT-H-CHRG = (H-TOT-H-CHRG + H-SUB-CHRG) END-IF. 8555-CALC-H-TOT-EXIT. EXIT. *************************************************************** * * * CALCULATE PAYMENT FOR PAID AT COST LINES * * (PAYMENT BASED ON CHARGE ADJUSTED TO COST) * * UPDATE PASS-THROUGH DEVICE TABLE * * * *************************************************************** 8555-CALC-H-STANDARD. *-------------------------------------------------------------* * SET LINE ITEM PAYMENT TO LINE COST * *-------------------------------------------------------------* MOVE OPPS-SUB-CHRG (LN-SUB) TO H-SUB-CHRG. COMPUTE T-LITEM-PYMT ROUNDED = (H-SUB-CHRG * L-PSF-OPCOST-RATIO). *-------------------------------------------------------------* * WAGE ADJUST 60% OF THE CLAIM TOTAL DEVICE OFFSET AMOUNT * * (OFFSET AMOUNTS ARE COSTS, NOT CHARGES) * * (C-FLAG = Y MEANS THERE IS A DEVICE ON THE CLAIM) * *-------------------------------------------------------------* * 11/13/2008 - MODIFIED LOGIC TO PROCESS DEVICES ONLY * * (EXCLUDE BRACHYS & THERAPEUTIC RADIOPHARMS) * *-------------------------------------------------------------* IF C-FLAG = 'Y' AND OPPS-SRVC-IND (LN-SUB) = ' H' AND RADIOPH-APC-FLAG = 'N' *-------------------------------------------------------------* * OTHER LINES ON THE CLAIM BESIDES DEVICE LINES ARE OFFSET; * * CALCULATE DEVICE PORTION OF THE TOTAL WAGE ADJUSTED OFFSET * *-------------------------------------------------------------* IF (H-TOT-OFF-UNITS > H-TOT-HTD-UNITS) COMPUTE H-TOTAL-WAOFF ROUNDED = (((H-TOTAL-OFFSET * .60) * A-WINX) + (H-TOTAL-OFFSET * .40)) * (H-TOT-HTD-UNITS / H-TOT-OFF-UNITS) PERFORM 8700-CALC-H-OFFSET THRU 8700-CALC-H-OFFSET-EXIT ELSE *-------------------------------------------------------------* * ONLY DEVICE LINES ON THE CLAIM ARE OFFSET; * * WAGE ADJUST THE TOTAL CLAIM OFFSET AMOUNT * *-------------------------------------------------------------* COMPUTE H-TOTAL-WAOFF ROUNDED = ((H-TOTAL-OFFSET * .60) * A-WINX) + (H-TOTAL-OFFSET * .40) PERFORM 8700-CALC-H-OFFSET THRU 8700-CALC-H-OFFSET-EXIT *-------------------------------------------------------------* * THERE IS NO DEVICE ON THE CLAIM * *-------------------------------------------------------------* ELSE NEXT SENTENCE. IF T-LITEM-PYMT < 0 THEN MOVE 0 TO H-LITEM-PYMT ELSE MOVE T-LITEM-PYMT TO H-LITEM-PYMT. *-------------------------------------------------------------* * UPDATE PASS-THROUGH DEVICE TABLE WITH LINE ITEM PAYMENT OF * * DEVICE LINE (CHARGES CONVERTED TO COST LESS APPLICABLE * * OFFSET AMOUNT) * * WHEN PTD-FLAG = 'Y', A PASS-THROUGH DEVICE IS ON THE CLAIM * *-------------------------------------------------------------* IF PTD-FLAG = 'Y' AND OPPS-SRVC-IND (LN-SUB) = ' H' AND RADIOPH-APC-FLAG = 'N' PERFORM 8557-LOAD-PTD-LINE-PYMT THRU 8557-LOAD-PTD-LINE-PYMT-EXIT END-IF. 8555-CALC-H-STANDARD-EXIT. EXIT. *************************************************************** * * * UPDATE PASS-THROUGH DEVICE TABLE WITH CHARGES FOR THE * * DEVICE LINE (LINE ITEM PAYMENT LESS OFFSET CONVERTED TO * * CHARGES) * * * *************************************************************** 8557-LOAD-PTD-LINE-PYMT. *-------------------------------------------------------------* * SEARCH PTD TABLE STARTING AT ENTRY #1 FOR THE RECORD THAT * * CORRESPONDS TO THE CURRENT SERVICE LINE * *-------------------------------------------------------------* SET W-PTD-INDX TO 1. SEARCH W-PTD-ENTRY VARYING W-PTD-INDX *-------------------------------------------------------------* * IF THE SERVICE LINE'S PAYMENT ADJUSTMENT FLAG IS NOT * * ALREADY IN THE TABLE, ADD IT * *-------------------------------------------------------------* AT END GO TO 8557-LOAD-PTD-LINE-PYMT-EXIT *-------------------------------------------------------------* * IF THE LINE'S HCPCS IS IN THE TABLE, CALCULATE THE LINE'S * * CHARGES AND PLACE INTO TABLE (FOR H LINES, THE PAYMENT IS * * CONVERTED TO COST AND OFFSET. HERE, THE PAYMENT IS * * CONVERTED BACK INTO CHARGES BY DIVIDING IT BY THE COST TO * * CHARGE RATIO.) * *-------------------------------------------------------------* WHEN W-PTD-SUB (W-PTD-INDX) = LN-SUB MOVE H-LITEM-PYMT TO W-PTD-LITEM-PYMT (W-PTD-INDX) END-SEARCH. 8557-LOAD-PTD-LINE-PYMT-EXIT. EXIT. *************************************************************** * * * CALCULATE THE BENEFICIARY DEDUCTIBLE AMOUNT THAT WILL BE * * APPLIED TO THE SERVICE LINES IN THE DEDUCTIBLE TABLE * * * * (THE DEDUCTIBLE IS APPLIED TO THE LOWEST TO HIGHEST RANKED * * APCS. THE LOWER THE RANK, THE HIGHER THE COINSURANCE %. * * THE TOTAL CLAIM BENEFICIARY COINSURANCE AMOUNT IS CHEAPER * * WHEN THE DEDUCTIBLE IS APPLIED IN THIS ORDER.) * * * *************************************************************** 8560-CALC-BENE-DEDUCT. *-------------------------------------------------------------* * LINES INELIGIBLE FOR DEDUCTIBLE SKIP DEDUCTIBLE CALCULATION * * EFF. 7/1/2009 - CLINICAL TRIAL LINES FOR MANAGED CARE BENES * * ASSIGNED A PAF = ' 4' * *-------------------------------------------------------------* IF OPPS-PYMT-ADJ-FLAG (LN-SUB) = ' 4' GO TO 8560-CALC-BENE-DEDUCT-EXIT. *-------------------------------------------------------------* * BENEFICIARY HAS NOT MET HIS/HER DEDUCTIBLE LIMIT. * * CALCULATE THE "LINE BLOOD PAYMENT" * *-------------------------------------------------------------* IF H-BENE-DEDUCT > 0 THEN COMPUTE H-LN-BLD-PYMT = H-LITEM-PYMT - H-LN-BLOOD-DEDUCT *-------------------------------------------------------------* * BENEFICIARY'S DEDUCTIBLE DOES NOT COVER OR JUST COVERS THE * * ENTIRE LINE BLOOD PAYMENT: * * - BENEFICIARY'S REMAINING DEDUCTIBLE AMT APPLIED TO LINE * * - BENEFICIARY HAS REACHED HIS/HER DEDUCTIBLE LIMIT * *-------------------------------------------------------------* IF H-BENE-DEDUCT <= H-LN-BLD-PYMT THEN MOVE H-BENE-DEDUCT TO H-TOTAL-LN-DEDUCT MOVE 0 TO H-BENE-DEDUCT *-------------------------------------------------------------* * BENEFICIARY'S DEDUCTIBLE MORE THAN COVERS THE LINE BLOOD * * PAYMENT, DO THE FOLLOWING: * * - CALCULATE THE BENEFICIARY'S REMAINING DEDUCTIBLE AMOUNT * * AFTER PAYING FOR CURRENT SERVICE LINE * * - MEDICARE LINE PAYMENT = 0 * *-------------------------------------------------------------* ELSE COMPUTE H-BENE-DEDUCT = H-BENE-DEDUCT - H-LN-BLD-PYMT MOVE H-LN-BLD-PYMT TO H-TOTAL-LN-DEDUCT MOVE 20 TO A-RETURN-CODE (LN-SUB) END-IF END-IF. 8560-CALC-BENE-DEDUCT-EXIT. EXIT. *************************************************************** * * * CALCULATE OUTLIER PAYMENT * * ** CHANGE OUTLIER THRESHOLD EVERY JANUARY (HARD-CODED) ** * * * *************************************************************** * * * LOOP THROUGH THE COINSURANCE DEDUCTIBLE TABLE TO DO THE * * FOLLOWING FOR EACH SERVICE LINE: * * * * - DETERMINE IF THE LINE IS ELIGIBLE FOR AN OUTLIER PAYMENT * * - ADJUST CHARGES FOR LINES WITH ARTIFICIAL CHARGES ON CLAIM * * - DISTRIBUTE TOTAL CLAIM PACKAGED LINE CHARGES TO NON- * * PACKAGED PAYABLE LINES * * - ADJUST CHARGES OF PRIME CODE COMPOSITE APC LINES * * - ADJUST CHARGES OF MENTAL HEALTH LINES (APC = 34) * * - CALCULATE THE LINE OUTLIER PAYMENT FOR ELIGIBLE LINES * * * * * * NOTES: * * ------ * * - NEW FOR JANUARY 2004: * * - CHECK >= 20040101 AND SRVC-IND = 'K' * * - DISCONTINUE OUTLIER PROCESS * * * * - NEW FOR JANUARY 2008: * * - REVISED LOGIC FOR DETERMINING WHICH LINES WITH SRVC-IND * * = 'K' ARE ELIGIBLE FOR AN OUTLIER PAYMENT. THIS WAS * * NECESSARY B/C SOME RADIOPHARMS & ALL BRACHYTHERAPIES * * SRVC-IND = 'K' STARTING CY 2008. * * - PER LEGISLATION, BRACHYTHERAPY & RADIOPARM LINES' * * STATUS INDICATOR CHANGED BACK TO ' H' FOR CY 2008 QTR 1 * * ' K' LOGIC RETAINED B/C IT WILL NOT AFFECT PAYMENTS TO * * BRACHYTHERAPY OR RADIOPHARM LINES * * - COMPOSITE APC AND MENTAL HEALTH LINE CHARGE CALCS * * * * - NEW FOR APRIL 2008: ADD CHARGES AND PAYMENTS OF * * - PASS-THROUGH DEVICES TO THE CHARGES AND PAYMENTS OF * * PROCEDURES ELIGIBLE FOR THE DEVICES * * - A-LITEM-PYMT MOVED TO H-LITEM-PYMT-OUTL B/C PAYMENTS * * ARE ADJUSTED FOR PASS-THROUGH DEVICES FOR OUTLIER * * DETERMINATION ONLY * * * * - NEW FOR JULY 2008: BRACHYTHERAPY AND THERAPEUTIC * * RADIOPHARM LINES' SI CHANGED TO ' K'. BRACHYTHERAPY * * LINES ARE NOW ELIGIBLE FOR AN OUTLIER PAYMENT. * * * * - JULY 2008: DUE TO LEGISLATION, THERAPEUTIC RADIOPHARMS * * & BRACHYTHERAPY SOURCE'S SI CHANGED FROM 'K' BACK TO 'H' * * EFFECTIVE 7/1/2008; THESE LINES ARE NOT YET ELIGIBLE FOR * * AN OUTLIER PAYMENT. * * * * - 11/12/2008: FOR CY 2009, BRACHYS SI = U AND BLOOD SI = R * * BRACHY INELIGIBLE FOR OUTLIER, BLOOD ELIGIBLE FOR OUTLIER * * * * - 12/05/2008: ADDED SI = K TO LIST OF SIS INELIGIBLE FOR * * OUTLIER (BRACHYS & BLOOD NO LONGER HAVE SI = K) * * * * - 12/16/2009: ADDED SI R TO LOGIC THAT DISTRIBUTES * * PACKAGED CHARGES TO PAYABLE LINES. V2010.1.2 * * * *************************************************************** 8600-ADJ-CHRG-OUTL. *-------------------------------------------------------------* * GO TO SERVICE LINE ASSOCIATED WITH THE CURRENT COINSURANCE * * DEDUCTIBLE TABLE RECORD * *-------------------------------------------------------------* MOVE W-LP-SUB (W-LP-INDX) TO LN-SUB. *-------------------------------------------------------------* * LINES WITH SERVICE INDICATORS NOT ELIGIBLE FOR AN OUTLIER * * PAYMENT AND LINES PACKAGED AS PART OF DRUG ADMINISTRATION * * APC PAYMENT BYPASS OUTLIER CALCULATION * * (DRUGS, DEVICES, PACKAGED SERVICES, BRACHYS, BIOLOGICALS) * *-------------------------------------------------------------* * 11/12/2008 - BRACHY (SI=U) ADDED TO LIST * * 12/05/2008 - SI K ADDED TO THE LIST * *-------------------------------------------------------------* IF (OPPS-SRVC-IND (LN-SUB) = ' G' OR ' H' OR ' N' OR ' K') OR (OPPS-SRVC-IND (LN-SUB) = ' U' AND OPPS-PYMT-ADJ-FLAG (LN-SUB) = ' 2') OR (OPPS-PKG-FLAG (LN-SUB) = '4') GO TO 8600-ADJ-CHRG-OUTL-EXIT. *-------------------------------------------------------------* * DISTRIBUTE TOTAL CLAIM PROCEDURE CHARGES TO PROCEDURE LINES * * IN PROPORTION TO THE PROCEDURE LINES' PAYMENTS WHEN THERE * * ARE ARTIFICIAL PROCEDURE CHARGES (< $1.01) ON THE CLAIM. * * (DISTRIBUTED CHARGES REPLACE BILLED CHARGES) * *-------------------------------------------------------------* * NOTE: LINES WITH CHARGES < $1.01 ARE FIXED BY FISS BEFORE * * ENTERING THE PRICER. THEREFORE, THIS LOGIC IS NO * * LONGER NECESSARY. THIS LOGIC WAS NECESSARY BEFORE * * FISS IMPLEMENTED THE FIX. * *-------------------------------------------------------------* IF (ST0-FLAG = 'Y') AND ((OPPS-SRVC-IND (LN-SUB) = ' T') OR ((OPPS-SRVC-IND (LN-SUB) = ' S') AND (OPPS-HCPCS (LN-SUB) > '09999' AND OPPS-HCPCS (LN-SUB) < '70000'))) AND (H-TOT-ST-PYMT > 0) COMPUTE H-CHRG-RATE ROUNDED = (A-LITEM-PYMT (LN-SUB) / H-TOT-ST-PYMT) COMPUTE W-SUB-CHRG (W-LP-INDX) ROUNDED = (H-CHRG-RATE * H-TOT-ST-CHRG) *-------------------------------------------------------------* * DISTRIBUTE TOTAL CLAIM PACKAGED LINE CHARGES TO SEPARATELY * * PAYABLE LINES IN PROPORTION TO THEIR PAYMENTS WHEN THERE * * ARE NO ARTIFICIAL PROCEDURE CHARGES (< $1.01) ON THE CLAIM. * * (DISTRIBUTED CHARGES ARE ADDED TO THE BILLED CHARGES) * *-------------------------------------------------------------* * 12/16/2009 - ADDED SI R TO LOGIC * *-------------------------------------------------------------* ELSE IF (N-FLAG = 'Y' AND ST0-FLAG = 'N') AND ((OPPS-SRVC-IND (LN-SUB) = ' S' OR ' T' OR ' V' OR ' X' OR ' P' OR ' R') AND (OPPS-PKG-FLAG (LN-SUB) = '0' OR '3')) AND (H-TOT-STVX-PYMT > 0) COMPUTE H-CHRG-RATE ROUNDED = (A-LITEM-PYMT (LN-SUB) / H-TOT-STVX-PYMT) COMPUTE H-SUB-CHRG ROUNDED = (H-CHRG-RATE * H-TOT-N-CHRG) COMPUTE W-SUB-CHRG (W-LP-INDX) ROUNDED = W-SUB-CHRG (W-LP-INDX) + H-SUB-CHRG. *-------------------------------------------------------------* * DISTRIBUTE TOTAL CLAIM PACKAGED LINE CHARGES TO SEPARATELY * * PAYABLE LINES IN PROPORTION TO THEIR PAYMENTS WHEN THERE * * ARE ARTIFICIAL PROCEDURE CHARGES (< $1.01) ON THE CLAIM. * * (DISTRIBUTED CHARGES ARE ADDED TO THE BILLED CHARGES) * *-------------------------------------------------------------* * NOTE: LINES WITH CHARGES < $1.01 ARE FIXED BY FISS BEFORE * * ENTERING THE PRICER. THEREFORE, THIS LOGIC IS NO * * LONGER NECESSARY. THIS LOGIC WAS NECESSARY BEFORE * * FISS IMPLEMENTED THE FIX. * *-------------------------------------------------------------* * 12/16/2009 - ADDED SI R TO LOGIC * *-------------------------------------------------------------* IF (N-FLAG = 'Y' AND ST0-FLAG = 'Y') AND ((OPPS-SRVC-IND (LN-SUB) = ' S' OR ' T' OR ' V' OR ' X' OR ' P' OR ' R') AND (OPPS-PKG-FLAG (LN-SUB) = '0' OR '3')) AND (H-TOT-STVX-PYMT > 0) COMPUTE H-CHRG-RATE ROUNDED = (A-LITEM-PYMT (LN-SUB) / H-TOT-STVX-PYMT) COMPUTE H-SUB-CHRG ROUNDED = (H-CHRG-RATE * H-TOT-N-CHRG) COMPUTE W-SUB-CHRG (W-LP-INDX) ROUNDED = W-SUB-CHRG (W-LP-INDX) + H-SUB-CHRG. *************************************************************** * CALCULATE COMPOSITE APC CHARGES FOR PRIME CODE LINES * * * * THE CHARGES OF ALL PACKAGED LINES WITH A COMPOSITE ADJ. * * FLAG THAT INDICATES THE LINE IS A PART OF A COMPOSITE APC * * (VALUES 01 - NN...) ARE ACCUMULATED BY COMPOSITE * * ADJUSTMENT FLAG AND ADDED TO THE CORRESPONDING PRIME * * (PAYABLE) LINE'S CHARGES. * *-------------------------------------------------------------* * 11/29/2007 - LOGIC ADDED FOR CY 2008 * * 12/14/2007 - ROUNDED W-SUB-CHRG WHEN ADDING COMPOSITES * * 11/12/2008 - CHANGED LOGIC TO USE THE COMPOSITE ADJUSTMENT * * FLAG INSTEAD OF THE PAYMENT ADJUSTMENT FLAG * * VALUES 91 - 99 TO ID PRIME COMPOSITE LINES * *************************************************************** *-------------------------------------------------------------* * COMPOSITE ADJUSTMENT FLAG > 0 INDICATES COMPOSITE APC * *-------------------------------------------------------------* IF OPPS-COMP-ADJ-FLAG (LN-SUB) NOT = '00' *-------------------------------------------------------------* * SEARCH COMPOSITE APC TABLE STARTING AT ENTRY #1 * *-------------------------------------------------------------* MOVE OPPS-COMP-ADJ-FLAG (LN-SUB) TO H-CMP-CAF SET W-CMP-INDX TO 1 SEARCH W-CMP-ENTRY VARYING W-CMP-INDX *-------------------------------------------------------------* * SERVICE LINE'S PAYMENT ADJUSTMENT FLAG NOT IN TABLE * *-------------------------------------------------------------* AT END ADD 0 TO W-SUB-CHRG (W-LP-INDX) *-------------------------------------------------------------* * SERVICE LINE'S PAYMENT ADJUSTMENT FLAG IS IN TABLE, * * ADD THE PACKAGED SUBMITTED CHARGES TO THE LINE'S CHARGES * *-------------------------------------------------------------* WHEN W-CMP-PAF (W-CMP-INDX) = H-CMP-CAF COMPUTE W-SUB-CHRG (W-LP-INDX) ROUNDED = W-SUB-CHRG (W-LP-INDX) + W-CMP-TOT-SUB-CHRG (W-CMP-INDX) END-IF. *************************************************************** * CALCULATE TOTAL MENTAL HEALTH CHARGES FOR APC 34 LINES * * * * THE CHARGES OF PACKAGED LINES WITH A PACKAGING FLAG OF '2' * * ON A CLAIM WITH APC 34 (MENTAL HEALTH APC) ARE ACCUMULATED * * AND ADDED TO THE SEPARATELY PAYABLE APC 34 LINE'S CHARGES. * *-------------------------------------------------------------* * 11/29/2007 - LOGIC ADDED FOR CY 2008 * * 11/12/2008 - LOGIC DISABLED FOR CY 2009 BECAUSE MENTAL * * HEALTH COMPOSITES ARE NOW PROCESSED THE SAME * * AS ALL OTHER COMPOSITES USING THE COMPOSITE * * ADJUSTMENT FLAG * *************************************************************** * IF APC34-FLAG = 'Y' AND OPPS-APC (LN-SUB) = '0034' * COMPUTE W-SUB-CHRG (W-LP-INDX) = * W-SUB-CHRG (W-LP-INDX) + * H-TOT-MH-CHRG * END-IF. *************************************************************** * MOVE LINE PAYMENTS TO HOLD FIELD BECAUSE PAYMENTS MAY BE * * ADJUSTED FOR PASS-THROUGH DEVICES - ADDED 02/14/2008 * * NEW FOR CY 2009 - ALWAYS USE THE PHP "CAP" APC'S WAGE ADJ * * PMT FOR PHP LINES (SI=P) * *************************************************************** MOVE ZEROS TO H-LITEM-PYMT-OUTL. IF OPPS-SRVC-IND (LN-SUB) = ' P' MOVE H-PHP-LITEM-PYMT-OUTL TO H-LITEM-PYMT-OUTL ELSE MOVE A-LITEM-PYMT (LN-SUB) TO H-LITEM-PYMT-OUTL END-IF. *************************************************************** * CALCULATE TOTAL CHARGES AND PAYMENTS FOR PROCEDURE LINES * * ELIGIBLE FOR PASS-THROUGH DEVICE(S) * * * * THE CHARGES AND LINE PAYMENTS OF PASS-THROUGH DEVICE LINES * * ARE ADDED TO THE CHARGES AND PAYMENTS OF ALL PROCEDURES * * ELIGIBLE TO BE BILLED WITH THE PASS-THROUGH DEVICE. * * (PTD-FLAG = 'Y' INDICATES THERE IS AT LEAST ONE * * PASS-THROUGH DEVICE ON THE CLAIM) * *-------------------------------------------------------------* * 02/12/2008 - LOGIC ADDED FOR CY 2008 QTR 2 * *************************************************************** IF (PTD-FLAG = 'Y') AND (OPPS-SRVC-IND (LN-SUB) = ' S' OR ' T' OR ' V' OR ' X') *-------------------------------------------------------------* * DETERMINE WHETHER THE LINE IS ELIGIBLE FOR A PT DEVICE * *-------------------------------------------------------------* PERFORM 8670-SET-PTD-PROC-FLAG THRU 8670-SET-PTD-PROC-FLAG-EXIT *-------------------------------------------------------------* * PROCEDURE IS ELIGIBLE FOR A PASS-THROUGH DEVICE * *-------------------------------------------------------------* * 11/12/2008 - EDITED TO LOOK AT PTD-PROC-FLAG, NOT PTD-FLAG * * NO HARM DONE USING THE PTD-FLAG PREVIOUSLY * *-------------------------------------------------------------* IF PTD-PROC-FLAG = 'Y' *-------------------------------------------------------------* * LOOP THROUGH ELIGIBLE PROCEDURE'S PASS-THROUGH DEVICE TABLE * * GET THE PASS-THROUGH DEVICE HCPCS(S) FOR WHICH THE * * PROCEDURE IS ELIGIBLE & UPDATE PROCEDURE CHARGES & PAYMENTS * *-------------------------------------------------------------* PERFORM 8610-PERFORM-SEARCH THRU 8610-PERFORM-SEARCH-EXIT VARYING W-PTD-PROC-SUB FROM 1 BY 1 UNTIL W-PTD-PROC-SUB > W-PTD-CNT END-IF END-IF. *************************************************************** * * * CALCULATE THE OUTLIER PAYMENT FOR ELIGIBLE LINES * * * * -NEW FOR JANUARY 2005 * * - PROVIDER RANGE FOR CMHC * * - COMPUTE H-LITEM-OUTL-PYMT USING NEW FORMULA * * - CHANGE OUTLIER THRESHOLD AMOUNT EVERY JANUARY * * * * -NEW FOR APRIL 2008 * * - A-LITEM-PYMT (LN-SUB) CHANGED TO H-LITEM-PYMT-OUTL B/C * * PAYMENTS ARE NOW ADJUSTED FOR OUTLIER DETERMINATION * * * * -NEW FOR JANUARY 2009 * * - ALL PARTIAL HOSPITALIZATION (PHP) LINES (SI=P) USE * * THE PHP "CAP" APC'S LINE PAYMENT * * * *************************************************************** MOVE 1.75 TO H-OUTLIER-FACTOR. MOVE .50 TO H-OUTLIER-PCT. COMPUTE H-COST ROUNDED = W-SUB-CHRG (W-LP-INDX) * L-PSF-OPCOST-RATIO. COMPUTE H-APC-ADJ-PYMT ROUNDED = H-OUTLIER-FACTOR * H-LITEM-PYMT-OUTL. *-------------------------------------------------------------* * IDENTIFY COMMUNITY MENTAL HEALTH CENTER (CMHC) PROVIDERS * * FOR CMHCS, INCREASE OUTLIER FACTOR & CALC LINE OUTLIER PMT * * (CMHC PROVIDERS ONLY PROCESS PARTIAL HOSPITALIZATION LINES) * *-------------------------------------------------------------* IF (L-PSF-PROV-3456 >= '1400' AND L-PSF-PROV-3456 <= '1499') OR (L-PSF-PROV-3456 >= '4600' AND L-PSF-PROV-3456 <= '4799') OR (L-PSF-PROV-3456 >= '4900' AND L-PSF-PROV-3456 <= '4999') MOVE 3.4 TO H-OUTLIER-FACTOR COMPUTE H-LITEM-OUTL-PYMT ROUNDED = (H-COST - (H-OUTLIER-FACTOR * H-LITEM-PYMT-OUTL)) * H-OUTLIER-PCT *-------------------------------------------------------------* * FOR NON-CMHC PROVIDERS, LINE'S OUTLIER ELIGIBILITY & * * CALCULATE OUTLIER PAYMENT IF ELIGIBLE * * ** UPDATE THE LITERAL NUMBER BELOW EACH JANUARY ** * *-------------------------------------------------------------* ELSE IF (H-COST > H-APC-ADJ-PYMT) AND (H-COST > H-LITEM-PYMT-OUTL + 1800) COMPUTE H-LITEM-OUTL-PYMT ROUNDED = (H-COST - H-APC-ADJ-PYMT) * H-OUTLIER-PCT ELSE MOVE ZERO TO H-LITEM-OUTL-PYMT END-IF END-IF. *-------------------------------------------------------------* * ACCUMULATE TOTAL CLAIM OUTLIER PAYMENTS * *-------------------------------------------------------------* IF H-LITEM-OUTL-PYMT > 0 COMPUTE H-OUTLIER-PYMT = H-OUTLIER-PYMT + H-LITEM-OUTL-PYMT. *-------------------------------------------------------------* * LINES THAT RECEIVE AN EXTERNAL ADJUSTMENT ARE NOT ELIGIBLE * * FOR AN OUTLIER PAYMENT - ZERO OUT PAYMENT & REMOVE FROM * * CLAIM TOTAL * *-------------------------------------------------------------* IF OPPS-LITEM-ACT-FLAG (LN-SUB) = '4' COMPUTE H-OUTLIER-PYMT = H-OUTLIER-PYMT - H-LITEM-OUTL-PYMT MOVE 0 TO H-LITEM-OUTL-PYMT. 8600-ADJ-CHRG-OUTL-EXIT. EXIT. *************************************************************** * * * SEARCH THE PASS-THROUGH DEVICE TABLE FOR THE PASS-THROUGH * * DEVICE(S) THE PROCEDURE IS ELIGIBLE FOR * * * *************************************************************** 8610-PERFORM-SEARCH. *-------------------------------------------------------------* * SEARCH PTD TABLE STARTING AT ENTRY #1 FOR ALL OCCURANCES * * OF THE PASS-THRU DEVICE HCPCS IN THE PASS-THRU DEVICE TABLE.* * THIS IS DONE FOR ALL PASS-THROUGH DEVICES THE PROCEDURE IS * * ELIGIBLE FOR. * *-------------------------------------------------------------* MOVE 'N' TO W-END-OF-PTD-TBL. IF W-PTD-PROC-HCPCS (W-PTD-PROC-SUB) NOT = ' ' SET W-PTD-INDX TO 1 PERFORM 8611-SEARCH-PTD-HCPCS THRU 8611-SEARCH-PTD-HCPCS-EXIT UNTIL W-END-OF-PTD-TBL = 'Y' END-IF. 8610-PERFORM-SEARCH-EXIT. EXIT. *************************************************************** * * * SEARCH FOR THE PASS-THROUGH DEVICE FOR WHICH THE PROCEDURE * * IS ELIGIBLE IN THE TABLE & UPDATE PROCEDURE LINE PAYMENTS * * AND CHARGES * * * *************************************************************** 8611-SEARCH-PTD-HCPCS. MOVE 'N' TO W-END-OF-PTD-TBL. *-------------------------------------------------------------* * SEARCH PASS-THROUGH DEVICE TABLE * *-------------------------------------------------------------* SEARCH W-PTD-ENTRY VARYING W-PTD-INDX *-------------------------------------------------------------* * IF THERE ARE NO MORE OCCURANCES OF THE PASS-THROUGH DEVICE, * * STOP THE SEARCH AND INDICATE END OF FILE * *-------------------------------------------------------------* AT END MOVE 'Y' TO W-END-OF-PTD-TBL GO TO 8611-SEARCH-PTD-HCPCS-EXIT *-------------------------------------------------------------* * IF THE PASS-THROUGH DEVICE IS FOUND, INDICATE NOT END OF * * FILE AND UPDATE THE PROCEDURE'S CHARGES AND PAYMENTS * *-------------------------------------------------------------* WHEN W-PTD-HCPCS (W-PTD-INDX) = W-PTD-PROC-HCPCS (W-PTD-PROC-SUB) MOVE 'N' TO W-END-OF-PTD-TBL PERFORM 8612-UPDATE-PTD-PROC THRU 8612-UPDATE-PTD-PROC-EXIT SET W-PTD-INDX UP BY 1 END-SEARCH. *-------------------------------------------------------------* * SET UP FOR NEXT PASS-THROUGH DEVICE RECORD * *-------------------------------------------------------------* MOVE ZEROS TO H-PTD-UNIT-RATE H-PTD-SUB-CHRG H-PTD-LITEM-PYMT. 8611-SEARCH-PTD-HCPCS-EXIT. EXIT. *************************************************************** * * * UPDATE THE PROCEDURE LINE'S PAYMENTS AND CHARGES WITH THE * * PASS-THROUGH DEVICE'S PAYMENTS AND CHARGES (IN PROPORTION * * TO THE PROCEDURE'S UNITS IF OTHER PROCEDURES ARE ELIGIBLE * * FOR THE PASS-THROUGH DEVICE AS WELL) * * * *************************************************************** 8612-UPDATE-PTD-PROC. *-------------------------------------------------------------* * DETERMINE PROPORTION OF CHARGES & PAYMENTS PROCEDURE LINE * * WILL RECEIVE BASED ON ITS NUMBER OF UNITS * *-------------------------------------------------------------* IF W-PTD-TOTAL-PROC-UNITS (W-PTD-INDX) NOT = 0 COMPUTE H-PTD-UNIT-RATE ROUNDED = OPPS-SRVC-UNITS (LN-SUB) / W-PTD-TOTAL-PROC-UNITS (W-PTD-INDX) ELSE MOVE 0 TO H-PTD-UNIT-RATE END-IF. *-------------------------------------------------------------* * CALCULATE THE AMOUNT OF PASS-THROUGH DEVICE CHARGES TO BE * * ADDED TO THE PROCEDURE'S CHARGES IN PROPORTION TO UNITS * *-------------------------------------------------------------* COMPUTE H-PTD-SUB-CHRG ROUNDED = W-PTD-SUB-CHRG (W-PTD-INDX) * H-PTD-UNIT-RATE. *-------------------------------------------------------------* * ADD PASS-THROUGH DEVICE CHARGES TO PROCEDURE LINE CHARGES * *-------------------------------------------------------------* COMPUTE W-SUB-CHRG (W-LP-INDX) ROUNDED = W-SUB-CHRG (W-LP-INDX) + H-PTD-SUB-CHRG. *-------------------------------------------------------------* * CALCULATE THE AMOUNT OF PASS-THROUGH DEVICE PAYMENTS TO BE * * ADDED TO THE PROCEDURE'S PAYMENTS IN PROPORTION TO UNITS * *-------------------------------------------------------------* COMPUTE H-PTD-LITEM-PYMT ROUNDED = W-PTD-LITEM-PYMT (W-PTD-INDX) * H-PTD-UNIT-RATE. *-------------------------------------------------------------* * ADD PASS-THROUGH DEVICE PAYMENT TO PROCEDURE LINE PAYMENT * *-------------------------------------------------------------* COMPUTE H-LITEM-PYMT-OUTL ROUNDED = H-LITEM-PYMT-OUTL + H-PTD-LITEM-PYMT. 8612-UPDATE-PTD-PROC-EXIT. EXIT. *************************************************************** * * * DETERMINE WHETHER THE CURRENT APC IS A BRACHYTHERAPY APC * * - IF SO, SET BRACHY-APC-FLAG = 'Y' * * - THIS FLAG IS USED IN PARAGRAPHS 8600-ADJ-CHRG-OUTL & * * 8550-CALC-GJK TO PROCESS BRACHYS * * ** UPDATE THIS LIST EVERY JANUARY * * (CODE NEW FOR CY2008; ADDED 11/6/2007) * * * * 11/12/2008 - BRACHYTHERAPY APC LIST REMOVED FOR CY 2009; * * BRACHYTHERAPY LINES NOW IDENTIFIED BY A * * STATUS INDICATOR OF ' U' * * * *************************************************************** *8650-SET-BRACHY-APC-FLAG. * * MOVE 'N' TO BRACHY-APC-FLAG. * * IF OPPS-APC (LN-SUB) = ('2632' OR * '1716' OR * '1717' OR * '1719' OR * '2616' OR * '2634' OR * '2635' OR * '2636' OR * '2638' OR * '2639' OR * '2640' OR * '2641' OR * '2642' OR * '2643' OR * '2698' OR * '2699') * * MOVE 'Y' TO BRACHY-APC-FLAG * END-IF. * *8650-SET-BRACHY-APC-FLAG-EXIT. * EXIT. *************************************************************** * * * DETERMINE WHETHER THE CURRENT HCPCS IS A BLOOD DEDUCTIBLE * * HCPCS * * - IF SO, SET BLD-DEDUC-HCPCS-FLAG = 'Y' * * - THIS FLAG IS USED IN PARAGRAPHS 8550-CALC-GJK & * * 8550-SCH-ADJ TO PROCESS BLOOD DEDUCTIBLE LINES * * ** UPDATE THIS LIST EVERY JANUARY * * (CODE NEW FOR CY2008; ADDED 12/4/2007) * * * *************************************************************** 8655-SET-BD-HCPCS-FLAG. MOVE 'N' TO BLD-DEDUC-HCPCS-FLAG. IF OPPS-HCPCS(LN-SUB) = ('P9054' OR 'P9021' OR 'P9051' OR 'P9016' OR 'P9056' OR 'P9010' OR 'P9038' OR 'P9040' OR 'P9022' OR 'P9058' OR 'P9039' OR 'P9057' ) MOVE 'Y' TO BLD-DEDUC-HCPCS-FLAG END-IF. 8655-SET-BD-HCPCS-FLAG-EXIT. EXIT. *************************************************************** * * * DETERMINE WHETHER THE CURRENT APC IS A RADIOPHARM APC * * - IF SO, SET RADIOPH-APC-FLAG = 'Y' * * - THIS FLAG IS USED IN PARAGRAPH 8550-CALC-STANDARD * * TO PROCESS RADIOPHARM LINES * * ** UPDATE THIS LIST EVERY JANUARY * * (CODE NEW FOR CY2008; ADDED 12/27/2007) * * * *************************************************************** 8660-SET-RADIOPH-APC-FLAG. MOVE 'N' TO RADIOPH-APC-FLAG. IF OPPS-APC (LN-SUB) = ('1064' OR '1150' OR '1643' OR '1645' OR '1675' OR '1676' OR '0701' OR '0702') MOVE 'Y' TO RADIOPH-APC-FLAG END-IF. 8660-SET-RADIOPH-APC-FLAG-EXIT. EXIT. *************************************************************** * * * DETERMINE WHETHER THE CURRENT HCPCS IS A PASS-THROUGH * * DEVICE HCPCS * * - IF SO, SET PTD-LINE-FLAG = 'Y' * * - THIS FLAG IS USED IN THE PASS-THROUGH DEVICE LOGIC * * TO POPULATE THE PASS-THROUGH-DEVICE TABLE * * ** UPDATE THIS LIST EVERY QUARTER * * (CODE NEW FOR CY2008 QTR 2; ADDED 02/11/2008) * * * *************************************************************** 8665-SET-PTD-LINE-FLAG. MOVE 'N' TO PTD-LINE-FLAG. *********************************************************** * 11/12/2008 - ALL LOGIC DISABLED B/C THERE ARE NO * * NO PASS-THROUGH DEVICES FOR CY 2009 * *********************************************************** *---------------------------------------------------------* * ONLY CLAIMS WITH A DATE OF SERVICE ON OR AFTER * * _____________ ARE ELIGIBLE * *---------------------------------------------------------* * IF OPPS-LITEM-DOS (LN-SUB) >= 20080401 * * IF OPPS-HCPCS (LN-SUB) = ('C1821' OR * 'L8690') * * MOVE 'Y' TO PTD-LINE-FLAG * * END-IF * END-IF. 8665-SET-PTD-LINE-FLAG-EXIT. EXIT. *************************************************************** * * * DETERMINE WHETHER THE CURRENT HCPCS IS A PROCEDURE * * ELIGIBLE FOR A PASS-THROUGH DEVICE * * - IF SO, SET PTD-PROC-FLAG = 'Y' * * - THIS FLAG IS USED IN THE PASS-THROUGH DEVICE LOGIC * * ** UPDATE THIS LIST EVERY QUARTER * * (CODE NEW FOR CY2008 QTR 2; ADDED 02/11/2008) * * * *************************************************************** 8670-SET-PTD-PROC-FLAG. MOVE 'N' TO PTD-PROC-FLAG. *********************************************************** * 11/12/2008 - ALL LOGIC DISABLED B/C THERE ARE NO * * NO PASS-THROUGH DEVICES FOR CY 2009 * *********************************************************** *---------------------------------------------------------* * ONLY CLAIMS WITH A DATE OF SERVICE ON OR AFTER * * _____________ ARE ELIGIBLE * *---------------------------------------------------------* * IF OPPS-LITEM-DOS (LN-SUB) >= 20080401 * *---------------------------------------------------------* * SPECIFY NUMBER OF ENTRIES (# OF PT DEVICES FROM POLICY)* *---------------------------------------------------------* * MOVE 2 TO W-PTD-CNT * *---------------------------------------------------------* * INITIALIZE PROCEDURE'S PTD HCPCS TABLE TO SPACES * *---------------------------------------------------------* * PERFORM VARYING W-PTD-PROC-SUB FROM 1 BY 1 * UNTIL W-PTD-PROC-SUB > W-PTD-CNT * MOVE SPACES TO W-PTD-PROC-HCPCS (W-PTD-PROC-SUB) * END-PERFORM * *---------------------------------------------------------* * PROCEDURES ELIGIBLE FOR PASS-THROUGH DEVICE 1 * *---------------------------------------------------------* * IF OPPS-HCPCS (LN-SUB) = ('0171T' OR * '0172T') * * MOVE 'Y' TO PTD-PROC-FLAG * MOVE 1 TO W-PTD-PROC-SUB * MOVE 'C1821' TO W-PTD-PROC-HCPCS (W-PTD-PROC-SUB) * END-IF * *---------------------------------------------------------* * PROCEDURES ELIGIBLE FOR PASS-THROUGH DEVICE 2 * *---------------------------------------------------------* * IF OPPS-HCPCS (LN-SUB) = ('69714' OR * '69715' OR * '69717' OR * '69718') * * MOVE 'Y' TO PTD-PROC-FLAG * MOVE 2 TO W-PTD-PROC-SUB * MOVE 'L8690' TO W-PTD-PROC-HCPCS (W-PTD-PROC-SUB) * END-IF * END-IF. 8670-SET-PTD-PROC-FLAG-EXIT. EXIT. *************************************************************** * * * DETERMINE WHETHER THE LINE HCPCS IS A CURRENT PASS-THROUGH * * RADIOPHARMACEUTICAL HCPCS * * * * - IF SO: SET PTRADIO-LINE-FLAG = 'Y', * * ADD 1 TO COUNT OF TOTAL PT RADIOPHARMS, * * ADD CHARGES TO CLAIM TOTAL PT RADIOPHARM CHRGES * * - THIS FLAG IS USED IN PARAGRAPHS 8125-INIT & * * 8550-CALC-STANDARD TO PROCESS PT RADIOPHARM LINES * * * * ** PASS-THROUGH RADOIOPHARM TABLE IS UPDATED QUARTERLY * * (CODE NEW FOR CY2009; ADDED 02/10/2009) * * * *-------------------------------------------------------------* * * * 12/20/2011 - LOGIC REVISED TO INCLUDE TERMINATION DATE * * AS A VALID DATE OF SERVICE * * * *************************************************************** 8680-SET-PTRADIO-LINE-FLAG. MOVE 'N' TO PTRADIO-LINE-FLAG. SEARCH ALL PTRH-ENTRY AT END MOVE 'N' TO PTRADIO-LINE-FLAG WHEN PTRH-PTRADIO-HCPCS (PTRH-INDX) = OPPS-HCPCS (LN-SUB) IF OPPS-LITEM-DOS (LN-SUB) >= PTRH-EFF-DATE (PTRH-INDX) AND (OPPS-LITEM-DOS (LN-SUB) <= PTRH-TERM-DATE (PTRH-INDX) OR PTRH-TERM-DATE (PTRH-INDX) = 0) THEN MOVE 'Y' TO PTRADIO-LINE-FLAG END-IF. 8680-SET-PTRADIO-LINE-FL-EXIT. EXIT. *************************************************************** * * * REDUCE LINE ITEM PAYMENTS OF DEVICE LINES (SI = H) BY THE * * WAGE ADJUSTED DEVICE OFFSET AMOUNT WHEN THERE ARE DEVICE * * OFFSETS ON THE CLAIM (PASS-THROUGH DEVICES) * * * *************************************************************** * * * 1. RE-CALCULATE LINE ITEM PAYMENT FOR SERVICE INDICATOR * * TYPE H * * 2. SUBTRACT WAGE ADJUSTED OFFSET AMOUNT FROM SI TYPE 'H' * * WITH HCPCS CODE BEGINNING WITH 'C' * * ** EFFECTIVE 04/01/2002 * * * *************************************************************** 8700-CALC-H-OFFSET. *-------------------------------------------------------------* * REDUCE EACH DEVICE LINE'S PAYMENT BY THE WAGE ADJUSTED * * OFFSET AMOUNT IN PROPORTION TO THE DEVICE LINE'S CHARGES * *-------------------------------------------------------------* IF H-TOT-H-CHRG > 0 COMPUTE H-OFF-RATE ROUNDED = H-SUB-CHRG / H-TOT-H-CHRG COMPUTE T-LITEM-PYMT ROUNDED = T-LITEM-PYMT - (H-TOTAL-WAOFF * H-OFF-RATE) ELSE NEXT SENTENCE. IF T-LITEM-PYMT < 0 MOVE 0 TO T-LITEM-PYMT. 8700-CALC-H-OFFSET-EXIT. EXIT. *************************************************************** * * * PROCESS DRUG COINSURANCE TABLE RECORDS * * * *************************************************************** * * * ADJUST THE "DRUG" LINE COINSURANCE WHEN THE PROCEDURE * * COINSURANCE AMOUNTS PLUS THE "DRUG" COINSURANCE AMOUNT(S) * * BILLED ON THE SAME DAY EXCEED THE DAILY INPATIENT * * COINSURANCE LIMIT. * * * *************************************************************** 8800-ADJ-STV-REIM. IF W-DCP-CODE (W-DCP-INDX) = 1 PERFORM 8810-PROCESS-TYPE1 THRU 8810-PROCESS-TYPE1-EXIT ELSE PERFORM 8840-PROCESS-TYPE2 THRU 8840-PROCESS-TYPE2-EXIT. 8800-ADJ-STV-REIM-EXIT. EXIT. *************************************************************** * * * FOR DAYS OF SERVICE WITH "DRUG" COINSURANCE, DETERMINE THE * * % OF TOTAL "DRUG" COINSURANCE THAT CAN BE PAID IN ADDITION * * TO THE DAY'S MOST EXPENSIVE PROCEDURE/VISIT WAGE ADJUSTED * * COINSURANCE WHILE KEEPING WITHIN THE INPATIENT DAILY * * COINSURANCE LIMIT. * * * * WHEN H-RATIO = 0, NONE OF THE DRUG COINSURANCE CAN BE PAID * * WHEN H-RATIO = 1, ALL OF THE DRUG COINSURANCE CAN BE PAID * * * * BY USING THE DAY'S MOST EXPENSIVE PROCEDURE/VIST WAGE * * ADJUSTED COINSURANCE, THE BENEFICIARY RECEIVES THE * * GREATEST BENEFIT FROM THE INPATIENT LIMITATION PROVISION. * * * *************************************************************** 8810-PROCESS-TYPE1. *-------------------------------------------------------------* * DRUGS WERE ADMINISTERED ON THE DAY * *-------------------------------------------------------------* IF W-DCP-COIN2 (W-DCP-INDX) > 0 *-------------------------------------------------------------* * GET DATE OF SERVICE & WAGE ADJUSTED COINSURANCE OF THE * * DAY'S MOST EXPENSIVE PROCEDURE/VISIT * *-------------------------------------------------------------* MOVE W-DCP-DOS (W-DCP-INDX) TO H-DCP-DOS MOVE W-DCP-WGNAT (W-DCP-INDX) TO H-TOTAL *-------------------------------------------------------------* * CALCULATE THE % OF THE DAY'S TOTAL DRUG COIN THAT CAN BE * * PAID IN ADDITION TO THE PROCEDURE/VISIT COIN WITHIN THE * * INPATIENT LIMIT * *-------------------------------------------------------------* COMPUTE H-RATIO = (H-IP-LIMIT - W-DCP-WGNAT (W-DCP-INDX)) / W-DCP-COIN2 (W-DCP-INDX) *-------------------------------------------------------------* * NONE OF THE DAY'S DRUG COIN CAN BE PAID B/C THE PROCEDURE/ * * VISIT COIN > INPATIENT COIN LIMIT * *-------------------------------------------------------------* IF H-RATIO < 0 MOVE 0 TO H-RATIO. *-------------------------------------------------------------* * THE DAY'S TOTAL DRUG COINSURANCE CAN BE PAID WITHIN THE * * INPATIENT COIN LIMIT * *-------------------------------------------------------------* IF H-RATIO > 1 MOVE 1 TO H-RATIO. 8810-PROCESS-TYPE1-EXIT. EXIT. *************************************************************** * * * REDUCE THE "DRUG" LINE'S NATIONAL COINSURANCE AMOUNT AND * * ADD THE REDUCTION AMOUNT TO THE LINE'S REIMBURSEMENT * * AMOUNT WHEN THE INPATIENT LIMIT IS EXCEEDED * * * *************************************************************** 8840-PROCESS-TYPE2. *-------------------------------------------------------------* * CURRENT TYPE 2 DRUG COIN REC HAS SAME DATE OF SERVICE AS * * THE LAST TYPE 1 RECORD PROCESSED * *-------------------------------------------------------------* IF W-DCP-DOS (W-DCP-INDX) = H-DCP-DOS *-------------------------------------------------------------* * GO TO SERVICE LINE THAT CORRESPONDS TO THE DRUG COIN RECORD * *-------------------------------------------------------------* MOVE W-DCP-SUB (W-DCP-INDX) TO LN-SUB *-------------------------------------------------------------* * CALCULATE ACTUAL COIN AMT TO BE REIMBURSED DUE TO IP LIMIT * *-------------------------------------------------------------* COMPUTE H-SHIFT = W-DCP-COIN2 (W-DCP-INDX) * (1 - H-RATIO) *-------------------------------------------------------------* * ACCUMULATE THE TOTAL NATIONAL COIN DUE FOR THE DAY * * (LESS ACTUAL COIN AMT TO BE REIMBURSED DUE TO IP LIMIT) * *-------------------------------------------------------------* COMPUTE H-TOTAL = A-ADJ-COIN (LN-SUB) + H-TOTAL - H-SHIFT *-------------------------------------------------------------* * DETERMINE HOW MUCH THE DAY'S TOTAL NATIONAL COIN DUE * * EXCEEDS THE DAILY INPATIENT LIMIT (IF IT EXCEEDS THE LIMIT) * *-------------------------------------------------------------* * OCCURS WHEN THE NATIONAL COIN OF THIS LINE AND/OR PREVIOUS * * LINES FROM THE SAME DAY IS GREATER THAN THE ACTUAL COIN DUE * * & PUSHES THE DAILY TOTAL OVER THE INPATIENT LIMIT * *-------------------------------------------------------------* IF H-TOTAL > H-IP-LIMIT COMPUTE H-SHIFT = H-SHIFT + H-TOTAL - H-IP-LIMIT END-IF *-------------------------------------------------------------* * CALCULATE THE ADJUSTED NATIONAL COIN FOR THE DRUG LINE BY * * DEDUCTING THE AMT THAT EXCEEDS THE INPATIENT LIMIT * *-------------------------------------------------------------* COMPUTE A-ADJ-COIN (LN-SUB) = A-ADJ-COIN (LN-SUB) - H-SHIFT *-------------------------------------------------------------* * ADD DRUG COIN AMT THAT EXCEEDS IP LIMIT TO LINE REIM AMT * * SET RETURN CODE TO INDICATE DAILY COINSURANCE LIMITATION * *-------------------------------------------------------------* COMPUTE A-LITEM-REIM (LN-SUB) = A-LITEM-REIM (LN-SUB) + H-SHIFT MOVE 22 TO A-RETURN-CODE (LN-SUB) END-IF. 8840-PROCESS-TYPE2-EXIT. EXIT. *************************************************************** * * * END OF CLAIM PROCESSING * * * * 1. MOVE TOTAL CLAIM CHARGE AMOUNT. * * 2. MOVE TOTAL CLAIM PAYMENT AMOUNT. * * 3. MOVE TOTAL CLAIM BLOOD PINTS USED. * * 4. CALCULATE CLAIM LEVEL OUTLIER AMOUNT. * * * *************************************************************** 8900-END-PRICE-RTN. MOVE H-TOT-CHRG TO A-TOT-CLM-CHRG. MOVE H-TOT-PYMT TO A-TOT-CLM-PYMT. *-------------------------------------------------------------* * NUMBER OF BLOOD PINTS USED FOR BLOOD DEDUCTIBLES ON CLAIM = * * INITIAL NUMBER OF BLOOD PINTS ALLOWED FOR DEDUCTIBLES - * * BLOOD PINTS STILL LEFT AFTER PROCESSING BLOOD DEDUCTIBLES * *-------------------------------------------------------------* COMPUTE A-BLOOD-PINTS-USED = H-BENE-BLOOD-PINTS - H-BENE-PINTS-USED. IF H-OUTLIER-PYMT > 0 MOVE H-OUTLIER-PYMT TO A-OUTLIER-PYMT. 8900-END-PRICE-RTN-EXIT. EXIT. ****************************************************************** ****************************************************************** *** *** ** ** ** OUTPATIENT PROSPECTIVE PAYMENT SYSTEM PRICER ** ** -------------------------------------------- ** ** SECTION 9000 FOR CALENDAR YEAR 2010 PROCESSING ** ** SERVICE FROM DATES: 1/1/2010 - 12/31/2010 ** ** ** *** *** ****************************************************************** ****************************************************************** ****************************************************************** * * * PRICING PROCESS OVERVIEW * * ------------------------ * * * * 1. GET RATES & OTHER INFORMATION FOR THE CLAIM * * 2. VALIDATE CLAIM * * 3. VALIDATE SERVICE LINES (INCLUDING DATA FROM THE OCE) * * 4. GET RATES & OTHER INFORMATION FOR THE SERVICE LINES * * 5. ACCUMULATE NON-PRIME LINE CHARGES FOR COMPOSITE APCS * * 6. ACCUMULATE PACKAGED MENTAL HEALTH CHARGES * * 7. ORDER THE SERVICE LINES IN THE SEQUENCE IN WHICH * * DEDUCTIBLES WILL BE APPLIED * * 8. ORDER BLOOD LINES IN THE SEQUENCE IN WHICH DEDUCTIBLES * * WILL BE APPLIED * * 9. CALCULATE SERVICE LINE PAYMENTS * * 10. CALCULATE DEDUCTIBLE AMOUNT APPLIED TO EACH SERVICE LINE * * 11. CALCULATE BLOOD DEDUCTIBLE AMOUNT APPLIED TO EACH BLOOD * * DEDUCTIBLE LINE * * 12. CALCULATE BENEFICIARY MAXIMUM (IP LIMIT), NATIONAL, * * MINIMUM, & REDUCED COINSURANCE FOR EACH SERVICE LINE * * 13. CALCULATE REIMBURSEMENT FOR EACH SERVICE LINE * * 14. ADJUST LINE CHARGES FOR ARTIFICAL, PACKAGED, COMPOSITE, * * AND MENTAL HEALTH CHARGES OF APPLICABLE PROCEDURES. ALSO, * * ADJUST LINE CHARGES AND PAYMENTS FOR PASS-THROUGH DEVICES * * FOR ELIGIBLE PROCEDURES. ALL ADJUSTMENTS ARE DONE FOR * * OUTLIER DETERMINATION ONLY. * * 15. CALCULATE OUTLIER PAYMENT FOR ELIGIBLE SERVICE LINES * * 16. APPLY THE DAILY INPATIENT LIMIT IN CALCULATING THE * * COINSURANCE TO BE PAID BY THE BENEFICIARY FOR DRUG LINES; * * ADD ANY COINSURANCE AMOUNT THAT EXCEEDS THE INPATIENT * * LIMIT TO THE DRUG LINE'S REIMBURSEMENT * * 17. ACCUMULATE CLAIM TOTALS * * 18. MOVE FINAL SERVICE LINE AMOUNTS TO AREA TO BE PASSED BACK * * * ****************************************************************** 9000-PROCESS-MAIN-NEW. ***************************************************************** * * * STEP 1 - INITIALIZE & SET WORKING-STORAGE VARIABLES, ASSIGN * * ------ CBSA & WAGE INDEX, PERFORM CLAIM DATE EDITS, SET * * INPATIENT DAILY COINSURANCE LIMIT (SET ANNUALLY) * * * ***************************************************************** PERFORM 9100-INIT THRU 9100-INIT-EXIT. *--------------------------------------------------------* * SET ERROR CODE IF THE WAGE INDEX = 0 * *--------------------------------------------------------* IF H-WINX1 = 0 AND A-CLM-RTN-CODE = 01 MOVE 51 TO A-CLM-RTN-CODE. *--------------------------------------------------------* * IF THE CLAIM HAS ERROR(S), STOP PROCESSING * *--------------------------------------------------------* IF A-CLM-RTN-CODE >= 50 GOBACK. *--------------------------------------------------------* * MOVE WAGE INDEX TO VARIABLE TO BE PASSED BACK * *--------------------------------------------------------* MOVE H-WINX1 TO A-WINX. ***************************************************************** * * * STEP 2 - SET CLAIM FLAGS WHEN CERTAIN CODES ARE FOUND * * ------ (LOOP THROUGH THE CLAIM) * * * * - PHP-APC-FLAG - PARTIAL HOSPITALIZATION CLAIM (0172 & 0173)* * - APC34-FLAG - MENTAL HEALTH CLAIM * * - PTD-FLAG - PASS-THROUGH DEVICE(S) ON CLAIM FOR OUTLIER * * - PTRADIO-CLAIM-FLAG - PASS-THROUGH RADIOPAHARM(S) ON CLAIM * * - PTCA-CLAIM-FLAG - PASS-THROUGH CONTRAST AGENT ON CLAIM * * CREATE PASS-THROUGH CONTRAST AGENT DAY TABLE * * - PTDO-CLAIM-FLAG - PASS-THROUGH DEVICE ON CLAIM FOR OFFSET * * CREATE PASS-THROUGH DEVICE HCPCS TABLE * * * * - DISABLED CY 2009: C1820-OFFSET-FLAG - DEVICE OFFSET CLAIM * * * ***************************************************************** *--------------------------------------------------------* * EMPTY PASS-THROUGH CONTRAST AGENT DAY TABLE FOR CLAIM * *--------------------------------------------------------* MOVE 0 TO W-PTCA-DAY-MAX. *--------------------------------------------------------* * EMPTY PASS-THROUGH DEVICE HCPCS TABLE FOR CLAIM * *--------------------------------------------------------* MOVE 0 TO W-PTDO-HCPCS-MAX. PERFORM 9125-INIT THRU 9125-INIT-EXIT VARYING LN-SUB FROM 1 BY 1 UNTIL LN-SUB > OPPS-LINE-CNT. ***************************************************************** * * * STEP 3 - VALIDATE CLAIM LINES, CALCULATE LINE DISCOUNTS & * * ------ OFFSETS, ACCUMULATE CLAIM TOTALS, SET FLAGS, * * POPULATE COINSURANCE & BLOOD DEDUCTIBLE TABLES * * WITH VALID SERVICE LINES, POPULATE COMPOSITE APC * * TABLE WITH NON-PRIME COMPOSITE LINE CHARGES, * * CALCULATE TOTAL PACKAGED MENTAL HEALTH CHARGES, * * CREATE PASS-THROUGH DEVICE TABLE (OUTLIER), CREATE * * NUCLEAR MEDICINE APC TABLE FOR PASS-THROUGH * * RADIOPHARMACEUTICAL OFFSET, CREATE CONTRAST * * AGENT PROCEDURE TABLE FOR PASS-THROUGH CONTRAST * * AGENT OFFSET & CREATE PASS-THROUGH DEVICE OFFSET * * PROCEDURE TABLE FOR PASS-THROUGH DEVICE OFFSET. * * (LOOP THROUGH THE CLAIM) * * * ***************************************************************** *--------------------------------------------------------* * EMPTY TABLES FOR NEW CLAIM * *--------------------------------------------------------* MOVE 0 TO W-DCP-MAX W-BLD-MAX W-CMP-MAX W-PTD-MAX W-NUCMED-MAX W-CAPROC-MAX W-PTDO-PROC-MAX. PERFORM 9150-INIT THRU 9150-INIT-EXIT VARYING LN-SUB FROM 1 BY 1 UNTIL LN-SUB > OPPS-LINE-CNT. *--------------------------------------------------------* * CALCULATE RATIO OF BLOOD PRODUCT CHARGES TO TOTAL * * BLOOD CHARGES (PRODUCT & STORAGE/PROCESSING) * *--------------------------------------------------------* IF H-TOT-38X-39X > 0 COMPUTE H-38X-39X-RATE ROUNDED = H-TOT-38X / H-TOT-38X-39X. *--------------------------------------------------------* * CALCULATE TOTAL OFFSET AMT FOR PT RADIOPHARM LINE(S) * * (# OF UNITS SUMMED LIMITED TO THE LESSER OF THE # OF * * PT RADIOPHARM HCPCS & THE # OF NUCLEAR MEDICINE UNITS)* *--------------------------------------------------------* IF W-NUCMED-MAX > 0 SET W-NUCMED-INDX TO 1 PERFORM UNTIL (W-NUCMED-INDX > W-NUCMED-MAX) OR (W-NUCMED-INDX > H-PTRADIO-HCPCS-CNT) COMPUTE H-NUCMED-TOT-OFFSET ROUNDED = H-NUCMED-TOT-OFFSET + W-NUCMED-WAGE-ADJ-OFFSET (W-NUCMED-INDX) SET W-NUCMED-INDX UP BY 1 END-PERFORM END-IF. *--------------------------------------------------------* * CALCULATE TOTAL OFFSET AMT PER DAY FOR PT CONTRAST * * AGENT LINE(S) (# OF UNITS SUMMED LIMITED TO THE LESSER * * OF THE # OF PT CONTRAST AGENT HCPCS & THE # OF PT * * CONTRAST AGENT PROCEDURE APC UNITS PER DAY) * *--------------------------------------------------------* IF W-PTCA-DAY-MAX > 0 AND W-CAPROC-MAX > 0 SET W-PTCA-DAY-INDX TO 1 PERFORM UNTIL (W-PTCA-DAY-INDX > W-PTCA-DAY-MAX) PERFORM 9396-TOTAL-DAY-PTCA-OFFS THRU 9396-TOTAL-DAY-PTCA-OFFS-EXIT SET W-PTCA-DAY-INDX UP BY 1 END-PERFORM END-IF. *--------------------------------------------------------* * MAP PASS-THROUGH DEVICE HCPCS TO THEIR CORRESPONDING * * OFFSET PROCEDURES * *--------------------------------------------------------* PERFORM 9397-PTDO-MAPPINGS-1 THRU 9397-PTDO-MAPPINGS-1-EXIT VARYING W-PTDO-HCPCS-INDX FROM 1 BY 1 UNTIL W-PTDO-HCPCS-INDX > W-PTDO-HCPCS-MAX. PERFORM 9397-PTDO-MAPPINGS-2 THRU 9397-PTDO-MAPPINGS-2-EXIT VARYING W-PTDO-HCPCS-INDX FROM 1 BY 1 UNTIL W-PTDO-HCPCS-INDX > W-PTDO-HCPCS-MAX. ***************************************************************** * * * STEP 4 - ACCUMULATE TOTAL CLAIM CHARGES FROM DEVICE LINES * * ------ (FOR DEVICES, SERVICE INDICATOR = H) * * (LOOP THROUGH THE COINSURANCE DEDUCTIBLE TABLE) * * * * *** DISABLED 08-11-2010 - NO LONGER NEEDED; REPLACED BY * * REVISED PASS-THROUGH DEVICE LOGIC * * * ***************************************************************** MOVE 0 TO W-DCP-MAX. * PERFORM 9555-CALC-H-TOT * THRU 9555-CALC-H-TOT-EXIT * VARYING W-LP-INDX FROM 1 BY 1 * UNTIL W-LP-INDX > W-LNC-MAX. ***************************************************************** * * * STEP 5 - CALCULATE LINE PAYMENTS, DEDUCTIBLES, COINSURANCE, * * ------ & REIMBURSEMENT, ACCUMULATE CLAIM TOTALS, POPULATE * * DRUG COINSURANCE TABLE, POPULATE PASS-THROUGH * * DEVICE TABLE WITH ELIGIBLE PROCEDURE DATA AND * * DEVICE LINE ITEM PAYMENT, AND MOVE LINE ITEM * * VALUES TO VARIABLES TO BE PASSED BACK * * (LOOP THROUGH THE COINSURANCE DEDUCTIBLE TABLE) * * * ***************************************************************** *--------------------------------------------------------* * POINT TO 1ST RECORD IN THE BLOOD DEDUCTIBLE TABLE * *--------------------------------------------------------* SET W-BD-INDX TO 1. *--------------------------------------------------------* * CLEAR THE DRUG COINSURANCE TABLE * *--------------------------------------------------------* MOVE 0 TO W-DCP-MAX. PERFORM 9400-CALCULATE THRU 9400-CALCULATE-EXIT VARYING W-LP-INDX FROM 1 BY 1 UNTIL W-LP-INDX > W-LNC-MAX. ***************************************************************** * * * STEP 6 - ADJUST PROCEDURE LINE CHARGES FOR ARTIFICIAL * * ------ CHARGES, PACKAGING, COMPOSITES, MENTAL HEALTH, AND * * PASS-THROUGH DEVICES, AND CALCULATE OUTLIER * * PAYMENTS * * (LOOP THROUGH THE COINSURANCE DEDUCTIBLE TABLE) * * * ***************************************************************** PERFORM 9600-ADJ-CHRG-OUTL THRU 9600-ADJ-CHRG-OUTL-EXIT VARYING W-LP-INDX FROM 1 BY 1 UNTIL W-LP-INDX > W-LNC-MAX ***************************************************************** * * * STEP 7 - CALCULATE THE COINSURANCE & REIMBURSEMENT AMOUNTS * * ------ FOR STATUS INDICATOR G & K LINES. THE DAILY INPA- * * TIENT COINSURANCE LIMIT IS APPLIED USING THE WAGE * * ADJUSTED COINSURANCE OF EACH DAY'S MOST EXPENSIVE * * PROCEDURE OR VISIT. * * (LOOP THROUGH THE DRUG COINSURANCE TABLE) * * * ***************************************************************** IF GJK-FLAG = 'Y' PERFORM 9800-ADJ-STV-REIM THRU 9800-ADJ-STV-REIM-EXIT VARYING W-DCP-INDX FROM 1 BY 1 UNTIL W-DCP-INDX > W-DCP-MAX ELSE NEXT SENTENCE. ***************************************************************** * * * STEP 8 - MOVE CLAIM TOTAL CHARGES, PAYMENTS, BLOOD PINTS * * ------ USED, AND OUTLIER PAYMENTS TO VARIABLES TO BE * * PASSED BACK. CALCULATE BLOOD PINTS USED. * * * ***************************************************************** PERFORM 9900-END-PRICE-RTN THRU 9900-END-PRICE-RTN-EXIT. 9000-PROCESS-MAIN-NEW-EXIT. EXIT. *************************************************************** * * * INITIALIZE WORKING STORAGE HOLD AREAS AND ADDITIONAL * * VARIABLES TO BE PASSED BACK TO THE STANDARD SYSTEM, * * ASSIGN CLAIM CBSA AND WAGE INDEX, & PERFORM DATE EDITS * * * * ** CHANGE EVERY JANUARY: * * - INPATIENT DAILY COINSURANCE LIMIT (H-IP-LIMIT) * * - CAL-VERSION * * * *************************************************************** * * * ERROR RETURN CODES: * * ------------------- * * - IF PROVIDER SPECIFIC FILE WAGE INDEX RECLASSIFICATION * * CODE INVALID OR MISSING * * - MOVE '52' TO CLAIM LEVEL RETURN CODE * * - DISCONTINUE CLAIM PROCESSING * * - IF SERVICE FROM DATE NOT NUMERIC OR < 20000801 * * - MOVE '53' TO CLAIM LEVEL RETURN CODE * * - DISCONTINUE CLAIM PROCESSING * * - IF SERVICE FROM DATE < PROVIDER EFFECTIVE DATE * * - MOVE '54' TO CLAIM LEVEL RETURN CODE * * - DISCONTINUE CLAIM PROCESSING * * - IF SERVICE FROM DATE > PROVIDER TERMINATION DATE * * - MOVE '54' TO CLAIM LEVEL RETURN CODE * * - DISCONTINUE CLAIM PROCESSING * * * *************************************************************** 9100-INIT. *-------------------------------------------------------------* * INITIALIZE CLAIM RETURN CODE (01 = CLAIM PROCESSED) * *-------------------------------------------------------------* MOVE 01 TO A-CLM-RTN-CODE. *-------------------------------------------------------------* * INITIALIZE CLAIM AND LINE VARIABLES * *-------------------------------------------------------------* * 11/05/2007 - PHP-HCPCS-FLAG & MH-HCPCS-FLAG ADDED * * 11/06/2007 - BRACHY-APC-FLAG ADDED * * 11/13/2007 - BLD-DEDUC-HCPCS-FLAG ADDED * * 11/28/2007 - APC34-FLAG ADDED * * 12/27/2007 - RADIOPH-APC-FLAG ADDED * * 02/11/2008 - PTD-FLAG, PTD-LINE-FLAG, PTD-PROC-FLAG ADDED * * 11/03/2008 - APC33-FLAG REPLACED BY PHP-APC-FLAG * * 11/12/2008 - BRACHY-APC-FLAG REMOVED, NOT USED FOR CY 2009 * * 02/09/2009 - PTRADIO-CLAIM-FLAG, PTRADIO-LINE-FLAG ADDED * * 11/16/2009 - RADIOPH-APC-FLAG REMOVED; PTCA-CLAIM-FLAG, * * PTCA-LINE FLAG ADDED * *-------------------------------------------------------------* MOVE 'N' TO PHP-APC-FLAG GJK-FLAG ST0-FLAG N-FLAG C-FLAG C1820-OFFSET-FLAG PHP-HCPCS-FLAG MH-HCPCS-FLAG APC34-FLAG PTD-FLAG PTD-LINE-FLAG PTD-PROC-FLAG BLD-DEDUC-HCPCS-FLAG PTRADIO-CLAIM-FLAG PTRADIO-LINE-FLAG PTCA-CLAIM-FLAG PTCA-LINE-FLAG. MOVE SPACE TO A-MSA A-CBSA BILL14X-FLAG. MOVE ZERO TO A-OUTLIER-PYMT A-TOTAL-CLM-DEDUCT A-TOT-CLM-CHRG A-TOT-CLM-PYMT A-BLOOD-DEDUCT-DUE A-BLOOD-PINTS-USED A-WINX W-LNC-MAX. INITIALIZE H-ADDITIONAL-VARIABLES. INITIALIZE LINE-HOLD-ITEMS. INITIALIZE T-LITEM-PYMT. *-------------------------------------------------------------* * VALIDATE CLAIM & PSF DATES * *-------------------------------------------------------------* IF L-SERVICE-FROM-DATE NOT NUMERIC MOVE 53 TO A-CLM-RTN-CODE GO TO 9100-INIT-EXIT ELSE IF L-SERVICE-FROM-DATE < L-PSF-EFFDT MOVE 54 TO A-CLM-RTN-CODE GO TO 9100-INIT-EXIT ELSE IF L-PSF-TERMDT > 0 IF L-SERVICE-FROM-DATE > L-PSF-TERMDT MOVE 54 TO A-CLM-RTN-CODE GO TO 9100-INIT-EXIT END-IF END-IF. *-------------------------------------------------------------* * UPDATE CAL-VERSION EVERY JANUARY * *-------------------------------------------------------------* MOVE CAL-VERSION9 TO A-CALC-VERS. *-------------------------------------------------------------* * RECEIVE BENEFICIARY SPECIFIC ITEMS FROM THE OCE * *-------------------------------------------------------------* MOVE BENE-DEDUCT TO H-BENE-DEDUCT. MOVE BENE-BLOOD-PINTS TO H-BENE-BLOOD-PINTS H-BENE-PINTS-USED. *-------------------------------------------------------------* * GET TO PROPER APC DATE BY SERVICE DATE (STARTING AT THE * * LATEST EFFECTIVE DATE IN THE APC DATE TABLE) * *-------------------------------------------------------------* MOVE WAD-MAX TO WAD-SUB. PERFORM UNTIL L-SERVICE-FROM-DATE NOT < WAD-DATE (WAD-SUB) SUBTRACT 1 FROM WAD-SUB END-PERFORM. *-------------------------------------------------------------* * DETERMINE WHICH CBSA TO USE & WHETHER TO USE THE SPECIAL * * WAGE INDEX IN THE PSF, AND SET THE INPATIENT DAILY * * COINSURANCE LIMIT (IN 2 PLACES; CHANGE EVERY JANUARY) * *-------------------------------------------------------------* IF L-PSF-SPEC-PYMT-IND = 'Y' MOVE L-PSF-WI-CBSA TO H-PSF-CBSA ELSE IF L-PSF-SPEC-PYMT-IND = ' ' MOVE L-PSF-GEO-CBSA TO H-PSF-CBSA ELSE IF L-PSF-SPEC-PYMT-IND = '1' OR '2' MOVE L-PSF-GEO-CBSA TO H-PSF-CBSA A-CBSA MOVE L-PSF-SPEC-WGIDX TO H-WINX1 MOVE 1100 TO H-IP-LIMIT GO TO 9100-INIT-EXIT ELSE MOVE 52 TO A-CLM-RTN-CODE GO TO 9100-INIT-EXIT. IF H-PSF-CBSA = SPACE MOVE 52 TO A-CLM-RTN-CODE GO TO 9100-INIT-EXIT. MOVE 1100 TO H-IP-LIMIT. *-------------------------------------------------------------* * APPLY WAGE INDEX FLOOR POLICY * * UPDATE WITH NEW FLOOR PARAGRAPH EVERY JANUARY * *-------------------------------------------------------------* PERFORM 9120-FLOOR-2010 THRU 9120-FLOOR-2010-EXIT. *-------------------------------------------------------------* * APPLY SECTION 401 WAGE INDEX POLICY * * UPDATE WITH NEW SECTION 401 PARAGRAPH EVERY JANUARY * *-------------------------------------------------------------* PERFORM 9120-SEC401-2010 THRU 9120-SEC401-2010-EXIT. *-------------------------------------------------------------* * GET THE CBSA WAGE INDEX VALUE (IF NOT ALREADY OVERRIDDEN * * BY THE PSF SPECIAL WAGE INDEX VALUE) * *-------------------------------------------------------------* MOVE H-PSF-CBSA TO A-CBSA. IF H-WINX1 = 0 PERFORM 9200-CALC-WAGEINDX THRU 9200-CALC-WAGEINDX-EXIT. 9100-INIT-EXIT. EXIT. *************************************************************** * * * NEW CY 2010 FLOOR FOR CBSA WAGE INDEX * * IPPS PRICER PGM FLOORS TAKEN FROM: IPDRV103 * * * * 05/13/2010 - CORRECTED LOGIC FOR CBSA 33 * * * *************************************************************** * * * SYNC ALL OF THE FOLLOWING WITH INPATIENT. * * SEE IPPS PRICER MAINTAINER. * * * * * SPECIAL NOTES * * * ------------- * * 1) INPATIENT MOVES 'N' TO P-NEW-CBSA-SPEC-PAY-IND * * OPPS MOVES ' ' TO L-PSF-SPEC-PYMT-IND * * * * 2) INPATIENT CHECKS P-NEW-CBSA-SPEC-PAY-IND = 'Y' * * OPPS CHECKS L-PSF-SPEC-PYMT-IND = 'Y' * * * * 3) INPATIENT CHECKS VALUE OF HOLD-PROV-CBSA * * OPPS CHECKS VALUE OF H-PSF-CBSA * * * * 4) INPATIENT MOVES THE STATE CBSA TO HOLD-PROV-CBSA * * OPPS MOVES THE STATE CBSA TO H-PSF-CBSA * * * * 5) INPATIENT CHECKS P-NEW-STATE * * OPPS CHECKS L-PSF-PROV-ST * * * * 6) ADD SINGLE QUOTES AROUND L-PSF-PROV-ST VALUES * * * * * * BE SURE TO MAKE THESE SIX CHANGES EVERY JANUARY * * * *************************************************************** 9120-FLOOR-2010. 315800 IF H-PSF-CBSA = ' 33' 26943400 315900 AND L-PSF-SPEC-PYMT-IND = 'Y' 26943500 316000 AND L-PSF-PROV-ST = '30' 26943600 316100 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 26943700 316200 MOVE ' 30' TO H-PSF-CBSA. 26943800 316300 26943300 316400 IF H-PSF-CBSA = ' 33' 26943400 316500 AND L-PSF-SPEC-PYMT-IND = 'Y' 26943500 316600 AND L-PSF-PROV-ST = '33' 26943600 316700 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 26943700 316800 MOVE ' 33' TO H-PSF-CBSA. 26943800 316900 26943900 317000 IF H-PSF-CBSA = '10900' 26944000 317100 AND L-PSF-PROV-ST = '31' 26944200 317200 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 26944300 317300 MOVE ' 31' TO H-PSF-CBSA. 26944400 317400 26944500 317500 IF H-PSF-CBSA = '19340' 26944600 317600 AND L-PSF-PROV-ST = '16' 26944800 317700 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 26944900 317800 MOVE ' 16' TO H-PSF-CBSA. 26945000 317900 26945100 318000 IF H-PSF-CBSA = '19340' 26944600 318100 AND L-PSF-SPEC-PYMT-IND = 'Y' 26943500 318200 AND L-PSF-PROV-ST = '16' 26944800 318300 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 26944900 318400 MOVE ' 16' TO H-PSF-CBSA. 26945000 318500 26945100 318600 IF H-PSF-CBSA = '21780' 26945800 318700 AND L-PSF-PROV-ST = '15' 26946000 318800 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 26946100 318900 MOVE ' 15' TO H-PSF-CBSA. 26946200 319000 26945100 319100 IF H-PSF-CBSA = '21780' 26945800 319200 AND L-PSF-SPEC-PYMT-IND = 'Y' 26948500 319300 AND L-PSF-PROV-ST = '15' 26946000 319400 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 26946100 319500 MOVE ' 15' TO H-PSF-CBSA. 26946200 319600 26946300 319700 IF H-PSF-CBSA = '25180' 26946400 319800 AND L-PSF-PROV-ST = '21' 26946500 319900 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 26946600 320000 MOVE ' 21' TO H-PSF-CBSA. 26946700 320100 26946800 320200 IF H-PSF-CBSA = '25540' 26948400 320300 AND L-PSF-SPEC-PYMT-IND = 'Y' 26948500 320400 AND L-PSF-PROV-ST = '07' 26948600 320500 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 26948700 320600 MOVE ' 07' TO H-PSF-CBSA. 26948800 320700 26948900 320800 IF H-PSF-CBSA = '28420' 26948400 320900 AND L-PSF-SPEC-PYMT-IND = 'Y' 26948500 321000 AND L-PSF-PROV-ST = '50' 26948600 321100 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 26948700 321200 MOVE ' 50' TO H-PSF-CBSA. 26948800 321300 26948900 321400 IF H-PSF-CBSA = '28940' 26948400 321500 AND L-PSF-SPEC-PYMT-IND = 'Y' 26948500 321600 AND L-PSF-PROV-ST = '18' 26948600 321700 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 26948700 321800 MOVE ' 18' TO H-PSF-CBSA. 26948800 321900 26948900 322000 IF H-PSF-CBSA = '28940' 26948400 322100 AND L-PSF-SPEC-PYMT-IND = 'Y' 26948500 322200 AND L-PSF-PROV-ST = '44' 26948600 322300 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 26948700 322400 MOVE ' 44' TO H-PSF-CBSA. 26948800 322500 26948900 322600 IF H-PSF-CBSA = '35084' 26952000 322700 AND L-PSF-SPEC-PYMT-IND = 'Y' 26953000 322800 AND L-PSF-PROV-ST = '31' 26953100 322900 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 26953200 323000 MOVE ' 31' TO H-PSF-CBSA. 26953300 323100 26953400 323200 IF H-PSF-CBSA = '37620' 26954000 323300 AND L-PSF-PROV-ST = '36' 26955000 323400 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 26955100 323500 MOVE ' 36' TO H-PSF-CBSA. 26955200 323600 26955300 323700 IF H-PSF-CBSA = '37964' 26956000 323800 AND L-PSF-SPEC-PYMT-IND = 'Y' 26956100 323900 AND L-PSF-PROV-ST = '31' 26956200 324000 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 26956300 324100 MOVE ' 31' TO H-PSF-CBSA. 26956400 324200 26956500 324300 IF H-PSF-CBSA = '48540' 26956600 324400 AND L-PSF-PROV-ST = '36' 26956800 324500 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 26956900 324600 MOVE ' 36' TO H-PSF-CBSA. 26957000 324700 26957100 324800 IF H-PSF-CBSA = '48540' 26956600 324900 AND L-PSF-PROV-ST = '51' 26956800 325000 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 26956900 325100 MOVE ' 51' TO H-PSF-CBSA. 26957000 325200 26957100 325300 IF H-PSF-CBSA = '48864' 26959000 325400 AND L-PSF-PROV-ST = '31' 26959200 325500 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 26959300 325600 MOVE ' 31' TO H-PSF-CBSA. 26959400 325700 26957100 325800 IF H-PSF-CBSA = '48864' 26959000 325900 AND L-PSF-SPEC-PYMT-IND = 'Y' 26962500 326000 AND L-PSF-PROV-ST = '31' 26959200 326100 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 26959300 326200 MOVE ' 31' TO H-PSF-CBSA. 26959400 326300 26959500 326400 IF H-PSF-CBSA = '49660' 26959600 326500 AND L-PSF-SPEC-PYMT-IND = 'Y' 26962500 326600 AND L-PSF-PROV-ST = '36' 26959700 326700 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 26959800 326800 MOVE ' 36' TO H-PSF-CBSA. 26959900 326900 26960000 327000 IF H-PSF-CBSA = '19060' 26961000 327100 AND L-PSF-PROV-ST = '21' 26962000 327200 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 26962100 327300 MOVE ' 21' TO H-PSF-CBSA. 26962200 327400 26962300 327500 IF H-PSF-CBSA = '22020' 26962400 327600 AND L-PSF-PROV-ST = '24' 26962600 327700 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 26962700 327800 MOVE ' 24' TO H-PSF-CBSA. 26962800 327900 26962900 328000 IF H-PSF-CBSA = '24220' 26963000 328100 AND L-PSF-PROV-ST = '24' 26963200 328200 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 26963300 328300 MOVE ' 24' TO H-PSF-CBSA. 26963400 328400 26963500 328500 IF H-PSF-CBSA = '30300' 26963600 328600 AND L-PSF-PROV-ST = '50' 26963800 328700 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 26963900 328800 MOVE ' 50' TO H-PSF-CBSA. 26964000 328900 26964100 329000 IF H-PSF-CBSA = '35084' 26964200 329100 AND L-PSF-PROV-ST = '31' 26964400 329200 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 26964500 329300 MOVE ' 31' TO H-PSF-CBSA. 26964600 329400 26964700 329500 IF H-PSF-CBSA = '48260' 26964800 329600 AND L-PSF-PROV-ST = '36' 26965000 329700 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 26965100 329800 MOVE ' 36' TO H-PSF-CBSA. 26965200 329900 26965300 330000 IF H-PSF-CBSA = '48260' 26964800 330100 AND L-PSF-PROV-ST = '51' 26965000 330200 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 26965100 330300 MOVE ' 51' TO H-PSF-CBSA. 26965200 9120-FLOOR-2010-EXIT. EXIT. *************************************************************** * * * NEW CY 2010 SECTION 401 HOSPITALS * * IPPS PRICER PGM SECTION 401S TAKEN FROM: IPDRV103 * * * *************************************************************** * * * SYNC ALL OF THE FOLLOWING WITH INPATIENT. * * SEE IPPS PRICER MAINTAINER. * * * * * SPECIAL NOTES * * * ------------- * * 1) INPATIENT CHECKS P-NEW-PROVIDER-NO * * OPPS CHECKS L-PSF-PROV-OSCAR * * * * 2) INPATIENT MOVES THE STATE CBSA TO HOLD-PROV-CBSA * * AND P-NEW-CBSA-STAND-AMT-LOC * * OPPS MOVES THE STATE CBSA TO H-PSF-CBSA. ONLY * * * * 3) DELETE THE P-NEW-CBSA-STAND-AMT-LOC LINES * * * * BE SURE TO MAKE THESE THREE CHANGES EVERY JANUARY * * * *************************************************************** 9120-SEC401-2010. 413600 IF (L-PSF-PROV-OSCAR = '040118') 33558901 413700 MOVE ' 04' TO H-PSF-CBSA. 33559001 413900 33559201 414000 IF (L-PSF-PROV-OSCAR = '050192' OR 33559301 414100 '050528' OR '050618') 33559401 414200 MOVE ' 05' TO H-PSF-CBSA. 33559501 414400 33559701 414500 IF (L-PSF-PROV-OSCAR = '070004') 33559801 414600 MOVE ' 07' TO H-PSF-CBSA. 33560001 414800 33560201 414900 IF (L-PSF-PROV-OSCAR = '100048' OR 33560301 415000 '100118' OR '100134') 33560401 415100 MOVE ' 10' TO H-PSF-CBSA. 33560501 415300 33560701 415400 IF (L-PSF-PROV-OSCAR = '140167') 33560801 415500 MOVE ' 14' TO H-PSF-CBSA. 33560901 415700 33561101 415800 IF (L-PSF-PROV-OSCAR = '170137') 33561201 415900 MOVE ' 17' TO H-PSF-CBSA. 33561301 416100 33561501 416200 IF (L-PSF-PROV-OSCAR = '180038') 33561601 416300 MOVE ' 18' TO H-PSF-CBSA. 33561701 416500 33561901 416600 IF (L-PSF-PROV-OSCAR = '220051') 33562001 416700 MOVE ' 22' TO H-PSF-CBSA. 33562101 416900 33562301 417000 IF (L-PSF-PROV-OSCAR = '230078') 33562401 417100 MOVE ' 23' TO H-PSF-CBSA. 33562501 417300 33562701 417400 IF (L-PSF-PROV-OSCAR = '250017') 33562801 417500 MOVE ' 25' TO H-PSF-CBSA. 33562901 417700 33563101 417800 IF (L-PSF-PROV-OSCAR = '260006' OR '260034' OR 33563201 417900 '260047' OR '260195') 33563301 418000 MOVE ' 26' TO H-PSF-CBSA. 33563401 418200 33563601 418300 IF (L-PSF-PROV-OSCAR = '300023' OR '330235' OR '330268') 33563701 418400 MOVE ' 33' TO H-PSF-CBSA. 33563801 418600 33564001 418700 IF (L-PSF-PROV-OSCAR = '360125') 33564101 418800 MOVE ' 36' TO H-PSF-CBSA. 33564201 419000 33564401 419100 IF (L-PSF-PROV-OSCAR = '370054') 33564501 419200 MOVE ' 37' TO H-PSF-CBSA. 33564601 419400 33564801 419500 IF (L-PSF-PROV-OSCAR = '380040') 33564901 419600 MOVE ' 38' TO H-PSF-CBSA. 33565001 419800 33565201 419900 IF (L-PSF-PROV-OSCAR = '390130' OR '390183' OR 33565301 420000 '390233') 33565401 420100 MOVE ' 39' TO H-PSF-CBSA. 33565501 420300 33566001 420400 IF (L-PSF-PROV-OSCAR = '450052' OR '450078' OR 33566101 420500 '450243' OR '450348') 33566201 420600 MOVE ' 45' TO H-PSF-CBSA. 33566301 420800 33566501 420900 IF (L-PSF-PROV-OSCAR = '490116') 33566601 421000 MOVE ' 49' TO H-PSF-CBSA. 33566701 421200 33566901 421300 IF (L-PSF-PROV-OSCAR = '500148') 33567001 421400 MOVE ' 50' TO H-PSF-CBSA. 33567101 9120-SEC401-2010-EXIT. EXIT. *************************************************************** * * * LOOP THROUGH ALL CLAIM LINES TO FIND AN APC / HCPCS * * * * - SET FLAG IF APC = 0172/0173 (FOR PARITAL HOSPITALIZATION)* * - SET FLAG IF APC = 0034 (FOR MENTAL HEALTH CHARGES) * * (NEW FOR CY 2008 - ADDED 11/28/2007) * * - SET FLAG IF PASS-THROUGH DEVICE(S) ON CLAIM: FOR OUTLIER * * (NEW FOR CY 2008 - ADDED 02/11/2008) * * - SET FLAG IF PASS-THROUGH RADIOPHARMS(S) ON CLAIM * * (NEW FOR APRIL CY 2009 - ADDED 02/10/2009) * * - SET FLAG IF PASS-THROUGH CONTRAST AGENT(S) ON CLAIM * * (NEW FOR JANUARY CY 2010 - ADDED 11/15/2009) * * - SET FLAG IF PASS-THROUGH DEVICE(S) ON CLAIM: FOR OFFSET * * (NEW FOR OCTOBER CY 2010 - ADDED 08/02/2010) * * * * - DISABLED: SET FLAG IF HCPCS = C1820 (FOR DEVICE OFFSETS) * * * *-------------------------------------------------------------* * * * 11/03/2008 - CHANGED PARTIAL HOSPITALIZATION HCPCS FROM * * 0033 TO 0172 & 0173 FOR CY 2009 * * * * 11/12/2008 - HCPCS C1820 EXPIRED FROM PASS-THROUGH STATUS * * DECEMBER 2007, OFFSET FLAG LOGIC DISABLED * * * * 08/02/2010 - ADDED LOGIC TO SET PASS-THOUGH DEVICE FLAG FOR * * DEVICE OFFSETS AND POPULATE THE CORRESPONDING * * TABLE * * * *************************************************************** 9125-INIT. *-------------------------------------------------------------* * FLAG CLAIM WHEN AT LEAST 1 LINE HAS A PHP APC * *-------------------------------------------------------------* IF OPPS-APC (LN-SUB) = '0172' OR OPPS-APC (LN-SUB) = '0173' MOVE 'Y' TO PHP-APC-FLAG. *-------------------------------------------------------------* * FLAG CLAIM WHEN AT LEAST 1 LINE HAS APC 0034 * *-------------------------------------------------------------* IF OPPS-APC (LN-SUB) = '0034' MOVE 'Y' TO APC34-FLAG. *-------------------------------------------------------------* * FOR CY 2010, NO HCPCS HAVE PASS-THROUGH STATUS * * ** FOR OLD PT DEVICE LOGIC, REPLACED BY NEW LOGIC * *-------------------------------------------------------------* * IF OPPS-HCPCS (LN-SUB) = 'C1820' * MOVE 'Y' TO C1820-OFFSET-FLAG. *-------------------------------------------------------------* * FLAG CLAIM WHEN AT LEAST ONE LINE IS A PASS-THROUGH DEVICE * * (FOR OUTLIER PAYMENT CALCULATION) * *-------------------------------------------------------------* PERFORM 9665-SET-PTD-LINE-FLAG THRU 9665-SET-PTD-LINE-FLAG-EXIT. IF PTD-LINE-FLAG = 'Y' MOVE 'Y' TO PTD-FLAG END-IF. *-------------------------------------------------------------* * FLAG CLAIM WHEN AT LEAST 1 LINE IS PASS-THROUGH RADIOPHARM * * AND ACCUMULATE TOTAL PT RADIOPHARM LINES & CHARGES * *-------------------------------------------------------------* PERFORM 9680-SET-PTRADIO-LINE-FLAG THRU 9680-SET-PTRADIO-LINE-FL-EXIT. IF PTRADIO-LINE-FLAG = 'Y' MOVE 'Y' TO PTRADIO-CLAIM-FLAG ADD 1 TO H-PTRADIO-HCPCS-CNT MOVE OPPS-SUB-CHRG (LN-SUB) TO H-SUB-CHRG COMPUTE H-PTRADIO-TOT-CHRGS ROUNDED = H-PTRADIO-TOT-CHRGS + H-SUB-CHRG END-IF. *-------------------------------------------------------------* * FLAG CLAIM WHEN AT LEAST 1 LINE IS A PASS-THROUGH CONTRAST * * AGENT AND ACCUMULATE TOTAL PT CONTRAST AGENT LINES & * * CHARGES, SUM BY LINE ITEM DATE OF SERVICE, & CREATE A * * RECORD FOR EACH DAY IN THE PASS-THROUGH CONTRAST AGENT * * DAY TABLE * *-------------------------------------------------------------* PERFORM 9681-SET-PTCA-LINE-FLAG THRU 9681-SET-PTCA-LINE-FL-EXIT. IF PTCA-LINE-FLAG = 'Y' MOVE 'Y' TO PTCA-CLAIM-FLAG MOVE OPPS-SUB-CHRG (LN-SUB) TO H-SUB-CHRG PERFORM 9130-LOAD-PTCA-DAY-TABLE THRU 9130-LOAD-PTCA-DAY-TABLE-EXIT END-IF. *-------------------------------------------------------------* * FLAG CLAIM WHEN AT LEAST 1 LINE IS A PASS-THROUGH DEVICE * * ON THE CLAIM AND CREATE A RECORD FOR THE PT DEVICE HCPCS * * LINE IN THE PT DEVICE HCPCS TABLE * *-------------------------------------------------------------* PERFORM 9682-SET-PTDO-LINE-FLAG THRU 9682-SET-PTDO-LINE-FL-EXIT. IF PTDO-LINE-FLAG = 'Y' MOVE 'Y' TO PTDO-CLAIM-FLAG MOVE OPPS-SUB-CHRG (LN-SUB) TO H-SUB-CHRG MOVE OPPS-SRVC-UNITS (LN-SUB) TO H-SRVC-UNITS PERFORM 9132-LOAD-PTDO-HCPCS-TBL THRU 9132-LOAD-PTDO-HCPCS-TBL-EXIT END-IF. *-------------------------------------------------------------* * FLAG CLAIM WHEN ALL LINES HAVE A HCPCS BETWEEN 80000-89999 * * INCLUSIVE (LAB CODES), INDICATES BILL TYPE 14X * * 05/09/2011 - LOGIC ADDED * *-------------------------------------------------------------* IF (OPPS-HCPCS (LN-SUB) >= '80000' AND <= '89999') IF BILL14X-FLAG NOT = 'N' MOVE 'Y' TO BILL14X-FLAG END-IF ELSE MOVE 'N' TO BILL14X-FLAG END-IF. 9125-INIT-EXIT. EXIT. *************************************************************** * * * ACCUMULATE PASS-THROUGH CONTRAST AGENT HCPCS COUNT AND * * CHARGES FOR EACH DAY WITH A PASS-THROUGH CONTRAST AGENT * * * *************************************************************** * * * ORDER SERVICE LINES BY LINE ITEM DATE OF SERVICE (LIDOS) - * * EARLIEST TO LATEST DATE * * * * EACH PT CONTRAST AGENT HCPCS LINE'S CHARGES ARE ADDED TO * * THE TOTAL FOR ITS LIDOS. THESE CHARGES ARE LATER USED * * TO DETERMINE THE PROPORTION OF THE DAY'S TOTAL CONTRAST * * PROCEDURE OFFSET THAT SHOULD BE SUBTRACTED FROM A GIVEN PT * * CONTRAST AGENT HCPCS'S LINE PAYMENT. * * * * 11/16/2009 - LOGIC ADDED FOR CY 2010 * * * *************************************************************** 9130-LOAD-PTCA-DAY-TABLE. *-------------------------------------------------------------* * GET THE LINE'S SERVICE DATE & CHARGES FOR TABLE SEARCH * *-------------------------------------------------------------* MOVE OPPS-LITEM-DOS (LN-SUB) TO H-PTCA-LIDOS. MOVE OPPS-SUB-CHRG (LN-SUB) TO H-SUB-CHRG. *-------------------------------------------------------------* * ADD OR UPDATE CONTRAST AGENT DAY ENTRY FOR THE LIDOS * *-------------------------------------------------------------* PERFORM 9130-SEARCH-PTCA-LIDOS THRU 9130-SEARCH-PTCA-LIDOS-EXIT. 9130-LOAD-PTCA-DAY-TABLE-EXIT. EXIT. *************************************************************** * * * DETERMINE WHETHER A NEW PT CONTRAST AGENT DAY TABLE RECORD * * SHOULD BE ADDED OR IF AN EXISITING RECORD MUST BE UPDATED * * * *************************************************************** 9130-SEARCH-PTCA-LIDOS. *-------------------------------------------------------------* * SEARCH PT CONTRAST AGENT DAY TABLE STARTING AT ENTRY #1 * *-------------------------------------------------------------* SET W-PTCA-DAY-INDX TO 1. SEARCH W-PTCA-DAY-ENTRY VARYING W-PTCA-DAY-INDX *-------------------------------------------------------------* * IF THE SERVICE LINE'S LIDOS IS NOT ALREADY IN THE TABLE, * * ADD IT * *-------------------------------------------------------------* AT END PERFORM 9130-ADD-ENTRY THRU 9130-ADD-ENTRY-EXIT *-------------------------------------------------------------* * IF THE SERVICE LINE'S LIDOS IS ALREADY IN THE TABLE, * * UPDATE THE ENTRY * *-------------------------------------------------------------* WHEN W-PTCA-DAY-LIDOS (W-PTCA-DAY-INDX) = H-PTCA-LIDOS PERFORM 9130-UPDATE-ENTRY THRU 9130-UPDATE-ENTRY-EXIT. 9130-SEARCH-PTCA-LIDOS-EXIT. EXIT. *************************************************************** * * * INSERT THE NEW PT CONTRAST AGENT DAY RECORD IN THE CORRECT * * POSITION (LOWEST TO HIGHEST CAF) OF THE COMPOSITE APC TABLE * * * *************************************************************** 9130-ADD-ENTRY. *-------------------------------------------------------------* * INCREASE THE TOTAL NUMBER OF TABLE RECORDS FOR NEW ENTRY * *-------------------------------------------------------------* ADD 1 TO W-PTCA-DAY-MAX. *-------------------------------------------------------------* * MOVE TO THE NEW ENTRY POSITION (EMPTY RECORD) * *-------------------------------------------------------------* SET W-PTCA-DAY-INDX TO W-PTCA-DAY-MAX. INITIALIZE W-PTCA-DAY-ENTRY (W-PTCA-DAY-INDX). *-------------------------------------------------------------* * DETERMINE WHERE THE NEW PT CONTRAST AGENT DAY ENTRY FOR THE * * CURRENT SERVICE LINE SHOULD BE ENTERED INTO THE TABLE * * ACCORDING TO ITS LIDOS - EARLIEST TO LATEST LIDOS * *-------------------------------------------------------------* PERFORM 9130-STAGE-PTCA-DAY-ENTRY THRU 9130-STAGE-PTCA-DAY-ENTRY-EXIT UNTIL W-PTCA-DAY-INDX = 1 OR H-PTCA-LIDOS NOT < W-PTCA-DAY-LIDOS (W-PTCA-DAY-INDX - 1). *-------------------------------------------------------------* * POPULATE THE EMPTY RECORD WITH THE NEW SERVICE LINE'S DATA * *-------------------------------------------------------------* MOVE H-PTCA-LIDOS TO W-PTCA-DAY-LIDOS (W-PTCA-DAY-INDX). MOVE 1 TO W-PTCA-DAY-HCPCS-CNT (W-PTCA-DAY-INDX). MOVE H-SUB-CHRG TO W-PTCA-DAY-TOT-CHRGS (W-PTCA-DAY-INDX). 9130-ADD-ENTRY-EXIT. EXIT. *************************************************************** * * * UPDATE THE EXISTING PT CONTRAST AGENT DAY RECORD WITH THE * * SAME LIDOS AS THE CURRENT SERVICE LINE * * * *************************************************************** 9130-UPDATE-ENTRY. *-------------------------------------------------------------* * ACCUMULATE THE LIDOS'S TOTAL SUBMITTED CHARGES & HCPCS COUNT* *-------------------------------------------------------------* ADD 1 TO W-PTCA-DAY-HCPCS-CNT (W-PTCA-DAY-INDX). ADD H-SUB-CHRG TO W-PTCA-DAY-TOT-CHRGS (W-PTCA-DAY-INDX). 9130-UPDATE-ENTRY-EXIT. EXIT. *************************************************************** * * * MOVE THE EXISTING PT CONTRAST AGENT DAY RECORD WITH A LATER * * LIDOS DOWN ONE RECORD POSITION AND SET THE EMPTY RECORD FOR * * THE NEW ENTRY'S INDEX TO THE NEXT HIGHER RECORD POSITION. * * * *************************************************************** 9130-STAGE-PTCA-DAY-ENTRY. MOVE W-PTCA-DAY-ENTRY (W-PTCA-DAY-INDX - 1) TO W-PTCA-DAY-ENTRY (W-PTCA-DAY-INDX). SET W-PTCA-DAY-INDX DOWN BY 1. 9130-STAGE-PTCA-DAY-ENTRY-EXIT. EXIT. *************************************************************** * * * POPULATE PASS-THROUGH DEVICE HCPCS TABLE WITH PASS-THROUGH * * DEVICE LINE INFORMATION * * * *************************************************************** * * * ORDER SERVICE LINES BY SUBMITTED CHARGE * * HIGHEST TO LOWEST, * * THEN BY LINE UNITS * * HIGHEST TO LOWEST * * * * THESE RECORDS ARE LATER USED TO DETERMINE THE PASS-THROUGH * * DEVICE OFFSET AMOUNT IF APPLICABLE. * * * * 08/02/2010 - LOGIC ADDED FOR OCT 2010 * * * *************************************************************** 9132-LOAD-PTDO-HCPCS-TBL. *-------------------------------------------------------------* * POPULATE VARIABLES FOR TABLE SORTING * *-------------------------------------------------------------* MOVE H-SUB-CHRG TO H-PTDO-CHRG. MOVE H-SRVC-UNITS TO H-PTDO-UNITS. *-------------------------------------------------------------* * ADD THE CURRENT PASS-THROUGH DEVICE HCPCS LINE TO TABLE * *-------------------------------------------------------------* PERFORM 9132-ADD-ENTRY THRU 9132-ADD-ENTRY-EXIT. 9132-LOAD-PTDO-HCPCS-TBL-EXIT. EXIT. *************************************************************** * * * INSERT THE NEW PT DEVICE HCPCS RECORD IN THE CORRECT * * POSITION (HIGHEST TO LOWEST SUBMITTED CHARGE & THEN HIGHEST * * TO LOWEST LINE UNITS) * * * *************************************************************** 9132-ADD-ENTRY. *-------------------------------------------------------------* * INCREASE THE TOTAL NUMBER OF TABLE RECORDS FOR NEW ENTRY * *-------------------------------------------------------------* ADD 1 TO W-PTDO-HCPCS-MAX. *-------------------------------------------------------------* * MOVE TO THE NEW ENTRY POSITION (EMPTY RECORD) * *-------------------------------------------------------------* SET W-PTDO-HCPCS-INDX TO W-PTDO-HCPCS-MAX. INITIALIZE W-PTDO-HCPCS-ENTRY (W-PTDO-HCPCS-INDX). *-------------------------------------------------------------* * DETERMINE WHERE THE NEW PT DEVICE HCPCS ENTRY FOR THE * * CURRENT SERVICE LINE SHOULD BE ENTERED INTO THE TABLE * * ACCORDING TO ITS SUBMITTED CHARGES & LINE UNITS (BOTH * * HIGHEST TO LOWEST) * *-------------------------------------------------------------* PERFORM 9132-STAGE-PTDO-HCPCS-ENTRY THRU 9132-STAGE-PTDO-HCPCS-ENTRY-EX UNTIL W-PTDO-HCPCS-INDX = 1 OR H-PTDO-CHRGUNIT NOT > W-PTDO-HCPCS-CHRGUNIT (W-PTDO-HCPCS-INDX - 1). *-------------------------------------------------------------* * POPULATE THE EMPTY RECORD WITH THE NEW SERVICE LINE'S DATA * *-------------------------------------------------------------* MOVE OPPS-HCPCS (LN-SUB) TO W-PTDO-HCPCS-HCPCS (W-PTDO-HCPCS-INDX). MOVE LN-SUB TO W-PTDO-HCPCS-LNSUB (W-PTDO-HCPCS-INDX). MOVE H-PTDO-CHRG TO W-PTDO-HCPCS-SUB-CHRG (W-PTDO-HCPCS-INDX). MOVE H-PTDO-UNITS TO W-PTDO-HCPCS-UNITS (W-PTDO-HCPCS-INDX). MOVE 0 TO W-PTDO-HCPCS-PROC-CNT (W-PTDO-HCPCS-INDX). MOVE SPACES TO W-PTDO-HCPCS-PROC-APC (W-PTDO-HCPCS-INDX). MOVE 0 TO W-PTDO-HCPCS-PROC-LNSUB (W-PTDO-HCPCS-INDX). 9132-ADD-ENTRY-EXIT. EXIT. *************************************************************** * * * MOVE THE EXISTING PT CONTRAST AGENT DAY RECORD WITH A LATER * * LIDOS DOWN ONE RECORD POSITION AND SET THE EMPTY RECORD FOR * * THE NEW ENTRY'S INDEX TO THE NEXT HIGHER RECORD POSITION. * * * *************************************************************** 9132-STAGE-PTDO-HCPCS-ENTRY. MOVE W-PTDO-HCPCS-ENTRY (W-PTDO-HCPCS-INDX - 1) TO W-PTDO-HCPCS-ENTRY (W-PTDO-HCPCS-INDX). SET W-PTDO-HCPCS-INDX DOWN BY 1. 9132-STAGE-PTDO-HCPCS-ENTRY-EX. EXIT. *************************************************************** * * * VALIDATE CLAIM LINES, CALCULATE LINE DISCOUNTS & OFFSETS, * * ACCUMULATE CLAIM TOTALS, SET FLAGS, POPULATE COINSURANCE & * * BLOOD DEDUCTIBLE TABLES WITH VALID SERVICE LINES, POPULATE * * COMPOSITE APC TABLE WITH NON-PRIME COMPOSITE LINE CHARGES, * * AND CALCULATE TOTAL PACKAGED MENTAL HEALTH CHARGES. * * CREATE PASS-THROUGH CONTRAST AGENT PROC TABLE (NEW CY2010) * * CREATE PASS-THROUGH DEVICE PROC TABLE (NEW OCT 2010) * * * * ** UPDATE PARTIAL HOSPITALIZATION (PHP) & MENTAL HEALTH * * (MH) TABLE REFERENCES EVERY JANUARY * * * *************************************************************** * * * VALIDATION RULES & RETURN CODES: * * -------------------------------- * * * * 1. VERIFY THE SERVICE INDICATOR PASSED BY THE OCE * * - IF INVALID SET RETURN CODE TO '40' * * - DISCONTINUE LINE PROCESSING * * - IF VALID SET RETURN CODE TO '01' * * - CONTINUE LINE PROCESSING * * 2. PROCESS LINES AND LOAD WORK TABLE ACCORDING TO PRICE * * RANKING * * 3. CHECK OCE EDIT INDICATORS AND SET RETURN CODES IF * * INDICATORS ARE INVALID. * * - VALID RETURN CODES FOR EDIT INDICATORS * * - '41' - SERVICE INDICATOR INVALID FOR OPPS PRICER * * - '42' - APC = '00000' OR (PACKAGING FLAG = 1, 2,OR 4)* * - '43' - PAYMENT INDICATOR NOT = TO 1 OR 5 THRU 9 * * - '44' - SERVICE INDICATOR = 'H' BUT PAYMENT * * INDICATOR NOT = TO 6 * * - '45' - PACKAGING FLAG NOT = TO 0, 1, 2, 3, OR 4 * * - '46' - (LINE ITEM DENIAL/REJECT FLAG NOT = TO 0 * * OR LINE ITEM DENIAL/REJECT FLAG = TO 1 * * AND (NOT A PARTIAL HOSPITALIZATION OR * * MENTAL HEALTH HCPCS)) * * OR LINE ITEM ACTION FLAG NOT = TO 1 * * - '47' - LINE ITEM ACTION FLAG = 2 OR 3 * * - '48' - PAYMENT ADJUSTMENT FLAG NOT VALID * * - '49' - SITE OF SERVICE FLAG NOT = TO 0 * * - OR (PARTIAL HOSP. APC IS NOT ON THE CLAIM * * AND SERVICE INDICATOR = 'P' * * OR PARTIAL HOSPITALIZATION HCPCS) * * 4. IF OCE INDICATORS ARE VALID, SEARCH APC TABLE * * - IF MISSING, DELETED OR INVALID APC * * - SET RETURN CODE TO '30' * * - DISCONTINUE LINE PROCESSING * * * *************************************************************** 9150-INIT. *************************************************************** * INITIALIZE LINE RETURN CODE TO VALID VALUE * *************************************************************** MOVE 01 TO A-RETURN-CODE (LN-SUB). *************************************************************** * OVERRIDE SERVICE UNITS FOR APC 0339 - EFFECTIVE 04/01/2002 * *************************************************************** IF OPPS-APC (LN-SUB) = '0339' MOVE 1 TO OPPS-SRVC-UNITS (LN-SUB). *************************************************************** * CALCULATE DISCOUNT RATE (FOR REDUCED COIN & OFFSET CALCS) * *************************************************************** MOVE OPPS-SRVC-UNITS (LN-SUB) TO H-SRVC-UNITS. PERFORM 9250-CALC-DISCOUNT THRU 9250-CALC-DISCOUNT-EXIT. IF A-RETURN-CODE (LN-SUB) = 42 GO TO 9150-INIT-EXIT. *************************************************************** * FLAG LINE IF THE LINE APC IS A RADIOPHARM APC * * ** NEW LIST EVERY JANUARY ** * *-------------------------------------------------------------* * 11/13/2008 - LOGIC ADDED B/C THERAP. RADIO. LINES MUST BE * * EXCLUDED FROM SI=H DEVICE UNIT CALCULATION * * 11/16/2009 - LOGIC REMOVED BECAUSE THERAP. RADIO NO LONGER * * HAVE AN SI=H (NOT PAID AT COST) * *************************************************************** * PERFORM 9660-SET-RADIOPH-APC-FLAG * THRU 9660-SET-RADIOPH-APC-FLAG-EXIT. *************************************************************** * ACCUMULATE TOTAL CLAIM DEVICE SERVICE UNITS -AND- * * FLAG CLAIMS THAT HAVE AT LEAST ONE DEVICE LINE * * - SI = H IDENTIFIES DEVICE LINES * * - EFFECTIVE AS OF 04-01-2002 * *-------------------------------------------------------------* * 11/16/2009 - RADIOPH-APC-FLAG CHECK REMOVED B/C NO THX * * RADIOPHARMS HAVE SI=H FOR CY 2010 * * 08/11/2010 - DISABLED & REPLACED BY REVISED LOGIC * *************************************************************** * IF OPPS-SRVC-IND (LN-SUB) = ' H' * MOVE 'Y' TO C-FLAG * COMPUTE H-TOT-HTD-UNITS = * H-TOT-HTD-UNITS + H-SRVC-UNITS. *************************************************************** * ACCUMULATE CLAIM TOTAL OFFSET AMOUNT & OFFSET UNITS * * WHEN PASS-THROUGH/OFFSET DEVICE APPEARS ON THE CLAIM * *-------------------------------------------------------------* * - HCPCS C1820 EXPIRES FROM PASS-THRU PMT 01-01-2008. THERE * * ARE NO OFFSET DEVICES FOR CY 2008; LOGIC RETAINED & ALL * * OFFSET AMOUNTS IN OFFSET TABLE SET TO $0. * * - THERE ARE NO PASS-THROUGH/OFFSET DEVICES FOR CY 2009 * * C1820-OFFSET-FLAG ALWAYS = 'N', OFFSET LOGIC NOT * * NEVER PERFORMED, RETAINED FOR FUTURE USE * * - 08/02/2010: DISABLED CODE, REPLACED BY REVISED LOGIC * *************************************************************** * IF C1820-OFFSET-FLAG = 'Y' * PERFORM 9160-TOTAL-OFFSET * THRU 9160-TOTAL-OFFSET-EXIT. *************************************************************** * CREATE NUCLEAR MEDICINE APC TABLE FOR PASS-THROUGH * * RADIOPHARM OFFSET WHEN PASS-THROUGH RADIOPHARM(S) ON CLAIM * * EFFECTIVE APRIL 2009 * *************************************************************** IF PTRADIO-CLAIM-FLAG = 'Y' PERFORM 9165-PROCESS-NUCLEAR-MED THRU 9165-PROCESS-NUCLEAR-MED-EXIT. *************************************************************** * CREATE CONTRAST AGENT PROCEDURE TABLE FOR PASS-THOUGH * * CONTRAST AGENT OFFSET WHEN PT CONTRAST AGENT(S) ON CLAIM * * EFFECTIVE JANUARY 2010 * *************************************************************** IF PTCA-CLAIM-FLAG = 'Y' PERFORM 9168-PROCESS-PTCA-PROC THRU 9168-PROCESS-PTCA-PROC-EXIT. *************************************************************** * CREATE PASS-THROUGH DEVICE PROCEDURE TABLE FOR PASS- * * THROUGH DEVICE OFFSET WHEN PT DEVICE(S) ON CLAIM * * EFFECTIVE OCTOBER 2010 * *************************************************************** IF PTDO-CLAIM-FLAG = 'Y' PERFORM 9169-PROCESS-PTDO-PROC THRU 9169-PROCESS-PTDO-PROC-EXIT. *************************************************************** * SET AND INTIALIZE LINE SPECIFIC DATA ITEMS * *************************************************************** *-------------------------------------------------------------* * SET COIN & BLOOD DEDUCTIBLE TABLES UP FOR CURRENT LINE * *-------------------------------------------------------------* SET W-LP-INDX TO LN-SUB. SET W-BD-INDX TO LN-SUB. INITIALIZE W-LP-ENTRY (W-LP-INDX). INITIALIZE W-BD-ENTRY (W-BD-INDX). *-------------------------------------------------------------* * INITIALIZE LINE ITEM VARIABLES TO BE PASSED BACK * *-------------------------------------------------------------* MOVE ZERO TO A-LITEM-PYMT (LN-SUB) A-LITEM-REIM (LN-SUB) A-ADJ-COIN (LN-SUB) A-RED-COIN (LN-SUB) A-TOTAL-LN-DEDUCT (LN-SUB) A-BLOOD-LN-DEDUCT (LN-SUB). *-------------------------------------------------------------* * INITIALIZE LINE FLAGS * *-------------------------------------------------------------* * 11/05/2007 - PHP-HCPCS-FLAG & MH-HCPCS-FLAG ADDED * *-------------------------------------------------------------* MOVE 'N' TO PHP-HCPCS-FLAG MH-HCPCS-FLAG. *************************************************************** * SEARCH PARTIAL HOSPITALIZATION (PHP) TABLE FOR LINE HCPCS * * (LOGIC NEW FOR CY2008; ADDED 11/5/2007) * *************************************************************** SEARCH ALL PHP-ENTRY10 AT END MOVE 'N' TO PHP-HCPCS-FLAG WHEN PHP-HCPCS10 (PHP-INDX10) = OPPS-HCPCS (LN-SUB) MOVE 'Y' TO PHP-HCPCS-FLAG. *************************************************************** * SEARCH MENTAL HEALTH (MH) TABLE FOR LINE HCPCS * * (LOGIC NEW FOR CY2008; ADDED 11/5/2007) * *************************************************************** SEARCH ALL MH-ENTRY10 AT END MOVE 'N' TO MH-HCPCS-FLAG WHEN MH-HCPCS10 (MH-INDX10) = OPPS-HCPCS (LN-SUB) MOVE 'Y' TO MH-HCPCS-FLAG. *************************************************************** * POPULATE PASS-THROUGH DEVICE TABLE W/ PASS-THROUGH * * DEVICE LINE DATA (FOR OUTLIER PAYMENT ADJUSTMENT) * *-------------------------------------------------------------* * 11/16/2009 - RADIOPH-APC-FLAG CHECK REMOVED B/C NO THX * * RADIOPHARMS HAVE SI=H FOR CY 2010 * *************************************************************** IF A-RETURN-CODE (LN-SUB) = 01 AND PTD-FLAG = 'Y' AND OPPS-SRVC-IND (LN-SUB) = ' H' PERFORM 9665-SET-PTD-LINE-FLAG THRU 9665-SET-PTD-LINE-FLAG-EXIT IF PTD-LINE-FLAG = 'Y' MOVE OPPS-HCPCS (LN-SUB) TO W-PTD-LINE-HCPCS PERFORM 9390-PASS-THRU-DEVICES THRU 9390-PASS-THRU-DEVICES-EXIT END-IF END-IF. *************************************************************** * * * ** CHECK LINE OCE VALUES FOR VALIDITY ** * * * *************************************************************** *************************************************************** * IDENTIFY ALL VALID SERVICE INDICATORS (SI) & RETURN * * ERROR CODE 40 IF THE SI IS INVALID. * *************************************************************** IF NOT (OPPS-SRVC-IND (LN-SUB) = ' A' OR ' B' OR ' C' OR ' E' OR ' F' OR ' G' OR ' H' OR ' K' OR ' L' OR ' N' OR ' P' OR ' R' OR ' S' OR ' T' OR ' U' OR ' V' OR ' X' OR ' W' OR ' Y' OR ' Z' OR ' M') THEN MOVE 40 TO A-RETURN-CODE (LN-SUB) GO TO 9150-INIT-EXIT ELSE MOVE 01 TO A-RETURN-CODE (LN-SUB). *************************************************************** * IDENTIFY SERVICE INDICATORS (SI) NOT VALID FOR THE OPPS * * PRICER & RETURN ERROR CODE 41 IF THE SI IS INVALID * * FOR THE OPPS PRICER. * *************************************************************** IF OPPS-SRVC-IND (LN-SUB) = ' A' OR ' B' OR ' C' OR ' E' OR ' F' OR ' L' OR ' W' OR ' Y' OR ' Z' OR ' M' MOVE 41 TO A-RETURN-CODE (LN-SUB) GO TO 9150-INIT-EXIT. *************************************************************** ** ** ** NOTE: ERROR CODES FOR THE VALIDATION RULES BELOW ARE ** ** ASSIGNED IN THE ELSE STATMENTS AFTER THE APC ** ** TABLE SEARCH. ** ** ** *************************************************************** *************************************************************** * IDENTIFY VALID PAYMENT INDICATORS & RETURN ERROR CODE 43 * * IF THE PAYMENT INDICATOR IS INVALID. * *************************************************************** IF OPPS-PYMT-IND (LN-SUB) = ' 1' OR ' 5' OR ' 6' OR ' 7' OR ' 8' OR ' 9' *************************************************************** * IDENTIFY VALID PACKAGING FLAGS & RETURN ERROR CODE 45 * * IF THE PACKAGING FLAG IS INVALID. * *************************************************************** IF OPPS-PKG-FLAG (LN-SUB) = '0' OR '1' OR '2' OR '3' OR '4' *************************************************************** * IDENTIFY VALID LINE ITEM DENIAL OR REJECTION (D/R) FLAGS * * AND VALID D/R FLAG-HCPCS COMBINATIONS & RETURN ERROR CODE * * 46 IF THE D/R FLAG OR D/R FLAG-HCPCS COMBO IS INVALID. * *-------------------------------------------------------------* * 11/6/2007 - CHANGED PHP/MENTAL HEALTH CODES LISTED FROM * * APCS TO HCPCS (VIA TABLE SEARCH) FOR CY 2008 * *************************************************************** *--------------------------------------------------------* * LINE IS NOT DENIED OR REJECTED * *--------------------------------------------------------* IF ( OPPS-LITEM-DR-FLAG (LN-SUB) = '0' OR *--------------------------------------------------------* * LINE IS DENIED OR REJECTED AND HAS A PHP OR MH HCPCS * *--------------------------------------------------------* OPPS-LITEM-DR-FLAG (LN-SUB) = '1' AND ( PHP-HCPCS-FLAG = 'Y' OR MH-HCPCS-FLAG = 'Y' ) ) OR *--------------------------------------------------------* * LINE ITEM DENIAL/REJECTION CODE IS IGNORED * *--------------------------------------------------------* ( OPPS-LITEM-ACT-FLAG (LN-SUB) = '1' ) *************************************************************** * IDENTIFY INVALID LINE ITEM ACTION FLAGS & RETURN ERROR * * CODE 47 IF THE LINE ITEM ACTION FLAG IS INVALID. * *************************************************************** IF NOT (OPPS-LITEM-ACT-FLAG (LN-SUB) EQUAL '2' OR '3') *************************************************************** * IDENTIFY VALID PAYMENT ADJUSTMENT FLAGS (PAF) & RETURN * * ERROR CODE 48 IF THE PAF IS INVALID. * *-------------------------------------------------------------* * 10/31/2007 - ADDED ' 8' AS A VALID PAF FOR CY 2008 * * 12/06/2007 - ADDED PAFS 91 - 99 FOR COMPOSITES FOR CY 2008 * * 11/03/2008 - REMOVED PAFS 91 - 99 FOR COMPOSITES FOR CY 2009* *************************************************************** IF OPPS-PYMT-ADJ-FLAG (LN-SUB) = ' 0' OR ' 1' OR ' 2' OR ' 3' OR ' 4' OR ' 5' OR ' 6' OR ' 7' OR ' 8' *************************************************************** * IDENTIFY VALID SITE OF SERVICE (SOS) FLAG AND CASES * * WHERE THE SOS FLAG IS IGNORED & RETURN ERROR CODE 49 IF * * THE SOS FLAG IS INVALID AND NOT IGNORED. * * * * ** SITE OF SERVICE FLAG = PAYMENT METHOD FLAG IN OCE ** * * * * NOTE: PHP = PARTIAL HOSPITALIZATION * * WHEN SI = 'P', PHP APC IS ON THE CURRENT LINE * *-------------------------------------------------------------* * 11/06/2007 - CHANGED PHP HEALTH CODES LISTED FROM * * APCS TO HCPCS (VIA TABLE SEARCH) FOR CY 2008 * * 11/03/2008 - CHANGED PARTIAL HOSPITALIZATION APC FROM * * 0033 TO 0172 & 0173 FOR CY 2009, FLAG CHANGED * * FROM APC33-FLAG TO PHP-APC-FLAG * *************************************************************** *-------------------------------------------------------------* * LINE SOS FLAG IS VALID * *-------------------------------------------------------------* IF (OPPS-SITE-SRVC-FLAG (LN-SUB) = '0') OR *-------------------------------------------------------------* * LINE SOS FLAG INVALID & PHP APC ON CLAIM - CHECK FURTHER * *-------------------------------------------------------------* ( (PHP-APC-FLAG = 'Y') AND *-------------------------------------------------------------* * LINE SOS FLAG INVALID, PHP APC ON CLAIM, & LINE APC IS PHP* *-------------------------------------------------------------* ( (OPPS-SRVC-IND (LN-SUB) = ' P') OR *-------------------------------------------------------------* * LINE SOS FLAG INVALID, PHP APC ON CLAIM, & LINE PHP HCPCS * *-------------------------------------------------------------* (PHP-HCPCS-FLAG = 'Y') ) ) *************************************************************** * * * ** ACCUMULATE TOTAL CHARGES OF ALL LINES THAT PASS ** * * ** VALIDATION RULES ** * * * *************************************************************** MOVE OPPS-SUB-CHRG (LN-SUB) TO H-SUB-CHRG COMPUTE H-TOT-CHRG = H-TOT-CHRG + H-SUB-CHRG *-------------------------------------------------------------* * EXCLUDE LINES THAT RECEIVE EXTERNAL LINE ITEM ADJ. * *-------------------------------------------------------------* IF OPPS-LITEM-ACT-FLAG (LN-SUB) = '4' COMPUTE H-TOT-CHRG = H-TOT-CHRG - H-SUB-CHRG END-IF *-------------------------------------------------------------* * ACCUMULATE PACKAGED LINE TOTAL CHARGES & SET CLAIM N-FLAG * * EXCLUDE ALL PACKAGED COMPOSITE LINES * *-------------------------------------------------------------* * 11/28/2007 - LOGIC ADDED TO EXCLUDE COMPOSITE & MENTAL * * HEALTH LINES (APC34-FLAG INDICATES MH) * * 08/08/2008 - LOGIC CORRECTED TO ADD CHARGES OF PACKAGED * * LINES WITH A PACKAGING FLAG OF '1' OR '4' TO * * THE CLAIM'S TOTAL DISTRIBUTED PACKAGED * * CHARGES WHEN A CLAIM HAS APC 34 (MENTAL * * HEALTH) ON IT - EFFECTIVE RETROCTIVE TO * * JANUARY 1, 2008. * * 11/12/2008 - CHANGED LOGIC THAT EXCLUDES ALL COMPOSITE * * LINES & MENTAL HEALTH PKG LINES TO USE THE * * COMPOSITE ADJUSTMENT FLAG INSTEAD OF PAYMENT * * ADJUSTMENT FLAG VALUES 91 - 99 * *-------------------------------------------------------------* IF (OPPS-PKG-FLAG (LN-SUB) = '1' OR '2' OR '4') AND (OPPS-COMP-ADJ-FLAG (LN-SUB) = '00') COMPUTE H-TOT-N-CHRG = H-SUB-CHRG + H-TOT-N-CHRG MOVE 'Y' TO N-FLAG END-IF *-------------------------------------------------------------* * ACCUMULATE PACKAGED MENTAL HEALTH LINE CHARGES * *-------------------------------------------------------------* * 11/28/2007 - LOGIC ADDED FOR CY 2008 * * 11/12/2008 - LOGIC DISABLED B/C MENTAL HEALTH COMPOSITE * * LINES ARE NOW IDENTIFIED WITH THE COMPOSITE * * ADJUSTMENT FLAG JUST AS ALL OTHER COMPOSITES * * (MENTAL HEALTH COMPOSITE LINES NOW HAVE A * * PACKAGING FLAG OF '1' (CY 2009) * *-------------------------------------------------------------* * IF (APC34-FLAG = 'Y') AND * (OPPS-SRVC-IND (LN-SUB) = ' N') AND * (OPPS-PKG-FLAG (LN-SUB) = '1') * COMPUTE H-TOT-MH-CHRG = H-SUB-CHRG + * H-TOT-MH-CHRG * END-IF *-------------------------------------------------------------* * ACCUMULATE NON-PRIME (PACKAGED) COMPOSITE APC CHARGES * * FOR EACH COMPOSITE APC BY THE COMPOSITE ADJUSTMENT FLAG * * (POPULATE COMPOSITE TABLE) * *-------------------------------------------------------------* * 11/28/2007 - LOGIC ADDED FOR CY 2008 * * 11/12/2007 - LOGIC REVISED FOR CY 2009 TO IDENTIFY ALL * * COMPOSITE LINES USING THE COMPOSITE * * ADJUSTMENT FLAG INSTEAD OF PAYMENT * * ADJUSTMENT FLAG VALUES 91 - 99 * * (INCLUDES PROCESSING FOR MENTAL HEALTH * * COMPOSITES) * *-------------------------------------------------------------* IF OPPS-COMP-ADJ-FLAG (LN-SUB) NOT = "00" AND OPPS-COMP-ADJ-FLAG (LN-SUB) NOT = " " AND OPPS-SRVC-IND (LN-SUB) = ' N' PERFORM 9170-COMPOSITES THRU 9170-COMPOSITES-EXIT END-IF *-------------------------------------------------------------* * RETURN ERROR CODE WHEN PACKAGED LINE OR LINE APC = 0000 * *-------------------------------------------------------------* IF (OPPS-APC (LN-SUB) = '0000') OR (OPPS-PKG-FLAG (LN-SUB) = '1' OR '2' OR '4') MOVE 42 TO A-RETURN-CODE (LN-SUB) GO TO 9150-INIT-EXIT END-IF *************************************************************** * * * ** LOOK-UP LINE APC IN APC TABLE FOR ALL LINES THAT ** * * ** PASS VALIDATION RULES ** * * * *************************************************************** SEARCH ALL WAA-ENTRY AT END MOVE 30 TO A-RETURN-CODE (LN-SUB) GO TO 9150-INIT-EXIT WHEN WAA-APC (WAA-INDX) = OPPS-GRP (LN-SUB) *-------------------------------------------------------------* * START SEARCH AT THE APC'S MOST CURRENT RECORD * *-------------------------------------------------------------* MOVE WAA-PTR (WAA-INDX) TO W-SUB2 *-------------------------------------------------------------* * GET APC DATA FROM THE REC WITH THE CORRECT EFFECTIVE DATE * *-------------------------------------------------------------* PERFORM 9175-APC-LOOKUP *-------------------------------------------------------------* * REDUCE APC PMT BY REDUCED UPDATE RATIO WHEN APPROPRIATE * * 11/13/2009 - NEW FOR CY 2009 (QUALITY) * *-------------------------------------------------------------* PERFORM 9180-REDUCE-APC-PYMT THRU 9180-REDUCE-APC-PYMT-EXIT *************************************************************** * * * ** RETURN ERROR CODE AND STOP PROCESSING LINES ** * * ** THAT FAIL OCE VALIDATION RULES ** * * * *************************************************************** ELSE MOVE 49 TO A-RETURN-CODE (LN-SUB) GO TO 9150-INIT-EXIT ELSE MOVE 48 TO A-RETURN-CODE (LN-SUB) GO TO 9150-INIT-EXIT ELSE MOVE 47 TO A-RETURN-CODE (LN-SUB) GO TO 9150-INIT-EXIT ELSE MOVE 46 TO A-RETURN-CODE (LN-SUB) GO TO 9150-INIT-EXIT ELSE MOVE 45 TO A-RETURN-CODE (LN-SUB) GO TO 9150-INIT-EXIT ELSE MOVE 43 TO A-RETURN-CODE (LN-SUB) GO TO 9150-INIT-EXIT. *************************************************************** * PROCESS BLOOD DEDUCTIBLE (EFFECTIVE AS OF 07-01-2005) * * - TOTAL BLOOD CODE CHARGES WHEN PAF = '5' OR '6' * * 5: BLOOD/BLOOD PRODUCT USED IN BLOOD DEDUC CALC * * 6: BLOOD PROCESS/STORAGE (LABOR) NOT SBJ TO BLD DEDUC * *************************************************************** IF OPPS-PYMT-ADJ-FLAG (LN-SUB) = ' 5' COMPUTE H-TOT-38X = OPPS-SUB-CHRG (LN-SUB) + H-TOT-38X. IF OPPS-PYMT-ADJ-FLAG (LN-SUB) = ' 5' OR ' 6' COMPUTE H-TOT-38X-39X = OPPS-SUB-CHRG (LN-SUB) + H-TOT-38X-39X. *************************************************************** * POPULATE COINSURANCE DEDUCTIBLE TABLE W/ ALL VALID LINES * * ORDERED LOWEST TO HIGHEST RANK FROM APC TABLE * *************************************************************** IF A-RETURN-CODE (LN-SUB) = 01 OR 11 PERFORM 9300-COIN-DEDUCT THRU 9300-COIN-DEDUCT-EXIT. *************************************************************** * POPULATE BLOOD DEDUCTIBLE TABLE W/ BLOOD DEDUC LINES * * ORDERED EARLIEST TO LATEST DATE OF SERVICE AND THEN * * LOWEST TO HIGHEST RANK FROM BLOOD DEDUCTIBLE TABLE * * (APPLIES WHEN HCPCS IS IN BLOOD DEDUCTIBLE RANKING TABLE) * * * * 05/11/2009 - ADDED THE REQUIREMENT PAF = 5 OR 6 TO BLOOD * * DEDUCTIBLE LOGIC TO CORRECT PRICING ERROR. * * FIX EFFECTIVE RETROACTIVE TO 01/01/2009. * *************************************************************** IF A-RETURN-CODE (LN-SUB) = 01 OR 11 SET W10BD-INDX TO 1 SEARCH W10BD-ENTRY VARYING W10BD-INDX AT END GO TO 9150-INIT-EXIT WHEN W-2010-BLOOD-HCPCS (W10BD-INDX) = OPPS-HCPCS (LN-SUB) IF OPPS-PYMT-ADJ-FLAG (LN-SUB) = (' 5' OR ' 6') MOVE W-2010-BLOOD-RANK (W10BD-INDX) TO H-BLOOD-RANK MOVE OPPS-LITEM-DOS (LN-SUB) TO H-BLD-DOS PERFORM 9375-BLOOD-DEDUCT THRU 9375-BLOOD-DEDUCT-EXIT END-IF. 9150-INIT-EXIT. EXIT. *************************************************************** * * * ACCUMULATE CLAIM TOTAL OFFSET AMT FROM CURRENT OFFSET TABLE * * FOR PASS-THRU ITEMS * * * * *** DISABLED 08/10/2010 & REPLACED WITH REVISED LOGIC *** * * * *************************************************************** * * * - SEARCH TABLE OPPSOF09 FOR LINE APC. * * - CALCULATE TOTAL OFFSET & TOTAL OFFSET UNITS IF APC * * OFFSET AMOUNT IN TABLE NOT EQUAL TO 0. * * * NOTE: C1820 EXPIRES FROM PASS-THRU PAYMENT IN 2009. * * ALL OFFSET AMOUNTS IN THE 2009 TABLE = $0. * * THIS LOGIC KEPT FOR FUTURE OFFSET CODES. * * * * EFFECTIVE AS OF 01-01-2003 * * - CONTINUE FOR 01-01-2004 * * - CONTINUE FOR 01-01-2005 * * - CONTINUE FOR 01-01-2006 * * - CONTINUE FOR 01-01-2007 * * - CONTINUE FOR 01-01-2008 (ALL OFFSETS IN TBL = $0) * * - CONTINUE FOR 01-01-2009 (ALL OFFSETS IN TBL = $0) * * - THIS LOGIC NOT USED FOR CY 2010, REVISED PASS-THROUGH* * OFFSET LOGIC TO BE ADDED WHEN DEVICES ARE APPROVED * * * *************************************************************** *9160-TOTAL-OFFSET. * * MOVE OPPS-GRP (LN-SUB) TO W-OFF-APC. * SEARCH ALL WOO-ENTRY8 * AT END * GO TO 9160-TOTAL-OFFSET-EXIT * WHEN WOO-APC8 (WOO-INDX8) = W-OFF-APC * PERFORM 9161-TOTAL-OFFSET-AMT * THRU 9161-TOTAL-OFFSET-AMT-EXIT. * *9160-TOTAL-OFFSET-EXIT. * EXIT. * * *************************************************************** * * * ACCUMULATE CLAIM TOTAL OFFSET AND OFFSET UNITS * * * *************************************************************** *9161-TOTAL-OFFSET-AMT. * * IF WOO-OFFSET8 (WOO-INDX8) EQUAL 0 * GO TO 9161-TOTAL-OFFSET-AMT-EXIT. * * COMPUTE H-TOTAL-OFFSET = H-TOTAL-OFFSET * + (WOO-OFFSET8 (WOO-INDX8) * H-DISC-RATE * H-SRVC-UNITS). * * COMPUTE H-TOT-OFF-UNITS = H-TOT-OFF-UNITS + H-SRVC-UNITS. * * IF H-TOTAL-OFFSET < 0 * MOVE 0 TO H-TOTAL-OFFSET. * *9161-TOTAL-OFFSET-AMT-EXIT. * EXIT. *************************************************************** * * * PROCESS LINES WITH A NUCLEAR MEDICINE APC FOR THE * * PASS-THROUGH RADIOPHARM OFFSET * * * *************************************************************** * * * - SEARCH TABLE PTROFFST FOR LINE APC & LINE YEAR * * - IF FOUND, ADD A RECORD TO TABLE W-NUCMED-APC-TBL * * FOR EVERY UNIT. * * * * 02/10/2009 - LOGIC ADDED EFFECTIVE STARTING APRIL 2009 * * * *************************************************************** 9165-PROCESS-NUCLEAR-MED. *-------------------------------------------------------------* * HOLD THE LINE'S APC, UNITS, & SERVICE FROM DATE * *-------------------------------------------------------------* MOVE OPPS-GRP (LN-SUB) TO W-NUCMED-LINE-APC. MOVE OPPS-SRVC-UNITS (LN-SUB) TO W-NUCMED-UNIT-CNT. MOVE OPPS-LITEM-DOS (LN-SUB) TO W-LINE-SRVC-DATE. *-------------------------------------------------------------* * SEARCH PT RADIOPHARM OFFSET TABLE FOR THE APC & YEAR * *-------------------------------------------------------------* SET PTRO-INDX TO 1. SEARCH PTRO-ENTRY AT END GO TO 9165-PROCESS-NUCLEAR-MED-EXIT *-------------------------------------------------------------* * WHEN APC & YEAR FOUND, WAGE ADJUST OFFSET & ADD NEW RECORD * * TO NUCLEAR MEDICINE TABLE FOR EVERY UNIT * *-------------------------------------------------------------* WHEN PTRO-NUCMED-APC (PTRO-INDX) = W-NUCMED-LINE-APC AND PTRO-EFF-YEAR (PTRO-INDX) = W-LINE-SRVC-YEAR MOVE PTRO-OFFSET-AMT (PTRO-INDX) TO W-NUCMED-OFFSET COMPUTE W-NUCMED-WA-OFFSET ROUNDED = W-NUCMED-OFFSET * (.6 * A-WINX + .4) PERFORM 9166-LOAD-NUCMED-TABLE THRU 9166-LOAD-NUCMED-TABLE-EXIT VARYING W-NUCMED-SUB FROM 1 BY 1 UNTIL W-NUCMED-SUB > W-NUCMED-UNIT-CNT. 9165-PROCESS-NUCLEAR-MED-EXIT. EXIT. *************************************************************** * * * LOAD A NUCLEAR MEDICINE APC TABLE RECORD FOR EVERY UNIT OF * * THE NUCLEAR MEDICINE LINE AND WAGE ADJUST 60% OF THE OFFSET * * (INSERT THE NEW RECORD IN THE CORRECT TABLE POSITION - * * HIGHEST TO LOWEST OFFSET) * * * *************************************************************** 9166-LOAD-NUCMED-TABLE. *-------------------------------------------------------------* * INCREASE THE TOTAL NUMBER OF TABLE RECORDS FOR NEW ENTRY * *-------------------------------------------------------------* ADD 1 TO W-NUCMED-MAX. *-------------------------------------------------------------* * MOVE TO THE NEW (LAST) ENTRY POSITION (EMPTY RECORD) * *-------------------------------------------------------------* SET W-NUCMED-INDX TO W-NUCMED-MAX. INITIALIZE W-NUCMED-APC-ENTRY (W-NUCMED-INDX). *-------------------------------------------------------------* * DETERMINE WHERE THE NEW NUCMED APC ENTRY FOR THE CURRENT * * SERVICE LINE SHOULD BE ENTERED INTO THE TABLE ACCORDING TO * * ITS OFFSET VALUE - HIGHEST TO LOWEST OFFSET * *-------------------------------------------------------------* PERFORM 9167-STAGE-NUCMED-ENTRY THRU 9167-STAGE-NUCMED-ENTRY-EXIT UNTIL W-NUCMED-INDX = 1 OR W-NUCMED-WA-OFFSET NOT > W-NUCMED-WAGE-ADJ-OFFSET (W-NUCMED-INDX - 1) *-------------------------------------------------------------* * POPULATE THE EMPTY RECORD WITH THE NEW SERVICE LINE'S DATA * *-------------------------------------------------------------* MOVE W-NUCMED-LINE-APC TO W-NUCMED-APC (W-NUCMED-INDX). MOVE W-NUCMED-WA-OFFSET TO W-NUCMED-WAGE-ADJ-OFFSET (W-NUCMED-INDX). 9166-LOAD-NUCMED-TABLE-EXIT. EXIT. *************************************************************** * * * MOVE THE EXISTING NUCMED APC RECORD WITH A HIGHER OFFSET * * DOWN ONE RECORD POSITION AND SET THE EMPTY RECORD FOR THE * * NEW ENTRY'S INDEX TO THE NEXT HIGHER RECORD POSITION. * * * *************************************************************** 9167-STAGE-NUCMED-ENTRY. MOVE W-NUCMED-APC-ENTRY (W-NUCMED-INDX - 1) TO W-NUCMED-APC-ENTRY (W-NUCMED-INDX). SET W-NUCMED-INDX DOWN BY 1. 9167-STAGE-NUCMED-ENTRY-EXIT. EXIT. *************************************************************** * * * PROCESS LINES WITH A PASS-THROUGH CONTRAST AGENT PROCEDURE * * APC FOR THE PASS-THROUGH CONTRAST AGENT OFFSET * * * *************************************************************** * * * - SEARCH TABLE PTCOFFST FOR LINE APC & LINE YEAR * * - IF FOUND, ADD A RECORD TO TABLE W-CAPROC-APC-TBL * * FOR EVERY UNIT. * * * * 11/16/2009 - LOGIC ADDED EFFECTIVE STARTING JANUARY 2010 * * * *************************************************************** 9168-PROCESS-PTCA-PROC. *-------------------------------------------------------------* * HOLD THE LINE'S APC, UNITS, & LINE ITEM DATE OF SERVICE * *-------------------------------------------------------------* MOVE OPPS-GRP (LN-SUB) TO W-CAPROC-LINE-APC. MOVE OPPS-SRVC-UNITS (LN-SUB) TO W-CAPROC-UNIT-CNT. MOVE OPPS-LITEM-DOS (LN-SUB) TO W-CAPROC-SRVC-DATE. *-------------------------------------------------------------* * SEARCH PT CONTRAST AGENT OFFSET TABLE FOR THE APC & YEAR * *-------------------------------------------------------------* SET PTCO-INDX TO 1. SEARCH PTCO-ENTRY AT END GO TO 9168-PROCESS-PTCA-PROC-EXIT *-------------------------------------------------------------* * WHEN APC & YEAR FOUND, WAGE ADJUST OFFSET & ADD NEW RECORD * * TO PT CONTRAST PROCEDURE APC TABLE FOR EVERY UNIT * *-------------------------------------------------------------* WHEN PTCO-CONTR-APC (PTCO-INDX) = W-CAPROC-LINE-APC AND PTCO-EFF-YEAR (PTCO-INDX) = W-CAPROC-SRVC-YEAR MOVE PTCO-OFFSET-AMT (PTCO-INDX) TO W-CAPROC-OFFSET COMPUTE W-CAPROC-WA-OFFSET ROUNDED = W-CAPROC-OFFSET * (.6 * H-WINX1 + .4) PERFORM 9168-LOAD-PTCA-PROC-TABLE THRU 9168-LOAD-PTCA-PROC-TABLE-EXIT VARYING W-CAPROC-SUB FROM 1 BY 1 UNTIL W-CAPROC-SUB > W-CAPROC-UNIT-CNT. 9168-PROCESS-PTCA-PROC-EXIT. EXIT. *************************************************************** * * * LOAD A PT CONTRAST AGENT PROCEDURE APC TABLE RECORD FOR * * EVERY UNIT OF THE PT CONTRAST AGENT PROCEDURE LINE * * (INSERT THE NEW RECORD IN THE CORRECT TABLE POSITION - * * EARLIEST TO LATEST LIDOS, THEN HIGHEST TO LOWEST OFFSET) * * * *************************************************************** 9168-LOAD-PTCA-PROC-TABLE. *-------------------------------------------------------------* * INCREASE THE TOTAL NUMBER OF TABLE RECORDS FOR NEW ENTRY * *-------------------------------------------------------------* ADD 1 TO W-CAPROC-MAX. *-------------------------------------------------------------* * MOVE TO THE NEW (LAST) ENTRY POSITION (EMPTY RECORD) * *-------------------------------------------------------------* SET W-CAPROC-INDX TO W-CAPROC-MAX. INITIALIZE W-CAPROC-APC-ENTRY (W-CAPROC-INDX). *-------------------------------------------------------------* * DETERMINE WHERE THE NEW CAPROC APC ENTRY FOR THE CURRENT * * SERVICE LINE SHOULD BE ENTERED INTO THE TABLE ACCORDING TO * * ITS LIDOS & OFFSET VALUE (EARLIEST TO LATEST, HIGHEST TO * * LOWEST) * *-------------------------------------------------------------* PERFORM 9168-STAGE-PTCA-PROC-ENTRY THRU 9168-STAGE-PTCA-PROC-ENTRY-EXT UNTIL W-CAPROC-INDX = 1 OR W-CAPROC-KEY NOT > W-CAPROC-TBL-KEY (W-CAPROC-INDX - 1) *-------------------------------------------------------------* * POPULATE THE EMPTY RECORD WITH THE NEW SERVICE LINE'S DATA * *-------------------------------------------------------------* MOVE W-CAPROC-LINE-APC TO W-CAPROC-APC (W-CAPROC-INDX). MOVE W-CAPROC-KEY TO W-CAPROC-TBL-KEY (W-CAPROC-INDX). 9168-LOAD-PTCA-PROC-TABLE-EXIT. EXIT. *************************************************************** * * * MOVE THE EXISTING NUCMED APC RECORD WITH A HIGHER OFFSET * * DOWN ONE RECORD POSITION AND SET THE EMPTY RECORD FOR THE * * NEW ENTRY'S INDEX TO THE NEXT HIGHER RECORD POSITION. * * * *************************************************************** 9168-STAGE-PTCA-PROC-ENTRY. MOVE W-CAPROC-APC-ENTRY (W-CAPROC-INDX - 1) TO W-CAPROC-APC-ENTRY (W-CAPROC-INDX). SET W-CAPROC-INDX DOWN BY 1. 9168-STAGE-PTCA-PROC-ENTRY-EXT. EXIT. *************************************************************** * * * PROCESS LINES WITH A PASS-THROUGH DEVICE PROCEDURE * * APC FOR THE PASS-THROUGH DEVICE OFFSET * * * *************************************************************** * * * - SEARCH TABLE OPPSPTDO FOR LINE APC * * - IF FOUND, DETERMINE IF IT MAPS TO A PASS-THROUGH * * DEVICE HCPCS, HOW MANY IT MAPS TO, IF SOM STORE * * IT IN THE PASS-THROUGH DEVICE OFFSET PROCEDURE TABLE * * * * 08/02/2010 - LOGIC ADDED EFFECTIVE STARTING OCTOBER 2010 * * 12/20/2011 - LOGIC REVISED TO INCLUDE TERMINATION DATE * * AS A VALID DATE OF SERVICE * * * *************************************************************** 9169-PROCESS-PTDO-PROC. *-------------------------------------------------------------* * INITIALIZE VARIBLES SPECIFIC TO THE CURRENT PROCEDURE LINE * *-------------------------------------------------------------* MOVE 1 TO W-DOPROC-SUB. PERFORM UNTIL W-DOPROC-SUB > W-PTDO-ASSOC-HCPCS-MAX INITIALIZE W-PTDO-ASSOC-HCPCS-HCPCS (W-DOPROC-SUB) INITIALIZE W-PTDO-ASSOC-HCPCS-IND (W-DOPROC-SUB) ADD 1 TO W-DOPROC-SUB END-PERFORM. SET W-PTDO-ASSOC-HCPCS-INDX TO 1. MOVE 0 TO W-PTDO-ASSOC-HCPCS-MAX. MOVE 'N' TO W-PTDO-EOF-SWITCH. INITIALIZE H-PTDO-ASSOC-HCPCS-CTR. INITIALIZE H-PTDO-PROC-KEY. INITIALIZE W-PTDO-DARRAY-MAX. SET PTDO-INDX TO 1. *-------------------------------------------------------------* * HOLD THE LINE'S APC, UNITS, & LINE ITEM DATE OF SERVICE * *-------------------------------------------------------------* MOVE OPPS-GRP (LN-SUB) TO W-DOPROC-LINE-APC. MOVE OPPS-SRVC-UNITS (LN-SUB) TO H-PTDO-PROC-UNITS. MOVE OPPS-LITEM-DOS (LN-SUB) TO W-DOPROC-SRVC-DATE. *-------------------------------------------------------------* * SEARCH PT DEVICE OFFSET TBL FOR EVERY OCCURANCE OF THE APC * * AND CAPTURE EACH ASSOCIATED DEVICE HCPCS * *-------------------------------------------------------------* PERFORM UNTIL W-PTDO-EOF-SWITCH = 'Y' SEARCH PTDO-ENTRY AT END MOVE 'Y' TO W-PTDO-EOF-SWITCH *-------------------------------------------------------------* * EACH TIME A CURRENT RECORD FOR THE APC IS FOUND, ADD THE * * ASSOCIATED HCPCS TO A TABLE, HOLD THE OFFSET AMOUNT, AND * * SEARCH FOR ANOTHER CURRENT RECORD * *-------------------------------------------------------------* WHEN (PTDO-PROC-APC (PTDO-INDX) = W-DOPROC-LINE-APC) AND (PTDO-EFF-DATE (PTDO-INDX) <= W-DOPROC-SRVC-DATE) AND (PTDO-TERM-DATE (PTDO-INDX) = 0 OR PTDO-TERM-DATE (PTDO-INDX) >= W-DOPROC-SRVC-DATE) MOVE 'N' TO W-PTDO-EOF-SWITCH COMPUTE H-PTDO-PROC-WA-OFFSET = ((PTDO-OFFSET-AMT (PTDO-INDX) * .60) * H-WINX1) + (PTDO-OFFSET-AMT (PTDO-INDX) * .40) PERFORM 9169-LOAD-ASSOC-PTD-HCPCS THRU 9169-LOAD-ASSOC-PTD-HCPCS-EXIT SET PTDO-INDX UP BY 1 END-SEARCH END-PERFORM. *-------------------------------------------------------------* * SEARCH THE DEVICE OFFSET HCPCS TABLE FOR EACH HCPCS IN * * THE PT DEVICE ASSOCIATED HCPCS TABLE & TRY TO MAP THE HCPCS * * TO THE PROCEDURE APC * *-------------------------------------------------------------* IF W-PTDO-ASSOC-HCPCS-MAX > 0 PERFORM 9169-COUNT-PTDO-MAPPINGS THRU 9169-COUNT-PTDO-MAPPINGS-EXIT VARYING W-DOPROC-SUB FROM 1 BY 1 UNTIL W-DOPROC-SUB > W-PTDO-ASSOC-HCPCS-MAX END-IF. *-------------------------------------------------------------* * CREATE RECORD IN THE OFFSET PROCEDURE APC TABLE IF * * PROCEDURE HAS >= 1 ASSOCIATED DEVICE HCPCS ON THE CLAIM * *-------------------------------------------------------------* IF H-PTDO-ASSOC-HCPCS-CTR > 0 PERFORM 9169-LOAD-PTDO-PROC-TABLE THRU 9169-LOAD-PTDO-PROC-TABLE-EXIT END-IF. 9169-PROCESS-PTDO-PROC-EXIT. EXIT. *************************************************************** * * * LOAD THE PASS-THROUGH DEVICE HCPCS ON THE RECORD INTO THE * * PTDO ASSOCIATED HCPCS TABLE * * * *************************************************************** 9169-LOAD-ASSOC-PTD-HCPCS. *-------------------------------------------------------------* * DETERMINE IF THE RECORD'S PTDO HCPCS IS ALREADY IN THE TBL * * IF IT'S NOT IN THE TBL, ADD IT, IF IT IS, DO NOT ADD IT * *-------------------------------------------------------------* SET W-PTDO-ASSOC-HCPCS-INDX TO 1. SEARCH W-PTDO-ASSOC-HCPCS-ENTRY AT END MOVE PTDO-DEV-HCPCS (PTDO-INDX) TO W-PTDO-ASSOC-HCPCS-HCPCS (W-PTDO-ASSOC-HCPCS-INDX) ADD 1 TO W-PTDO-ASSOC-HCPCS-MAX ADD 1 TO W-PTDO-DARRAY-MAX WHEN W-PTDO-ASSOC-HCPCS-HCPCS(W-PTDO-ASSOC-HCPCS-INDX) = PTDO-DEV-HCPCS (PTDO-INDX) GO TO 9169-LOAD-ASSOC-PTD-HCPCS-EXIT END-SEARCH. 9169-LOAD-ASSOC-PTD-HCPCS-EXIT. EXIT. *************************************************************** * * * DETERMINE HOW MANY PT DEVICE OFFSET HCPCS MAP TO THE OFFSET * * PROCEDURE, AND HOW MANY PROCEDURES MAP TO THE DEVICE HCPCS * * * *************************************************************** 9169-COUNT-PTDO-MAPPINGS. *-------------------------------------------------------------* * SEARCH PT DEVICE OFFSET HCPCS TBL FOR THE CURRENT DEVICE * * HCPCS (IN THE ASSOC. HCPCS TBL) * *-------------------------------------------------------------* SET W-PTDO-HCPCS-INDX TO 1. SEARCH W-PTDO-HCPCS-ENTRY AT END MOVE 'N' TO W-PTDO-ASSOC-HCPCS-IND(W-DOPROC-SUB) WHEN W-PTDO-HCPCS-HCPCS (W-PTDO-HCPCS-INDX) = W-PTDO-ASSOC-HCPCS-HCPCS(W-DOPROC-SUB) MOVE 'Y' TO W-PTDO-ASSOC-HCPCS-IND(W-DOPROC-SUB) ADD 1 TO H-PTDO-ASSOC-HCPCS-CTR ADD 1 TO W-PTDO-HCPCS-PROC-CNT(W-PTDO-HCPCS-INDX). 9169-COUNT-PTDO-MAPPINGS-EXIT. EXIT. *************************************************************** * * * LOAD A PT DEVICE OFFSET PROCEDURE APC TABLE RECORD FOR * * THE CURRENT PROCEDURE LINE IF THERE IS AT LEAST ONE * * ASSOCIATED PT DEVICE ON THE CLAIM * * (INSERT THE NEW RECORD IN THE CORRECT TABLE POSITION - * * HIGHEST TO LOWEST OFFSET, THEN HIGHEST TO LOWEST UNITS) * * * *************************************************************** 9169-LOAD-PTDO-PROC-TABLE. *-------------------------------------------------------------* * INCREASE THE TOTAL NUMBER OF TABLE RECORDS FOR NEW ENTRY * *-------------------------------------------------------------* ADD 1 TO W-PTDO-PROC-MAX. *-------------------------------------------------------------* * MOVE TO THE NEW (LAST) ENTRY POSITION (EMPTY RECORD) * *-------------------------------------------------------------* SET W-PTDO-PROC-INDX TO W-PTDO-PROC-MAX. * INITIALIZE W-PTDO-PROC-ENTRY (W-PTDO-PROC-INDX). *-------------------------------------------------------------* * DETERMINE WHERE THE NEW PROC APC ENTRY FOR THE CURRENT * * SERVICE LINE SHOULD BE ENTERED INTO THE TABLE ACCORDING TO * * ITS OFFSET & UNITS (HIGHEST TO LOWEST, HIGHEST TO LOWEST) * *-------------------------------------------------------------* PERFORM 9169-STAGE-PTDO-PROC-ENTRY THRU 9169-STAGE-PTDO-PROC-ENTRY-EX UNTIL W-PTDO-PROC-INDX = 1 OR H-PTDO-PROC-KEY NOT > W-PTDO-PROC-KEY (W-PTDO-PROC-INDX - 1) *-------------------------------------------------------------* * POPULATE THE EMPTY RECORD WITH THE NEW SERVICE LINE'S DATA * *-------------------------------------------------------------* MOVE W-DOPROC-LINE-APC TO W-PTDO-PROC-APC (W-PTDO-PROC-INDX). MOVE LN-SUB TO W-PTDO-PROC-LNSUB (W-PTDO-PROC-INDX). MOVE H-PTDO-PROC-UNITS TO W-PTDO-PROC-UNITS (W-PTDO-PROC-INDX). MOVE H-PTDO-PROC-WA-OFFSET TO W-PTDO-PROC-WA-OFFSET (W-PTDO-PROC-INDX). MOVE 0 TO W-PTDO-PROC-DEVICE-CNT (W-PTDO-PROC-INDX). MOVE 0 TO W-PTDO-PROC-TOT-DCHRGS (W-PTDO-PROC-INDX). MOVE 0 TO W-PTDO-PROC-TOT-DUNITS (W-PTDO-PROC-INDX). MOVE SPACES TO W-PTDO-PROC-USED (W-PTDO-PROC-INDX). *------------------------------------------------------------* * LOAD HCPCS IN ASSOCIATED HCPCS TABLE INTO THE EMPTY RECORD * *------------------------------------------------------------* MOVE 1 TO W-DOPROC-SUB. MOVE 0 TO W-PTDO-DARRAY-SIZE (W-PTDO-PROC-INDX). PERFORM UNTIL W-DOPROC-SUB > W-PTDO-ASSOC-HCPCS-MAX IF W-PTDO-ASSOC-HCPCS-IND (W-DOPROC-SUB) = 'Y' MOVE W-PTDO-ASSOC-HCPCS-HCPCS (W-DOPROC-SUB) TO W-PTDO-PROC-DHCPCS (W-PTDO-PROC-INDX, W-DOPROC-SUB) ADD 1 TO W-PTDO-DARRAY-SIZE (W-PTDO-PROC-INDX) END-IF ADD 1 TO W-DOPROC-SUB END-PERFORM. 9169-LOAD-PTDO-PROC-TABLE-EXIT. EXIT. *************************************************************** * * * MOVE THE EXISTING PROCEDURE RECORD WITH A LOWER OFFSET & * * LOWER UNITS DOWN ONE RECORD POSITION AND SET THE EMPTY * * RECORD FOR THE NEW ENTRY'S INDEX TO THE NEXT HIGHER RECORD * * POSITION. * * * *************************************************************** 9169-STAGE-PTDO-PROC-ENTRY. MOVE W-PTDO-PROC-ENTRY (W-PTDO-PROC-INDX - 1) TO W-PTDO-PROC-ENTRY (W-PTDO-PROC-INDX). SET W-PTDO-PROC-INDX DOWN BY 1. 9169-STAGE-PTDO-PROC-ENTRY-EX. EXIT. *************************************************************** * * * ACCUMULATE NON-PRIME COMPOSITE APC CHARGES FOR EACH * * COMPOSITE APC USING PACKAGED LINES WITH COMPOSITE * * ADJUSTMENT FLAG NOT = '00' & POPULATE COMPOSITE APC TABLE * * * *************************************************************** * * * ORDER SERVICE LINES BY COMPOSITE ADJUSTMENT FLAG (CAF) - * * LOWEST TO HIGHEST FLAG VALUE (01 - NN) * * * * EACH NON-PRIME COMPOSITE PACKAGED LINE'S CHARGES ARE ADDED * * TO THE TOTAL NON-PRIME CHARGES FOR EACH CAF, WHICH * * CORRESPONDS TO THE PRIME LINE'S APC. THESE CHARGES ARE * * LATER ADDED TO THE PRIME LINE'S CHARGES TO CALCULATE THE * * OUTLIER PAYMENT. * * * * 11/28/2007 - LOGIC ADDED FOR CY 2008 * * 11/12/2008 - LOGIC REVISED FOR CY 2009 TO USE THE * * COMPOSITE ADJUSTMENT FLAG INSTEAD OF THE * * PAYMENT ADJUSTMENT FLAG, VARIABLE H-CMP-CAF * * HOLDS COMPOSITE ADJUSTMENT FLAG, VARIABLE * * W-CMP-PAF RETAINED AND NOW HOLDS THE CAF * * (RETAINED TO CONTINUE USE OF EXISTING TABLE) * * * *************************************************************** 9170-COMPOSITES. *-------------------------------------------------------------* * GET THE LINE'S COMPOSITE ADJUSTMENT FLAG FOR TABLE SEARCH * *-------------------------------------------------------------* MOVE OPPS-COMP-ADJ-FLAG (LN-SUB) TO H-CMP-CAF. *-------------------------------------------------------------* * ADD OR UPDATE COMPOSITE APC TABLE ENTRY FOR THE CAF * *-------------------------------------------------------------* PERFORM 9171-SEARCH-CAF THRU 9171-SEARCH-CAF-EXIT. 9170-COMPOSITES-EXIT. EXIT. *************************************************************** * * * DETERMINE WHETHER A NEW COMPOSITE APC TABLE RECORD SHOULD * * BE ADDED OR IF AN EXISITING RECORD NEEDS TO BE UPDATED * * * *************************************************************** 9171-SEARCH-CAF. *-------------------------------------------------------------* * SEARCH COMPOSITE APC TABLE STARTING AT ENTRY #1 * *-------------------------------------------------------------* SET W-CMP-INDX TO 1. SEARCH W-CMP-ENTRY VARYING W-CMP-INDX *-------------------------------------------------------------* * IF THE SERVICE LINE'S COMPOSITE ADJUSTMENT FLAG IS NOT * * ALREADY IN THE TABLE, ADD IT * *-------------------------------------------------------------* AT END PERFORM 9172-ADD-ENTRY THRU 9172-ADD-ENTRY-EXIT *-------------------------------------------------------------* * IF THE SERVICE LINE'S COMPOSITE ADJUSTMENT FLAG IS ALREADY * * IN THE TABLE, UPDATE THE ENTRY * *-------------------------------------------------------------* WHEN W-CMP-PAF (W-CMP-INDX) = H-CMP-CAF PERFORM 9173-UPDATE-ENTRY THRU 9173-UPDATE-ENTRY-EXIT. 9171-SEARCH-CAF-EXIT. EXIT. *************************************************************** * * * INSERT THE NEW COMPOSITE APC RECORD IN THE CORRECT POSITION * * (LOWEST TO HIGHEST CAF) OF THE COMPOSITE APC TABLE * * * *************************************************************** 9172-ADD-ENTRY. *-------------------------------------------------------------* * INCREASE THE TOTAL NUMBER OF TABLE RECORDS FOR NEW ENTRY * *-------------------------------------------------------------* ADD 1 TO W-CMP-MAX. *-------------------------------------------------------------* * MOVE TO THE NEW ENTRY POSITION (EMPTY RECORD) * *-------------------------------------------------------------* SET W-CMP-INDX TO W-CMP-MAX. *-------------------------------------------------------------* * DETERMINE WHERE THE NEW COMPOSITE APC ENTRY FOR THE CURRENT * * SERVICE LINE SHOULD BE ENTERED INTO THE TABLE ACCORDING TO * * ITS COMPOSITE ADJUSTMENT FLAG (CAF) - LOWEST TO HIGHEST CAF * *-------------------------------------------------------------* PERFORM 9174-STAGE-CMP-ENTRY THRU 9174-STAGE-CMP-ENTRY-EXIT UNTIL W-CMP-INDX = 1 OR H-CMP-CAF NOT < W-CMP-PAF (W-CMP-INDX - 1). *-------------------------------------------------------------* * POPULATE THE EMPTY RECORD WITH THE NEW SERVICE LINE'S DATA * *-------------------------------------------------------------* MOVE H-CMP-CAF TO W-CMP-PAF (W-CMP-INDX). MOVE H-SUB-CHRG TO W-CMP-TOT-SUB-CHRG (W-CMP-INDX). 9172-ADD-ENTRY-EXIT. EXIT. *************************************************************** * * * UPDATE THE EXISTING COMPOSITE APC RECORD WITH THE SAME * * COMPOSITE ADJUSTMENT FLAG OF THE CURRENT SERVICE LINE * * * *************************************************************** 9173-UPDATE-ENTRY. *-------------------------------------------------------------* * ACCUMULATE THE CAF'S TOTAL NON-PRIME SUBMITTED CHARGES * *-------------------------------------------------------------* ADD H-SUB-CHRG TO W-CMP-TOT-SUB-CHRG (W-CMP-INDX). 9173-UPDATE-ENTRY-EXIT. EXIT. *************************************************************** * * * MOVE THE EXISTING COMPOSITE APC RECORD WITH A HIGHER CAF * * UP ONE RECORD POSITION AND SET THE EMPTY RECORD FOR THE * * NEW ENTRY'S INDEX TO THE NEXT LOWER RECORD POSITION. * * * *************************************************************** 9174-STAGE-CMP-ENTRY. MOVE W-CMP-ENTRY (W-CMP-INDX - 1) TO W-CMP-ENTRY (W-CMP-INDX). SET W-CMP-INDX DOWN BY 1. 9174-STAGE-CMP-ENTRY-EXIT. EXIT. *************************************************************** * * * LOCATE THE APC RECORD WITH THE APPROPRIATE EFFECTIVE DATE * * - MOVE APC DATA TO HOLD AREA FOR PROCESSING WHEN FOUND * * - ADJUST TOTAL CHARGES FOR DELETED APCS & RETURN ERROR * * - RETURN ERROR WHEN USABLE EFFECTIVE DATE NOT FOUND * * * *************************************************************** 9175-APC-LOOKUP. *************************************************************** * APC RECORD EFFECTIVE DATE IS BEFORE OR ON THE LATEST * * EFFECTIVE DATE THE CLAIM CAN USE (SEARCH STARTS AT THE * * MOST CURRENT RECORD FOR THE APC) * *************************************************************** IF WAR-DTCD (W-SUB2) NOT > WAD-DTCD (WAD-SUB) *-------------------------------------------------------------* * APC RECORD EFFECTIVE DATE CORRECT, APC DELETED - ERROR * *-------------------------------------------------------------* IF WAR-RATEX (W-SUB2) = 'DELETED' MOVE 30 TO A-RETURN-CODE (LN-SUB) COMPUTE H-TOT-CHRG = H-TOT-CHRG - H-SUB-CHRG *-------------------------------------------------------------* * APC RECORD EFFECTIVE DATE CORRECT, APC ACTIVE - ACCEPT REC * *-------------------------------------------------------------* ELSE MOVE WAR-RATE (W-SUB2) TO H-APC-PYMT MOVE WAR-RANK (W-SUB2) TO H-RANK MOVE WAR-MINC (W-SUB2) TO H-MIN-COIN MOVE WAR-COIN (W-SUB2) TO H-NAT-COIN MOVE WAR-PPCT (W-SUB2) TO H-PPCT *************************************************************** * APC RECORD EFFECTIVE DATE IS AFTER THE LATEST EFFECTIVE * * DATE THE CLAIM CAN USE. GO TO THE PREVIOUS RECORD IN THE * * APC TABLE. * *************************************************************** ELSE SUBTRACT 1 FROM W-SUB2 *-------------------------------------------------------------* * PREVIOUS REC BELONGS TO THE LINE APC, TEST EFFECTIVE DATE * *-------------------------------------------------------------* IF W-SUB2 > WAA-PTR (WAA-INDX - 1) GO TO 9175-APC-LOOKUP *-------------------------------------------------------------* * THERE IS NO RECORD FOR THE LINE APC WITH AN ACCEPTABLE * * EFFECTIVE DATE FOR THE LINE. RETURN ZEROS. * *-------------------------------------------------------------* ELSE MOVE 0 TO H-APC-PYMT H-RANK H-MIN-COIN H-NAT-COIN H-PPCT. 9175-APC-LOOKUP-EXIT. EXIT. *************************************************************** * * * REDUCE APC PAYMENT OF LINES FROM PROVIDERS WITH A * * SPACE IN THE QUALITY INDICATOR FIELD OF THE OPSF * * * * LOCATE THE APC RECORD WITH THE APPROPRIATE EFFECTIVE DATE * * - MOVE APC DATA TO HOLD AREA FOR PROCESSING WHEN FOUND * * - ADJUST TOTAL CHARGES FOR DELETED APCS & RETURN ERROR * * - RETURN ERROR WHEN USABLE EFFECTIVE DATE NOT FOUND * * * * 11/16/2010 - ADDED SI = U (BRACHY) TO LOGIC * * * *************************************************************** 9180-REDUCE-APC-PYMT. *-------------------------------------------------------------* * SPECIFY LINES ELIGIBLE FOR REDUCTION * *-------------------------------------------------------------* IF ( L-PSF-HOSP-QUAL-IND = ' ' ) AND ( (OPPS-SRVC-IND (LN-SUB) = ' P') OR (OPPS-SRVC-IND (LN-SUB) = ' R') OR (OPPS-SRVC-IND (LN-SUB) = ' S' AND NOT (OPPS-GRP (LN-SUB) >= '01491' AND OPPS-GRP (LN-SUB) <= '01537')) OR (OPPS-SRVC-IND (LN-SUB) = ' T' AND NOT (OPPS-GRP (LN-SUB) >= '01539' AND OPPS-GRP (LN-SUB) <= '01574')) OR (OPPS-SRVC-IND (LN-SUB) = ' U') OR (OPPS-SRVC-IND (LN-SUB) = ' V') OR (OPPS-SRVC-IND (LN-SUB) = ' X') ) THEN COMPUTE H-APC-PYMT ROUNDED = H-APC-PYMT * 0.980 MOVE 11 TO A-RETURN-CODE (LN-SUB) END-IF. 9180-REDUCE-APC-PYMT-EXIT. EXIT. *************************************************************** * * * DELETED CODE: * * IF DATE OF SERVICE BETWEEN 12/31/2002 AND 04/01/2003 * * IF HCPCS CODE = C9114 OR C9115 ADJUST PAYMENT AND * * COINSURANCE AMOUNTS - LOGIC REMOVED FOR 20050101 * * * *************************************************************** *************************************************************** * * * SEARCH WAGE INDEX TABLE FOR THE CBSA IN THE PROVIDER * * SPECIFIC FILE (PSF) * * * *************************************************************** * * * IF CBSA NOT LOCATED * * - SET CLAIM RETURN CODE TO '50' * * - DISCONTINUE CLAIM PROCESSING * * IF WAGE INDEX EQUALS ZERO * * - SET CLAIM RETURN CODE TO '51' * * - DISCONTINUE CLAIM PROCESSING * * * *************************************************************** 9200-CALC-WAGEINDX. *************************************************************** * STARTING AT THE LAST DATE IN THE TABLE, SEARCH WAGE INDEX * * DATE TABLE FOR THE MOST CURRENT EFFECTIVE DATE THAT CAN BE * * USED BY THE CLAIM * *************************************************************** MOVE WCD-MAX TO WCD-SUB. PERFORM UNTIL L-SERVICE-FROM-DATE NOT < WCD-DATE (WCD-SUB) SUBTRACT 1 FROM WCD-SUB END-PERFORM. *************************************************************** * SEARCH CBSA TABLE FOR THE PSF CBSA * *************************************************************** SEARCH ALL WCM-ENTRY *-------------------------------------------------------------* * PSF CBSA NOT FOUND IN CBSA TABLE, RETURN ERROR * *-------------------------------------------------------------* AT END MOVE 50 TO A-CLM-RTN-CODE GO TO 9200-CALC-WAGEINDX-EXIT *-------------------------------------------------------------* * PSF CBSA FOUND IN CBSA TABLE * *-------------------------------------------------------------* WHEN WCM-CBSA (WCM-INDX) = H-PSF-CBSA *-------------------------------------------------------------* * START SEARCH AT THE MOST CURRENT RECORD FOR THE CBSA * *-------------------------------------------------------------* MOVE WCM-PTR (WCM-INDX) TO W-SUB3 *-------------------------------------------------------------* * GET WAGE INDEX FROM THE REC W/ THE CORRECT EFFECTIVE DATE * *-------------------------------------------------------------* PERFORM 9210-WAGE-LOOKUP. *-------------------------------------------------------------* * ADJUST THE WAGE INDEX BY THE APPROPRIATE STATE SPECIFIC * * RURAL FLOOR BUDGET NEUTRALILTY FACTOR (SSRFBN) * * 11/10/2008 - NEW FOR CY 2009 * * 05/13/2010 - ADDED SECOND SET OF PARAGRAPHS TO APPLY * * DIFFERENT SSRFBN FACTORS FOR 2ND HALF OF YR * *-------------------------------------------------------------* IF L-SERVICE-FROM-DATE < 20100701 PERFORM 9220-APPLY-SSRFBN THRU 9220-EXIT ELSE PERFORM 9226-APPLY-SSRFBN-2ND-HALF THRU 9226-EXIT END-IF. *************************************************************** * RETURN ERROR IF WAGE INDEX = 0 OR NOT NUMERIC * *************************************************************** IF H-WINX1 = 0 OR H-WINX1 NOT NUMERIC THEN MOVE 51 TO A-CLM-RTN-CODE. 9200-CALC-WAGEINDX-EXIT. EXIT. *************************************************************** * * * LOCATE THE CBSA RECORD WITH THE APPROPRIATE EFFECTIVE DATE * * WHEN FOUND, SELECT THE APPLICABLE WAGE INDEX VALUE * * * *************************************************************** 9210-WAGE-LOOKUP. *************************************************************** * WAGE INDEX RECORD EFFECTIVE DATE IS BEFORE OR ON THE * * LATEST EFFECTIVE DATE THE CLAIM CAN USE - CORRECT * * (SEARCH STARTS AT THE MOST CURRENT RECORD FOR THE CBSA) * *************************************************************** IF WCW-DTCD (W-SUB3) NOT > WCD-DTCD (WCD-SUB) *-------------------------------------------------------------* * THIS PROVIDER HAS RECLASSIFIED, USE THE WAGE INDEX IN THE * * SECOND COLUMN FOR RECLASSIFYING PROVIDERS. * *-------------------------------------------------------------* IF L-PSF-SPEC-PYMT-IND = 'Y' MOVE WCW-WINX2 (W-SUB3) TO H-WINX1 *-------------------------------------------------------------* * THIS PROVIDER HAS NOT RECLASSIFIED, USE THE WAGE INDEX IN * * THE FIRST COLUMN FOR AREA PROVIDERS. * *-------------------------------------------------------------* ELSE MOVE WCW-WINX1 (W-SUB3) TO H-WINX1 *************************************************************** * WAGE INDEX RECORD EFFECTIVE DATE IS AFTER LATEST EFFECTIVE * * DATE THE CLAIM CAN USE. GO TO THE PREVIOUS RECORD IN THE * * CBSA WAGE INDEX TABLE. * *************************************************************** ELSE SUBTRACT 1 FROM W-SUB3 *-------------------------------------------------------------* * PREVIOUS REC BELONGS TO THE PSF CBSA, TEST EFFECTIVE DATE * *-------------------------------------------------------------* IF W-SUB3 > WCM-PTR (WCM-INDX - 1) GO TO 9210-WAGE-LOOKUP *-------------------------------------------------------------* * THERE IS NO RECORD FOR THE PSF CBSA WITH AN ACCEPTABLE * * EFFECTIVE DATE FOR THE LINE. RETURN ZERO. * *-------------------------------------------------------------* ELSE MOVE 0 TO H-WINX1. 9210-WAGE-LOOKUP-EXIT. EXIT. *************************************************************** * * * ADJUST THE WAGE INDEX BY THE STATE SPECIFIC * * RURAL FLOOR BUDGET NEUTRALITY FACTOR (SSRFBN) * * (CY 2010 - 1ST HALF 1/1 - 6/30) * * * *************************************************************** 9220-APPLY-SSRFBN. *-------------------------------------------------------------* * THE PROVIDER'S STATE IS THE SSRFBN TABLE SEARCH KEY; * * SEARCH SSRFBN TABLE FOR APPROPRIATE FACTOR * *-------------------------------------------------------------* MOVE L-PSF-PROV-ST TO MES-PPS-STATE-10. PERFORM 9225-FIND-SSRFBN THRU 9225-EXIT. *-------------------------------------------------------------* * ADJUST THE WAGE INDEX BY THE SSRFBN FACTOR FOUND IN THE TBL * *-------------------------------------------------------------* IF H-WINX1 NOT = 0 AND H-WINX1 IS NUMERIC AND A-CLM-RTN-CODE NOT = 51 COMPUTE H-WINX1 ROUNDED = H-WINX1 * MES-SSRFBN-RATE-10 END-IF. 9220-EXIT. EXIT. *************************************************************** * * * FIND THE STATE SPECIFIC RURAL FLOOR BUDGET * * NEUTRALITY FACTOR (SSRFBN) * * (CY 2010 - 1ST HALF 1/1 - 6/30) * * * *************************************************************** 9225-FIND-SSRFBN. *----------------------------------------------------------------* * SEARCH SSRFBN STARTING WITH THE FIRST RECORD * *----------------------------------------------------------------* SET SSRFBN-IDX10 TO 1. SEARCH SSRFBN-TAB-10 VARYING SSRFBN-IDX10 *----------------------------------------------------------------* * PROVIDER STATE NOT FOUND IN SSRFBN TABLE, ASSIGN ERROR CODE * *----------------------------------------------------------------* AT END MOVE 51 TO A-CLM-RTN-CODE GO TO 9225-EXIT *----------------------------------------------------------------* * PROVIDER STATE FOUND, CAPTURE SSRFBN FACTOR * *----------------------------------------------------------------* WHEN WK-SSRFBN-STATE-10 (SSRFBN-IDX10) = MES-PPS-STATE-10 MOVE WK-SSRFBN-REASON-ALL-10 (SSRFBN-IDX10) TO MES-SSRFBN-10. 9225-EXIT. EXIT. *************************************************************** * * * ADJUST THE WAGE INDEX BY THE STATE SPECIFIC * * RURAL FLOOR BUDGET NEUTRALITY FACTOR (SSRFBN) * * (CY 2010 - 2ND HALF 7/1 - 12/31) * * * *************************************************************** 9226-APPLY-SSRFBN-2ND-HALF. *-------------------------------------------------------------* * THE PROVIDER'S STATE IS THE SSRFBN TABLE SEARCH KEY; * * SEARCH SSRFBN TABLE FOR APPROPRIATE FACTOR * *-------------------------------------------------------------* MOVE L-PSF-PROV-ST TO MES-PPS-STATE-10B. PERFORM 9227-FIND-SSRFBN-2ND-HALF THRU 9227-EXIT. *-------------------------------------------------------------* * ADJUST THE WAGE INDEX BY THE SSRFBN FACTOR FOUND IN THE TBL * *-------------------------------------------------------------* IF H-WINX1 NOT = 0 AND H-WINX1 IS NUMERIC AND A-CLM-RTN-CODE NOT = 51 COMPUTE H-WINX1 ROUNDED = H-WINX1 * MES-SSRFBN-RATE-10B END-IF. 9226-EXIT. EXIT. *************************************************************** * * * FIND THE STATE SPECIFIC RURAL FLOOR BUDGET * * NEUTRALITY FACTOR (SSRFBN) * * (CY 2010 - 2ND HALF 7/1 - 12/31) * * * *************************************************************** 9227-FIND-SSRFBN-2ND-HALF. *----------------------------------------------------------------* * SEARCH SSRFBN STARTING WITH THE FIRST RECORD * *----------------------------------------------------------------* SET SSRFBN-IDX10B TO 1. SEARCH SSRFBN-TAB-10B VARYING SSRFBN-IDX10B *----------------------------------------------------------------* * PROVIDER STATE NOT FOUND IN SSRFBN TABLE, ASSIGN ERROR CODE * *----------------------------------------------------------------* AT END MOVE 51 TO A-CLM-RTN-CODE GO TO 9227-EXIT *----------------------------------------------------------------* * PROVIDER STATE FOUND, CAPTURE SSRFBN FACTOR * *----------------------------------------------------------------* WHEN WK-SSRFBN-STATE-10B (SSRFBN-IDX10B) = MES-PPS-STATE-10B MOVE WK-SSRFBN-REASON-ALL-10B (SSRFBN-IDX10B) TO MES-SSRFBN-10B. 9227-EXIT. EXIT. *************************************************************** * * * CALCULATE DISCOUNT RATE BASED ON THE DISCOUNT * * FACTOR PASSED BY THE OCE: VALUES 1 - 9 * * * * IF MISSING OR INVALID DISCOUNT FACTOR * * - SET RETURN CODE TO '38' * * - DISCONTINUE LINE PROCESSING * * * *************************************************************** * * * 11/1/2007 - NEW DISCOUNT INDICATOR 9 ADDED FOR CY 2008 * * * *************************************************************** 9250-CALC-DISCOUNT. IF (H-SRVC-UNITS = 0 AND OPPS-APC (LN-SUB) = '0000') MOVE 42 TO A-RETURN-CODE (LN-SUB) GO TO 9250-CALC-DISCOUNT-EXIT ELSE IF (H-SRVC-UNITS = 0 AND OPPS-APC (LN-SUB) > '0000') MOVE 1 TO H-SRVC-UNITS. IF OPPS-DISC-FACT (LN-SUB) = 1 THEN MOVE 1 TO H-DISC-RATE ELSE IF OPPS-DISC-FACT (LN-SUB) = 2 THEN COMPUTE H-DISC-RATE = (1 + DISC-FRACTION * (H-SRVC-UNITS - 1)) / H-SRVC-UNITS ELSE IF OPPS-DISC-FACT (LN-SUB) = 3 THEN COMPUTE H-DISC-RATE = TERM-PROC-DISC / H-SRVC-UNITS ELSE IF OPPS-DISC-FACT (LN-SUB) = 4 THEN COMPUTE H-DISC-RATE = (1 + DISC-FRACTION) / H-SRVC-UNITS ELSE IF OPPS-DISC-FACT (LN-SUB) = 5 THEN COMPUTE H-DISC-RATE = DISC-FRACTION ELSE IF OPPS-DISC-FACT (LN-SUB) = 6 THEN COMPUTE H-DISC-RATE = (TERM-PROC-DISC * DISC-FRACTION) / H-SRVC-UNITS ELSE IF OPPS-DISC-FACT (LN-SUB) = 7 THEN COMPUTE H-DISC-RATE = (DISC-FRACTION * (1 + DISC-FRACTION) / H-SRVC-UNITS) ELSE IF OPPS-DISC-FACT (LN-SUB) = 8 THEN MOVE 2 TO H-DISC-RATE ELSE IF OPPS-DISC-FACT (LN-SUB) = 9 THEN COMPUTE H-DISC-RATE = 1 / H-SRVC-UNITS ELSE MOVE 38 TO A-RETURN-CODE (LN-SUB). 9250-CALC-DISCOUNT-EXIT. EXIT. *************************************************************** * * * POPULATE COINSURANCE DEDUCTIBLE TABLE WITH SERVICE LINES * * * *************************************************************** * * * ORDER SERVICES LINES BY THE DEDUCTIBLE SEQUENCE - * * LOWEST TO HIGHEST APC RANK FROM APC TABLE * * * * DEDUCTIBLE WILL BE TAKEN FROM OPPS SERVICES FIRST, * * THEN FROM ANY OTHER TYPES OF SERVICES FROM THE CLAIM. * * ALL VALID SERVICE LINES APPEAR IN THIS TABLE IN THE * * ORDER OF THEIR RANK FROM LOWEST TO HIGHEST. * * - THE LOWER THE RANK, THE HIGHER % THE NATIONAL * * UNADJUSTED COINSURANCE IS OF THE APC PAYMENT RATE * * - MOVE ALL LINE PRICING VARIABLES TO STAGING AREA * * (NEW COINSURANCE DEDUCTIBLE TABLE RECORD) * * * * NOTE: THE PURPOSE OF APC RANKING IS TO ENSURE THAT THE * * BENEFICIARY DEDUCTIBLE GOES TOWARD LINES WITH * * HIGHER COINSURANCE %S FIRST. THIS RESULTS IN THE * * BENEFICIARY PAYING LESS TOTAL COINSURANCE FOR THE * * CLAIM. * * * *************************************************************** 9300-COIN-DEDUCT. *-------------------------------------------------------------* * ADD 1 TO THE TOTAL TABLE RECORDS FOR THE NEW ENTRY * *-------------------------------------------------------------* ADD 1 TO W-LNC-MAX. *-------------------------------------------------------------* * MOVE TO THE NEW ENTRY POSITION (EMPTY RECORD) * *-------------------------------------------------------------* SET W-LP-INDX TO W-LNC-MAX. *-------------------------------------------------------------* * DETERMINE WHERE THE NEW SERVICE LINE SHOULD BE ENTERED INTO * * THE TABLE ACCORDING TO ITS RANK AND THE RANK OF THE RECORDS * * ALREADY IN THE TABLE - LOWEST TO HIGHEST RANK. * *-------------------------------------------------------------* PERFORM 9350-STAGE-ENTRY THRU 9350-STAGE-ENTRY-EXIT UNTIL W-LP-INDX = 1 OR H-RANK NOT < W-RANK (W-LP-INDX - 1). *-------------------------------------------------------------* * POPULATE THE EMPTY RECORD WITH THE NEW SERVICE LINE'S DATA * *-------------------------------------------------------------* MOVE LN-SUB TO W-LP-SUB (W-LP-INDX). MOVE H-NAT-COIN TO W-NAT-COIN (W-LP-INDX). MOVE H-MIN-COIN TO W-MIN-COIN (W-LP-INDX). MOVE H-SUB-CHRG TO W-SUB-CHRG (W-LP-INDX). MOVE H-APC-PYMT TO W-APC-PYMT (W-LP-INDX). MOVE H-WINX1 TO W-WINX1 (W-LP-INDX). MOVE H-RANK TO W-RANK (W-LP-INDX). MOVE H-PPCT TO W-PPCT (W-LP-INDX). MOVE H-DISC-RATE TO W-DISC-RATE (W-LP-INDX). *-------------------------------------------------------------* * PARTIAL HOSPITALIZATION LINES RECEIVE 1 SERVICE UNIT * *-------------------------------------------------------------* IF OPPS-SRVC-IND (LN-SUB) = ' P' THEN MOVE 1 TO W-SRVC-UNITS (W-LP-INDX) *-------------------------------------------------------------* * NON-PARTIAL HOSPITALIZATION LINES RECEIVE INPUT SVC UNITS * *-------------------------------------------------------------* ELSE MOVE H-SRVC-UNITS TO W-SRVC-UNITS (W-LP-INDX). *-------------------------------------------------------------* * SEARCH PROVIDER SPECIFIC FILE FOR THE LINE APC. * * IF FOUND, CALCULATE THE REDUCED COINSURANCE AMOUNT FOR * * THE LINE, ENTER IT INTO THE NEW COIN DEDUC TABLE REC, & * * RETURN CODE 25 * *-------------------------------------------------------------* MOVE 0 TO W-RED-COIN (W-LP-INDX). PERFORM VARYING PS-SUB FROM 1 BY 1 UNTIL PS-SUB > L-PSF-APC-LINE-CNT IF L-PSF-APC (PS-SUB) = OPPS-APC (LN-SUB) COMPUTE W-RED-COIN (W-LP-INDX) ROUNDED = L-PSF-RED-COIN (PS-SUB) * H-SRVC-UNITS * H-DISC-RATE MOVE 25 TO A-RETURN-CODE (LN-SUB) MOVE L-PSF-APC-LINE-CNT TO PS-SUB END-IF END-PERFORM. 9300-COIN-DEDUCT-EXIT. EXIT. *************************************************************** * * * MOVE THE EXISTING COINSURANCE DEDUCTIBLE RECORD WITH A * * HIGHER RANK UP ONE RECORD POSITION AND SET THE INDEX OF * * THE EMPTY RECORD FOR THE NEW ENTRY TO THE NEXT LOWER * * RECORD POSITION. * * * *************************************************************** 9350-STAGE-ENTRY. MOVE W-LP-ENTRY (W-LP-INDX - 1) TO W-LP-ENTRY (W-LP-INDX). SET W-LP-INDX DOWN BY 1. 9350-STAGE-ENTRY-EXIT. EXIT. *************************************************************** * * * POPULATE BLOOD DEDUCTIBLE TABLE WITH SERVICE LINES * * THAT HAVE A BLOOD DEDUCTIBLE HCPCS * * * *************************************************************** * * * ORDER SERVICES LINES BY DEDUCTIBLE SEQUENCE - * * 1. EARLIEST TO LATEST DATE OF SERVICE * * 2. LOWEST TO HIGHEST BLOOD RANK FROM BLOOD DEDUC TABLE * * * * DEDUCTIBLES WILL PAID FOR LINES IN THE ORDER OF DATE OF * * SERVICE (EARLIEST TO LATEST) AND THEN BY COST (LEAST TO * * MOST EXPENSIVE). ONLY VALID LINES WITH A HCPCS IN THE * * BLOOD DEDUCTIBLE RANKING TABLE APPEAR IN THIS TABLE. * * - BLOOD RANK OF 1 IS ASSIGNED TO THE LEAST EXPENSIVE * * BLOOD CODE * * - MOVE ALL LINE PRICING VARIABLES TO STAGING AREA * * (NEW BLOOD DEDUCTIBLE TABLE RECORD) * * * * NOTE: THE PURPOSE OF BLOOD LINE RANKING IS TO ENSURE * * THAT THE BENEFICIARY PAYS DEDUCTIBLES FOR THE * * THREE LEAST EXPENSIVE BLOOD PRODUCTS. * * * *************************************************************** 9375-BLOOD-DEDUCT. *-------------------------------------------------------------* * ADD 1 TO THE TOTAL TABLE RECORDS FOR THE NEW ENTRY * *-------------------------------------------------------------* ADD 1 TO W-BLD-MAX. *-------------------------------------------------------------* * MOVE TO THE NEW ENTRY POSITION (EMPTY RECORD) * *-------------------------------------------------------------* SET W-BD-INDX TO W-BLD-MAX. *-------------------------------------------------------------* * DETERMINE WHERE THE NEW SERVICE LINE SHOULD BE ENTERED INTO * * THE TABLE ACCORDING TO ITS RANK AND THE RANK OF THE RECORDS * * ALREADY IN THE TABLE - LOWEST TO HIGHEST RANK. * * (RANK IS THE DATE OF SERVICE & BLOOD RANK) * *-------------------------------------------------------------* PERFORM 9385-STAGE-ENTRY THRU 9385-STAGE-ENTRY-EXIT UNTIL W-BD-INDX = 1 OR H-BLD-RNK NOT < W-BD-RNK (W-BD-INDX - 1). *-------------------------------------------------------------* * POPULATE THE EMPTY RECORD WITH THE NEW SERVICE LINE'S DATA * *-------------------------------------------------------------* MOVE LN-SUB TO W-BD-SUB (W-BD-INDX). MOVE H-NAT-COIN TO W-BD-NAT-COIN (W-BD-INDX). MOVE H-MIN-COIN TO W-BD-MIN-COIN (W-BD-INDX). MOVE H-SUB-CHRG TO W-BD-SUB-CHRG (W-BD-INDX). MOVE H-APC-PYMT TO W-BD-APC-PYMT (W-BD-INDX). MOVE H-WINX1 TO W-BD-WINX1 (W-BD-INDX). MOVE H-BLOOD-RANK TO W-BD-RANK (W-BD-INDX). MOVE H-BLD-DOS TO W-BD-DOS (W-BD-INDX). MOVE H-PPCT TO W-BD-PPCT (W-BD-INDX). MOVE H-DISC-RATE TO W-BD-DISC-RATE (W-BD-INDX). MOVE H-SRVC-UNITS TO W-BD-SRVC-UNITS (W-BD-INDX). *-------------------------------------------------------------* * SEARCH PROVIDER SPECIFIC FILE FOR THE LINE APC. * * IF FOUND, CALCULATE THE REDUCED COINSURANCE AMOUNT FOR * * THE LINE, ENTER IT INTO THE NEW COIN DEDUC TABLE REC, & * * RETURN CODE 25 * *-------------------------------------------------------------* MOVE 0 TO W-BD-RED-COIN (W-BD-INDX). PERFORM VARYING PS-SUB FROM 1 BY 1 UNTIL PS-SUB > L-PSF-APC-LINE-CNT IF L-PSF-APC (PS-SUB) = OPPS-APC (LN-SUB) COMPUTE W-BD-RED-COIN (W-BD-INDX) ROUNDED = L-PSF-RED-COIN (PS-SUB) * H-SRVC-UNITS * H-DISC-RATE MOVE 25 TO A-RETURN-CODE (LN-SUB) MOVE L-PSF-APC-LINE-CNT TO PS-SUB END-IF END-PERFORM. 9375-BLOOD-DEDUCT-EXIT. EXIT. *************************************************************** * * * MOVE THE EXISTING BLOOD DEDUCTIBLE RECORD WITH A * * HIGHER RANK UP ONE RECORD POSITION AND SET THE INDEX OF * * THE EMPTY RECORD FOR THE NEW ENTRY TO THE NEXT LOWER * * RECORD POSITION. * * * *************************************************************** 9385-STAGE-ENTRY. MOVE W-BD-ENTRY (W-BD-INDX - 1) TO W-BD-ENTRY (W-BD-INDX). SET W-BD-INDX DOWN BY 1. 9385-STAGE-ENTRY-EXIT. EXIT. *************************************************************** * * * POPULATE PASS-THROUGH DEVICE TABLE * * (FOR ASSOCIATED PROCEDURE PAYMENT & CHARGE * * ADJUSTMENTS IN THE OUTLIER ROUTINE) * * (IMPLEMENTED IN APRIL 2008 PRICER) * * * *************************************************************** * * * ORDER RECORDS AS FOLLOWS - * * 1. HCPCS, ASCENDING * * 2. LOWEST TO HIGHEST LINE SUBSCRIPT * * * * 02/11/2008 - LOGIC ADDED FOR CY 2008, QTR 2 * * 11/12/2008 - LOGIC NOT CHANGED, NO CY 2009 PT DEVICES * * * *************************************************************** 9390-PASS-THRU-DEVICES. *-------------------------------------------------------------* * ADD 1 TO THE TOTAL TABLE RECORDS FOR THE NEW ENTRY * *-------------------------------------------------------------* ADD 1 TO W-PTD-MAX. *-------------------------------------------------------------* * MOVE TO THE NEW ENTRY POSITION (EMPTY RECORD) * *-------------------------------------------------------------* SET W-PTD-INDX TO W-PTD-MAX. INITIALIZE W-PTD-ENTRY (W-PTD-INDX). *-------------------------------------------------------------* * DETERMINE WHERE THE NEW RECORD SHOULD BE ENTERED INTO THE * * TABLE ACCORDING TO ITS HCPCS AND THE HCPCS OF THE RECORDS * * ALREADY IN THE TABLE - LOWEST TO HIGHEST HCPCS * *-------------------------------------------------------------* PERFORM 9391-STAGE-ENTRY THRU 9391-STAGE-ENTRY-EXIT UNTIL W-PTD-INDX = 1 OR W-PTD-LINE-HCPCS NOT < W-PTD-HCPCS (W-PTD-INDX - 1). *-------------------------------------------------------------* * POPULATE THE EMPTY RECORD WITH THE NEW SERVICE LINE'S DATA * *-------------------------------------------------------------* MOVE OPPS-HCPCS (LN-SUB) TO W-PTD-HCPCS (W-PTD-INDX). MOVE LN-SUB TO W-PTD-SUB (W-PTD-INDX). MOVE OPPS-SUB-CHRG (LN-SUB) TO W-PTD-SUB-CHRG (W-PTD-INDX). 9390-PASS-THRU-DEVICES-EXIT. EXIT. *************************************************************** * * * MOVE THE EXISTING PASS-THROUGH DEVICE RECORD WITH A * * HIGHER HCPCS UP ONE RECORD POSITION AND SET THE INDEX OF * * THE EMPTY RECORD FOR THE NEW ENTRY TO THE NEXT LOWER * * RECORD POSITION. * * * *************************************************************** 9391-STAGE-ENTRY. MOVE W-PTD-ENTRY (W-PTD-INDX - 1) TO W-PTD-ENTRY (W-PTD-INDX). SET W-PTD-INDX DOWN BY 1. 9391-STAGE-ENTRY-EXIT. EXIT. *************************************************************** * * * UPDATE PASS-THROUGH DEVICE TABLE WITH PROCEDURE DATA * * (IMPLEMENTED IN APRIL 2008 PRICER) * * * *************************************************************** * * * 02/11/2008 - LOGIC ADDED FOR CY 2008, QTR 2 * * * *************************************************************** 9392-PASS-THRU-DEV-PROCS. *-------------------------------------------------------------* * LOOP THROUGH ELIGIBLE PROCEDURE'S PASS-THROUGH DEVICE TABLE * *-------------------------------------------------------------* PERFORM 9393-PERFORM-SEARCH THRU 9393-PERFORM-SEARCH-EXIT VARYING W-PTD-PROC-SUB FROM 1 BY 1 UNTIL W-PTD-PROC-SUB > W-PTD-CNT. 9392-PASS-THRU-DEV-PROCS-EXIT. EXIT. *************************************************************** * * * SEARCH FOR THE PASS-THROUGH DEVICE FOR WHICH THE PROCEDURE * * IS ELIGIBLE IN THE TABLE * * * *************************************************************** 9393-PERFORM-SEARCH. *-------------------------------------------------------------* * SEARCH PTD TABLE STARTING AT ENTRY #1 FOR ALL OCCURANCES * * OF THE PASS-THRU DEVICE HCPCS IN THE PASS-THRU DEVICE TABLE.* * THIS IS DONE FOR ALL PASS-THROUGH DEVICES THE PROCEDURE IS * * ELIGIBLE FOR. * *-------------------------------------------------------------* MOVE 'N' TO W-END-OF-PTD-TBL. IF W-PTD-PROC-HCPCS (W-PTD-PROC-SUB) NOT = ' ' SET W-PTD-INDX TO 1 PERFORM 9394-SEARCH-PTD-HCPCS THRU 9394-SEARCH-PTD-HCPCS-EXIT UNTIL W-END-OF-PTD-TBL = 'Y' END-IF. 9393-PERFORM-SEARCH-EXIT. EXIT. *************************************************************** * * * SEARCH FOR THE PASS-THROUGH DEVICE FOR WHICH THE PROCEDURE * * IS ELIGIBLE IN THE TABLE * * * *************************************************************** 9394-SEARCH-PTD-HCPCS. MOVE 'N' TO W-END-OF-PTD-TBL. *-------------------------------------------------------------* * SEARCH PASS-THROUGH DEVICE TABLE * *-------------------------------------------------------------* SEARCH W-PTD-ENTRY VARYING W-PTD-INDX *-------------------------------------------------------------* * IF THERE ARE NO MORE OCCURANCES OF THE PASS-THROUGH DEVICE, * * STOP THE SEARCH AND INDICATE END OF FILE * *-------------------------------------------------------------* AT END MOVE 'Y' TO W-END-OF-PTD-TBL GO TO 9394-SEARCH-PTD-HCPCS-EXIT *-------------------------------------------------------------* * IF THE PASS-THROUGH DEVICE IS FOUND, INDICATE NOT END OF * * FILE AND UPDATE THE DEVICE'S RECORD WITH THE PROCEDURE DATA * *-------------------------------------------------------------* WHEN W-PTD-HCPCS (W-PTD-INDX) = W-PTD-PROC-HCPCS (W-PTD-PROC-SUB) MOVE 'N' TO W-END-OF-PTD-TBL PERFORM 9395-UPDATE-ENTRY THRU 9395-UPDATE-ENTRY-EXIT SET W-PTD-INDX UP BY 1 END-SEARCH. 9394-SEARCH-PTD-HCPCS-EXIT. EXIT. *************************************************************** * * * UPDATE THE EXISTING PASS-THROUGH DEVICE RECORD WITH THE * * CURRENT ELIGIBLE PROCEDURE'S DATA * * * *************************************************************** 9395-UPDATE-ENTRY. *-------------------------------------------------------------* * UPDATE PASS-THROUGH DEVICE RECORD * *-------------------------------------------------------------* ADD 1 TO W-PTD-PROC-CNT (W-PTD-INDX). ADD OPPS-SRVC-UNITS (LN-SUB) TO W-PTD-TOTAL-PROC-UNITS (W-PTD-INDX). 9395-UPDATE-ENTRY-EXIT. EXIT. *************************************************************** * * * SUM PASS-THROUGH CONTRAST AGENT OFFSET AMOUNT(S) FOR EACH * * DAY ON WHICH A PASS-THROUGH CONTRAST AGENT APPEARS * * * *************************************************************** 9396-TOTAL-DAY-PTCA-OFFS. *-------------------------------------------------------------* * CAPTURE DATE OF SERVICE FROM PT CONTRAST AGENT DAY TABLE * *-------------------------------------------------------------* MOVE W-PTCA-DAY-LIDOS (W-PTCA-DAY-INDX) TO W-CAPROC-SRVC-DATE. *-------------------------------------------------------------* * MOVE TO FIRST RECORD IN PT CONTRAST AGENT PROCEDURE APC TBL * *-------------------------------------------------------------* SET W-CAPROC-INDX TO 1. *-------------------------------------------------------------* * START COUNTER THAT MONITORS THE # OF OFFSETS ADDED * *-------------------------------------------------------------* MOVE 1 TO W-CAPROC-UNIT-CNT. SEARCH W-CAPROC-APC-ENTRY *-------------------------------------------------------------* * DATE OF SERVICE NOT FOUND IN TABLE, STOP PROCESS * *-------------------------------------------------------------* AT END GO TO 9396-TOTAL-DAY-PTCA-OFFS-EXIT *-------------------------------------------------------------* * DATE OF SERVICE FOUND IN TABLE, ACCUMULATE OFFSETS * *-------------------------------------------------------------* WHEN W-CAPROC-LIDOS (W-CAPROC-INDX) = W-CAPROC-SRVC-DATE PERFORM UNTIL * *-------------------------------------------------------* * * STOP SEARCH WHEN END OF TABLE REACHED * * *-------------------------------------------------------* (W-CAPROC-INDX > W-CAPROC-MAX) OR * *-------------------------------------------------------* * * STOP SEARCH WHEN NUMBER OF DAY'S HCPCS LINES EXCEEDED * * *-------------------------------------------------------* (W-CAPROC-UNIT-CNT > W-PTCA-DAY-HCPCS-CNT (W-PTCA-DAY-INDX)) OR * *-------------------------------------------------------* * * STOP SEARCH WHEN DATE OF SERVICE CHANGES * * *-------------------------------------------------------* (W-CAPROC-LIDOS (W-CAPROC-INDX) NOT = W-CAPROC-SRVC-DATE) * *-------------------------------------------------------* * * ADD PT CONTRAST AGENT PROCEDURE OFFSET TO DAY TOTAL * * *-------------------------------------------------------* COMPUTE W-PTCA-DAY-TOT-OFFSET (W-PTCA-DAY-INDX) ROUNDED = W-PTCA-DAY-TOT-OFFSET (W-PTCA-DAY-INDX) + W-CAPROC-WAGE-ADJ-OFFSET (W-CAPROC-INDX) * *-------------------------------------------------------* * * SET POINTER TO NEXT PROCEDURE RECORD * * *-------------------------------------------------------* SET W-CAPROC-INDX UP BY 1 ADD 1 TO W-CAPROC-UNIT-CNT END-PERFORM END-SEARCH. 9396-TOTAL-DAY-PTCA-OFFS-EXIT. EXIT. *************************************************************** * * * MAP EACH PT DEVICE HCPCS ON THE CLAIM TO AN OFFSET * * PROCEDURE WHEN POSSIBLE - FIRST PASS: ASSIGN EACH PROCEDURE * * ONLY ONE PT DEVICE * * * *************************************************************** 9397-PTDO-MAPPINGS-1. *-------------------------------------------------------------* * INITIALIZE VARIABLES SPECIFIC TO THIS PT HCPCS RECORD * *-------------------------------------------------------------* MOVE 'N' TO W-PTDO-EOF-SWITCH. SET W-PTDO-PROC-INDX TO 1. *-------------------------------------------------------------* * SEARCH PTDO PROCEDURE TABLE FOR A PROCEDURE THAT MAPS TO * * THE CURRENT PT DEVICE * *-------------------------------------------------------------* PERFORM UNTIL W-PTDO-EOF-SWITCH = 'Y' SEARCH W-PTDO-PROC-ENTRY AT END MOVE 'Y' TO W-PTDO-EOF-SWITCH GO TO 9397-PTDO-MAPPINGS-1-EXIT *-------------------------------------------------------------* * PROCEDURE NOT ASSIGNED TO A PT DEVICE, SEE IF IT MAPS * *-------------------------------------------------------------* WHEN W-PTDO-PROC-USED (W-PTDO-PROC-INDX) NOT = 'Y' SET W-PTDO-DARRAY-INDX TO 1 MOVE W-PTDO-DARRAY-SIZE (W-PTDO-PROC-INDX) TO W-PTDO-DARRAY-MAX SEARCH W-PTDO-PROC-DARRAY AT END CONTINUE *-------------------------------------------------------------* * PROCEDURE MAPS TO CURRENT PT DEVICE HCPCS * *-------------------------------------------------------------* WHEN W-PTDO-PROC-DHCPCS (W-PTDO-PROC-INDX, W-PTDO-DARRAY-INDX) = W-PTDO-HCPCS-HCPCS (W-PTDO-HCPCS-INDX) MOVE W-PTDO-PROC-APC (W-PTDO-PROC-INDX) TO W-PTDO-HCPCS-PROC-APC (W-PTDO-HCPCS-INDX) MOVE W-PTDO-PROC-LNSUB (W-PTDO-PROC-INDX) TO W-PTDO-HCPCS-PROC-LNSUB (W-PTDO-HCPCS-INDX) MOVE 'Y' TO W-PTDO-PROC-USED (W-PTDO-PROC-INDX) MOVE 1 TO W-PTDO-PROC-DEVICE-CNT (W-PTDO-PROC-INDX) MOVE W-PTDO-HCPCS-SUB-CHRG (W-PTDO-HCPCS-INDX) TO W-PTDO-PROC-TOT-DCHRGS (W-PTDO-PROC-INDX) MOVE W-PTDO-HCPCS-UNITS (W-PTDO-HCPCS-INDX) TO W-PTDO-PROC-TOT-DUNITS (W-PTDO-PROC-INDX) GO TO 9397-PTDO-MAPPINGS-1-EXIT END-SEARCH SET W-PTDO-PROC-INDX UP BY 1 END-SEARCH END-PERFORM. 9397-PTDO-MAPPINGS-1-EXIT. EXIT. *************************************************************** * * * MAP EACH PT DEVICE HCPCS ON THE CLAIM TO AN OFFSET * * PROCEDURE WHEN POSSIBLE - SECOND PASS: ASSIGN PROCEDURES * * ADDITIONAL PT DEVICES WHEN NECESSARY * * * *************************************************************** 9397-PTDO-MAPPINGS-2. *-------------------------------------------------------------* * DETERMINE WHETHER THE PT DEVICE HCPCS NEEDS A PROCEDURE * *-------------------------------------------------------------* IF W-PTDO-HCPCS-PROC-CNT (W-PTDO-HCPCS-INDX) > 0 AND W-PTDO-HCPCS-PROC-APC (W-PTDO-HCPCS-INDX) = SPACES CONTINUE ELSE GO TO 9397-PTDO-MAPPINGS-2-EXIT END-IF. SET W-PTDO-PROC-INDX TO 1. *-------------------------------------------------------------* * INITIALIZE VARIABLES SPECIFIC TO THIS PT HCPCS RECORD * *-------------------------------------------------------------* MOVE 'N' TO W-PTDO-EOF-SWITCH. *-------------------------------------------------------------* * SEARCH PTDO PROCEDURE TABLE FOR A PROCEDURE THAT MAPS TO * * THE CURRENT PT DEVICE * *-------------------------------------------------------------* PERFORM UNTIL W-PTDO-EOF-SWITCH = 'Y' SEARCH W-PTDO-PROC-ENTRY AT END MOVE 'Y' TO W-PTDO-EOF-SWITCH GO TO 9397-PTDO-MAPPINGS-2-EXIT *-------------------------------------------------------------* * PROCEDURE ALREADY ASSIGNED TO PT DEVICE(S) * *-------------------------------------------------------------* WHEN W-PTDO-PROC-USED (W-PTDO-PROC-INDX) = 'Y' OR W-PTDO-PROC-USED (W-PTDO-PROC-INDX) = 'S' SET W-PTDO-DARRAY-INDX TO 1 MOVE W-PTDO-DARRAY-SIZE (W-PTDO-PROC-INDX) TO W-PTDO-DARRAY-MAX SEARCH W-PTDO-PROC-DARRAY AT END CONTINUE *-------------------------------------------------------------* * PROCEDURE MAPS TO CURRENT PT DEVICE HCPCS, SEE IF IT MAPS * *-------------------------------------------------------------* WHEN W-PTDO-PROC-DHCPCS (W-PTDO-PROC-INDX, W-PTDO-DARRAY-INDX) = W-PTDO-HCPCS-HCPCS (W-PTDO-HCPCS-INDX) MOVE W-PTDO-PROC-APC (W-PTDO-PROC-INDX) TO W-PTDO-HCPCS-PROC-APC (W-PTDO-HCPCS-INDX) MOVE W-PTDO-PROC-LNSUB (W-PTDO-PROC-INDX) TO W-PTDO-HCPCS-PROC-LNSUB (W-PTDO-HCPCS-INDX) MOVE 'S' TO W-PTDO-PROC-USED (W-PTDO-PROC-INDX) ADD 1 TO W-PTDO-PROC-DEVICE-CNT (W-PTDO-PROC-INDX) COMPUTE W-PTDO-PROC-TOT-DCHRGS (W-PTDO-PROC-INDX) = W-PTDO-PROC-TOT-DCHRGS (W-PTDO-PROC-INDX) + W-PTDO-HCPCS-SUB-CHRG (W-PTDO-HCPCS-INDX) COMPUTE W-PTDO-PROC-TOT-DUNITS (W-PTDO-PROC-INDX) = W-PTDO-PROC-TOT-DUNITS (W-PTDO-PROC-INDX) + W-PTDO-HCPCS-UNITS (W-PTDO-HCPCS-INDX) GO TO 9397-PTDO-MAPPINGS-2-EXIT END-SEARCH SET W-PTDO-PROC-INDX UP BY 1 END-SEARCH END-PERFORM. 9397-PTDO-MAPPINGS-2-EXIT. EXIT. *************************************************************** * * * CALCULATE LINE PYMNTS, DEDUCTIBLES, REIM., & COINSURANCE, * * ACCUMULATE CLAIM TOTALS, POPULATE DRUG DEDUCTIBLE TABLE, * * UPDATE PASS-THROUGH DEVICE TABLE WITH PROCEDURE & DEVICE * * LINE DATA, MOVE LINE VALUES TO VARIABLES TO BE PASSED BACK * * * *************************************************************** * * * LOOP THROUGH THE COINSURANCE DEDUCTIBLE TABLE TO DO THE * * FOLLOWING FOR EACH SERVICE LINE: * * * * - CHECK ALL APPROPRIATE FLAGS AND INDICATORS FROM OCE * * - SET RETURN CODES TO INDICATE ERRORS OR STATUS * * '20' - LINE PROCESSED BUT PAYMENT = 0, * * BENE DEDUCTIBLE => ADJUSTED PAYMENT * * - CALCULATE & ACCUMULATE LINE AND CLAIM LEVEL ITEMS * * - POPULATE DRUG COINSURANCE TABLE * * - MOVE LINE VARIABLE VALUES TO VARIABLES TO BE PASSED BACK * * * *************************************************************** 9400-CALCULATE. *-------------------------------------------------------------* * SET THE SERVICE LINE SUBSCRIPT TO THE CLAIM SERVICE LINE # * * ASSOCIATED WITH THE COINSURANCE DEDUCTIBLE TABLE RECORD * *-------------------------------------------------------------* MOVE W-LP-SUB (W-LP-INDX) TO LN-SUB. *-------------------------------------------------------------* * STOP PROCESSING LINE IF ERROR CODE * *-------------------------------------------------------------* IF A-RETURN-CODE (LN-SUB) > 25 GO TO 9400-CALCULATE-EXIT. *-------------------------------------------------------------* * CALCULATE THE FOLLOWING FOR VALID LINES IN THE COINSURANCE * * DEDUCTIBLE TABLE WITH A PAYABLE STATUS: * * - LINE ITEM PAYMENT (BASED ON LINE SERVICE INDICATOR) * * - BENEFICIARY DEDUCTIBLE (IN ORDER OF APC RANK) * * - MINIMUM, MAXIMUM, AND REDUCED COINSURANCE AMOUNTS * * - LINE ITEM REIMBURSEMENT IF MAX COIN LIMIT EXCEEDED * *-------------------------------------------------------------* IF OPPS-PYMT-IND (LN-SUB) = ' 1' OR ' 5' OR ' 6' OR ' 7' OR ' 8' PERFORM 9550-CALC-STANDARD THRU 9550-CALC-STANDARD-EXIT ELSE GO TO 9400-CALCULATE-EXIT. *-------------------------------------------------------------* * POPULATE DRUG COINSURANCE TABLE FOR LATER PROCESSING * * - ENFORCE INPATIENT COINSURANCE LIMIT * * - SET GJK-FLAG WHEN SERVICE = G OR K * *-------------------------------------------------------------* IF (A-RETURN-CODE (LN-SUB) < 30) PERFORM 9450-ADJ-PROC-COIN THRU 9450-ADJ-PROC-COIN-EXIT ELSE NEXT SENTENCE. *-------------------------------------------------------------* * FLAG CLAIMS WITH ARTIFICIAL CHARGES AND TOTAL PAYMENTS & * * CHARGES FOR ARTIFICIAL CHARGE AND PACKAGING PROCESSING * *-------------------------------------------------------------* PERFORM 9500-ADJ-CHRGS THRU 9500-ADJ-CHRGS-EXIT. *-------------------------------------------------------------* * UPDATE PASS-THROUGH DEVICE TABLE W/ ELIGIBLE PROCEDURE * * LINE DATA (FOR ASSOCIATED PROCEDURE OUTLIER CALC) * * EFFECTIVE CY 2008 QTR 2, LOGIC ADDED 02/12/2008 * *-------------------------------------------------------------* IF A-RETURN-CODE (LN-SUB) < 30 AND PTD-FLAG = 'Y' AND OPPS-SRVC-IND (LN-SUB) = ' S' OR ' T' OR ' V' OR ' X' PERFORM 9670-SET-PTD-PROC-FLAG THRU 9670-SET-PTD-PROC-FLAG-EXIT IF PTD-PROC-FLAG = 'Y' PERFORM 9392-PASS-THRU-DEV-PROCS THRU 9392-PASS-THRU-DEV-PROCS-EXIT END-IF END-IF. *-------------------------------------------------------------* * ACCUMULATE CLAIM TOTALS USING DATA FROM THE CURRENT VALID * * SERVICE LINE (IN THE COINSURANCE DEDUCTIBLE TABLE) * *-------------------------------------------------------------* IF A-RETURN-CODE (LN-SUB) < 30 COMPUTE A-TOTAL-CLM-DEDUCT = H-TOTAL-LN-DEDUCT + A-TOTAL-CLM-DEDUCT COMPUTE H-TOT-PYMT = H-TOT-PYMT + H-LITEM-PYMT COMPUTE A-BLOOD-DEDUCT-DUE = A-BLOOD-DEDUCT-DUE + H-LN-BLOOD-DEDUCT *-------------------------------------------------------------* * MOVE LINE VALUES TO VARIABLES TO BE PASSED BACK * * - THE LINE REIM. & ADJ-COIN IS ADJUSTED LATER (IF NEEDED) * * FOR THE INPATIENT DAILY LIMIT IN 9840-PROCESS-TYPE2 * *-------------------------------------------------------------* MOVE H-LITEM-PYMT TO A-LITEM-PYMT (LN-SUB) MOVE H-LITEM-REIM TO A-LITEM-REIM (LN-SUB) MOVE H-TOTAL-LN-DEDUCT TO A-TOTAL-LN-DEDUCT (LN-SUB) MOVE H-LN-BLOOD-DEDUCT TO A-BLOOD-LN-DEDUCT (LN-SUB) MOVE H-NAT-COIN TO A-ADJ-COIN (LN-SUB) MOVE H-RED-COIN TO A-RED-COIN (LN-SUB) IF H-RED-COIN > H-NAT-COIN MOVE H-NAT-COIN TO A-RED-COIN (LN-SUB) END-IF IF OPPS-LITEM-ACT-FLAG (LN-SUB) = '4' MOVE 0 TO A-LITEM-PYMT (LN-SUB) MOVE 0 TO A-LITEM-REIM (LN-SUB) COMPUTE H-TOT-PYMT = H-TOT-PYMT - H-LITEM-PYMT END-IF END-IF. *-------------------------------------------------------------* * INITIALIZE LINE VARIABLES FOR THE NEXT SERVICE LINE IN THE * * COINSURANCE DEDUCTIBLE TABLE * *-------------------------------------------------------------* MOVE ZERO TO LINE-HOLD-ITEMS. 9400-CALCULATE-EXIT. EXIT. *************************************************************** * * * POPULATE DRUG COINSURANCE ROLL-UP TABLE WITH THE * * COINSURANCE AMOUNTS OF SERVICE LINES IN THE COINSURANCE * * DEDUCTIBLE TABLE * * * *************************************************************** * * * ORDER LINES BY: * * 1. DATE OF SERVICE (EARLIEST TO LATEST) * * 2. DCP-CODE - TYPE OF ENTRY BASED ON SERVICE INDICATOR * * DCP-CODE OF 1: DAY SUMMARY * * DCP-CODE OF 2: DRUG / BLOOD LINE * * THERE IS ONE TYPE 1 RECORD PER DAY; THERE MAY BE MULTIPLE * * TYPE 2 RECORDS PER DAY - ONE FOR EVERY DRUG LINE * * ("DRUG" REFERS TO ANY SI = G OR K LINE FOR SIMPLICITY) * * * * DRUG COINSURANCE RECORD COMBINATIONS: * * - TYPE 1, COIN1 = 0, COIN2 > 0, & SI = X => * * DRUG(S) ADMINISTERED INDEPENDENT OF A PROCEDURE VISIT * * ON THE DATE OF SERVICE * * - TYPE 1, COIN1 > 0, COIN2 = 0, & SI = S, V, OR T => * * PROCEDURE / VISIT WITH NO DRUG(S) ADMINISTERED ON THE * * DATE OF SERVICE * * - TYPE 1, COIN1 > 0, COIN2 > 0, & SI = S, V, OR T => * * PROCEDURE / VISIT WITH DRUG(S) ADMINISTERED ON THE * * DATE OF SERVICE * * - TYPE 2, COIN1 = 0, COIN2 > 0, & SI = G OR K => * * DRUG ADMINSTERED ON THE DATE OF SERVICE * * * *************************************************************** 9450-ADJ-PROC-COIN. *************************************************************** * MOVE LINE DATE OF SERVICE TO DATE OF SERVICE HOLD AREA * *************************************************************** MOVE OPPS-LITEM-DOS (LN-SUB) TO H-DCP-DOS. *************************************************************** * * * PROCESS SI = S, T, OR V LINES (PROCEDURE OR VISIT) * * * *************************************************************** IF OPPS-SRVC-IND (LN-SUB) = ' S' OR ' T' OR ' V' *-------------------------------------------------------------* * CALCULATE WAGE ADJUSTED LINE NATIONAL COINSURANCE AMOUNT * *-------------------------------------------------------------* COMPUTE H-NEW-WGNAT ROUNDED = W-NAT-COIN (W-LP-INDX) * (.6 * W-WINX1 (W-LP-INDX) + .4) *-------------------------------------------------------------* * ENFORCE INPATIENT LIMIT ON NATIONAL COINSURANCE AMOUNT * *-------------------------------------------------------------* IF H-NEW-WGNAT > H-IP-LIMIT MOVE H-IP-LIMIT TO H-NEW-WGNAT END-IF *-------------------------------------------------------------* * CALCULATE LINE NEW COINSURANCE AMOUNT (ACTUAL COIN DUE) * *-------------------------------------------------------------* COMPUTE H-NEW-COIN = H-LITEM-PYMT - H-TOTAL-LN-DEDUCT - H-LITEM-REIM - H-LN-BLOOD-DEDUCT *-------------------------------------------------------------* * INDICATE TYPE 1 RECORD (ONE TYPE 1 RECORD PER DAY) * *-------------------------------------------------------------* MOVE 1 TO H-DCP-CODE *-------------------------------------------------------------* * ADD OR UPDATE DRUG COINSURANCE TABLE ENTRY FOR THE DOS * *-------------------------------------------------------------* PERFORM 9455-SEARCH-KEY THRU 9455-SEARCH-KEY-EXIT *************************************************************** * * * PROCESS SI = G, K, & R LINES ("DRUG" & BLOOD) * * * *************************************************************** ELSE IF OPPS-SRVC-IND (LN-SUB) = ' G' OR ' K' OR ' R' *-------------------------------------------------------------* * CALCULATE LINE NEW COINSURANCE AMOUNT (ACTUAL COIN DUE) * *-------------------------------------------------------------* COMPUTE H-NEW-COIN = H-LITEM-PYMT - H-TOTAL-LN-DEDUCT - H-LITEM-REIM - H-LN-BLOOD-DEDUCT *-------------------------------------------------------------* * SET GJK-FLAG TO INDICATE "DRUG" LINE * *-------------------------------------------------------------* MOVE 'Y' TO GJK-FLAG *-------------------------------------------------------------* * INDICATE TYPE 1 RECORD (ONE TYPE 1 RECORD PER DAY) * *-------------------------------------------------------------* MOVE 1 TO H-DCP-CODE *-------------------------------------------------------------* * ADD OR UPDATE DRUG COINSURANCE TABLE ENTRY FOR THE DOS * *-------------------------------------------------------------* PERFORM 9455-SEARCH-KEY THRU 9455-SEARCH-KEY-EXIT *-------------------------------------------------------------* * INDICATE TYPE 2 RECORD (ONE TYPE 2 REC FOR EVERY DRUG LINE) * *-------------------------------------------------------------* MOVE 2 TO H-DCP-CODE *-------------------------------------------------------------* * INCREASE THE TOTAL NUMBER OF TABLE RECORDS FOR NEW ENTRY * *-------------------------------------------------------------* ADD 1 TO W-DCP-MAX *-------------------------------------------------------------* * MOVE TO THE NEW ENTRY POSITION (EMPTY RECORD) * * A NEW TYPE 2 RECORD ENTRY IS CREATED FOR EVERY SI = G OR K * * SERVICE LINE REGARDLESS OF THE DATE OF SERVICE * *-------------------------------------------------------------* SET W-DCP-INDX TO W-DCP-MAX *-------------------------------------------------------------* * DETERMINE WHERE THE NEW DRUG / DEVICE COINSURANCE ENTRY * * FOR THE CURRENT SERVICE LINE SHOULD BE ENTERED INTO THE * * TABLE ACCORDING TO ITS DATE OF SERVICE AND RECORD TYPE * * COMBO KEY - LOWEST TO HIGHEST KEY. (RECORD TYPE 2 ONLY) * *-------------------------------------------------------------* PERFORM 9475-STAGE-DCP-ENTRY THRU 9475-STAGE-DCP-ENTRY-EXIT UNTIL W-DCP-INDX = 1 OR H-DCP-STAGE NOT < W-DCP-STAGE (W-DCP-INDX - 1) *-------------------------------------------------------------* * POPULATE THE EMPTY RECORD WITH THE NEW SERVICE LINE'S DATA * * RECORD TYPE 2, "DRUG" * *-------------------------------------------------------------* MOVE LN-SUB TO W-DCP-SUB (W-DCP-INDX) MOVE H-DCP-STAGE TO W-DCP-STAGE (W-DCP-INDX) MOVE ZERO TO W-DCP-COIN1 (W-DCP-INDX) MOVE ZERO TO W-DCP-WGNAT (W-DCP-INDX) MOVE H-NEW-COIN TO W-DCP-COIN2 (W-DCP-INDX) MOVE OPPS-SRVC-IND (LN-SUB) TO W-DCP-SRVC-IND (W-DCP-INDX). 9450-ADJ-PROC-COIN-EXIT. EXIT. *************************************************************** * * * DETERMINE WHETHER A NEW DRUG/DEVICE COINSURANCE TABLE * * RECORD SHOULD BE ADDED OR IF AN EXISITING RECORD NEEDS TO * * BE UPDATED * * * * (RECORD KEY IS DATE OF SERVICE & RECORD TYPE) * * * *************************************************************** 9455-SEARCH-KEY. *-------------------------------------------------------------* * SEARCH DRUG/DEVICE COINSURANCE TABLE STARTING AT ENTRY #1 * *-------------------------------------------------------------* SET W-DCP-INDX TO 1. SEARCH W-DCP-ENTRY VARYING W-DCP-INDX *-------------------------------------------------------------* * IF THE SERVICE LINE'S DATE OF SERVICE AND RECORD TYPE COMBO * * IS NOT ALREADY IN THE TABLE, ADD IT * *-------------------------------------------------------------* AT END PERFORM 9460-ADD-ENTRY THRU 9460-ADD-ENTRY-EXIT *-------------------------------------------------------------* * IF THE SERVICE LINE'S DATE OF SERVICE AND RECORD TYPE COMBO * * IS ALREADY IN THE TABLE, UPDATE THE ENTRY * *-------------------------------------------------------------* WHEN W-DCP-STAGE (W-DCP-INDX) = H-DCP-STAGE PERFORM 9465-UPDATE-ENTRY THRU 9465-UPDATE-ENTRY-EXIT. 9455-SEARCH-KEY-EXIT. EXIT. *************************************************************** * * * INSERT THE NEW COINSURANCE RECORD INTO THE CORRECT POSITION * * (LOWEST TO HIGHEST DATE OF SERVICE - RECORD TYPR COMBO) OF * * THE DRUG / DEVICE COINSURANCE TABLE * * (ONLY PROCESSES TYPE 1 RECORDS) * * * *************************************************************** 9460-ADD-ENTRY. *-------------------------------------------------------------* * INCREASE THE TOTAL NUMBER OF TABLE RECORDS FOR NEW ENTRY * *-------------------------------------------------------------* ADD 1 TO W-DCP-MAX. *-------------------------------------------------------------* * MOVE TO THE NEW ENTRY POSITION (EMPTY RECORD) * *-------------------------------------------------------------* SET W-DCP-INDX TO W-DCP-MAX. *-------------------------------------------------------------* * DETERMINE WHERE THE NEW DRUG / DEVICE COINSURANCE ENTRY * * FOR THE CURRENT SERVICE LINE SHOULD BE ENTERED INTO THE * * TABLE ACCORDING TO ITS DATE OF SERVICE AND RECORD TYPE * * COMBO KEY - LOWEST TO HIGHEST KEY. (TYPE 1 RECORDS ONLY) * *-------------------------------------------------------------* PERFORM 9475-STAGE-DCP-ENTRY THRU 9475-STAGE-DCP-ENTRY-EXIT UNTIL W-DCP-INDX = 1 OR H-DCP-STAGE NOT < W-DCP-STAGE (W-DCP-INDX - 1). *-------------------------------------------------------------* * POPULATE THE EMPTY RECORD WITH THE NEW SERVICE LINE'S DATA * * RECORD TYPE 1, "DRUG" * *-------------------------------------------------------------* IF OPPS-SRVC-IND (LN-SUB) = ' G' OR ' K' OR ' R' MOVE ZERO TO W-DCP-SUB (W-DCP-INDX) MOVE H-DCP-STAGE TO W-DCP-STAGE (W-DCP-INDX) MOVE ZERO TO W-DCP-COIN1 (W-DCP-INDX) MOVE ZERO TO W-DCP-WGNAT (W-DCP-INDX) MOVE H-NEW-COIN TO W-DCP-COIN2 (W-DCP-INDX) MOVE ' X' TO W-DCP-SRVC-IND (W-DCP-INDX) *-------------------------------------------------------------* * POPULATE THE EMPTY RECORD WITH THE NEW SERVICE LINE'S DATA * * RECORD TYPE 1, PROCEDURE OR VISIT * *-------------------------------------------------------------* ELSE MOVE LN-SUB TO W-DCP-SUB (W-DCP-INDX) MOVE H-DCP-STAGE TO W-DCP-STAGE (W-DCP-INDX) MOVE H-NEW-COIN TO W-DCP-COIN1 (W-DCP-INDX) MOVE H-NEW-WGNAT TO W-DCP-WGNAT (W-DCP-INDX) MOVE ZERO TO W-DCP-COIN2 (W-DCP-INDX) MOVE OPPS-SRVC-IND (LN-SUB) TO W-DCP-SRVC-IND (W-DCP-INDX). 9460-ADD-ENTRY-EXIT. EXIT. *************************************************************** * * * UPDATE THE EXISTING DRUG COINSURANCE RECORD WITH THE SAME * * DATE OF SERVICE AND RECORD TYPE OF THE CURRENT SERVICE LINE * * (ONLY PROCESSES TYPE 1 RECORDS) * * * *************************************************************** 9465-UPDATE-ENTRY. *-------------------------------------------------------------* * FOR "DRUG" LINES - ACCUMULATE DAY'S TOTAL "DRUG" COIN DUE * *-------------------------------------------------------------* IF OPPS-SRVC-IND (LN-SUB) = ' G' OR ' K' OR ' R' ADD H-NEW-COIN TO W-DCP-COIN2 (W-DCP-INDX) *-------------------------------------------------------------* * FOR PROCEDURE & VISIT LINES - WHEN THE EXISITING RECORD WAS * * WAS INITIALLY CREATED FOR A "DRUG" LINE, UPDATE THE RECORD * *-------------------------------------------------------------* ELSE IF W-DCP-SRVC-IND (W-DCP-INDX) = ' X' PERFORM 9485-REPLACE-TYPE1 THRU 9485-REPLACE-TYPE1-EXIT *-------------------------------------------------------------* * FOR PROCEDURE & VISIT LINES - WHEN THE EXISTING RECORD HAS * * DATA FROM ANOTHER PROCEDURE / VISIT, ENSURE THE PROC/VISIT * * WITH THE HIGHEST WAGE ADJUSTED NATIONAL COIN IS IN THE TBL * *-------------------------------------------------------------* ELSE PERFORM 9480-RANK-COIN THRU 9480-RANK-COIN-EXIT. 9465-UPDATE-ENTRY-EXIT. EXIT. *************************************************************** * * * MOVE THE EXISTING DRUG COINSURANCE RECORD WITH A HIGHER * * RANK UP ONE RECORD POSITION AND SET THE INDEX OF THE EMPTY * * RECORD FOR THE NEW ENTRY TO THE NEXT LOWER RECORD POSITION. * * * *************************************************************** 9475-STAGE-DCP-ENTRY. MOVE W-DCP-ENTRY (W-DCP-INDX - 1) TO W-DCP-ENTRY (W-DCP-INDX). SET W-DCP-INDX DOWN BY 1. 9475-STAGE-DCP-ENTRY-EXIT. EXIT. *************************************************************** * * * ENSURE THAT THE PROCEDURE/VISIT WITH THE HIGHEST WAGE ADJ. * * NATIONAL COINSURANCE AMOUNT IS IN THE TABLE WHEN THERE ARE * * MULTIPLE PROCEDURES/VISITS ON THE SAME DATE OF SERVICE. * * ONLY ONE PROCEDURE/VISIT'S DATA PER DAY APPEARS IN THE TBL. * * (ONLY PROCESSES TYPE 1 RECORDS) * * * *************************************************************** 9480-RANK-COIN. IF H-NEW-WGNAT > W-DCP-WGNAT (W-DCP-INDX) MOVE LN-SUB TO W-DCP-SUB (W-DCP-INDX) MOVE H-NEW-COIN TO W-DCP-COIN1 (W-DCP-INDX) MOVE H-NEW-WGNAT TO W-DCP-WGNAT (W-DCP-INDX) MOVE OPPS-SRVC-IND (LN-SUB) TO W-DCP-SRVC-IND (W-DCP-INDX). 9480-RANK-COIN-EXIT. EXIT. *************************************************************** * * * ENTER VALUES FROM THE CURRENT SI = S, V, OR T SERVICE LINE * * INTO AN EXISITING RECORD THAT WAS FORMERLY AN SI = G OR K * * ONLY ENTRY. * * - SERVICE LINE REFERENCES CURRENT PROCEDURE / VISIT LINE * * - COIN1 = PROCEDURE / VISIT LINE NEW COINSURANCE AMOUNT * * - COIN2 = DRUG / BLOOD LINE NEW COINSURANCE AMOUNT(S) * * - WAGE ADJUSTED NATIONAL COIN OF CURRENT LINE ENTERED * * - SERVICE INDICATOR = SI OF CURRENT LINE (S, V, OR T) * * * *************************************************************** 9485-REPLACE-TYPE1. MOVE LN-SUB TO W-DCP-SUB (W-DCP-INDX) MOVE H-NEW-COIN TO W-DCP-COIN1 (W-DCP-INDX) MOVE H-NEW-WGNAT TO W-DCP-WGNAT (W-DCP-INDX) MOVE OPPS-SRVC-IND (LN-SUB) TO W-DCP-SRVC-IND (W-DCP-INDX). 9485-REPLACE-TYPE1-EXIT. EXIT. *************************************************************** * * * IDENTIFY CLAIMS THAT HAVE SIGNIFICANT PROCEDURE (SURGERY) * * LINE(S) WITH ARTIFICIAL CHARGES FOR FURTHER PROCESSING, * * ACCUMULATE TOTAL CLAIM PAYMENTS AND CHARGES FOR SIGNIFICANT * * PROCEDURE LINES, AND ACCUMULATE TOTAL CLAIM CHARGES OF ALL * * SEPARATELY PAYABLE LINES. (THE FLAG AND CLAIM TOTALS ARE * * USED IN PARAGRAPH 9600-ADJ-CHRG-OUTL.) * * * *************************************************************** 9500-ADJ-CHRGS. *************************************************************** ** NEW LOGIC INSERTED FOR WEB USE ONLY * *************************************************************** *-------------------------------------------------------------* * FLAG CLAIM WHEN A SIGNIFICANT PROCEDURE LINE HAS ARTIFICIAL * * CHARGES ($1 OR LESS) - FLAGS ENTIRE CLAIM * *-------------------------------------------------------------* * NOTE: LINES WITH CHARGES < $1.01 ARE FIXED BY FISS BEFORE * * ENTERING THE PRICER. THEREFORE, THIS LOGIC IS NO * * LONGER NECESSARY. THIS LOGIC WAS NECESSARY BEFORE * * FISS IMPLEMENTED THE FIX. * *-------------------------------------------------------------* IF ((OPPS-SRVC-IND (LN-SUB) = ' T') OR ((OPPS-SRVC-IND (LN-SUB) = ' S') AND (OPPS-HCPCS (LN-SUB) > '09999' AND OPPS-HCPCS (LN-SUB) < '70000'))) AND (W-SUB-CHRG (W-LP-INDX) < 1.01) MOVE 'Y' TO ST0-FLAG. *-------------------------------------------------------------* * ACCUMULATE TOTAL CLAIM CHARGES AND PAYMENTS FROM UNPACKAGED * * SIGNIFICANT PROCEDURE (SURGERY) LINES * *-------------------------------------------------------------* IF ((OPPS-SRVC-IND (LN-SUB) = ' T') OR ((OPPS-SRVC-IND (LN-SUB) = ' S') AND (OPPS-HCPCS (LN-SUB) > '09999' AND OPPS-HCPCS (LN-SUB) < '70000'))) AND (OPPS-PKG-FLAG (LN-SUB) = '0' OR '3') COMPUTE H-TOT-ST-CHRG = W-SUB-CHRG (W-LP-INDX) + H-TOT-ST-CHRG COMPUTE H-TOT-ST-PYMT = H-LITEM-PYMT + H-TOT-ST-PYMT. *-------------------------------------------------------------* * ACCUMULATE TOTAL CLAIM PAYMENTS FROM UNPACKAGED SEPARATELY * * PAYABLE LINES (FOR PACKAGING LATER) * *-------------------------------------------------------------* * 12/18/2009 - ADD SIS R & U, WHICH ARE ELIGIBLE FOR OUTLIER * *-------------------------------------------------------------* IF (OPPS-SRVC-IND (LN-SUB) = ' S' OR ' T' OR ' V' OR ' X' OR ' P' OR ' R' OR ' U') AND (OPPS-PKG-FLAG (LN-SUB) = '0' OR '3') COMPUTE H-TOT-STVX-PYMT = H-LITEM-PYMT + H-TOT-STVX-PYMT. 9500-ADJ-CHRGS-EXIT. EXIT. *************************************************************** * * * CALCULATE THE FOLLOWING FOR VALID LINES IN THE COINSURANCE * * DEDUCTIBLE TABLE WITH A PAYABLE STATUS: * * - LINE ITEM PAYMENT (BASED ON LINE SERVICE INDICATOR) * * - BENEFICIARY DEDUCTIBLE (IN ORDER OF APC RANK) * * - MINIMUM, MAXIMUM, AND REDUCED COINSURANCE AMOUNTS * * * *************************************************************** * * * 1. CALCULATE STANDARD LINE ITEM PAYMENT (LINE PRICE) * * (APC PAYMENT * WAGE INDEX * SERVICE UNITS * * * DISCOUNT FACTOR) * * WAGE ADJUST 60% OF THE APC PAYMENT FOR SI = S, V, T, P, * * OR X LINES, THESE ARE ELIGIBLE FOR THE SCH ADJUSTMENT * * 2. APPLY DEDUCTIBLE TO HIGHEST NATIONAL COINSURANCE AMOUNT * * DESCENDING UNTIL DEDUCTIBLE = 0. * * 3. ADD LINE PRICE TO OUTLIER HOLD AREA * * 4. CALCULATE THE LINE PRICE FOR DESIGNATED DEVICES * * AND DRUGS & TAKE PT DEVICE OFFSET WHEN APPLICABLE * * 5. CALCULATE DEVICE REDUCTIONS * * * *************************************************************** 9550-CALC-STANDARD. *************************************************************** * INITIALIZE & SET LINE VARIABLES AND FLAGS * *************************************************************** *-------------------------------------------------------------* * INITIALIZE VARIABLE FOR LINES ELIGIBLE FOR BLOOD DEDUCTIBLE * *-------------------------------------------------------------* MOVE 0 TO H-BLOOD-FRACTION. *-------------------------------------------------------------* * FLAG LINE IF THE LINE APC IS A BRACHYTHERAPY APC * * ** NEW LIST EVERY JANUARY ** * *-------------------------------------------------------------* * 11/13/2007 - BRACHY APC CHECK ADDED * * 12/28/2007 - LOGIC MOVED HERE * * 11/12/2008 - LOGIC DISABLED, BRACHYTHERAPY LINES IDENTIFIED * * WITH A STATUS INDICATOR OF ' U' FOR CY 2009 * *-------------------------------------------------------------* * PERFORM 9650-SET-BRACHY-APC-FLAG * THRU 9650-SET-BRACHY-APC-FLAG-EXIT. *-------------------------------------------------------------* * FLAG LINE IF THE LINE HCPCS IS A BLOOD DEDUCTIBLE HCPCS * * ** NEW LIST EVERY JANUARY ** * *-------------------------------------------------------------* * 11/13/2007 - HCPCS LIST MOVED FROM 7550-CALC-GJK TO HERE * * 12/04/2007 - LIST MOVED TO 7655-SET-BD-HCPCS-FLAG * * 12/28/2007 - LOGIC MOVED HERE * *-------------------------------------------------------------* PERFORM 9655-SET-BD-HCPCS-FLAG THRU 9655-SET-BD-HCPCS-FLAG-EXIT. *-------------------------------------------------------------* * FLAG LINE IF THE LINE APC IS A RADIOPHARM APC * * ** NEW LIST EVERY JANUARY ** * *-------------------------------------------------------------* * 12/27/2007 - RADIOPHARM APC CHECK ADDED * * 12/28/2007 - LOGIC MOVED HERE * * 11/16/2009 - LOGIC REMOVED BECAUSE THERAP. RADIO NO LONGER * * HAVE AN SI=H (NOT PAID AT COST) - CY 2010 * *-------------------------------------------------------------* * PERFORM 9660-SET-RADIOPH-APC-FLAG * THRU 9660-SET-RADIOPH-APC-FLAG-EXIT. *-------------------------------------------------------------* * FLAG LINE IF LINE HCPCS IS A PASS-THROUGH RADIOPHARM HCPCS * * ** QUARTERLY UPDATES TO TABLE ** * *-------------------------------------------------------------* * 02/10/2009 - PT RADIOPHARM HCPCS CHECK ADDED * *-------------------------------------------------------------* PERFORM 9680-SET-PTRADIO-LINE-FLAG THRU 9680-SET-PTRADIO-LINE-FL-EXIT. *-------------------------------------------------------------* * FLAG LINE IF LINE HCPCS IS A PASS-THROUGH CONTRAST AGENT * * HCPCS ** QUARTERLY UPDATES TO TABLE ** * *-------------------------------------------------------------* * 11/16/2009 - PT CONTRAST AGENT HCPCS CHECK ADDED * *-------------------------------------------------------------* PERFORM 9681-SET-PTCA-LINE-FLAG THRU 9681-SET-PTCA-LINE-FL-EXIT. *************************************************************** * CALCULATE MAXIMUM COINSURANCE AMOUNT (INPATIENT LIMIT) * *************************************************************** COMPUTE H-MAX-COIN ROUNDED = (H-IP-LIMIT * W-SRVC-UNITS (W-LP-INDX) * W-DISC-RATE (W-LP-INDX)). *************************************************************** * CALCULATE FULL AND PARTIAL CREDIT DEVICE REDUCTIONS AND * * REDUCE THE APC PAYMENT BY THE REDUCTION AMOUNT * * PAYMENT ADJUSTMENT FLAGS: 7 = FULL, 8 = PARTIAL CREDIT * *-------------------------------------------------------------* * 11/1/2007 - PYMT ADJ FLAG 8 ADDED FOR PARTIAL CREDIT * * DEDUCTIONS - NEW FOR CY 2008 * *************************************************************** IF OPPS-PYMT-ADJ-FLAG (LN-SUB) = ' 7' OR ' 8' PERFORM 9550-DEVICE-REDUC THRU 9550-DEVICE-REDUC-EXIT. *************************************************************** * CALCULATE PAYMENT FOR SI = S, V, T, P, OR X LINES * * THE APC PAYMENT IS 60% WAGE ADJUSTED * *-------------------------------------------------------------* * 11/13/2007 - ADDED PERFORM 7560-CALC-BENE-DEDUCT * * (REMOVED FROM PARAGRAPH 7550-SCH-ADJ) * *************************************************************** IF (OPPS-SRVC-IND (LN-SUB) = ' S' OR ' V' OR ' T' OR ' P' OR ' X') THEN PERFORM 9550-SCH-ADJ THRU 9550-SCH-ADJ-EXIT PERFORM 9560-CALC-BENE-DEDUCT THRU 9560-CALC-BENE-DEDUCT-EXIT IF OPPS-SRVC-IND (LN-SUB) = ' P' THEN PERFORM 9550-PHP-PMT-FOR-OUTL THRU 9550-PHP-PMT-FOR-OUTL-EXIT END-IF *************************************************************** * CALCULATE PAYMENT FOR SI = H (DEVICE) LINES, PAYMENT IND. * * SHOULD BE 6 FOR THESE LINES (BASED ON CHARGE ADJ. TO COST) * * RETURN ERROR CODE 44 IF THIS IS NOT THE CASE * *-------------------------------------------------------------* * 01/01/2009 - BRACHYTHERAPY SERVICES ADDED FOR CY 2009 * * 11/15/2009 - BRACHYTHERAPY SERVICES (SI=U) REMOVED CY 2010 * * - THERAPEUTIC RADIOPHARMS' SI NOT 'H' FOR CY2010 * * 08/11/2010 - NEW PASS-THROUGH DEVICE OFFSET LOGIC ADDED IN * * PARAGRAPH 9555-CALC-H-STANDARD * *************************************************************** ELSE IF (OPPS-SRVC-IND (LN-SUB) = ' H') THEN IF (OPPS-SRVC-IND (LN-SUB) = ' H' AND OPPS-PYMT-IND (LN-SUB) = ' 6') PERFORM 9555-CALC-H-STANDARD THRU 9555-CALC-H-STANDARD-EXIT PERFORM 9560-CALC-BENE-DEDUCT THRU 9560-CALC-BENE-DEDUCT-EXIT ELSE MOVE 44 TO A-RETURN-CODE (LN-SUB) GO TO 9550-CALC-STANDARD-EXIT END-IF *************************************************************** * CALCULATE PAYMENT FOR SI = G, K, R & U LINES; THE PMT. IND. * * SHOULD BE 1, 5, OR 7 FOR THESE LINES (PAY STANDARD AMOUNT) * * RETURN ERROR CODE 41 IF INVALID SI - PYMT IND. COMBO * *-------------------------------------------------------------* * 12/31/2007 - REMOVED REDUNDANT H-BLOOD-FRAC. INITIALIZATION * * 11/15/2009 - ADDED BRACHYTHERAPY SERVICES (SI=U) FOR CY2010 * * THERAPEUTIC RADIOPHARMS' SI=K FOR CY 2010 * * 11/16/2009 - ADD LOGIC TO ADJUST PT CONTRAST AGENT HCPCS * * LINE PAYMENT BY OFFSET * *************************************************************** ELSE IF OPPS-SRVC-IND (LN-SUB) = ' G' OR ' K' OR ' R' OR ' U' THEN IF OPPS-PYMT-IND (LN-SUB) = ' 1' OR ' 5' OR ' 7' THEN PERFORM 9550-CALC-GJK THRU 9550-CALC-GJK-EXIT IF PTRADIO-LINE-FLAG = 'Y' AND H-NUCMED-TOT-OFFSET > 0 THEN PERFORM 9550-PTRADIO-OFFSET THRU 9550-PTRADIO-OFFSET-EXIT END-IF IF PTCA-LINE-FLAG = 'Y' AND W-PTCA-DAY-MAX > 0 AND W-CAPROC-MAX > 0 THEN PERFORM 9550-PTCA-OFFSET THRU 9550-PTCA-OFFSET-EXIT END-IF PERFORM 9560-CALC-BENE-DEDUCT THRU 9560-CALC-BENE-DEDUCT-EXIT ELSE MOVE 41 TO A-RETURN-CODE (LN-SUB) GO TO 9550-CALC-STANDARD-EXIT END-IF END-IF END-IF END-IF. *************************************************************** * CALCULATE LINE REIMBURSEMENT * *-------------------------------------------------------------* * 11/01/2007 - PERFORMS FOR PARAGRAPHS 7550-PD-AT-CST-JAN07 * * AND 7550-PD-AT-CST-JUL07 WERE DELETED (THE PARAGRAPHS * * WERE ALSO DELETED). THERE IS NO PAID AT COST TABLE FOR * * 2008. UNDER THE ORIGINAL 2008 LEGISLATION, DIAGNOSIS * * RADIOPHARM LINES WERE PACKAGED (SI=' N') AND THERAPEUTIC * * RADIOPHARM AND BRACHYTHERAPY LINES WERE SEPARATELY * * PAYABLE (SI=' K'). THEREFORE, PAID AT COST LOGIC WAS NOT * * NEEDED. * * * * 12/06/2007 - LINE REIMBURSEMENT AND NATIONAL COINSURANCE * * CALCULATIONS, AND MINIMUM COINSURANCE MOVE INSERTED * * (TAKEN FROM 6550-PD-AT-CST-JAN07). * * * * 12/27/2007 - PAID AT COST LOGIC REINSTATED FOR RADIOPHARM * * AND BRACHYTHERAPY LINES WITH A STATUS INDICATOR = ' H'. * * PAID AT COST LOGIC REVISED: NO TABLE OR TABLE SEARCH; * * FLAGS ARE USED INSTEAD. (REINSTATEMENT IS DUE TO A * * CHANGE IN LEGISLATION; ALL RADIO. & BRACHY SI = ' H'.) * * * * 05/14/2008 - PAID AT COST LOGIC NO LONGER APPLIED TO * * RADIOPHARM AND BRACHYTHERAPY LINES AS OF JULY 1, 2008. * * THESE LINES ARE ASSIGNED A SI OF ' K' EFFECTIVE JULY 1, * * 2008, SO THEY WILL AUTOMATICALLY BY-PASS THE LOGIC AND * * RECEIVE THE STANDARD REIM. PAID AT COST LOGIC RETAINED * * FOR PREVIOUS QUARTERS (JANUARY 1 - JUNE 30, 2008). * * * * 08/07/2008 - DUE TO LEGISLATION, THERAPEUTIC RADIOPHARMS & * * BRACHYTHERAPY SOURCE'S SI CHANGED FROM 'K' BACK TO 'H'; * * THEY CONTINUE TO BE PAID AT COST (EFFECTIVE 7/1/2008) * * * * 11/12/2008 - BRACHYTHERAPY SOURCE'S STATUS INDICATOR = ' U' * * EFFECTIVE 1/1/2009 * * * * 11/16/2009 - REMOVED LOGIC FOR THERAPEUTIC RADIOPHARMS & * * BRACHYTHERAPY SOURCES B/C THESE ARE NOT PAID * * AT COST FOR CY 2010 * * * *************************************************************** *-------------------------------------------------------------* * STANDARD LINE REIMBURSEMENT CALCULATION * *-------------------------------------------------------------* COMPUTE H-LITEM-REIM ROUNDED = ((H-LITEM-PYMT - H-TOTAL-LN-DEDUCT) - H-LN-BLOOD-DEDUCT) * W-PPCT (W-LP-INDX). *************************************************************** * CALCULATE NATIONAL COINSURANCE * *-------------------------------------------------------------* * 12/6/2007 - LOGIC ADDED (TAKEN FROM 6550-PD-AT-CST-JAN07) * *************************************************************** COMPUTE H-NAT-COIN = H-LITEM-PYMT - H-TOTAL-LN-DEDUCT - H-LITEM-REIM - H-LN-BLOOD-DEDUCT. *************************************************************** * ADJUST MINIMUM COINSURANCE AMOUNT * * (REPLACES WHAT WAS IN THE APC TABLE IF > 0) * *************************************************************** MOVE W-MIN-COIN (W-LP-INDX) TO H-MIN-COIN. IF H-MIN-COIN > 0 *-------------------------------------------------------------* * DRUGS, DEVICES, BRACHYTHERAPY, THERAP. RADIO, & BLOOD * * (SI = G AND H LINES HAVE A MIN-COIN = 0, WON'T ENTER LOGIC) * *-------------------------------------------------------------* IF OPPS-SRVC-IND (LN-SUB) = ' G' OR ' H' OR ' K' OR ' R' OR ' U' COMPUTE H-MIN-COIN ROUNDED = H-MIN-COIN * (W-SRVC-UNITS (W-LP-INDX) - (W-SRVC-UNITS (W-LP-INDX) * H-BLOOD-FRACTION)) * W-DISC-RATE (W-LP-INDX) *-------------------------------------------------------------* * APCS 0158 & 0159'S MIN COINSURANCE = 25% OF LINE PMT * *-------------------------------------------------------------* ELSE IF OPPS-APC (LN-SUB) = '0158' OR '0159' COMPUTE H-MIN-COIN ROUNDED = H-LITEM-PYMT * .25 *-------------------------------------------------------------* * OTHER SERVICE TYPES AND APCS' MIN COIN = 20% OF LINE PMT * *-------------------------------------------------------------* ELSE COMPUTE H-MIN-COIN ROUNDED = H-LITEM-PYMT * .2 END-IF END-IF END-IF. *************************************************************** * ADJUST REDUCED COINSURANCE WHEN NECESSARY & ADJUST CLAIM * * TOTAL LINE ITEM REIMBURSEMENT WHEN THE REDUCED AND/OR * * NATIONAL COINSURANCE AMOUNTS EXCEED THE MAXIMUM COINSURANCE * * (PROVIDER MAY ELECT TO REDUCE COINSURANCE) * *************************************************************** MOVE W-RED-COIN (W-LP-INDX) TO H-RED-COIN. IF (H-RED-COIN > 0 AND < H-MIN-COIN) MOVE H-MIN-COIN TO H-RED-COIN ELSE IF H-RED-COIN < H-NAT-COIN AND > H-MIN-COIN AND > H-MAX-COIN COMPUTE H-LITEM-REIM = H-LITEM-REIM + (H-RED-COIN - H-MAX-COIN) END-IF END-IF. IF H-NAT-COIN > H-MAX-COIN AND H-RED-COIN = 0 THEN COMPUTE H-LITEM-REIM = H-LITEM-REIM + (H-NAT-COIN - H-MAX-COIN) MOVE H-MAX-COIN TO H-NAT-COIN. 9550-CALC-STANDARD-EXIT. EXIT. *************************************************************** * * * DELETED CODE: * * PAID AT COST WITH COINSURANCE TABLE SEARCH REMOVED * * 11/1/2007 FOR CY 2008. THERE IS NO NEW PAID AT COST * * TABLE FOR 2008. PARAGRAPHS REMOVED: * * - 7550-PD-AT-CST-JAN07, * * - 7550-PD-AT-CST-JAN07-EXIT, * * - 7550-PD-AT-CST-JUL07, * * - 7550-PD-AT-CST-JUL07-EXIT. * * * *************************************************************** *************************************************************** * * * DEVICE REDUCTION PROCESSING * * * *************************************************************** * * * SEARCH THE DEVICE REDUCTION TABLE TO SEE IF THERE IS AN APC * * MATCH; IF SO, REDUCE THE PYMT BY THE REDUCTION AMOUNT * * BECAUSE THIS IS A FREE OR REPLACEMENT DEVICE -OR- A PARTIAL * * CREDIT DEVICE. * * * * * BE SURE TO UPDATE THE TABLE REFERENCES EACH YEAR * * * * *-------------------------------------------------------------* * * * 11/1/2007 - PARTIAL CREDIT DEVICE PROCESSING ADDED * * NEW FOR CY 2008 * * * *************************************************************** 9550-DEVICE-REDUC. SEARCH ALL DEV-RED10 AT END GO TO 9550-DEVICE-REDUC-EXIT WHEN DEV-APC10 (DEV-INDX10) = OPPS-APC (LN-SUB) PERFORM 9550-DEVICE-COMPUTE THRU 9550-DEVICE-COMPUTE-EXIT. 9550-DEVICE-REDUC-EXIT. EXIT. *************************************************************** * * * IF THE DEVICE IS FOUND, AND REDUCTION AMOUNT IS LESS THAN * * PAYMENT AMOUNT, SUBTRACT REDUCTION AMOUNT FROM THE PAYMENT * * * * * BE SURE TO UPDATE THE TABLE REFERENCES EACH YEAR * * * * *-------------------------------------------------------------* * * * 11/1/2007 - PARTIAL CREDIT DEVICE PROCESSING ADDED * * NEW FOR CY 2008 * * * *************************************************************** 9550-DEVICE-COMPUTE. *-------------------------------------------------------------* * PROCESS FULL DEVICE REDUCTION (PAF = 7, FB MODIFER) * *-------------------------------------------------------------* IF OPPS-PYMT-ADJ-FLAG (LN-SUB) = ' 7' IF W-APC-PYMT (W-LP-INDX) NUMERIC IF W-APC-PYMT (W-LP-INDX) > DEV-REDUC10 (DEV-INDX10) COMPUTE W-APC-PYMT (W-LP-INDX) = (W-APC-PYMT (W-LP-INDX) - DEV-REDUC10 (DEV-INDX10)). *-------------------------------------------------------------* * PROCESS PARTIAL CREDIT DEVICE REDUCTION (PAF = 8, FC MOD) * *-------------------------------------------------------------* IF OPPS-PYMT-ADJ-FLAG (LN-SUB) = ' 8' IF W-APC-PYMT (W-LP-INDX) NUMERIC IF W-APC-PYMT (W-LP-INDX) > (DEV-REDUC10 (DEV-INDX10) / 2) COMPUTE W-APC-PYMT (W-LP-INDX) = (W-APC-PYMT (W-LP-INDX) - (DEV-REDUC10 (DEV-INDX10) / 2)). 9550-DEVICE-COMPUTE-EXIT. EXIT. *************************************************************** * * * CALCULATE WAGE ADJUSTED LINE ITEM PAYMENT WITH RURAL * * SOLE COMMUNITY HOSPITAL (SCH) ADJUSTMENT WHEN APPLICABLE * * * * FOR LINES WITH A SI OF S, V, T, P, X, R, OR U * * * *************************************************************** * * * THE SCH ADJUSTMENT IS MADE WHEN THE FOLLOWING IS TRUE: * * EITHER THE L-PSF-GEO-CBSA OR THE L-PSF-WI-CBSA MUST BE A * * VALUE OF ' 01' THRU ' 99' AND THE L-PSF-PROV-TYPE * * MUST BE A '16' OR '17' OR '21' OR '22'. * * * * EACH YEAR, CHECK WHETHER THE SCH ADJUSTMENT HARDCODED BELOW * * HAS CHANGED. * * CYS 2006 - 2009: SCH ADJ = 7.1% (1.071) * * * * * * 11/08/2007 - PROCESSING FOR BRACHY & BLOOD CODES WITH AN SI * * = K ADDED FOR CY 2008 * * 11/13/2007 - PROCESSING FOR BRACHY & BLOOD CODES REVISED. * * BLD-DEDUC-HCPCS-FLAG ADDED TO LOGIC. * * 11/13/2007 - PARAGRAPH 7560-CALC-BENE-DEDUCT PERFORM * * DELETED & MOVED TO PAR. 7550-CALC-STANDARD * * 05/14/2008 - BRACHYTHERAPY LINES PROCESSED IN THIS * * PARAGRAPH STARTING 7/1/2008 BECAUSE SI CHANGED * * TO ' K' ON THIS DATE. * * 08/07/2008 - DUE TO LEGISLATION, THERAPEUTIC RADIOPHARMS & * * BRACHYTHERAPY SOURCE'S SI CHANGED FROM 'K' * * BACK TO 'H' EFFECTIVE 7/1/2008; THESE LINES * * ARE NOT YET PROCESSED IN THIS PARAGRAPH * * 11/13/2008 - FOR CY 2009, BLOOD DEDUCTIBLE LINES (SI=R) * * ADDED TO LOGIC. BRACHY LINES NOT PROCESSED IN * * PARAGRAPH & NOW HAVE A SI = U, SI = K LOGIC * * REMOVED FROM THIS PARAGRAPH. * * 05/11/2009 - ADDED THE REQUIREMENT PAF = 5 OR 6 TO BLOOD * * DEDUCTIBLE LOGIC TO CORRECT PRICING ERROR. * * FIX EFFECTIVE RETROACTIVE TO 01/01/2009. * * 11/17/2009 - BRACHYTHERAPY LINES NOW PROCESSED IN THIS * * PARAGRAPH FOR CY 2010 (SI=U), DO NOT RECEIVE * * WAGE ADJUSTMENT * * 05/09/2011 - REVISED LOGIC TO EXCLUDE BILL TYPE 14X FROM * * RECEIVING THE SCH ADD-ON * * * *************************************************************** 9550-SCH-ADJ. MOVE L-PSF-GEO-CBSA TO GEO-CBSA-FLAG. MOVE L-PSF-WI-CBSA TO WI-CBSA-FLAG. *************************************************************** * CALCULATE THE SCH PAYMENT * * - FOR SCHS = APC OR BLOOD APC PAYMENT ADJUSTED BY 7.1% * * - FOR NON-SCHS = UNADJUSTED APC OR BLOOD APC PAYMENT * *************************************************************** IF ((RURAL-GEO OR RURAL-WI) AND (L-PSF-PROV-TYPE = '16' OR '17' OR '21' OR '22') AND (BILL14X-FLAG = 'N')) *-------------------------------------------------------------* * SCH, BLOOD DEDUCTIBLE HCPCS LINE * *-------------------------------------------------------------* IF OPPS-SRVC-IND (LN-SUB) = ' R' AND BLD-DEDUC-HCPCS-FLAG = 'Y' AND OPPS-PYMT-ADJ-FLAG (LN-SUB) = (' 5' OR ' 6') COMPUTE H-SCH-PYMT ROUNDED = (W-BD-APC-PYMT (W-BD-INDX) * 1.071) *-------------------------------------------------------------* * SCH, NOT A LINE WITH A BLOOD DEDUCTIBLE HCPCS * *-------------------------------------------------------------* ELSE COMPUTE H-SCH-PYMT ROUNDED = (W-APC-PYMT (W-LP-INDX) * 1.071) END-IF *-------------------------------------------------------------* * NON-SCH, BLOOD DEDUCTIBLE HCPCS LINE * *-------------------------------------------------------------* ELSE IF OPPS-SRVC-IND (LN-SUB) = ' R' AND BLD-DEDUC-HCPCS-FLAG = 'Y' AND OPPS-PYMT-ADJ-FLAG (LN-SUB) = (' 5' OR ' 6') MOVE W-BD-APC-PYMT (W-BD-INDX) TO H-SCH-PYMT *-------------------------------------------------------------* * NON-SCH, NOT A LINE WITH A BLOOD DEDUCTIBLE HCPCS * *-------------------------------------------------------------* ELSE MOVE W-APC-PYMT (W-LP-INDX) TO H-SCH-PYMT END-IF END-IF. *************************************************************** * CALCULATE THE LINE ITEM PAYMENT * *************************************************************** *-------------------------------------------------------------* * SI = R (BLOOD) OR U (BRACHY) LINES ARE NOT WAGE-ADJUSTED * *-------------------------------------------------------------* IF OPPS-SRVC-IND (LN-SUB) = ' R' OR ' U' IF OPPS-SRVC-IND (LN-SUB) = ' R' AND BLD-DEDUC-HCPCS-FLAG = 'Y' AND OPPS-PYMT-ADJ-FLAG (LN-SUB) = (' 5' OR ' 6') COMPUTE H-LITEM-PYMT ROUNDED = H-SCH-PYMT * W-BD-SRVC-UNITS (W-BD-INDX) * W-BD-DISC-RATE (W-BD-INDX) ELSE COMPUTE H-LITEM-PYMT ROUNDED = H-SCH-PYMT * W-SRVC-UNITS (W-LP-INDX) * W-DISC-RATE (W-LP-INDX) END-IF *-------------------------------------------------------------* * SI = S, V, T, P, OR X LINES ARE WAGE-ADJUSTED (60%) * *-------------------------------------------------------------* ELSE COMPUTE H-LITEM-PYMT ROUNDED = (((H-SCH-PYMT * .60) * W-WINX1 (W-LP-INDX)) + (H-SCH-PYMT * .40)) * W-SRVC-UNITS (W-LP-INDX) * W-DISC-RATE (W-LP-INDX) END-IF. 9550-SCH-ADJ-EXIT. EXIT. *************************************************************** * * * SET PARTIAL HOSPITALIZATION (PHP) "CAP" APC * * FOR USE IN THE OUTLIER CALCULATION * * (FOR SI = P LINES ONLY) * * * * ** ASK POLICY FOR THE PHP "CAP" APC ANUALLY ** * * * *-------------------------------------------------------------* * * * 11/13/2008 - THIS PARAGRAPH IS NEW FOR CY 2009, * * CY 2009 PHP "CAP" APC = 0173 * * * *************************************************************** 9550-PHP-PMT-FOR-OUTL. *-------------------------------------------------------------* * LOOK-UP PHP "CAP" APC IN THE APC TABLE, STARTING AT * * THE APC'S MOST CURRENT RECORD - RETRIEVE PAYMENT RATE * *-------------------------------------------------------------* SEARCH ALL WAA-ENTRY AT END GO TO 9550-PHP-PMT-FOR-OUTL-EXIT WHEN WAA-APC (WAA-INDX) = '00173' MOVE WAA-PTR (WAA-INDX) TO W-SUB2 PERFORM 9550-PHP-APC-LOOKUP. *-------------------------------------------------------------* * REDUCE APC PMT RATE BY REDUCED UPDATE RATIO WHEN APPROPRIATE* * 11/13/2009 - NEW FOR CY 2009 * *-------------------------------------------------------------* PERFORM 9180-REDUCE-APC-PYMT THRU 9180-REDUCE-APC-PYMT-EXIT. *-------------------------------------------------------------* * APPLY THE SCH ADJUSTMENT TO APC RATE WHEN APPLICABLE * * CY 2009 ADJ = 7.1% * *-------------------------------------------------------------* IF ((RURAL-GEO OR RURAL-WI) AND (L-PSF-PROV-TYPE = '16' OR '17' OR '21' OR '22')) COMPUTE H-APC-PYMT ROUNDED = (H-APC-PYMT * 1.071) END-IF. *-------------------------------------------------------------* * CALCULATE THE PHP "CAP" APC'S LINE PAYMENT (INCLUDES * * WAGE ADJUSTMENT AND SCH ADJUSTMENT IF APPLICABLE) * *-------------------------------------------------------------* COMPUTE H-PHP-LITEM-PYMT-OUTL ROUNDED = (((H-APC-PYMT * .60) * W-WINX1 (W-LP-INDX)) + (H-APC-PYMT * .40)) * W-SRVC-UNITS (W-LP-INDX) * W-DISC-RATE (W-LP-INDX). 9550-PHP-PMT-FOR-OUTL-EXIT. EXIT. *************************************************************** * * * LOOK-UP PHP "CAP" APC IN THE APC TABLE * * * *-------------------------------------------------------------* * * * 11/13/2008 - THIS PARAGRAPH IS NEW FOR CY 2009 * * * *************************************************************** 9550-PHP-APC-LOOKUP. *************************************************************** * APC RECORD EFFECTIVE DATE IS BEFORE OR ON THE LATEST * * EFFECTIVE DATE THE CLAIM CAN USE (SEARCH STARTS AT THE * * MOST CURRENT RECORD FOR THE APC) * *************************************************************** IF WAR-DTCD (W-SUB2) NOT > WAD-DTCD (WAD-SUB) *-------------------------------------------------------------* * APC RECORD EFFECTIVE DATE CORRECT, APC DELETED - ERROR * *-------------------------------------------------------------* IF WAR-RATEX (W-SUB2) = 'DELETED' MOVE ZEROS TO H-APC-PYMT *-------------------------------------------------------------* * APC RECORD EFFECTIVE DATE CORRECT, APC ACTIVE - ACCEPT REC * *-------------------------------------------------------------* ELSE MOVE WAR-RATE (W-SUB2) TO H-APC-PYMT *************************************************************** * APC RECORD EFFECTIVE DATE IS AFTER THE LATEST EFFECTIVE * * DATE THE CLAIM CAN USE. GO TO THE PREVIOUS RECORD IN THE * * APC TABLE. * *************************************************************** ELSE SUBTRACT 1 FROM W-SUB2 *-------------------------------------------------------------* * PREVIOUS REC BELONGS TO THE LINE APC, TEST EFFECTIVE DATE * *-------------------------------------------------------------* IF W-SUB2 > WAA-PTR (WAA-INDX - 1) GO TO 9550-PHP-APC-LOOKUP *-------------------------------------------------------------* * THERE IS NO RECORD FOR THE LINE APC WITH AN ACCEPTABLE * * EFFECTIVE DATE FOR THE LINE. RETURN ZEROS. * *-------------------------------------------------------------* ELSE MOVE 0 TO H-APC-PYMT. 9550-PHP-APC-LOOKUP-EXIT. EXIT. *************************************************************** * * * CALCULATE THE FOLLOWING FOR VALID SI = G, K, R, & U LINES: * * - APC PAYMENT FOR BLOOD LINES (SI = R) * * - BLOOD SPECIFIC ITEMS FOR BLOOD LINES * * - LINE ITEM PMT FOR ALL SI = G, K, OR U LINES (DRUGS, * * BIOLOGICALS, RADIOPHARMS, & BRACHYTHERAPIES) * * - SCH ADJUSTMENT APPLIED TO BLOOD & BRACHY LINES * * - BLOOD DEDUCTIBLE FOR BLOOD DEDUCTIBLE HCPCS LINES * * * *-------------------------------------------------------------* * * * - EFFECTIVE 01/01/2003, REMOVE PRO RATA REDUCTION FOR * * ALL SERVICE INDICATOR 'G' PAYMENTS. * * - 11/13/2007 - LINE ITEM PAYMENTS FOR BLOOD AND BRACHY * * LINES ARE CALCULATED IN PARAGRAPH 7550-SCH-ADJ TO APPLY * * THE SOLE COMMUNITY HOSPITAL (SCH) ADJUSTMENT WHEN * * APPLICABLE * * - 12/31/2007 - BRACHYTHERAPY & RADIOPHARM LINES' STATUS * * INDICATOR CHANGED BACK TO 'H' TEMPORARILY; THESE LINES * * WILL NOT ENTER THIS PARAGRAPH NOR PARAGRAPH 7550-SCH-ADJ * * UNTIL THEIR STATUS INDICATOR IS CHANGED BACK TO 'K' * * - 05/14/2008 - BRACHYTHERAPY & RADIOPHARM LINES' SI CHANGED * * TO ' K' EFFECTIVE 7/1/2008. THESE LINES ARE PROCESSED * * IN THIS PARAGRAPH STARTING 7/1/2008. * * - 08/07/2008 - DUE TO LEGISLATION, THERAPEUTIC RADIOPHARMS * * & BRACHYTHERAPY SOURCE'S SI CHANGED FROM 'K' BACK TO 'H' * * EFFECTIVE 7/1/2008; THESE LINES ARE NOT YET PROCESSED IN * * THIS PARAGRAPH. * * - 11/12/2008 - FOR CY 2009, BRACHYS NOT PROCESSED IN THIS * * PARAGRAPH; BRACHY LINES ASSIGNED A NEW SI OF ' U' * * - 11/13/2008 - FOR CY 2009, BLOOD DEDUCTIBLE LINES HAVE A * * SI = R * * - 12/05/2008 - MODIFIED LOGIC TO SEND BLOOD LINES WITHOUT * * A PMT ADJ FLAG = 5 OR 6 TO THE SCH ADJUSTMENT PARAGRAPH, * * INCLUDED SI = R IN THE BLOOD IDENTIFICATION LOGIC * * - 11/15/2009 - BRACHYTHERPY SERVICES (SI = U) & THERAPEUTIC * * RADIOPHARMS (SI = K) SENT TO THIS PARAGRAPH FOR CY 2010, * * LOGIC ALTERED TO PROCESS SI = U (RECEIVE REGULAR APC PMT) * * - 11/17/2009 - SEND BRACHYTHERAPY LINES TO 9550-SCH-ADJ TO * * MAKE ELIGIBLE FOR SCH ADJUSTMENT, NOT WAGE ADJUSTED * * * *************************************************************** 9550-CALC-GJK. *************************************************************** * * * CALCULATE LINE ITEM PAYMENT & BLOOD DEDUCTIBLE FOR BLOOD * * LINE WITH A HCPCS SUBJECT TO THE BLOOD DEDUCTIBLE (BD) * * * * (BLOOD DEDUCTIBLE LINES ARE PROCESSED IN THE ORDER THEY * * APPEAR IN THE BLOOD DEDUCTIBLE TABLE - EARLIEST TO LATEST * * DATE, LEAST TO MOST EXPENSIVE PAYMENT RATE. THE CURRENT * * COINSURANCE DEDUCTIBLE TABLE LINE BEING PROCESSED DOES NOT * * NECESSARILY CORRESPOND TO THE BLOOD DEDUCTIBLE LINE * * PROCESSED IN THE LOGIC BELOW.) * * * *************************************************************** IF OPPS-SRVC-IND (LN-SUB) = ' R' AND BLD-DEDUC-HCPCS-FLAG = 'Y' AND OPPS-PYMT-ADJ-FLAG (LN-SUB) = (' 5' OR ' 6') *-------------------------------------------------------------* * CALCULATE BLOOD FRACTION & BLOOD PINTS USED * *-------------------------------------------------------------* PERFORM 9550-SET-BLOOD-FRACTION THRU 9550-SET-BLOOD-FRACTION-EXIT *-------------------------------------------------------------* * ADJUST BLOOD APC PAYMENT BY BLOOD PRODUCT OR LABOR RATE * *-------------------------------------------------------------* PERFORM 9550-ADJ-BLOOD-COST THRU 9550-ADJ-BLOOD-COST-EXIT *-------------------------------------------------------------* * CALCULATE LINE ITEM PAYMENT W/ SCH ADJUSTMENT IF APPLICABLE * *-------------------------------------------------------------* * 11/14/2007 - 7550-SCH-ADJ PERFORM ADDED; LINE ITEM PAYMENT * * CALCULATION REMOVED FROM THIS SECTION * *-------------------------------------------------------------* PERFORM 9550-SCH-ADJ THRU 9550-SCH-ADJ-EXIT *-------------------------------------------------------------* * CALCULATE BLOOD DEDUCTIBLE (BD) - H-BLOOD-FRACTION IS THE * * FRACTION OF THE CURRENT LINE'S PINTS COVERED BY THE BD * *-------------------------------------------------------------* COMPUTE H-LN-BLOOD-DEDUCT ROUNDED = H-LITEM-PYMT * H-BLOOD-FRACTION *-------------------------------------------------------------* * POINT TO NEXT BLOOD DEDUCTIBLE RECORD FOR NEXT BD LINE * *-------------------------------------------------------------* SET W-BD-INDX UP BY 1 *************************************************************** * * * CALCULATE LINE ITEM PAYMENT FOR BLOOD LINE WITH A HCPCS NOT * * SUBJECT TO THE BLOOD DEDUCTIBLE, BUT PAF = 5 OR 6 * * (BLOOD PROCESSING AND PRODUCT BILLED TOGETHER) * * * *************************************************************** ELSE IF OPPS-SRVC-IND (LN-SUB) = ' R' AND OPPS-PYMT-ADJ-FLAG (LN-SUB) = (' 5' OR ' 6') *-------------------------------------------------------------* * ADJUST APC PAYMENT BY BLOOD PRODUCT OR LABOR RATE * *-------------------------------------------------------------* * 11/13/2007 - LINE ITEM PMT NO LONGER CALCULATED IN * * 7550-ADJ-PLATE-COST, BUT IN 7550-SCH-ADJ * *-------------------------------------------------------------* PERFORM 9550-ADJ-PLATE-COST THRU 9550-ADJ-PLATE-COST-EXIT *-------------------------------------------------------------* * CALCULATE LINE ITEM PAYMENT W/ SCH ADJUSTMENT IF APPLICABLE * *-------------------------------------------------------------* * 11/14/2007 - 7550-SCH-ADJ PERFORM ADDED; LINE ITEM PAYMENT * * CALCULATION REMOVED FROM THIS SECTION * *-------------------------------------------------------------* PERFORM 9550-SCH-ADJ THRU 9550-SCH-ADJ-EXIT *************************************************************** * * * CALCULATE LINE ITEM PAYMENT FOR BLOOD LINE WITH A HCPCS NOT * * SUBJECT TO THE BLOOD DEDUCTIBLE AND PAF NOT EQUAL TO 5 OR 6 * * (ONLY BLOOD PRODUCT BILLED) * * * *************************************************************** ELSE IF OPPS-SRVC-IND (LN-SUB) = ' R' *-------------------------------------------------------------* * CALCULATE LINE ITEM PAYMENT W/ SCH ADJUSTMENT IF APPLICABLE * *-------------------------------------------------------------* * 12/05/2008 - 7550-SCH-ADJ PERFORM ADDED FOR BLOOD LINES * * CALCULATION REMOVED FROM THIS SECTION * *-------------------------------------------------------------* PERFORM 9550-SCH-ADJ THRU 9550-SCH-ADJ-EXIT *************************************************************** * * * CALCULATE LINE ITEM PAYMENT FOR DRUGS, BIOLOGICALS, * * BRACHYTHERAPY SERVICES, & THERAPEUTIC RADIOPHARMS * * * *************************************************************** ELSE IF OPPS-SRVC-IND (LN-SUB) = ' G' OR ' K' COMPUTE H-LITEM-PYMT ROUNDED = W-APC-PYMT (W-LP-INDX) * W-SRVC-UNITS (W-LP-INDX) * W-DISC-RATE (W-LP-INDX) ELSE IF OPPS-SRVC-IND (LN-SUB) = ' U' PERFORM 9550-SCH-ADJ THRU 9550-SCH-ADJ-EXIT END-IF END-IF END-IF END-IF END-IF. 9550-CALC-GJK-EXIT. EXIT. *************************************************************** * * * DETERMINE THE FRACTION OF THE BLOOD LINE'S PAYMENT THAT * * WILL BE COVERED BY THE THE BENEFICIARY'S BLOOD DEDUCTIBLE * * FOR LINES WITH A HCPCS IN THE BLOOD DEDUCTIBLE LIST * * * * THE BENEFICIARY PAYS A BLOOD DEDUCTIBLE FOR THE FIRST * * 3 CHEAPEST BLOOD PINTS. MEDICARE COVERS ANY ADDITIONAL * * PINTS USED BY THE BENEFICIARY. * * * *************************************************************** 9550-SET-BLOOD-FRACTION. *-------------------------------------------------------------* * NAVIGATE TO SERVICE LINE ASSOCIATED WITH THE BLOOD ENTRY * *-------------------------------------------------------------* MOVE W-BD-SUB (W-BD-INDX) TO LN-SUB. *-------------------------------------------------------------* * BLOOD/BLOOD PRODUCT LINE * *-------------------------------------------------------------* IF OPPS-PYMT-ADJ-FLAG (LN-SUB) = ' 5' IF H-BENE-PINTS-USED > 0 *-------------------------------------------------------------* * BENEFICIARY HAS ENOUGH PINTS TO COVER ALL BLOOD LINE UNITS * * - BLOOD DEDUCTIBLE WILL COVER THE ENTIRE PYMNT (FRAC. = 1) * * - CALCULATE THE NUMBER OF DEDUCTIBLE PINTS BENE HAS LEFT * *-------------------------------------------------------------* IF W-BD-SRVC-UNITS (W-BD-INDX) <= H-BENE-PINTS-USED MOVE 1 TO H-BLOOD-FRACTION COMPUTE H-BENE-PINTS-USED = H-BENE-PINTS-USED - W-BD-SRVC-UNITS (W-BD-INDX) *-------------------------------------------------------------* * BENE. DOESN'T HAVE ENOUGH PINTS TO COVER ENTIRE BLOOD LINE * * - BLOOD DEDUCTIBLE WILL COVER A FRACTION OF THE PAYMENT * * (ACCORDING TO THE % OF PINTS COVERED) * * - BENEFICIARY HAS NO DEDUCTIBLE PINTS LEFT (PINTS = 0) * *-------------------------------------------------------------* ELSE IF W-BD-SRVC-UNITS (W-BD-INDX) > H-BENE-PINTS-USED COMPUTE H-BLOOD-FRACTION = H-BENE-PINTS-USED / W-BD-SRVC-UNITS (W-BD-INDX) MOVE 0 TO H-BENE-PINTS-USED ELSE MOVE 0 TO H-BLOOD-FRACTION *-------------------------------------------------------------* * BENEFICIARY HAS NO BLOOD DEDUCTIBLE PINTS LEFT * * THERE IS NO BLOOD DEDUCTIBLE * *-------------------------------------------------------------* ELSE MOVE 0 TO H-BLOOD-FRACTION *-------------------------------------------------------------* * BLOOD PROCESS/STORAGE LINE (PAF = 6) * * THERE IS NO BLOOD DEDUCTIBLE * *-------------------------------------------------------------* ELSE MOVE 0 TO H-BLOOD-FRACTION. 9550-SET-BLOOD-FRACTION-EXIT. EXIT. *************************************************************** * * * ADJUST APC PAYMENT BY BLOOD PRODUCT OR LABOR RATE TO * * CALCULATE THE BLOOD APC PAYMENT FOR LINES WITH A HCPCS * * IN THE BLOOD DEDUCTIBLE LIST * * * * THE RATE OF BLOOD TO BLOOD LABOR IS THE CLAIM AVERAGE. * * THE BLOOD LINE IS PAID ONLY THE PORTION OF THE APC * * PAYMENT THAT IS INDICATED BY THE PYMNT ADJUSTMENT FLAG. * * * *************************************************************** 9550-ADJ-BLOOD-COST. MOVE W-BD-SUB (W-BD-INDX) TO LN-SUB. *-------------------------------------------------------------* * CALCULATE BLOOD APC PAYMENT FOR BLOOD/BLOOD PRODUCT LINE * *-------------------------------------------------------------* IF OPPS-PYMT-ADJ-FLAG (LN-SUB) = ' 5' COMPUTE W-BD-APC-PYMT (W-BD-INDX) = W-BD-APC-PYMT (W-BD-INDX) * H-38X-39X-RATE. *-------------------------------------------------------------* * CALCULATE BLOOD APC PAYMENT FOR BLOOD PROCESS/STORAGE LINE * *-------------------------------------------------------------* IF OPPS-PYMT-ADJ-FLAG (LN-SUB) = ' 6' COMPUTE W-BD-APC-PYMT (W-BD-INDX) = W-BD-APC-PYMT (W-BD-INDX) * (1 - H-38X-39X-RATE). 9550-ADJ-BLOOD-COST-EXIT. EXIT. *************************************************************** * * * ADJUST APC PAYMENT BY BLOOD PRODUCT OR LABOR RATE TO * * CALCULATE THE BLOOD APC PAYMENT FOR BLOOD LINES WITH A * * HCPCS NOT IN THE BLOOD DEDUCTIBLE LIST * * * * THE RATE OF BLOOD TO BLOOD LABOR IS THE CLAIM AVERAGE. * * THE BLOOD LINE IS PAID ONLY THE PORTION OF THE APC * * PAYMENT THAT IS INDICATED BY THE PYMNT ADJUSTMENT FLAG. * * * *************************************************************** * * * 11/13/2007 - REMOVED LINE ITEM PAYMENT CALCULATION FROM * * THIS PARAGRAPH, NOW PERFORMED IN * * 7550-SCH-ADJ (CALLED FROM 7550-CALC-GJK) * * * *************************************************************** 9550-ADJ-PLATE-COST. *-------------------------------------------------------------* * CALCULATE BLOOD APC PAYMENT FOR BLOOD/BLOOD PRODUCT LINE * *-------------------------------------------------------------* IF OPPS-PYMT-ADJ-FLAG (LN-SUB) = ' 5' COMPUTE W-APC-PYMT (W-LP-INDX) = W-APC-PYMT (W-LP-INDX) * H-38X-39X-RATE. *-------------------------------------------------------------* * CALCULATE BLOOD APC PAYMENT FOR BLOOD PROCESS/STORAGE LINE * *-------------------------------------------------------------* IF OPPS-PYMT-ADJ-FLAG (LN-SUB) = ' 6' COMPUTE W-APC-PYMT (W-LP-INDX) = W-APC-PYMT (W-LP-INDX) * (1 - H-38X-39X-RATE). 9550-ADJ-PLATE-COST-EXIT. EXIT. *************************************************************** * * * ADJUST THE PASS-THROUGH RADIOPHARM PAYMENT BY * * ITS PROPORTION OF THE NUCLEAR MEDICINE OFFSET * * * * EFFECTIVE 04/01/2009, LOGIC ADDED 02/11/2009 * * * *************************************************************** 9550-PTRADIO-OFFSET. *-------------------------------------------------------------* * CALCULATE PROPORTION OF TOTAL OFFSET TO BE APPLIED TO LINE * *-------------------------------------------------------------* * 12/20/2009 - ADDED LOGIC TO PREVENT DIVISION BY ZERO ERROR * *-------------------------------------------------------------* MOVE OPPS-SUB-CHRG (LN-SUB) TO H-SUB-CHRG. IF H-PTRADIO-TOT-CHRGS > 0 THEN COMPUTE W-PTRADIO-CHRG-RATE ROUNDED = H-SUB-CHRG / H-PTRADIO-TOT-CHRGS ELSE MOVE 0 TO W-PTRADIO-CHRG-RATE END-IF. *-------------------------------------------------------------* * CALCULATE THE OFFSET AMOUNT TO BE APPLIED TO LINE * *-------------------------------------------------------------* COMPUTE W-PTRADIO-LINE-OFFSET ROUNDED = H-NUCMED-TOT-OFFSET * W-PTRADIO-CHRG-RATE. *-------------------------------------------------------------* * SUBTRACT THE APPLICABLE OFFSET FROM THE LINE PAYMENT * *-------------------------------------------------------------* COMPUTE H-LITEM-PYMT ROUNDED = H-LITEM-PYMT - W-PTRADIO-LINE-OFFSET. 9550-PTRADIO-OFFSET-EXIT. EXIT. *************************************************************** * * * ADJUST THE PASS-THROUGH CONTRAST AGENT PAYMENT BY * * ITS PROPORTION OF THE PT CONTRAST AGENT PROCEDURE OFFSET * * * * EFFECTIVE 01/01/2010, LOGIC ADDED 11/16/2009 * * * *************************************************************** 9550-PTCA-OFFSET. *-------------------------------------------------------------* * CAPTURE LINE DATE OF SERVICE * *-------------------------------------------------------------* MOVE OPPS-LITEM-DOS (LN-SUB) TO W-CAPROC-SRVC-DATE. *-------------------------------------------------------------* * SEARCH PT CONTRAST AGENT DAY TABLE FOR DATE OF SERVICE * *-------------------------------------------------------------* SET W-PTCA-DAY-INDX TO 1. SEARCH W-PTCA-DAY-ENTRY *-------------------------------------------------------------* * DATE OF SERVICE NOT FOUND IN TABLE, STOP PROCESS * *-------------------------------------------------------------* AT END GO TO 9550-PTCA-OFFSET-EXIT *-------------------------------------------------------------* * DATE OF SERVICE FOUND IN TABLE, TAKE OFFSET * *-------------------------------------------------------------* WHEN W-PTCA-DAY-LIDOS (W-PTCA-DAY-INDX) = W-CAPROC-SRVC-DATE *-------------------------------------------------------------* * CALCULATE PROPORTION OF TOTAL OFFSET TO BE APPLIED TO LINE * *-------------------------------------------------------------* * 12/20/2009 - ADDED LOGIC TO PREVENT DIVISION BY ZERO ERROR * *-------------------------------------------------------------* MOVE OPPS-SUB-CHRG (LN-SUB) TO H-SUB-CHRG IF W-PTCA-DAY-TOT-CHRGS (W-PTCA-DAY-INDX) > 0 COMPUTE W-PTCA-CHRG-RATE ROUNDED = H-SUB-CHRG / W-PTCA-DAY-TOT-CHRGS (W-PTCA-DAY-INDX) ELSE MOVE 0 TO W-PTCA-CHRG-RATE END-IF *-------------------------------------------------------------* * CALCULATE THE OFFSET AMOUNT TO BE APPLIED TO LINE * *-------------------------------------------------------------* COMPUTE W-PTCA-LINE-OFFSET ROUNDED = W-PTCA-DAY-TOT-OFFSET (W-PTCA-DAY-INDX) * W-PTCA-CHRG-RATE *-------------------------------------------------------------* * SUBTRACT THE APPLICABLE OFFSET FROM THE LINE PAYMENT * *-------------------------------------------------------------* IF H-LITEM-PYMT >= W-PTCA-LINE-OFFSET COMPUTE H-LITEM-PYMT ROUNDED = H-LITEM-PYMT - W-PTCA-LINE-OFFSET ELSE MOVE 0 TO H-LITEM-PYMT END-IF END-SEARCH. 9550-PTCA-OFFSET-EXIT. EXIT. *************************************************************** * * * ACCUMULATE TOTAL CLAIM CHARGES FROM DEVICE LINES * * * * *** DISABLED 08/11/2011 & REPLACED WITH NEW LOGIC *** * * * * EFFECTIVE 04/01/2002 A PRO RATA REDUCTION APPLIES TO ALL * * ALL SERVICE INDICATOR 'H' PAYMENTS (CURRENTLY .689) * * * * SERVICE INDICATOR OF 'H' = PASS-THROUGH DEVICES, * * THERAPEUTIC RADIOPHARMS * * * *************************************************************** *9555-CALC-H-TOT. * *-------------------------------------------------------------* * SET THE SERVICE LINE SUBSCRIPT TO THE CLAIM SERVICE LINE * * ASSOCIATED WITH THE COINSURANCE DEDUCTIBLE TABLE RECORD * *-------------------------------------------------------------* * MOVE W-LP-SUB (W-LP-INDX) TO LN-SUB. * *-------------------------------------------------------------* * ACCUMULATE TOTAL CLAIM DEVICE CHARGES FOR DEVICE LINES * *-------------------------------------------------------------* * 11/13/2008 - MODIFIED LOGIC TO PROCESS DEVICE LINES ONLY * * (EXCLUDE THERAPEUTIC RADIOPHARMS) * * 11/16/2009 REMOVED LOGIC THAT EXCLUDES THERAP. RADIOS * * (THERAP. RADIOS DO NOT HAVE AN SI=H CY 2010) * *-------------------------------------------------------------* * MOVE OPPS-SUB-CHRG (LN-SUB) TO H-SUB-CHRG. * * IF OPPS-SRVC-IND (LN-SUB) = ' H' AND * OPPS-PYMT-IND (LN-SUB) = ' 6' * COMPUTE H-TOT-H-CHRG = * (H-TOT-H-CHRG + H-SUB-CHRG) * END-IF. * *9555-CALC-H-TOT-EXIT. * EXIT. *************************************************************** * * * CALCULATE PAYMENT FOR PAID AT COST LINES * * (PAYMENT BASED ON CHARGE ADJUSTED TO COST) * * UPDATE PASS-THROUGH DEVICE TABLE * * * *-------------------------------------------------------------* * * * 08-11-2010 - PASS-THROUGH DEVICE OFFSET LOGIC REVISED * * * *************************************************************** 9555-CALC-H-STANDARD. *-------------------------------------------------------------* * SET LINE ITEM PAYMENT TO LINE COST - "PAID AT COST" * *-------------------------------------------------------------* MOVE OPPS-SUB-CHRG (LN-SUB) TO H-SUB-CHRG. COMPUTE T-LITEM-PYMT ROUNDED = (H-SUB-CHRG * L-PSF-OPCOST-RATIO). *-------------------------------------------------------------* * SEARCH THE PTDO HCPCS TABLE FOR THE CURRENT LINE HCPCS, * * IF FOUND APPLY THE OFFSET * *-------------------------------------------------------------* SET W-PTDO-HCPCS-INDX TO 1. SEARCH W-PTDO-HCPCS-ENTRY AT END CONTINUE WHEN W-PTDO-HCPCS-HCPCS (W-PTDO-HCPCS-INDX) = OPPS-HCPCS (LN-SUB) AND W-PTDO-HCPCS-LNSUB (W-PTDO-HCPCS-INDX) = LN-SUB PERFORM 9556-CALC-PTDO-OFFSET THRU 9556-CALC-PTDO-OFFSET-EXIT. *-------------------------------------------------------------* * CAPTURE PAYMENT AMOUNT * *-------------------------------------------------------------* IF T-LITEM-PYMT < 0 THEN MOVE 0 TO H-LITEM-PYMT ELSE MOVE T-LITEM-PYMT TO H-LITEM-PYMT. *-------------------------------------------------------------* * UPDATE PASS-THROUGH DEVICE TABLE WITH LINE ITEM PAYMENT OF * * DEVICE LINE (CHARGES CONVERTED TO COST LESS APPLICABLE * * OFFSET AMOUNT) * * WHEN PTD-FLAG = 'Y', A PASS-THROUGH DEVICE IS ON THE CLAIM * *-------------------------------------------------------------* * 11/16/2009 REMOVED LOGIC THAT EXCLUDES THERAP. RADIOS * * (THERAP. RADIOS DO NOT HAVE AN SI=H CY 2010) * *-------------------------------------------------------------* IF PTD-FLAG = 'Y' AND OPPS-SRVC-IND (LN-SUB) = ' H' PERFORM 9557-LOAD-PTD-LINE-PYMT THRU 9557-LOAD-PTD-LINE-PYMT-EXIT END-IF. *************************************************************** * OLD PASS-THROUGH DEVICE OFFSET LOGIC * * LOGIC DISABLED & REPLACED * *************************************************************** * WAGE ADJUST 60% OF THE CLAIM TOTAL DEVICE OFFSET AMOUNT * * (OFFSET AMOUNTS ARE COSTS, NOT CHARGES) * * (C-FLAG = Y MEANS THERE IS A DEVICE ON THE CLAIM) * *-------------------------------------------------------------* * 11/13/2008 - MODIFIED LOGIC TO PROCESS DEVICES ONLY * * (EXCLUDE BRACHYS & THERAPEUTIC RADIOPHARMS) * * 11/16/2009 REMOVED LOGIC THAT EXCLUDES THERAP. RADIOS * * (THERAP. RADIOS DO NOT HAVE AN SI=H CY 2010) * *-------------------------------------------------------------* * IF C-FLAG = 'Y' AND * OPPS-SRVC-IND (LN-SUB) = ' H' * *-------------------------------------------------------------* * OTHER LINES ON THE CLAIM BESIDES DEVICE LINES ARE OFFSET; * * CALCULATE DEVICE PORTION OF THE TOTAL WAGE ADJUSTED OFFSET * *-------------------------------------------------------------* * IF (H-TOT-OFF-UNITS > H-TOT-HTD-UNITS) * COMPUTE H-TOTAL-WAOFF ROUNDED = * (((H-TOTAL-OFFSET * .60) * A-WINX) + * (H-TOTAL-OFFSET * .40)) * * (H-TOT-HTD-UNITS / H-TOT-OFF-UNITS) * PERFORM 9700-CALC-H-OFFSET * THRU 9700-CALC-H-OFFSET-EXIT * ELSE * *-------------------------------------------------------------* * ONLY DEVICE LINES ON THE CLAIM ARE OFFSET; * * WAGE ADJUST THE TOTAL CLAIM OFFSET AMOUNT * *-------------------------------------------------------------* * COMPUTE H-TOTAL-WAOFF ROUNDED = * ((H-TOTAL-OFFSET * .60) * A-WINX) + * (H-TOTAL-OFFSET * .40) * PERFORM 9700-CALC-H-OFFSET * THRU 9700-CALC-H-OFFSET-EXIT * *-------------------------------------------------------------* * THERE IS NO DEVICE ON THE CLAIM * *-------------------------------------------------------------* * ELSE * NEXT SENTENCE. * * IF T-LITEM-PYMT < 0 THEN * MOVE 0 TO H-LITEM-PYMT * ELSE * MOVE T-LITEM-PYMT TO H-LITEM-PYMT. 9555-CALC-H-STANDARD-EXIT. EXIT. *************************************************************** * * * REDUCE LINE ITEM PAYMENTS OF PASS-THROUGH DEVICES THAT * * HAVE AN ASSOCIATED PROCEDURE ON THE CLAIM BY THE PROCEDURE * * WAGE-ADJUSTED OFFSET AMOUNT * * * *************************************************************** * * * ** EFFECTIVE 10/01/2010 - REVISED PT DEVICE OFFSET LOGIC * * * *************************************************************** 9556-CALC-PTDO-OFFSET. *-------------------------------------------------------------* * SEARCH PTDO PROCEDURE TABLE FOR THE PT DEVICE HCPCS LINE * *-------------------------------------------------------------* SET W-PTDO-PROC-INDX TO 1. SEARCH W-PTDO-PROC-ENTRY AT END GO TO 9556-CALC-PTDO-OFFSET-EXIT *-------------------------------------------------------------* * CURRENT PT DEVICE LINE'S ASSOCIATED PROCEDURE FOUND * *-------------------------------------------------------------* WHEN W-PTDO-PROC-APC (W-PTDO-PROC-INDX) = W-PTDO-HCPCS-PROC-APC (W-PTDO-HCPCS-INDX) AND W-PTDO-PROC-LNSUB (W-PTDO-PROC-INDX) = W-PTDO-HCPCS-PROC-LNSUB (W-PTDO-HCPCS-INDX) *-------------------------------------------------------------* * DETERMINE HOW MANY PROCEDURE UNITS WILL BE ALLOCATED * *-------------------------------------------------------------* IF W-PTDO-PROC-UNITS (W-PTDO-PROC-INDX) <= W-PTDO-PROC-TOT-DUNITS (W-PTDO-PROC-INDX) MOVE W-PTDO-PROC-UNITS (W-PTDO-PROC-INDX) TO W-DOPROC-UNITS ELSE MOVE W-PTDO-PROC-TOT-DUNITS (W-PTDO-PROC-INDX) TO W-DOPROC-UNITS END-IF *-------------------------------------------------------------* * DETERMINE WHAT % OF THE OFFSET WILL BE APPLIED * *-------------------------------------------------------------* IF W-PTDO-PROC-TOT-DCHRGS (W-PTDO-PROC-INDX) > 0 COMPUTE W-PTDO-CHRG-RATE ROUNDED = W-PTDO-HCPCS-SUB-CHRG (W-PTDO-HCPCS-INDX) / W-PTDO-PROC-TOT-DCHRGS (W-PTDO-PROC-INDX) ELSE GO TO 9556-CALC-PTDO-OFFSET-EXIT END-IF *-------------------------------------------------------------* * CALCULATE THE OFFSET AMOUNT TO BE TAKEN * *-------------------------------------------------------------* COMPUTE W-PTDO-LINE-OFFSET ROUNDED = W-PTDO-CHRG-RATE * W-DOPROC-UNITS * W-PTDO-PROC-WA-OFFSET (W-PTDO-PROC-INDX) *-------------------------------------------------------------* * SUBTRACT THE OFFSET AMOUNT FROM THE LINE PAYMENT * *-------------------------------------------------------------* IF W-PTDO-LINE-OFFSET <= T-LITEM-PYMT COMPUTE T-LITEM-PYMT ROUNDED = T-LITEM-PYMT - W-PTDO-LINE-OFFSET END-IF. 9556-CALC-PTDO-OFFSET-EXIT. EXIT. *************************************************************** * * * UPDATE PASS-THROUGH DEVICE TABLE WITH CHARGES FOR THE * * DEVICE LINE (LINE ITEM PAYMENT LESS OFFSET CONVERTED TO * * CHARGES) * * (FOR ASSOCIATED PROCEDURE OUTLIER CALCULATION) * * * *************************************************************** 9557-LOAD-PTD-LINE-PYMT. *-------------------------------------------------------------* * SEARCH PTD TABLE STARTING AT ENTRY #1 FOR THE RECORD THAT * * CORRESPONDS TO THE CURRENT SERVICE LINE * *-------------------------------------------------------------* SET W-PTD-INDX TO 1. SEARCH W-PTD-ENTRY VARYING W-PTD-INDX *-------------------------------------------------------------* * IF THE SERVICE LINE'S PAYMENT ADJUSTMENT FLAG IS NOT * * ALREADY IN THE TABLE, ADD IT * *-------------------------------------------------------------* AT END GO TO 9557-LOAD-PTD-LINE-PYMT-EXIT *-------------------------------------------------------------* * IF THE LINE'S HCPCS IS IN THE TABLE, CALCULATE THE LINE'S * * CHARGES AND PLACE INTO TABLE (FOR H LINES, THE PAYMENT IS * * CONVERTED TO COST AND OFFSET. HERE, THE PAYMENT IS * * CONVERTED BACK INTO CHARGES BY DIVIDING IT BY THE COST TO * * CHARGE RATIO.) * *-------------------------------------------------------------* WHEN W-PTD-SUB (W-PTD-INDX) = LN-SUB MOVE H-LITEM-PYMT TO W-PTD-LITEM-PYMT (W-PTD-INDX) END-SEARCH. 9557-LOAD-PTD-LINE-PYMT-EXIT. EXIT. *************************************************************** * * * CALCULATE THE BENEFICIARY DEDUCTIBLE AMOUNT THAT WILL BE * * APPLIED TO THE SERVICE LINES IN THE DEDUCTIBLE TABLE * * * * (THE DEDUCTIBLE IS APPLIED TO THE LOWEST TO HIGHEST RANKED * * APCS. THE LOWER THE RANK, THE HIGHER THE COINSURANCE %. * * THE TOTAL CLAIM BENEFICIARY COINSURANCE AMOUNT IS CHEAPER * * WHEN THE DEDUCTIBLE IS APPLIED IN THIS ORDER.) * * * *************************************************************** 9560-CALC-BENE-DEDUCT. *-------------------------------------------------------------* * LINES INELIGIBLE FOR DEDUCTIBLE SKIP DEDUCTIBLE CALCULATION * * EFF. 7/1/2009 - CLINICAL TRIAL LINES FOR MANAGED CARE BENES * * ASSIGNED A PAF = ' 4' * *-------------------------------------------------------------* IF OPPS-PYMT-ADJ-FLAG (LN-SUB) = ' 4' GO TO 9560-CALC-BENE-DEDUCT-EXIT. *-------------------------------------------------------------* * BENEFICIARY HAS NOT MET HIS/HER DEDUCTIBLE LIMIT. * * CALCULATE THE "LINE BLOOD PAYMENT" * *-------------------------------------------------------------* IF H-BENE-DEDUCT > 0 THEN COMPUTE H-LN-BLD-PYMT = H-LITEM-PYMT - H-LN-BLOOD-DEDUCT *-------------------------------------------------------------* * BENEFICIARY'S DEDUCTIBLE DOES NOT COVER OR JUST COVERS THE * * ENTIRE LINE BLOOD PAYMENT: * * - BENEFICIARY'S REMAINING DEDUCTIBLE AMT APPLIED TO LINE * * - BENEFICIARY HAS REACHED HIS/HER DEDUCTIBLE LIMIT * *-------------------------------------------------------------* IF H-BENE-DEDUCT <= H-LN-BLD-PYMT THEN MOVE H-BENE-DEDUCT TO H-TOTAL-LN-DEDUCT MOVE 0 TO H-BENE-DEDUCT *-------------------------------------------------------------* * BENEFICIARY'S DEDUCTIBLE MORE THAN COVERS THE LINE BLOOD * * PAYMENT, DO THE FOLLOWING: * * - CALCULATE THE BENEFICIARY'S REMAINING DEDUCTIBLE AMOUNT * * AFTER PAYING FOR CURRENT SERVICE LINE * * - MEDICARE LINE PAYMENT = 0 * *-------------------------------------------------------------* ELSE COMPUTE H-BENE-DEDUCT = H-BENE-DEDUCT - H-LN-BLD-PYMT MOVE H-LN-BLD-PYMT TO H-TOTAL-LN-DEDUCT MOVE 20 TO A-RETURN-CODE (LN-SUB) END-IF END-IF. 9560-CALC-BENE-DEDUCT-EXIT. EXIT. *************************************************************** * * * CALCULATE OUTLIER PAYMENT * * ** CHANGE OUTLIER THRESHOLD EVERY JANUARY (HARD-CODED) ** * * * *************************************************************** * * * LOOP THROUGH THE COINSURANCE DEDUCTIBLE TABLE TO DO THE * * FOLLOWING FOR EACH SERVICE LINE: * * * * - DETERMINE IF THE LINE IS ELIGIBLE FOR AN OUTLIER PAYMENT * * - ADJUST CHARGES FOR LINES WITH ARTIFICIAL CHARGES ON CLAIM * * - DISTRIBUTE TOTAL CLAIM PACKAGED LINE CHARGES TO NON- * * PACKAGED PAYABLE LINES * * - ADJUST CHARGES OF PRIME CODE COMPOSITE APC LINES * * - ADJUST CHARGES OF MENTAL HEALTH LINES (APC = 34) * * - CALCULATE THE LINE OUTLIER PAYMENT FOR ELIGIBLE LINES * * * * * * NOTES: * * ------ * * - NEW FOR JANUARY 2004: * * - CHECK >= 20040101 AND SRVC-IND = 'K' * * - DISCONTINUE OUTLIER PROCESS * * * * - NEW FOR JANUARY 2008: * * - REVISED LOGIC FOR DETERMINING WHICH LINES WITH SRVC-IND * * = 'K' ARE ELIGIBLE FOR AN OUTLIER PAYMENT. THIS WAS * * NECESSARY B/C SOME RADIOPHARMS & ALL BRACHYTHERAPIES * * SRVC-IND = 'K' STARTING CY 2008. * * - PER LEGISLATION, BRACHYTHERAPY & RADIOPARM LINES' * * STATUS INDICATOR CHANGED BACK TO ' H' FOR CY 2008 QTR 1 * * ' K' LOGIC RETAINED B/C IT WILL NOT AFFECT PAYMENTS TO * * BRACHYTHERAPY OR RADIOPHARM LINES * * - COMPOSITE APC AND MENTAL HEALTH LINE CHARGE CALCS * * * * - NEW FOR APRIL 2008: ADD CHARGES AND PAYMENTS OF * * - PASS-THROUGH DEVICES TO THE CHARGES AND PAYMENTS OF * * PROCEDURES ELIGIBLE FOR THE DEVICES * * - A-LITEM-PYMT MOVED TO H-LITEM-PYMT-OUTL B/C PAYMENTS * * ARE ADJUSTED FOR PASS-THROUGH DEVICES FOR OUTLIER * * DETERMINATION ONLY * * * * - NEW FOR JULY 2008: BRACHYTHERAPY AND THERAPEUTIC * * RADIOPHARM LINES' SI CHANGED TO ' K'. BRACHYTHERAPY * * LINES ARE NOW ELIGIBLE FOR AN OUTLIER PAYMENT. * * * * - JULY 2008: DUE TO LEGISLATION, THERAPEUTIC RADIOPHARMS * * & BRACHYTHERAPY SOURCE'S SI CHANGED FROM 'K' BACK TO 'H' * * EFFECTIVE 7/1/2008; THESE LINES ARE NOT YET ELIGIBLE FOR * * AN OUTLIER PAYMENT. * * * * - 11/12/2008: FOR CY 2009, BRACHYS SI = U AND BLOOD SI = R * * BRACHY INELIGIBLE FOR OUTLIER, BLOOD ELIGIBLE FOR OUTLIER * * * * - 12/05/2008: ADDED SI = K TO LIST OF SIS INELIGIBLE FOR * * OUTLIER (BRACHYS & BLOOD NO LONGER HAVE SI = K) * * * * - 11/17/2009: REMOVED U FROM LIST OF SIS INELIGIBLE FOR * * OUTLIER; BRACHYS NOW ELIGIBLE B/C NOT PAID AT COST CY 2010* * * * - 12/16/2009: ADDED SIS R AND U TO LOGIC THAT DISTRIBUTES * * PACKAGED CHARGES TO PAYABLE LINES. V2010.1.2 * * * *************************************************************** 9600-ADJ-CHRG-OUTL. *-------------------------------------------------------------* * GO TO SERVICE LINE ASSOCIATED WITH THE CURRENT COINSURANCE * * DEDUCTIBLE TABLE RECORD * *-------------------------------------------------------------* MOVE W-LP-SUB (W-LP-INDX) TO LN-SUB. *-------------------------------------------------------------* * LINES WITH SERVICE INDICATORS NOT ELIGIBLE FOR AN OUTLIER * * PAYMENT AND LINES PACKAGED AS PART OF DRUG ADMINISTRATION * * APC PAYMENT BYPASS OUTLIER CALCULATION * * (DRUGS, DEVICES, PACKAGED SERVICES, BIOLOGICALS) * *-------------------------------------------------------------* * *** ENSURE ALL SIS ELIGIBLE FOR AN OUTLIER PAYMENT ARE *** * * *** LISTED IN THE LOGIC BELOW THAT DISTRIBUTES PACKAGED *** * * *** CHARGES TO PAYABLE LINES AND IN THE SUMMING LOGIC *** * * *** IN PARAGRAPH _500-ADJ-CHRGS. *** * *-------------------------------------------------------------* * 11/12/2008 - BRACHY (SI=U) ADDED TO LIST * * 12/05/2008 - SI K ADDED TO THE LIST * * 11/16/2009 - REMOVED PAF=2 FROM BRACHY (SI=U) CRITERIA * * 11/17/2009 - REMOVE SI=U, BRACHYS ARE ELIGIBLE FOR OUTLIER * *-------------------------------------------------------------* IF (OPPS-SRVC-IND (LN-SUB) = ' G' OR ' H' OR ' N' OR ' K') OR (OPPS-PKG-FLAG (LN-SUB) = '4') GO TO 9600-ADJ-CHRG-OUTL-EXIT. *-------------------------------------------------------------* * DISTRIBUTE TOTAL CLAIM PROCEDURE CHARGES TO PROCEDURE LINES * * IN PROPORTION TO THE PROCEDURE LINES' PAYMENTS WHEN THERE * * ARE ARTIFICIAL PROCEDURE CHARGES (< $1.01) ON THE CLAIM. * * (DISTRIBUTED CHARGES REPLACE BILLED CHARGES) * *-------------------------------------------------------------* * NOTE: LINES WITH CHARGES < $1.01 ARE FIXED BY FISS BEFORE * * ENTERING THE PRICER. THEREFORE, THIS LOGIC IS NO * * LONGER NECESSARY. THIS LOGIC WAS NECESSARY BEFORE * * FISS IMPLEMENTED THE FIX. * *-------------------------------------------------------------* IF (ST0-FLAG = 'Y') AND ((OPPS-SRVC-IND (LN-SUB) = ' T') OR ((OPPS-SRVC-IND (LN-SUB) = ' S') AND (OPPS-HCPCS (LN-SUB) > '09999' AND OPPS-HCPCS (LN-SUB) < '70000'))) AND (H-TOT-ST-PYMT > 0) COMPUTE H-CHRG-RATE ROUNDED = (A-LITEM-PYMT (LN-SUB) / H-TOT-ST-PYMT) COMPUTE W-SUB-CHRG (W-LP-INDX) ROUNDED = (H-CHRG-RATE * H-TOT-ST-CHRG) *-------------------------------------------------------------* * DISTRIBUTE TOTAL CLAIM PACKAGED LINE CHARGES TO SEPARATELY * * PAYABLE LINES IN PROPORTION TO THEIR PAYMENTS WHEN THERE * * ARE NO ARTIFICIAL PROCEDURE CHARGES (< $1.01) ON THE CLAIM. * * (DISTRIBUTED CHARGES ARE ADDED TO THE BILLED CHARGES) * *-------------------------------------------------------------* * 12/16/2009 - ADDED SIS R AND U TO LOGIC * *-------------------------------------------------------------* ELSE IF (N-FLAG = 'Y' AND ST0-FLAG = 'N') AND ((OPPS-SRVC-IND (LN-SUB) = ' S' OR ' T' OR ' V' OR ' X' OR ' P' OR ' R' OR ' U') AND (OPPS-PKG-FLAG (LN-SUB) = '0' OR '3')) AND (H-TOT-STVX-PYMT > 0) COMPUTE H-CHRG-RATE ROUNDED = (A-LITEM-PYMT (LN-SUB) / H-TOT-STVX-PYMT) COMPUTE H-SUB-CHRG ROUNDED = (H-CHRG-RATE * H-TOT-N-CHRG) COMPUTE W-SUB-CHRG (W-LP-INDX) ROUNDED = W-SUB-CHRG (W-LP-INDX) + H-SUB-CHRG. *-------------------------------------------------------------* * DISTRIBUTE TOTAL CLAIM PACKAGED LINE CHARGES TO SEPARATELY * * PAYABLE LINES IN PROPORTION TO THEIR PAYMENTS WHEN THERE * * ARE ARTIFICIAL PROCEDURE CHARGES (< $1.01) ON THE CLAIM. * * (DISTRIBUTED CHARGES ARE ADDED TO THE BILLED CHARGES) * *-------------------------------------------------------------* * NOTE: LINES WITH CHARGES < $1.01 ARE FIXED BY FISS BEFORE * * ENTERING THE PRICER. THEREFORE, THIS LOGIC IS NO * * LONGER NECESSARY. THIS LOGIC WAS NECESSARY BEFORE * * FISS IMPLEMENTED THE FIX. * *-------------------------------------------------------------* * 12/16/2009 - ADDED SIS R AND U TO LOGIC * *-------------------------------------------------------------* IF (N-FLAG = 'Y' AND ST0-FLAG = 'Y') AND ((OPPS-SRVC-IND (LN-SUB) = ' S' OR ' T' OR ' V' OR ' X' OR ' P' OR ' R' OR ' U') AND (OPPS-PKG-FLAG (LN-SUB) = '0' OR '3')) AND (H-TOT-STVX-PYMT > 0) COMPUTE H-CHRG-RATE ROUNDED = (A-LITEM-PYMT (LN-SUB) / H-TOT-STVX-PYMT) COMPUTE H-SUB-CHRG ROUNDED = (H-CHRG-RATE * H-TOT-N-CHRG) COMPUTE W-SUB-CHRG (W-LP-INDX) ROUNDED = W-SUB-CHRG (W-LP-INDX) + H-SUB-CHRG. *************************************************************** * CALCULATE COMPOSITE APC CHARGES FOR PRIME CODE LINES * * * * THE CHARGES OF ALL PACKAGED LINES WITH A COMPOSITE ADJ. * * FLAG THAT INDICATES THE LINE IS A PART OF A COMPOSITE APC * * (VALUES 01 - NN...) ARE ACCUMULATED BY COMPOSITE * * ADJUSTMENT FLAG AND ADDED TO THE CORRESPONDING PRIME * * (PAYABLE) LINE'S CHARGES. * *-------------------------------------------------------------* * 11/29/2007 - LOGIC ADDED FOR CY 2008 * * 12/14/2007 - ROUNDED W-SUB-CHRG WHEN ADDING COMPOSITES * * 11/12/2008 - CHANGED LOGIC TO USE THE COMPOSITE ADJUSTMENT * * FLAG INSTEAD OF THE PAYMENT ADJUSTMENT FLAG * * VALUES 91 - 99 TO ID PRIME COMPOSITE LINES * *************************************************************** *-------------------------------------------------------------* * COMPOSITE ADJUSTMENT FLAG > 0 INDICATES COMPOSITE APC * *-------------------------------------------------------------* IF OPPS-COMP-ADJ-FLAG (LN-SUB) NOT = '00' *-------------------------------------------------------------* * SEARCH COMPOSITE APC TABLE STARTING AT ENTRY #1 * *-------------------------------------------------------------* MOVE OPPS-COMP-ADJ-FLAG (LN-SUB) TO H-CMP-CAF SET W-CMP-INDX TO 1 SEARCH W-CMP-ENTRY VARYING W-CMP-INDX *-------------------------------------------------------------* * SERVICE LINE'S PAYMENT ADJUSTMENT FLAG NOT IN TABLE * *-------------------------------------------------------------* AT END ADD 0 TO W-SUB-CHRG (W-LP-INDX) *-------------------------------------------------------------* * SERVICE LINE'S PAYMENT ADJUSTMENT FLAG IS IN TABLE, * * ADD THE PACKAGED SUBMITTED CHARGES TO THE LINE'S CHARGES * *-------------------------------------------------------------* WHEN W-CMP-PAF (W-CMP-INDX) = H-CMP-CAF COMPUTE W-SUB-CHRG (W-LP-INDX) ROUNDED = W-SUB-CHRG (W-LP-INDX) + W-CMP-TOT-SUB-CHRG (W-CMP-INDX) END-IF. *************************************************************** * CALCULATE TOTAL MENTAL HEALTH CHARGES FOR APC 34 LINES * * * * THE CHARGES OF PACKAGED LINES WITH A PACKAGING FLAG OF '2' * * ON A CLAIM WITH APC 34 (MENTAL HEALTH APC) ARE ACCUMULATED * * AND ADDED TO THE SEPARATELY PAYABLE APC 34 LINE'S CHARGES. * *-------------------------------------------------------------* * 11/29/2007 - LOGIC ADDED FOR CY 2008 * * 11/12/2008 - LOGIC DISABLED FOR CY 2009 BECAUSE MENTAL * * HEALTH COMPOSITES ARE NOW PROCESSED THE SAME * * AS ALL OTHER COMPOSITES USING THE COMPOSITE * * ADJUSTMENT FLAG * *************************************************************** * IF APC34-FLAG = 'Y' AND OPPS-APC (LN-SUB) = '0034' * COMPUTE W-SUB-CHRG (W-LP-INDX) = * W-SUB-CHRG (W-LP-INDX) + * H-TOT-MH-CHRG * END-IF. *************************************************************** * MOVE LINE PAYMENTS TO HOLD FIELD BECAUSE PAYMENTS MAY BE * * ADJUSTED FOR PASS-THROUGH DEVICES - ADDED 02/14/2008 * * NEW FOR CY 2009 - ALWAYS USE THE PHP "CAP" APC'S WAGE ADJ * * PMT FOR PHP LINES (SI=P) * *************************************************************** MOVE ZEROS TO H-LITEM-PYMT-OUTL. IF OPPS-SRVC-IND (LN-SUB) = ' P' MOVE H-PHP-LITEM-PYMT-OUTL TO H-LITEM-PYMT-OUTL ELSE MOVE A-LITEM-PYMT (LN-SUB) TO H-LITEM-PYMT-OUTL END-IF. *************************************************************** * CALCULATE TOTAL CHARGES AND PAYMENTS FOR PROCEDURE LINES * * ELIGIBLE FOR PASS-THROUGH DEVICE(S) * * * * THE CHARGES AND LINE PAYMENTS OF PASS-THROUGH DEVICE LINES * * ARE ADDED TO THE CHARGES AND PAYMENTS OF ALL PROCEDURES * * ELIGIBLE TO BE BILLED WITH THE PASS-THROUGH DEVICE. * * (PTD-FLAG = 'Y' INDICATES THERE IS AT LEAST ONE * * PASS-THROUGH DEVICE ON THE CLAIM) * *-------------------------------------------------------------* * 02/12/2008 - LOGIC ADDED FOR CY 2008 QTR 2 * *************************************************************** IF (PTD-FLAG = 'Y') AND (OPPS-SRVC-IND (LN-SUB) = ' S' OR ' T' OR ' V' OR ' X') *-------------------------------------------------------------* * DETERMINE WHETHER THE LINE IS ELIGIBLE FOR A PT DEVICE * *-------------------------------------------------------------* PERFORM 9670-SET-PTD-PROC-FLAG THRU 9670-SET-PTD-PROC-FLAG-EXIT *-------------------------------------------------------------* * PROCEDURE IS ELIGIBLE FOR A PASS-THROUGH DEVICE * *-------------------------------------------------------------* * 11/12/2008 - EDITED TO LOOK AT PTD-PROC-FLAG, NOT PTD-FLAG * * NO HARM DONE USING THE PTD-FLAG PREVIOUSLY * *-------------------------------------------------------------* IF PTD-PROC-FLAG = 'Y' *-------------------------------------------------------------* * LOOP THROUGH ELIGIBLE PROCEDURE'S PASS-THROUGH DEVICE TABLE * * GET THE PASS-THROUGH DEVICE HCPCS(S) FOR WHICH THE * * PROCEDURE IS ELIGIBLE & UPDATE PROCEDURE CHARGES & PAYMENTS * *-------------------------------------------------------------* PERFORM 9610-PERFORM-SEARCH THRU 9610-PERFORM-SEARCH-EXIT VARYING W-PTD-PROC-SUB FROM 1 BY 1 UNTIL W-PTD-PROC-SUB > W-PTD-CNT END-IF END-IF. *************************************************************** * * * CALCULATE THE OUTLIER PAYMENT FOR ELIGIBLE LINES * * * * -NEW FOR JANUARY 2005 * * - PROVIDER RANGE FOR CMHC * * - COMPUTE H-LITEM-OUTL-PYMT USING NEW FORMULA * * - CHANGE OUTLIER THRESHOLD AMOUNT EVERY JANUARY * * * * -NEW FOR APRIL 2008 * * - A-LITEM-PYMT (LN-SUB) CHANGED TO H-LITEM-PYMT-OUTL B/C * * PAYMENTS ARE NOW ADJUSTED FOR OUTLIER DETERMINATION * * * * -NEW FOR JANUARY 2009 * * - ALL PARTIAL HOSPITALIZATION (PHP) LINES (SI=P) USE * * THE PHP "CAP" APC'S LINE PAYMENT * * * *************************************************************** MOVE 1.75 TO H-OUTLIER-FACTOR. MOVE .50 TO H-OUTLIER-PCT. COMPUTE H-COST ROUNDED = W-SUB-CHRG (W-LP-INDX) * L-PSF-OPCOST-RATIO. COMPUTE H-APC-ADJ-PYMT ROUNDED = H-OUTLIER-FACTOR * H-LITEM-PYMT-OUTL. *-------------------------------------------------------------* * IDENTIFY COMMUNITY MENTAL HEALTH CENTER (CMHC) PROVIDERS * * FOR CMHCS, INCREASE OUTLIER FACTOR & CALC LINE OUTLIER PMT * * (CMHC PROVIDERS ONLY PROCESS PARTIAL HOSPITALIZATION LINES) * *-------------------------------------------------------------* IF (L-PSF-PROV-3456 >= '1400' AND L-PSF-PROV-3456 <= '1499') OR (L-PSF-PROV-3456 >= '4600' AND L-PSF-PROV-3456 <= '4799') OR (L-PSF-PROV-3456 >= '4900' AND L-PSF-PROV-3456 <= '4999') MOVE 3.4 TO H-OUTLIER-FACTOR COMPUTE H-LITEM-OUTL-PYMT ROUNDED = (H-COST - (H-OUTLIER-FACTOR * H-LITEM-PYMT-OUTL)) * H-OUTLIER-PCT *-------------------------------------------------------------* * FOR NON-CMHC PROVIDERS, LINE'S OUTLIER ELIGIBILITY & * * CALCULATE OUTLIER PAYMENT IF ELIGIBLE * * ** UPDATE THE LITERAL NUMBER BELOW EACH JANUARY ** * *-------------------------------------------------------------* ELSE IF (H-COST > H-APC-ADJ-PYMT) AND (H-COST > H-LITEM-PYMT-OUTL + 2175) COMPUTE H-LITEM-OUTL-PYMT ROUNDED = (H-COST - H-APC-ADJ-PYMT) * H-OUTLIER-PCT ELSE MOVE ZERO TO H-LITEM-OUTL-PYMT END-IF END-IF. *-------------------------------------------------------------* * ACCUMULATE TOTAL CLAIM OUTLIER PAYMENTS * *-------------------------------------------------------------* IF H-LITEM-OUTL-PYMT > 0 COMPUTE H-OUTLIER-PYMT = H-OUTLIER-PYMT + H-LITEM-OUTL-PYMT. *-------------------------------------------------------------* * LINES THAT RECEIVE AN EXTERNAL ADJUSTMENT ARE NOT ELIGIBLE * * FOR AN OUTLIER PAYMENT - ZERO OUT PAYMENT & REMOVE FROM * * CLAIM TOTAL * *-------------------------------------------------------------* IF OPPS-LITEM-ACT-FLAG (LN-SUB) = '4' COMPUTE H-OUTLIER-PYMT = H-OUTLIER-PYMT - H-LITEM-OUTL-PYMT MOVE 0 TO H-LITEM-OUTL-PYMT. 9600-ADJ-CHRG-OUTL-EXIT. EXIT. *************************************************************** * * * SEARCH THE PASS-THROUGH DEVICE TABLE FOR THE PASS-THROUGH * * DEVICE(S) THE PROCEDURE IS ELIGIBLE FOR * * * *************************************************************** 9610-PERFORM-SEARCH. *-------------------------------------------------------------* * SEARCH PTD TABLE STARTING AT ENTRY #1 FOR ALL OCCURANCES * * OF THE PASS-THRU DEVICE HCPCS IN THE PASS-THRU DEVICE TABLE.* * THIS IS DONE FOR ALL PASS-THROUGH DEVICES THE PROCEDURE IS * * ELIGIBLE FOR. * *-------------------------------------------------------------* MOVE 'N' TO W-END-OF-PTD-TBL. IF W-PTD-PROC-HCPCS (W-PTD-PROC-SUB) NOT = ' ' SET W-PTD-INDX TO 1 PERFORM 9611-SEARCH-PTD-HCPCS THRU 9611-SEARCH-PTD-HCPCS-EXIT UNTIL W-END-OF-PTD-TBL = 'Y' END-IF. 9610-PERFORM-SEARCH-EXIT. EXIT. *************************************************************** * * * SEARCH FOR THE PASS-THROUGH DEVICE FOR WHICH THE PROCEDURE * * IS ELIGIBLE IN THE TABLE & UPDATE PROCEDURE LINE PAYMENTS * * AND CHARGES * * * *************************************************************** 9611-SEARCH-PTD-HCPCS. MOVE 'N' TO W-END-OF-PTD-TBL. *-------------------------------------------------------------* * SEARCH PASS-THROUGH DEVICE TABLE * *-------------------------------------------------------------* SEARCH W-PTD-ENTRY VARYING W-PTD-INDX *-------------------------------------------------------------* * IF THERE ARE NO MORE OCCURANCES OF THE PASS-THROUGH DEVICE, * * STOP THE SEARCH AND INDICATE END OF FILE * *-------------------------------------------------------------* AT END MOVE 'Y' TO W-END-OF-PTD-TBL GO TO 9611-SEARCH-PTD-HCPCS-EXIT *-------------------------------------------------------------* * IF THE PASS-THROUGH DEVICE IS FOUND, INDICATE NOT END OF * * FILE AND UPDATE THE PROCEDURE'S CHARGES AND PAYMENTS * *-------------------------------------------------------------* WHEN W-PTD-HCPCS (W-PTD-INDX) = W-PTD-PROC-HCPCS (W-PTD-PROC-SUB) MOVE 'N' TO W-END-OF-PTD-TBL PERFORM 9612-UPDATE-PTD-PROC THRU 9612-UPDATE-PTD-PROC-EXIT SET W-PTD-INDX UP BY 1 END-SEARCH. *-------------------------------------------------------------* * SET UP FOR NEXT PASS-THROUGH DEVICE RECORD * *-------------------------------------------------------------* MOVE ZEROS TO H-PTD-UNIT-RATE H-PTD-SUB-CHRG H-PTD-LITEM-PYMT. 9611-SEARCH-PTD-HCPCS-EXIT. EXIT. *************************************************************** * * * UPDATE THE PROCEDURE LINE'S PAYMENTS AND CHARGES WITH THE * * PASS-THROUGH DEVICE'S PAYMENTS AND CHARGES (IN PROPORTION * * TO THE PROCEDURE'S UNITS IF OTHER PROCEDURES ARE ELIGIBLE * * FOR THE PASS-THROUGH DEVICE AS WELL) * * * *************************************************************** 9612-UPDATE-PTD-PROC. *-------------------------------------------------------------* * DETERMINE PROPORTION OF CHARGES & PAYMENTS PROCEDURE LINE * * WILL RECEIVE BASED ON ITS NUMBER OF UNITS * *-------------------------------------------------------------* IF W-PTD-TOTAL-PROC-UNITS (W-PTD-INDX) NOT = 0 COMPUTE H-PTD-UNIT-RATE ROUNDED = OPPS-SRVC-UNITS (LN-SUB) / W-PTD-TOTAL-PROC-UNITS (W-PTD-INDX) ELSE MOVE 0 TO H-PTD-UNIT-RATE END-IF. *-------------------------------------------------------------* * CALCULATE THE AMOUNT OF PASS-THROUGH DEVICE CHARGES TO BE * * ADDED TO THE PROCEDURE'S CHARGES IN PROPORTION TO UNITS * *-------------------------------------------------------------* COMPUTE H-PTD-SUB-CHRG ROUNDED = W-PTD-SUB-CHRG (W-PTD-INDX) * H-PTD-UNIT-RATE. *-------------------------------------------------------------* * ADD PASS-THROUGH DEVICE CHARGES TO PROCEDURE LINE CHARGES * *-------------------------------------------------------------* COMPUTE W-SUB-CHRG (W-LP-INDX) ROUNDED = W-SUB-CHRG (W-LP-INDX) + H-PTD-SUB-CHRG. *-------------------------------------------------------------* * CALCULATE THE AMOUNT OF PASS-THROUGH DEVICE PAYMENTS TO BE * * ADDED TO THE PROCEDURE'S PAYMENTS IN PROPORTION TO UNITS * *-------------------------------------------------------------* COMPUTE H-PTD-LITEM-PYMT ROUNDED = W-PTD-LITEM-PYMT (W-PTD-INDX) * H-PTD-UNIT-RATE. *-------------------------------------------------------------* * ADD PASS-THROUGH DEVICE PAYMENT TO PROCEDURE LINE PAYMENT * *-------------------------------------------------------------* COMPUTE H-LITEM-PYMT-OUTL ROUNDED = H-LITEM-PYMT-OUTL + H-PTD-LITEM-PYMT. 9612-UPDATE-PTD-PROC-EXIT. EXIT. *************************************************************** * * * DETERMINE WHETHER THE CURRENT APC IS A BRACHYTHERAPY APC * * - IF SO, SET BRACHY-APC-FLAG = 'Y' * * - THIS FLAG IS USED IN PARAGRAPHS 9600-ADJ-CHRG-OUTL & * * 9550-CALC-GJK TO PROCESS BRACHYS * * ** UPDATE THIS LIST EVERY JANUARY * * (CODE NEW FOR CY2008; ADDED 11/6/2007) * * * * 11/12/2008 - BRACHYTHERAPY APC LIST REMOVED FOR CY 2009; * * BRACHYTHERAPY LINES NOW IDENTIFIED BY A * * STATUS INDICATOR OF ' U' * * * *************************************************************** *9650-SET-BRACHY-APC-FLAG. * * MOVE 'N' TO BRACHY-APC-FLAG. * * IF OPPS-APC (LN-SUB) = ('2632' OR * '1716' OR * '1717' OR * '1719' OR * '2616' OR * '2634' OR * '2635' OR * '2636' OR * '2638' OR * '2639' OR * '2640' OR * '2641' OR * '2642' OR * '2643' OR * '2698' OR * '2699') * * MOVE 'Y' TO BRACHY-APC-FLAG * END-IF. * *9650-SET-BRACHY-APC-FLAG-EXIT. * EXIT. *************************************************************** * * * DETERMINE WHETHER THE CURRENT HCPCS IS A BLOOD DEDUCTIBLE * * HCPCS * * - IF SO, SET BLD-DEDUC-HCPCS-FLAG = 'Y' * * - THIS FLAG IS USED IN PARAGRAPHS 9550-CALC-GJK & * * 9550-SCH-ADJ TO PROCESS BLOOD DEDUCTIBLE LINES * * ** UPDATE THIS LIST EVERY JANUARY * * (CODE NEW FOR CY2008; ADDED 12/4/2007) * * * *************************************************************** 9655-SET-BD-HCPCS-FLAG. MOVE 'N' TO BLD-DEDUC-HCPCS-FLAG. IF OPPS-HCPCS(LN-SUB) = ('P9054' OR 'P9051' OR 'P9021' OR 'P9056' OR 'P9016' OR 'P9010' OR 'P9038' OR 'P9040' OR 'P9022' OR 'P9058' OR 'P9057' OR 'P9039' ) MOVE 'Y' TO BLD-DEDUC-HCPCS-FLAG END-IF. 9655-SET-BD-HCPCS-FLAG-EXIT. EXIT. *************************************************************** * * * DETERMINE WHETHER THE CURRENT APC IS A RADIOPHARM APC * * - IF SO, SET RADIOPH-APC-FLAG = 'Y' * * - THIS FLAG IS USED IN PARAGRAPH 9550-CALC-STANDARD * * TO PROCESS RADIOPHARM LINES * * ** UPDATE THIS LIST EVERY JANUARY * * (CODE NEW FOR CY2008; ADDED 12/27/2007) * * * * 11/16/2009 - LOGIC REMOVED BECAUSE THERAP. RADIO NO LONGER * * HAVE AN SI=H (NOT PAID AT COST) CY 2010 * * * *************************************************************** *9660-SET-RADIOPH-APC-FLAG. * * MOVE 'N' TO RADIOPH-APC-FLAG. * * IF OPPS-APC (LN-SUB) = ('1064' OR * '1150' OR * '1643' OR * '1645' OR * '1675' OR * '1676' OR * '0701' OR * '0702') * * MOVE 'Y' TO RADIOPH-APC-FLAG * END-IF. * *9660-SET-RADIOPH-APC-FLAG-EXIT. * EXIT. *************************************************************** * * * DETERMINE WHETHER THE CURRENT HCPCS IS A PASS-THROUGH * * DEVICE HCPCS (FOR OUTLIER PAYMENT ADJ) * * - IF SO, SET PTD-LINE-FLAG = 'Y' * * - THIS FLAG IS USED IN THE PASS-THROUGH DEVICE LOGIC * * TO POPULATE THE PASS-THROUGH-DEVICE TABLE * * ** UPDATE THIS LIST EVERY QUARTER * * (CODE NEW FOR CY2008 QTR 2; ADDED 02/11/2008) * * * *************************************************************** 9665-SET-PTD-LINE-FLAG. MOVE 'N' TO PTD-LINE-FLAG. *********************************************************** * 11/12/2008 - ALL LOGIC DISABLED B/C THERE ARE NO * * NO PASS-THROUGH DEVICES FOR CY 2009 * * 11/18/2009 - NO PASS-THROUGH DEVICES FOR CY 2010 * * 08/12/2010 - NEW PT DEVICE EFFECTIVE OCTOBER 1, 2010 * *********************************************************** *---------------------------------------------------------* * ONLY CLAIMS WITH A DATE OF SERVICE ON OR AFTER * * 10/01/2010 ARE ELIGIBLE * *---------------------------------------------------------* IF OPPS-LITEM-DOS (LN-SUB) >= 20101001 IF OPPS-HCPCS (LN-SUB) = ('C1749') MOVE 'Y' TO PTD-LINE-FLAG END-IF END-IF. 9665-SET-PTD-LINE-FLAG-EXIT. EXIT. *************************************************************** * * * DETERMINE WHETHER THE CURRENT HCPCS IS A PROCEDURE * * ELIGIBLE FOR A PASS-THROUGH DEVICE (FOR OUTLIER PMT ADJ) * * - IF SO, SET PTD-PROC-FLAG = 'Y' * * - THIS FLAG IS USED IN THE PASS-THROUGH DEVICE LOGIC * * ** UPDATE THIS LIST EVERY QUARTER * * (CODE NEW FOR CY2008 QTR 2; ADDED 02/11/2008) * * * *************************************************************** 9670-SET-PTD-PROC-FLAG. MOVE 'N' TO PTD-PROC-FLAG. *********************************************************** * 11/12/2008 - ALL LOGIC DISABLED B/C THERE ARE NO * * NO PASS-THROUGH DEVICES FOR CY 2009 * * 11/18/2009 - NO PASS-THROUGH DEVICES FOR CY 2010 * * 08/12/2010 - NEW PT DEVICE EFFECTIVE OCTOBER 1, 2010 * *********************************************************** *---------------------------------------------------------* * ONLY CLAIMS WITH A DATE OF SERVICE ON OR AFTER * * 10/01/2010 ARE ELIGIBLE * *---------------------------------------------------------* IF OPPS-LITEM-DOS (LN-SUB) >= 20101001 *---------------------------------------------------------* * SPECIFY NUMBER OF ENTRIES (# OF PT DEVICES FROM POLICY)* *---------------------------------------------------------* MOVE 1 TO W-PTD-CNT *---------------------------------------------------------* * INITIALIZE PROCEDURE'S PTD HCPCS TABLE TO SPACES * *---------------------------------------------------------* PERFORM VARYING W-PTD-PROC-SUB FROM 1 BY 1 UNTIL W-PTD-PROC-SUB > W-PTD-CNT MOVE SPACES TO W-PTD-PROC-HCPCS (W-PTD-PROC-SUB) END-PERFORM *---------------------------------------------------------* * PROCEDURES ELIGIBLE FOR PASS-THROUGH DEVICE 1 * *---------------------------------------------------------* IF OPPS-HCPCS (LN-SUB) = ('45378' OR '45380' OR '45381' OR '45382' OR '45383' OR '45384' OR '45385' OR 'G0105' OR 'G0121') MOVE 'Y' TO PTD-PROC-FLAG MOVE 1 TO W-PTD-PROC-SUB MOVE 'C1749' TO W-PTD-PROC-HCPCS (W-PTD-PROC-SUB) END-IF END-IF. *---------------------------------------------------------* * PROCEDURES ELIGIBLE FOR PASS-THROUGH DEVICE 2 * * ** ENABLE IF THERE ARE MULTIPLE PT DEVICES * *---------------------------------------------------------* * IF OPPS-HCPCS (LN-SUB) = ('69714' OR * '69715' OR * '69717' OR * '69718') * * MOVE 'Y' TO PTD-PROC-FLAG * MOVE 2 TO W-PTD-PROC-SUB * MOVE 'L8690' TO W-PTD-PROC-HCPCS (W-PTD-PROC-SUB) * END-IF * END-IF. 9670-SET-PTD-PROC-FLAG-EXIT. EXIT. *************************************************************** * * * DETERMINE WHETHER THE LINE HCPCS IS A CURRENT PASS-THROUGH * * RADIOPHARMACEUTICAL HCPCS * * * * - IF SO: SET PTRADIO-LINE-FLAG = 'Y', * * ADD 1 TO COUNT OF TOTAL PT RADIOPHARMS, * * ADD CHARGES TO CLAIM TOTAL PT RADIOPHARM CHRGES * * - THIS FLAG IS USED IN PARAGRAPHS 9125-INIT & * * 9550-CALC-STANDARD TO PROCESS PT RADIOPHARM LINES * * * * ** PASS-THROUGH RADOIOPHARM TABLE IS UPDATED QUARTERLY * * (CODE NEW FOR CY2009; ADDED 02/10/2009) * * * *-------------------------------------------------------------* * * * 12/20/2011 - LOGIC REVISED TO INCLUDE TERMINATION DATE * * AS A VALID DATE OF SERVICE * * * *************************************************************** 9680-SET-PTRADIO-LINE-FLAG. MOVE 'N' TO PTRADIO-LINE-FLAG. SEARCH ALL PTRH-ENTRY AT END MOVE 'N' TO PTRADIO-LINE-FLAG WHEN PTRH-PTRADIO-HCPCS (PTRH-INDX) = OPPS-HCPCS (LN-SUB) IF OPPS-LITEM-DOS (LN-SUB) >= PTRH-EFF-DATE (PTRH-INDX) AND (OPPS-LITEM-DOS (LN-SUB) <= PTRH-TERM-DATE (PTRH-INDX) OR PTRH-TERM-DATE (PTRH-INDX) = 0) THEN MOVE 'Y' TO PTRADIO-LINE-FLAG END-IF. 9680-SET-PTRADIO-LINE-FL-EXIT. EXIT. *************************************************************** * * * DETERMINE WHETHER THE LINE HCPCS IS A CURRENT PASS-THROUGH * * CONTRAST AGENT HCPCS * * * * - IF SO: SET PTCA-LINE-FLAG = 'Y', * * - THIS FLAG IS USED IN PARAGRAPHS 9125-INIT & * * 9550-CALC-STANDARD TO PROCESS PT CONTRAST AGENT LINES * * * * ** PASS-THROUGH CONTRAST AGENT TABLE IS UPDATED QUARTERLY * * (CODE NEW FOR CY2010; ADDED 11/16/2009) * * * *-------------------------------------------------------------* * * * 12/20/2011 - LOGIC REVISED TO INCLUDE TERMINATION DATE * * AS A VALID DATE OF SERVICE * * * *************************************************************** 9681-SET-PTCA-LINE-FLAG. MOVE 'N' TO PTCA-LINE-FLAG. SEARCH ALL PTCH-ENTRY AT END MOVE 'N' TO PTCA-LINE-FLAG WHEN PTCH-PTCONTR-HCPCS (PTCH-INDX) = OPPS-HCPCS (LN-SUB) IF OPPS-LITEM-DOS (LN-SUB) >= PTCH-EFF-DATE (PTCH-INDX) AND (OPPS-LITEM-DOS (LN-SUB) <= PTCH-TERM-DATE (PTCH-INDX) OR PTCH-TERM-DATE (PTCH-INDX) = 0) THEN MOVE 'Y' TO PTCA-LINE-FLAG END-IF. 9681-SET-PTCA-LINE-FL-EXIT. EXIT. *************************************************************** * * * DETERMINE WHETHER THE LINE HCPCS IS A CURRENT PASS-THROUGH * * DEVICE HCPCS (FOR OFFSET) * * * * - IF SO: SET PTDO-LINE-FLAG = 'Y', * * - THIS FLAG IS USED IN PARAGRAPHS 9125-INIT & * * 9550-CALC-STANDARD TO PROCESS PT DEVICE LINES * * * * ** PASS-THROUGH DEVICE OFFSET TABLE IS UPDATED QUARTERLY * * (CODE NEW FOR OCT 2010; ADDED 08/02/2010) * * * *-------------------------------------------------------------* * * * 12/20/2011 - LOGIC REVISED TO ACCOMMODATE DEVICES THAT HAVE * * MULTIPLE PROCEDURE PAIRINGS WITH DIFFERENT * * EFFECTIVE AND TERMINATION DATES. ALSO ENSURED * * THE TERMINATION DATE IS AFTER OR ON THE * * DATE OF SERVICE. * * * *************************************************************** 9682-SET-PTDO-LINE-FLAG. MOVE 'N' TO PTDO-LINE-FLAG. SET PTDO-INDX TO 1. SEARCH PTDO-ENTRY AT END MOVE 'N' TO PTDO-LINE-FLAG *----------------------------------------------------------------* * LINE HCPCS IS FOUND IN THE PT DEVICE OFFSET HISTORY TABLE AND * * THE DATE OF SERVICE IS WITHIN THE EFFECTIVE & TERMINATION DATE * * PARAMETERS. * *----------------------------------------------------------------* WHEN PTDO-DEV-HCPCS (PTDO-INDX) = OPPS-HCPCS (LN-SUB) AND PTDO-EFF-DATE (PTDO-INDX) <= OPPS-LITEM-DOS (LN-SUB) AND (PTDO-TERM-DATE (PTDO-INDX) >= OPPS-LITEM-DOS (LN-SUB) OR PTDO-TERM-DATE (PTDO-INDX) = 0) MOVE 'Y' TO PTDO-LINE-FLAG. *-------------------------------------------------------------* * OLD LOGIC DISABLED & REPLACED BY LOGIC ABOVE ON 12/20/2011 * *-------------------------------------------------------------* * MOVE 'N' TO PTDO-LINE-FLAG. * * SEARCH ALL PTDO-ENTRY * AT END * MOVE 'N' TO PTDO-LINE-FLAG * * WHEN PTDO-DEV-HCPCS (PTDO-INDX) = OPPS-HCPCS (LN-SUB) * IF OPPS-LITEM-DOS (LN-SUB) >= PTDO-EFF-DATE (PTDO-INDX) AND * (OPPS-LITEM-DOS (LN-SUB) < PTDO-TERM-DATE (PTDO-INDX) OR * PTDO-TERM-DATE (PTDO-INDX) = 0) THEN * MOVE 'Y' TO PTDO-LINE-FLAG * END-IF. *-------------------------------------------------------------* 9682-SET-PTDO-LINE-FL-EXIT. EXIT. *************************************************************** * * * *** PARAGRAPH COMMENTED OUT 8/11/2010, * * REPLACED WITH REVISED PT DEVICE OFFSET LOGIC ** * * * * REDUCE LINE ITEM PAYMENTS OF DEVICE LINES (SI = H) BY THE * * WAGE ADJUSTED DEVICE OFFSET AMOUNT WHEN THERE ARE DEVICE * * OFFSETS ON THE CLAIM (PASS-THROUGH DEVICES) * * * *************************************************************** * * * 1. RE-CALCULATE LINE ITEM PAYMENT FOR SERVICE INDICATOR * * TYPE H * * 2. SUBTRACT WAGE ADJUSTED OFFSET AMOUNT FROM SI TYPE 'H' * * WITH HCPCS CODE BEGINNING WITH 'C' * * ** EFFECTIVE 04/01/2002 * * * *************************************************************** *9700-CALC-H-OFFSET. * *-------------------------------------------------------------* * REDUCE EACH DEVICE LINE'S PAYMENT BY THE WAGE ADJUSTED * * OFFSET AMOUNT IN PROPORTION TO THE DEVICE LINE'S CHARGES * *-------------------------------------------------------------* * IF H-TOT-H-CHRG > 0 * COMPUTE H-OFF-RATE ROUNDED = * H-SUB-CHRG / H-TOT-H-CHRG * COMPUTE T-LITEM-PYMT ROUNDED = * T-LITEM-PYMT - (H-TOTAL-WAOFF * H-OFF-RATE) * ELSE * NEXT SENTENCE. * * IF T-LITEM-PYMT < 0 * MOVE 0 TO T-LITEM-PYMT. * *9700-CALC-H-OFFSET-EXIT. * EXIT. *************************************************************** * * * PROCESS DRUG COINSURANCE TABLE RECORDS * * * *************************************************************** * * * ADJUST THE "DRUG" LINE COINSURANCE WHEN THE PROCEDURE * * COINSURANCE AMOUNTS PLUS THE "DRUG" COINSURANCE AMOUNT(S) * * BILLED ON THE SAME DAY EXCEED THE DAILY INPATIENT * * COINSURANCE LIMIT. * * * *************************************************************** 9800-ADJ-STV-REIM. IF W-DCP-CODE (W-DCP-INDX) = 1 PERFORM 9810-PROCESS-TYPE1 THRU 9810-PROCESS-TYPE1-EXIT ELSE PERFORM 9840-PROCESS-TYPE2 THRU 9840-PROCESS-TYPE2-EXIT. 9800-ADJ-STV-REIM-EXIT. EXIT. *************************************************************** * * * FOR DAYS OF SERVICE WITH "DRUG" COINSURANCE, DETERMINE THE * * % OF TOTAL "DRUG" COINSURANCE THAT CAN BE PAID IN ADDITION * * TO THE DAY'S MOST EXPENSIVE PROCEDURE/VISIT WAGE ADJUSTED * * COINSURANCE WHILE KEEPING WITHIN THE INPATIENT DAILY * * COINSURANCE LIMIT. * * * * WHEN H-RATIO = 0, NONE OF THE DRUG COINSURANCE CAN BE PAID * * WHEN H-RATIO = 1, ALL OF THE DRUG COINSURANCE CAN BE PAID * * * * BY USING THE DAY'S MOST EXPENSIVE PROCEDURE/VIST WAGE * * ADJUSTED COINSURANCE, THE BENEFICIARY RECEIVES THE * * GREATEST BENEFIT FROM THE INPATIENT LIMITATION PROVISION. * * * *************************************************************** 9810-PROCESS-TYPE1. *-------------------------------------------------------------* * DRUGS WERE ADMINISTERED ON THE DAY * *-------------------------------------------------------------* IF W-DCP-COIN2 (W-DCP-INDX) > 0 *-------------------------------------------------------------* * GET DATE OF SERVICE & WAGE ADJUSTED COINSURANCE OF THE * * DAY'S MOST EXPENSIVE PROCEDURE/VISIT * *-------------------------------------------------------------* MOVE W-DCP-DOS (W-DCP-INDX) TO H-DCP-DOS MOVE W-DCP-WGNAT (W-DCP-INDX) TO H-TOTAL *-------------------------------------------------------------* * CALCULATE THE % OF THE DAY'S TOTAL DRUG COIN THAT CAN BE * * PAID IN ADDITION TO THE PROCEDURE/VISIT COIN WITHIN THE * * INPATIENT LIMIT * *-------------------------------------------------------------* COMPUTE H-RATIO = (H-IP-LIMIT - W-DCP-WGNAT (W-DCP-INDX)) / W-DCP-COIN2 (W-DCP-INDX) *-------------------------------------------------------------* * NONE OF THE DAY'S DRUG COIN CAN BE PAID B/C THE PROCEDURE/ * * VISIT COIN > INPATIENT COIN LIMIT * *-------------------------------------------------------------* IF H-RATIO < 0 MOVE 0 TO H-RATIO. *-------------------------------------------------------------* * THE DAY'S TOTAL DRUG COINSURANCE CAN BE PAID WITHIN THE * * INPATIENT COIN LIMIT * *-------------------------------------------------------------* IF H-RATIO > 1 MOVE 1 TO H-RATIO. 9810-PROCESS-TYPE1-EXIT. EXIT. *************************************************************** * * * REDUCE THE "DRUG" LINE'S NATIONAL COINSURANCE AMOUNT AND * * ADD THE REDUCTION AMOUNT TO THE LINE'S REIMBURSEMENT * * AMOUNT WHEN THE INPATIENT LIMIT IS EXCEEDED * * * *************************************************************** 9840-PROCESS-TYPE2. *-------------------------------------------------------------* * CURRENT TYPE 2 DRUG COIN REC HAS SAME DATE OF SERVICE AS * * THE LAST TYPE 1 RECORD PROCESSED * *-------------------------------------------------------------* IF W-DCP-DOS (W-DCP-INDX) = H-DCP-DOS *-------------------------------------------------------------* * GO TO SERVICE LINE THAT CORRESPONDS TO THE DRUG COIN RECORD * *-------------------------------------------------------------* MOVE W-DCP-SUB (W-DCP-INDX) TO LN-SUB *-------------------------------------------------------------* * CALCULATE ACTUAL COIN AMT TO BE REIMBURSED DUE TO IP LIMIT * *-------------------------------------------------------------* COMPUTE H-SHIFT = W-DCP-COIN2 (W-DCP-INDX) * (1 - H-RATIO) *-------------------------------------------------------------* * ACCUMULATE THE TOTAL NATIONAL COIN DUE FOR THE DAY * * (LESS ACTUAL COIN AMT TO BE REIMBURSED DUE TO IP LIMIT) * *-------------------------------------------------------------* COMPUTE H-TOTAL = A-ADJ-COIN (LN-SUB) + H-TOTAL - H-SHIFT *-------------------------------------------------------------* * DETERMINE HOW MUCH THE DAY'S TOTAL NATIONAL COIN DUE * * EXCEEDS THE DAILY INPATIENT LIMIT (IF IT EXCEEDS THE LIMIT) * *-------------------------------------------------------------* * OCCURS WHEN THE NATIONAL COIN OF THIS LINE AND/OR PREVIOUS * * LINES FROM THE SAME DAY IS GREATER THAN THE ACTUAL COIN DUE * * & PUSHES THE DAILY TOTAL OVER THE INPATIENT LIMIT * *-------------------------------------------------------------* IF H-TOTAL > H-IP-LIMIT COMPUTE H-SHIFT = H-SHIFT + H-TOTAL - H-IP-LIMIT END-IF *-------------------------------------------------------------* * CALCULATE THE ADJUSTED NATIONAL COIN FOR THE DRUG LINE BY * * DEDUCTING THE AMT THAT EXCEEDS THE INPATIENT LIMIT * *-------------------------------------------------------------* COMPUTE A-ADJ-COIN (LN-SUB) = A-ADJ-COIN (LN-SUB) - H-SHIFT *-------------------------------------------------------------* * ADD DRUG COIN AMT THAT EXCEEDS IP LIMIT TO LINE REIM AMT * * SET RETURN CODE TO INDICATE DAILY COINSURANCE LIMITATION * *-------------------------------------------------------------* COMPUTE A-LITEM-REIM (LN-SUB) = A-LITEM-REIM (LN-SUB) + H-SHIFT MOVE 22 TO A-RETURN-CODE (LN-SUB) END-IF. 9840-PROCESS-TYPE2-EXIT. EXIT. *************************************************************** * * * END OF CLAIM PROCESSING * * * * 1. MOVE TOTAL CLAIM CHARGE AMOUNT. * * 2. MOVE TOTAL CLAIM PAYMENT AMOUNT. * * 3. MOVE TOTAL CLAIM BLOOD PINTS USED. * * 4. CALCULATE CLAIM LEVEL OUTLIER AMOUNT. * * * *************************************************************** 9900-END-PRICE-RTN. MOVE H-TOT-CHRG TO A-TOT-CLM-CHRG. MOVE H-TOT-PYMT TO A-TOT-CLM-PYMT. *-------------------------------------------------------------* * NUMBER OF BLOOD PINTS USED FOR BLOOD DEDUCTIBLES ON CLAIM = * * INITIAL NUMBER OF BLOOD PINTS ALLOWED FOR DEDUCTIBLES - * * BLOOD PINTS STILL LEFT AFTER PROCESSING BLOOD DEDUCTIBLES * *-------------------------------------------------------------* COMPUTE A-BLOOD-PINTS-USED = H-BENE-BLOOD-PINTS - H-BENE-PINTS-USED. IF H-OUTLIER-PYMT > 0 MOVE H-OUTLIER-PYMT TO A-OUTLIER-PYMT. 9900-END-PRICE-RTN-EXIT. EXIT. ****************************************************************** ****************************************************************** *** *** ** ** ** OUTPATIENT PROSPECTIVE PAYMENT SYSTEM PRICER ** ** -------------------------------------------- ** ** SECTION 10000 FOR CALENDAR YEAR 2011 PROCESSING ** ** SERVICE FROM DATES: 1/1/2011 - 12/31/2011 ** ** ** *** *** ****************************************************************** ****************************************************************** ****************************************************************** * * * PRICING PROCESS OVERVIEW * * ------------------------ * * * * 1. GET RATES & OTHER INFORMATION FOR THE CLAIM * * 2. VALIDATE CLAIM * * 3. VALIDATE SERVICE LINES (INCLUDING DATA FROM THE OCE) * * 4. GET RATES & OTHER INFORMATION FOR THE SERVICE LINES * * 5. ACCUMULATE NON-PRIME LINE CHARGES FOR COMPOSITE APCS * * 6. ACCUMULATE PACKAGED MENTAL HEALTH CHARGES * * 7. ORDER THE SERVICE LINES IN THE SEQUENCE IN WHICH * * DEDUCTIBLES WILL BE APPLIED * * 8. ORDER BLOOD LINES IN THE SEQUENCE IN WHICH DEDUCTIBLES * * WILL BE APPLIED * * 9. CALCULATE SERVICE LINE PAYMENTS * * 10. CALCULATE DEDUCTIBLE AMOUNT APPLIED TO EACH SERVICE LINE * * 11. CALCULATE BLOOD DEDUCTIBLE AMOUNT APPLIED TO EACH BLOOD * * DEDUCTIBLE LINE * * 12. CALCULATE BENEFICIARY MAXIMUM (IP LIMIT), NATIONAL, * * MINIMUM, & REDUCED COINSURANCE FOR EACH SERVICE LINE * * 13. CALCULATE REIMBURSEMENT FOR EACH SERVICE LINE * * 14. ADJUST LINE CHARGES FOR ARTIFICAL, PACKAGED, COMPOSITE, * * AND MENTAL HEALTH CHARGES OF APPLICABLE PROCEDURES. ALSO, * * ADJUST LINE CHARGES AND PAYMENTS FOR PASS-THROUGH DEVICES * * FOR ELIGIBLE PROCEDURES. ALL ADJUSTMENTS ARE DONE FOR * * OUTLIER DETERMINATION ONLY. * * 15. CALCULATE OUTLIER PAYMENT FOR ELIGIBLE SERVICE LINES * * 16. APPLY THE DAILY INPATIENT LIMIT IN CALCULATING THE * * COINSURANCE TO BE PAID BY THE BENEFICIARY FOR DRUG LINES; * * ADD ANY COINSURANCE AMOUNT THAT EXCEEDS THE INPATIENT * * LIMIT TO THE DRUG LINE'S REIMBURSEMENT * * 17. ACCUMULATE CLAIM TOTALS * * 18. MOVE FINAL SERVICE LINE AMOUNTS TO AREA TO BE PASSED BACK * * * ****************************************************************** 10000-PROCESS-MAIN-NEW. ***************************************************************** * * * STEP 1 - INITIALIZE & SET WORKING-STORAGE VARIABLES, ASSIGN * * ------ CBSA & WAGE INDEX, PERFORM CLAIM DATE EDITS, SET * * INPATIENT DAILY COINSURANCE LIMIT (SET ANNUALLY) * * * ***************************************************************** PERFORM 10100-INIT THRU 10100-INIT-EXIT. *--------------------------------------------------------* * SET ERROR CODE IF THE WAGE INDEX = 0 * *--------------------------------------------------------* IF H-WINX1 = 0 AND A-CLM-RTN-CODE = 01 MOVE 51 TO A-CLM-RTN-CODE. *--------------------------------------------------------* * IF THE CLAIM HAS ERROR(S), STOP PROCESSING * *--------------------------------------------------------* IF A-CLM-RTN-CODE >= 50 GOBACK. *--------------------------------------------------------* * MOVE WAGE INDEX TO VARIABLE TO BE PASSED BACK * *--------------------------------------------------------* MOVE H-WINX1 TO A-WINX. ***************************************************************** * * * STEP 2 - SET CLAIM FLAGS WHEN CERTAIN CODES ARE FOUND * * ------ (LOOP THROUGH THE CLAIM) * * * * - PHP-APC-FLAG - PARTIAL HOSPITALIZATION CLAIM * * (APCS 00172, 00173, 00175, & 00176) * * - APC34-FLAG - MENTAL HEALTH CLAIM * * - PTD-FLAG - PASS-THROUGH DEVICE(S) ON CLAIM FOR OUTLIER * * - PTRADIO-CLAIM-FLAG - PASS-THROUGH RADIOPAHARM(S) ON CLAIM * * - PTCA-CLAIM-FLAG - PASS-THROUGH CONTRAST AGENT ON CLAIM * * CREATE PASS-THROUGH CONTRAST AGENT DAY TABLE * * - PTDO-CLAIM-FLAG - PASS-THROUGH DEVICE ON CLAIM FOR OFFSET * * CREATE PASS-THROUGH DEVICE HCPCS TABLE * * * * - DISABLED CY 2009: C1820-OFFSET-FLAG - DEVICE OFFSET CLAIM * * * ***************************************************************** *--------------------------------------------------------* * EMPTY PASS-THROUGH CONTRAST AGENT DAY TABLE FOR CLAIM * *--------------------------------------------------------* MOVE 0 TO W-PTCA-DAY-MAX. *--------------------------------------------------------* * EMPTY PASS-THROUGH DEVICE HCPCS TABLE FOR CLAIM * *--------------------------------------------------------* MOVE 0 TO W-PTDO-HCPCS-MAX. PERFORM 10125-INIT THRU 10125-INIT-EXIT VARYING LN-SUB FROM 1 BY 1 UNTIL LN-SUB > OPPS-LINE-CNT. ***************************************************************** * * * STEP 3 - VALIDATE CLAIM LINES, CALCULATE LINE DISCOUNTS & * * ------ OFFSETS, ACCUMULATE CLAIM TOTALS, SET FLAGS, * * POPULATE COINSURANCE & BLOOD DEDUCTIBLE TABLES * * WITH VALID SERVICE LINES, POPULATE COMPOSITE APC * * TABLE WITH NON-PRIME COMPOSITE LINE CHARGES, * * CALCULATE TOTAL PACKAGED MENTAL HEALTH CHARGES, * * CREATE PASS-THROUGH DEVICE TABLE (OUTLIER), CREATE * * NUCLEAR MEDICINE APC TABLE FOR PASS-THROUGH * * RADIOPHARMACEUTICAL OFFSET, CREATE CONTRAST * * AGENT PROCEDURE TABLE FOR PASS-THROUGH CONTRAST * * AGENT OFFSET & CREATE PASS-THROUGH DEVICE OFFSET * * PROCEDURE TABLE FOR PASS-THROUGH DEVICE OFFSET. * * (LOOP THROUGH THE CLAIM) * * * ***************************************************************** *--------------------------------------------------------* * EMPTY TABLES FOR NEW CLAIM * *--------------------------------------------------------* MOVE 0 TO W-DCP-MAX W-BLD-MAX W-CMP-MAX W-PTD-MAX W-NUCMED-MAX W-CAPROC-MAX W-PTDO-PROC-MAX. PERFORM 10150-INIT THRU 10150-INIT-EXIT VARYING LN-SUB FROM 1 BY 1 UNTIL LN-SUB > OPPS-LINE-CNT. *--------------------------------------------------------* * CALCULATE RATIO OF BLOOD PRODUCT CHARGES TO TOTAL * * BLOOD CHARGES (PRODUCT & STORAGE/PROCESSING) * *--------------------------------------------------------* IF H-TOT-38X-39X > 0 COMPUTE H-38X-39X-RATE ROUNDED = H-TOT-38X / H-TOT-38X-39X. *--------------------------------------------------------* * CALCULATE TOTAL OFFSET AMT FOR PT RADIOPHARM LINE(S) * * (# OF UNITS SUMMED LIMITED TO THE LESSER OF THE # OF * * PT RADIOPHARM HCPCS & THE # OF NUCLEAR MEDICINE UNITS)* *--------------------------------------------------------* IF W-NUCMED-MAX > 0 SET W-NUCMED-INDX TO 1 PERFORM UNTIL (W-NUCMED-INDX > W-NUCMED-MAX) OR (W-NUCMED-INDX > H-PTRADIO-HCPCS-CNT) COMPUTE H-NUCMED-TOT-OFFSET ROUNDED = H-NUCMED-TOT-OFFSET + W-NUCMED-WAGE-ADJ-OFFSET (W-NUCMED-INDX) SET W-NUCMED-INDX UP BY 1 END-PERFORM END-IF. *--------------------------------------------------------* * CALCULATE TOTAL OFFSET AMT PER DAY FOR PT CONTRAST * * AGENT LINE(S) (# OF UNITS SUMMED LIMITED TO THE LESSER * * OF THE # OF PT CONTRAST AGENT HCPCS & THE # OF PT * * CONTRAST AGENT PROCEDURE APC UNITS PER DAY) * *--------------------------------------------------------* IF W-PTCA-DAY-MAX > 0 AND W-CAPROC-MAX > 0 SET W-PTCA-DAY-INDX TO 1 PERFORM UNTIL (W-PTCA-DAY-INDX > W-PTCA-DAY-MAX) PERFORM 10396-TOTAL-DAY-PTCA-OFFS THRU 10396-TOTAL-DAY-PTCA-OFFS-EXIT SET W-PTCA-DAY-INDX UP BY 1 END-PERFORM END-IF. *--------------------------------------------------------* * MAP PASS-THROUGH DEVICE HCPCS TO THEIR CORRESPONDING * * OFFSET PROCEDURES * *--------------------------------------------------------* PERFORM 10397-PTDO-MAPPINGS-1 THRU 10397-PTDO-MAPPINGS-1-EXIT VARYING W-PTDO-HCPCS-INDX FROM 1 BY 1 UNTIL W-PTDO-HCPCS-INDX > W-PTDO-HCPCS-MAX. PERFORM 10397-PTDO-MAPPINGS-2 THRU 10397-PTDO-MAPPINGS-2-EXIT VARYING W-PTDO-HCPCS-INDX FROM 1 BY 1 UNTIL W-PTDO-HCPCS-INDX > W-PTDO-HCPCS-MAX. ***************************************************************** * * * STEP 4 - ACCUMULATE TOTAL CLAIM CHARGES FROM DEVICE LINES * * ------ (FOR DEVICES, SERVICE INDICATOR = H) * * (LOOP THROUGH THE COINSURANCE DEDUCTIBLE TABLE) * * * * *** DISABLED 08-11-2010 - NO LONGER NEEDED; REPLACED BY * * REVISED PASS-THROUGH DEVICE LOGIC * * * ***************************************************************** MOVE 0 TO W-DCP-MAX. * PERFORM 9555-CALC-H-TOT * THRU 9555-CALC-H-TOT-EXIT * VARYING W-LP-INDX FROM 1 BY 1 * UNTIL W-LP-INDX > W-LNC-MAX. ***************************************************************** * * * STEP 5 - CALCULATE LINE PAYMENTS, DEDUCTIBLES, COINSURANCE, * * ------ & REIMBURSEMENT, ACCUMULATE CLAIM TOTALS, POPULATE * * DRUG COINSURANCE TABLE, POPULATE PASS-THROUGH * * DEVICE TABLE WITH ELIGIBLE PROCEDURE DATA AND * * DEVICE LINE ITEM PAYMENT, AND MOVE LINE ITEM * * VALUES TO VARIABLES TO BE PASSED BACK * * (LOOP THROUGH THE COINSURANCE DEDUCTIBLE TABLE) * * * ***************************************************************** *--------------------------------------------------------* * POINT TO 1ST RECORD IN THE BLOOD DEDUCTIBLE TABLE * *--------------------------------------------------------* SET W-BD-INDX TO 1. *--------------------------------------------------------* * CLEAR THE DRUG COINSURANCE TABLE * *--------------------------------------------------------* MOVE 0 TO W-DCP-MAX. PERFORM 10400-CALCULATE THRU 10400-CALCULATE-EXIT VARYING W-LP-INDX FROM 1 BY 1 UNTIL W-LP-INDX > W-LNC-MAX. ***************************************************************** * * * STEP 6 - ADJUST PROCEDURE LINE CHARGES FOR ARTIFICIAL * * ------ CHARGES, PACKAGING, COMPOSITES, MENTAL HEALTH, AND * * PASS-THROUGH DEVICES, AND CALCULATE OUTLIER * * PAYMENTS * * (LOOP THROUGH THE COINSURANCE DEDUCTIBLE TABLE) * * * ***************************************************************** PERFORM 10600-ADJ-CHRG-OUTL THRU 10600-ADJ-CHRG-OUTL-EXIT VARYING W-LP-INDX FROM 1 BY 1 UNTIL W-LP-INDX > W-LNC-MAX ***************************************************************** * * * STEP 7 - CALCULATE THE COINSURANCE & REIMBURSEMENT AMOUNTS * * ------ FOR STATUS INDICATOR G & K LINES. THE DAILY INPA- * * TIENT COINSURANCE LIMIT IS APPLIED USING THE WAGE * * ADJUSTED COINSURANCE OF EACH DAY'S MOST EXPENSIVE * * PROCEDURE OR VISIT. * * (LOOP THROUGH THE DRUG COINSURANCE TABLE) * * * ***************************************************************** IF GJK-FLAG = 'Y' PERFORM 10800-ADJ-STV-REIM THRU 10800-ADJ-STV-REIM-EXIT VARYING W-DCP-INDX FROM 1 BY 1 UNTIL W-DCP-INDX > W-DCP-MAX ELSE NEXT SENTENCE. ***************************************************************** * * * STEP 8 - MOVE CLAIM TOTAL CHARGES, PAYMENTS, BLOOD PINTS * * ------ USED, AND OUTLIER PAYMENTS TO VARIABLES TO BE * * PASSED BACK. CALCULATE BLOOD PINTS USED. * * * ***************************************************************** PERFORM 10900-END-PRICE-RTN THRU 10900-END-PRICE-RTN-EXIT. 10000-PROCESS-MAIN-NEW-EXIT. EXIT. *************************************************************** * * * INITIALIZE WORKING STORAGE HOLD AREAS AND ADDITIONAL * * VARIABLES TO BE PASSED BACK TO THE STANDARD SYSTEM, * * ASSIGN CLAIM CBSA AND WAGE INDEX, & PERFORM DATE EDITS * * * * ** CHANGE EVERY JANUARY: * * - INPATIENT DAILY COINSURANCE LIMIT (H-IP-LIMIT) * * - CAL-VERSION * * * *************************************************************** * * * ERROR RETURN CODES: * * ------------------- * * - IF PROVIDER SPECIFIC FILE WAGE INDEX RECLASSIFICATION * * CODE INVALID OR MISSING * * - MOVE '52' TO CLAIM LEVEL RETURN CODE * * - DISCONTINUE CLAIM PROCESSING * * - IF SERVICE FROM DATE NOT NUMERIC OR < 20000801 * * - MOVE '53' TO CLAIM LEVEL RETURN CODE * * - DISCONTINUE CLAIM PROCESSING * * - IF SERVICE FROM DATE < PROVIDER EFFECTIVE DATE * * - MOVE '54' TO CLAIM LEVEL RETURN CODE * * - DISCONTINUE CLAIM PROCESSING * * - IF SERVICE FROM DATE > PROVIDER TERMINATION DATE * * - MOVE '54' TO CLAIM LEVEL RETURN CODE * * - DISCONTINUE CLAIM PROCESSING * * * *************************************************************** 10100-INIT. *-------------------------------------------------------------* * INITIALIZE CLAIM RETURN CODE (01 = CLAIM PROCESSED) * *-------------------------------------------------------------* MOVE 01 TO A-CLM-RTN-CODE. *-------------------------------------------------------------* * INITIALIZE CLAIM AND LINE VARIABLES * *-------------------------------------------------------------* * 11/05/2007 - PHP-HCPCS-FLAG & MH-HCPCS-FLAG ADDED * * 11/06/2007 - BRACHY-APC-FLAG ADDED * * 11/13/2007 - BLD-DEDUC-HCPCS-FLAG ADDED * * 11/28/2007 - APC34-FLAG ADDED * * 12/27/2007 - RADIOPH-APC-FLAG ADDED * * 02/11/2008 - PTD-FLAG, PTD-LINE-FLAG, PTD-PROC-FLAG ADDED * * 11/03/2008 - APC33-FLAG REPLACED BY PHP-APC-FLAG * * 11/12/2008 - BRACHY-APC-FLAG REMOVED, NOT USED FOR CY 2009 * * 02/09/2009 - PTRADIO-CLAIM-FLAG, PTRADIO-LINE-FLAG ADDED * * 11/16/2009 - RADIOPH-APC-FLAG REMOVED; PTCA-CLAIM-FLAG, * * PTCA-LINE FLAG ADDED * *-------------------------------------------------------------* MOVE 'N' TO PHP-APC-FLAG GJK-FLAG ST0-FLAG N-FLAG C-FLAG C1820-OFFSET-FLAG PHP-HCPCS-FLAG MH-HCPCS-FLAG APC34-FLAG PTD-FLAG PTD-LINE-FLAG PTD-PROC-FLAG BLD-DEDUC-HCPCS-FLAG PTRADIO-CLAIM-FLAG PTRADIO-LINE-FLAG PTCA-CLAIM-FLAG PTCA-LINE-FLAG. MOVE SPACE TO A-MSA A-CBSA BILL14X-FLAG. MOVE ZERO TO A-OUTLIER-PYMT A-TOTAL-CLM-DEDUCT A-TOT-CLM-CHRG A-TOT-CLM-PYMT A-BLOOD-DEDUCT-DUE A-BLOOD-PINTS-USED A-WINX W-LNC-MAX. INITIALIZE H-ADDITIONAL-VARIABLES. INITIALIZE LINE-HOLD-ITEMS. INITIALIZE T-LITEM-PYMT. *-------------------------------------------------------------* * VALIDATE CLAIM & PSF DATES * *-------------------------------------------------------------* IF L-SERVICE-FROM-DATE NOT NUMERIC MOVE 53 TO A-CLM-RTN-CODE GO TO 10100-INIT-EXIT ELSE IF L-SERVICE-FROM-DATE < L-PSF-EFFDT MOVE 54 TO A-CLM-RTN-CODE GO TO 10100-INIT-EXIT ELSE IF L-PSF-TERMDT > 0 IF L-SERVICE-FROM-DATE > L-PSF-TERMDT MOVE 54 TO A-CLM-RTN-CODE GO TO 10100-INIT-EXIT END-IF END-IF. *-------------------------------------------------------------* * UPDATE CAL-VERSION EVERY JANUARY * *-------------------------------------------------------------* MOVE CAL-VERSION10 TO A-CALC-VERS. *-------------------------------------------------------------* * RECEIVE BENEFICIARY SPECIFIC ITEMS FROM THE OCE * *-------------------------------------------------------------* MOVE BENE-DEDUCT TO H-BENE-DEDUCT. MOVE BENE-BLOOD-PINTS TO H-BENE-BLOOD-PINTS H-BENE-PINTS-USED. *-------------------------------------------------------------* * GET TO PROPER APC DATE BY SERVICE DATE (STARTING AT THE * * LATEST EFFECTIVE DATE IN THE APC DATE TABLE) * *-------------------------------------------------------------* MOVE WAD-MAX TO WAD-SUB. PERFORM UNTIL L-SERVICE-FROM-DATE NOT < WAD-DATE (WAD-SUB) SUBTRACT 1 FROM WAD-SUB END-PERFORM. *-------------------------------------------------------------* * DETERMINE WHICH CBSA TO USE & WHETHER TO USE THE SPECIAL * * WAGE INDEX IN THE PSF, AND SET THE INPATIENT DAILY * * COINSURANCE LIMIT (IN 2 PLACES; CHANGE EVERY JANUARY) * *-------------------------------------------------------------* IF L-PSF-SPEC-PYMT-IND = 'Y' MOVE L-PSF-WI-CBSA TO H-PSF-CBSA ELSE IF L-PSF-SPEC-PYMT-IND = ' ' MOVE L-PSF-GEO-CBSA TO H-PSF-CBSA ELSE IF L-PSF-SPEC-PYMT-IND = '1' OR '2' MOVE L-PSF-GEO-CBSA TO H-PSF-CBSA A-CBSA MOVE L-PSF-SPEC-WGIDX TO H-WINX1 MOVE 1132 TO H-IP-LIMIT GO TO 10100-INIT-EXIT ELSE MOVE 52 TO A-CLM-RTN-CODE GO TO 10100-INIT-EXIT. IF H-PSF-CBSA = SPACE MOVE 52 TO A-CLM-RTN-CODE GO TO 10100-INIT-EXIT. MOVE 1132 TO H-IP-LIMIT. *-------------------------------------------------------------* * APPLY WAGE INDEX FLOOR POLICY * * UPDATE WITH NEW FLOOR PARAGRAPH EVERY JANUARY * *-------------------------------------------------------------* PERFORM 10120-FLOOR-2011 THRU 10120-FLOOR-2011-EXIT. *-------------------------------------------------------------* * APPLY SECTION 401 WAGE INDEX POLICY * * UPDATE WITH NEW SECTION 401 PARAGRAPH EVERY JANUARY * *-------------------------------------------------------------* PERFORM 10120-SEC401-2011 THRU 10120-SEC401-2011-EXIT. *-------------------------------------------------------------* * GET THE CBSA WAGE INDEX VALUE (IF NOT ALREADY OVERRIDDEN * * BY THE PSF SPECIAL WAGE INDEX VALUE) * *-------------------------------------------------------------* MOVE H-PSF-CBSA TO A-CBSA. IF H-WINX1 = 0 PERFORM 10200-CALC-WAGEINDX THRU 10200-CALC-WAGEINDX-EXIT. 10100-INIT-EXIT. EXIT. *************************************************************** * * * NEW CY 2011 FLOOR FOR CBSA WAGE INDEX * * IPPS PRICER PGM FLOORS TAKEN FROM: IPDRV113 * * * * 11/15/2010 - ADDED LOGIC TO ASSIGN OHIO (36) PROVIDERS * * RECLASSIFYING INTO CBSA 49660 THEIR STATE RURAL FLOOR * * * *************************************************************** * * * SYNC ALL OF THE FOLLOWING WITH INPATIENT. * * SEE IPPS PRICER MAINTAINER. * * * * * SPECIAL NOTES * * * ------------- * * 1) INPATIENT MOVES 'N' TO P-NEW-CBSA-SPEC-PAY-IND * * OPPS MOVES ' ' TO L-PSF-SPEC-PYMT-IND * * * * 2) INPATIENT CHECKS P-NEW-CBSA-SPEC-PAY-IND = 'Y' * * OPPS CHECKS L-PSF-SPEC-PYMT-IND = 'Y' * * * * 3) INPATIENT CHECKS VALUE OF HOLD-PROV-CBSA * * OPPS CHECKS VALUE OF H-PSF-CBSA * * * * 4) INPATIENT MOVES THE STATE CBSA TO HOLD-PROV-CBSA * * OPPS MOVES THE STATE CBSA TO H-PSF-CBSA * * * * 5) INPATIENT CHECKS P-NEW-STATE * * OPPS CHECKS L-PSF-PROV-ST * * * * 6) ADD SINGLE QUOTES AROUND L-PSF-PROV-ST VALUES * * * * * * BE SURE TO MAKE THESE SIX CHANGES EVERY JANUARY * * * *************************************************************** 10120-FLOOR-2011. 353300 IF H-PSF-CBSA = ' 45' 26943900 353400 AND L-PSF-SPEC-PYMT-IND = 'Y' 26943900 353500 AND L-PSF-PROV-ST = '45' 26943900 353600 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 26943900 353700 MOVE ' 45' TO H-PSF-CBSA. 26943900 353800 26943900 353900 IF H-PSF-CBSA = ' 37' 26943900 354000 AND L-PSF-SPEC-PYMT-IND = 'Y' 26943900 354100 AND L-PSF-PROV-ST = '37' 26943900 354200 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 26943900 354300 MOVE ' 37' TO H-PSF-CBSA. 26943900 354400 26943900 354500 IF H-PSF-CBSA = '10900' 26944000 354600 AND L-PSF-PROV-ST = '31' 26944200 354700 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 26944300 354800 MOVE ' 31' TO H-PSF-CBSA. 26944400 354900 26944500 355000 IF H-PSF-CBSA = '21500' 26944600 355100 AND L-PSF-SPEC-PYMT-IND = 'Y' 26943900 355200 AND L-PSF-PROV-ST = '33' 26944800 355300 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 26944900 355400 MOVE ' 33' TO H-PSF-CBSA. 26945000 355500 26945100 355600 IF H-PSF-CBSA = '21500' 26944600 355700 AND L-PSF-SPEC-PYMT-IND = 'Y' 26943900 355800 AND L-PSF-PROV-ST = '39' 26944800 355900 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 26944900 356000 MOVE ' 39' TO H-PSF-CBSA. 26945000 356100 26945100 356200 IF H-PSF-CBSA = '21780' 26944600 356300 AND L-PSF-PROV-ST = '15' 26944800 356400 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 26944900 356500 MOVE ' 15' TO H-PSF-CBSA. 26945000 356600 26946300 356700 IF H-PSF-CBSA = '22900' 26946400 356800 AND L-PSF-PROV-ST = '37' 26946500 356900 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 26946600 357000 MOVE ' 37' TO H-PSF-CBSA. 26946700 357100 26946800 357200 IF H-PSF-CBSA = '24540' 26948400 357300 AND L-PSF-SPEC-PYMT-IND = 'Y' 26948500 357400 AND L-PSF-PROV-ST = '53' 26948600 357500 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 26948700 357600 MOVE ' 53' TO H-PSF-CBSA. 26948800 357700 26948900 357800 IF H-PSF-CBSA = '25540' 26948400 357900 AND L-PSF-SPEC-PYMT-IND = 'Y' 26948500 358000 AND L-PSF-PROV-ST = '07' 26948600 358100 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 26948700 358200 MOVE ' 07' TO H-PSF-CBSA. 26948800 358300 26948900 358400 IF H-PSF-CBSA = '28700' 26948400 358500 AND L-PSF-PROV-ST = '44' 26948600 358600 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 26948700 358700 MOVE ' 44' TO H-PSF-CBSA. 26948800 358800 26948900 358900 IF H-PSF-CBSA = '28700' 26948400 359000 AND L-PSF-PROV-ST = '49' 26948600 359100 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 26948700 359200 MOVE ' 49' TO H-PSF-CBSA. 26948800 359300 26948900 359400 IF H-PSF-CBSA = '28940' 26948400 359500 AND L-PSF-SPEC-PYMT-IND = 'Y' 26948500 359600 AND L-PSF-PROV-ST = '18' 26948600 359700 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 26948700 359800 MOVE ' 18' TO H-PSF-CBSA. 26948800 359900 26948900 360000 IF H-PSF-CBSA = '28940' 26948400 360100 AND L-PSF-SPEC-PYMT-IND = 'Y' 26948500 360200 AND L-PSF-PROV-ST = '44' 26948600 360300 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 26948700 360400 MOVE ' 44' TO H-PSF-CBSA. 26948800 360500 26948900 360600 IF H-PSF-CBSA = '37620' 26954000 360700 AND L-PSF-PROV-ST = '36' 26955000 360800 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 26955100 360900 MOVE ' 36' TO H-PSF-CBSA. 26955200 361000 26955300 361100 IF H-PSF-CBSA = '37620' 26954000 361200 AND L-PSF-PROV-ST = '51' 26955000 361300 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 26955100 361400 MOVE ' 51' TO H-PSF-CBSA. 26955200 361500 26955300 361600 IF H-PSF-CBSA = '37964' 26956000 361700 AND L-PSF-SPEC-PYMT-IND = 'Y' 26956100 361800 AND L-PSF-PROV-ST = '31' 26956200 361900 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 26956300 362000 MOVE ' 31' TO H-PSF-CBSA. 26956400 362100 26956500 362200 IF H-PSF-CBSA = '38300' 26956000 362300 AND L-PSF-SPEC-PYMT-IND = 'Y' 26956100 362400 AND L-PSF-PROV-ST = '36' 26956200 362500 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 26956300 362600 MOVE ' 36' TO H-PSF-CBSA. 26956400 362700 26956500 362800 IF H-PSF-CBSA = '38300' 26956000 362900 AND L-PSF-SPEC-PYMT-IND = 'Y' 26956100 363000 AND L-PSF-PROV-ST = '39' 26956200 363100 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 26956300 363200 MOVE ' 39' TO H-PSF-CBSA. 26956400 363300 26956500 363400 IF H-PSF-CBSA = '43580' 26956600 363500 AND L-PSF-PROV-ST = '43' 26956800 363600 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 26956900 363700 MOVE ' 43' TO H-PSF-CBSA. 26957000 363800 26957100 363900 IF H-PSF-CBSA = '48540' 26956600 364000 AND L-PSF-PROV-ST = '36' 26956800 364100 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 26956900 364200 MOVE ' 36' TO H-PSF-CBSA. 26957000 364300 26957100 364400 IF H-PSF-CBSA = '48540' 26956600 364500 AND L-PSF-PROV-ST = '51' 26956800 364600 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 26956900 364700 MOVE ' 51' TO H-PSF-CBSA. 26957000 364800 26957100 364900 IF H-PSF-CBSA = '48864' 26959000 365000 AND L-PSF-PROV-ST = '31' 26959200 365100 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 26959300 365200 MOVE ' 31' TO H-PSF-CBSA. 26959400 365300 26957100 365400 IF H-PSF-CBSA = '17300' 26959600 365500 AND L-PSF-PROV-ST = '18' 26959700 365600 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 26959800 365700 MOVE ' 18' TO H-PSF-CBSA. 26959900 365800 26960000 365900 IF H-PSF-CBSA = '17300' 26959600 366000 AND L-PSF-PROV-ST = '44' 26959700 366100 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 26959800 366200 MOVE ' 44' TO H-PSF-CBSA. 26959900 366300 26960000 366400 IF H-PSF-CBSA = '19060' 26961000 366500 AND L-PSF-PROV-ST = '21' 26962000 366600 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 26962100 366700 MOVE ' 21' TO H-PSF-CBSA. 26962200 366800 26962300 366900 IF H-PSF-CBSA = '22020' 26962400 367000 AND L-PSF-PROV-ST = '24' 26962600 367100 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 26962700 367200 MOVE ' 24' TO H-PSF-CBSA. 26962800 367300 26962900 367400 IF H-PSF-CBSA = '22020' 26962400 367500 AND L-PSF-PROV-ST = '35' 26962600 367600 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 26962700 367700 MOVE ' 35' TO H-PSF-CBSA. 26962800 367800 26962900 367900 IF H-PSF-CBSA = '24220' 26963000 368000 AND L-PSF-PROV-ST = '24' 26963200 368100 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 26963300 368200 MOVE ' 24' TO H-PSF-CBSA. 26963400 368300 26963500 368400 IF H-PSF-CBSA = '24220' 26963000 368500 AND L-PSF-PROV-ST = '35' 26963200 368600 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 26963300 368700 MOVE ' 35' TO H-PSF-CBSA. 26963400 368800 26963500 368900 IF H-PSF-CBSA = '30300' 26963600 369000 AND L-PSF-PROV-ST = '50' 26963800 369100 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 26963900 369200 MOVE ' 50' TO H-PSF-CBSA. 26964000 369300 26964100 369400 IF H-PSF-CBSA = '44600' 26964200 369500 AND L-PSF-PROV-ST = '36' 26964400 369600 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 26964500 369700 MOVE ' 36' TO H-PSF-CBSA. 26964600 369800 26964700 369900 IF H-PSF-CBSA = '44600' 26964800 370000 AND L-PSF-PROV-ST = '51' 26965000 370100 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 26965100 370200 MOVE ' 51' TO H-PSF-CBSA. 26965200 370300 26980800 370400 IF H-PSF-CBSA = '45500' 26964800 370500 AND L-PSF-PROV-ST = '45' 26965000 370600 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 26965100 370700 MOVE ' 45' TO H-PSF-CBSA. 26965200 26955300 IF H-PSF-CBSA = '49660' 26956000 AND L-PSF-SPEC-PYMT-IND = 'Y' 26956100 AND L-PSF-PROV-ST = '36' 26956200 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 26956300 MOVE ' 36' TO H-PSF-CBSA. 26956400 10120-FLOOR-2011-EXIT. EXIT. *************************************************************** * * * NEW CY 2011 SECTION 401 HOSPITALS * * IPPS PRICER PGM SECTION 401S TAKEN FROM: IPDRV113 * * * *************************************************************** * * * SYNC ALL OF THE FOLLOWING WITH INPATIENT. * * SEE IPPS PRICER MAINTAINER. * * * * * SPECIAL NOTES * * * ------------- * * 1) INPATIENT CHECKS P-NEW-PROVIDER-NO * * OPPS CHECKS L-PSF-PROV-OSCAR * * * * 2) INPATIENT MOVES THE STATE CBSA TO HOLD-PROV-CBSA * * AND P-NEW-CBSA-STAND-AMT-LOC * * OPPS MOVES THE STATE CBSA TO 'H-PSF-CBSA.' ONLY * * * * 3) DELETE THE P-NEW-CBSA-STAND-AMT-LOC LINES * * * * BE SURE TO MAKE THESE THREE CHANGES EVERY JANUARY * * * *************************************************************** 10120-SEC401-2011. 463200 IF (L-PSF-PROV-OSCAR = '040118') 33567001 463300 MOVE ' 04' TO H-PSF-CBSA. 33567101 463500 33558801 463600 IF (L-PSF-PROV-OSCAR = '050192' OR 33559301 463700 '050528' OR '050618') 33559401 463800 MOVE ' 05' TO H-PSF-CBSA. 33559501 464000 33566901 464100 IF (L-PSF-PROV-OSCAR = '070004') 33567001 464200 MOVE ' 07' TO H-PSF-CBSA. 33567101 464400 33566901 464500 IF (L-PSF-PROV-OSCAR = '100048' OR 33559301 464600 '100118' OR '100134') 33559401 464700 MOVE ' 10' TO H-PSF-CBSA. 33559501 464900 33567301 465000 IF (L-PSF-PROV-OSCAR = '140167') 33567001 465100 MOVE ' 14' TO H-PSF-CBSA. 33567101 465300 33567301 465400 IF (L-PSF-PROV-OSCAR = '170037' OR '170137') 33567001 465500 MOVE ' 17' TO H-PSF-CBSA. 33567101 465700 33567301 465800 IF (L-PSF-PROV-OSCAR = '180016' OR '180038') 33567001 465900 MOVE ' 18' TO H-PSF-CBSA. 33567101 466100 33567301 466200 IF (L-PSF-PROV-OSCAR = '220051') 33567001 466300 MOVE ' 22' TO H-PSF-CBSA. 33567101 466500 33567301 466600 IF (L-PSF-PROV-OSCAR = '230040' OR '230078') 33567001 466700 MOVE ' 23' TO H-PSF-CBSA. 33567101 466900 33567301 467000 IF (L-PSF-PROV-OSCAR = '260006' OR '260034' OR 33567001 467100 '260047' OR '260195') 33559401 467200 MOVE ' 26' TO H-PSF-CBSA. 33567101 467400 33567301 467500 IF (L-PSF-PROV-OSCAR = '300023') 33567001 467600 MOVE ' 30' TO H-PSF-CBSA. 33567101 467800 33567301 467900 IF (L-PSF-PROV-OSCAR = '330215' OR '330235' OR 33567001 468000 '330268') 01 468100 MOVE ' 33' TO H-PSF-CBSA. 33567101 468300 33567301 468400 IF (L-PSF-PROV-OSCAR = '340010') 33567001 468500 MOVE ' 34' TO H-PSF-CBSA. 33567101 468700 33567301 468800 IF (L-PSF-PROV-OSCAR = '360125') 33567001 468900 MOVE ' 36' TO H-PSF-CBSA. 33567101 469100 33567301 469200 IF (L-PSF-PROV-OSCAR = '370054') 33567001 469300 MOVE ' 37' TO H-PSF-CBSA. 33567101 469500 33567301 469600 IF (L-PSF-PROV-OSCAR = '380040') 33567001 469700 MOVE ' 38' TO H-PSF-CBSA. 33567101 469900 33567301 470000 IF (L-PSF-PROV-OSCAR = '390130' OR '390183' OR 33567001 470100 '390233') 33559401 470200 MOVE ' 39' TO H-PSF-CBSA. 33567101 470400 33567301 470500 IF (L-PSF-PROV-OSCAR = '450052' OR '450078' OR 33567001 470600 '450243' OR '450348') 33559401 470700 MOVE ' 45' TO H-PSF-CBSA. 33567101 470900 33567301 471000 IF (L-PSF-PROV-OSCAR = '490116') 33567001 471100 MOVE ' 49' TO H-PSF-CBSA. 33567101 471300 33567301 471400 IF (L-PSF-PROV-OSCAR = '500148') 33567001 471500 MOVE ' 50' TO H-PSF-CBSA. 33567101 10120-SEC401-2011-EXIT. EXIT. *************************************************************** * * * LOOP THROUGH ALL CLAIM LINES TO FIND AN APC / HCPCS * * * * - SET FLAG IF APC = 0172/0173/0175/0176 (PARTIAL HOSP.) * * - SET FLAG IF APC = 0034 (FOR MENTAL HEALTH CHARGES) * * (NEW FOR CY 2008 - ADDED 11/28/2007) * * - SET FLAG IF PASS-THROUGH DEVICE(S) ON CLAIM: FOR OUTLIER * * (NEW FOR CY 2008 - ADDED 02/11/2008) * * - SET FLAG IF PASS-THROUGH RADIOPHARMS(S) ON CLAIM * * (NEW FOR APRIL CY 2009 - ADDED 02/10/2009) * * - SET FLAG IF PASS-THROUGH CONTRAST AGENT(S) ON CLAIM * * (NEW FOR JANUARY CY 2010 - ADDED 11/15/2009) * * - SET FLAG IF PASS-THROUGH DEVICE(S) ON CLAIM: FOR OFFSET * * (NEW FOR OCTOBER CY 2010 - ADDED 08/02/2010) * * * * - DISABLED: SET FLAG IF HCPCS = C1820 (FOR DEVICE OFFSETS) * * * *-------------------------------------------------------------* * * * 11/03/2008 - CHANGED PARTIAL HOSPITALIZATION HCPCS FROM * * 0033 TO 0172 & 0173 FOR CY 2009 * * * * 11/12/2008 - HCPCS C1820 EXPIRED FROM PASS-THROUGH STATUS * * DECEMBER 2007, OFFSET FLAG LOGIC DISABLED * * * * 08/02/2010 - ADDED LOGIC TO SET PASS-THOUGH DEVICE FLAG FOR * * DEVICE OFFSETS AND POPULATE THE CORRESPONDING * * TABLE * * 11/15/2010 - ADDED APCS 0175 & 0176 TO LIST OF PHP APCS * * * *************************************************************** 10125-INIT. *-------------------------------------------------------------* * FLAG CLAIM WHEN AT LEAST 1 LINE HAS A PHP APC (PARTIAL HOSP)* *-------------------------------------------------------------* IF OPPS-APC (LN-SUB) = '0172' OR OPPS-APC (LN-SUB) = '0173' OR OPPS-APC (LN-SUB) = '0175' OR OPPS-APC (LN-SUB) = '0176' MOVE 'Y' TO PHP-APC-FLAG. *-------------------------------------------------------------* * FLAG CLAIM WHEN AT LEAST 1 LINE HAS APC 0034 * *-------------------------------------------------------------* IF OPPS-APC (LN-SUB) = '0034' MOVE 'Y' TO APC34-FLAG. *-------------------------------------------------------------* * FOR CY 2010, NO HCPCS HAVE PASS-THROUGH STATUS * * ** FOR OLD PT DEVICE LOGIC, REPLACED BY NEW LOGIC * *-------------------------------------------------------------* * IF OPPS-HCPCS (LN-SUB) = 'C1820' * MOVE 'Y' TO C1820-OFFSET-FLAG. *-------------------------------------------------------------* * FLAG CLAIM WHEN AT LEAST ONE LINE IS A PASS-THROUGH DEVICE * * (FOR OUTLIER PAYMENT CALCULATION) * *-------------------------------------------------------------* PERFORM 10665-SET-PTD-LINE-FLAG THRU 10665-SET-PTD-LINE-FLAG-EXIT. IF PTD-LINE-FLAG = 'Y' MOVE 'Y' TO PTD-FLAG END-IF. *-------------------------------------------------------------* * FLAG CLAIM WHEN AT LEAST 1 LINE IS PASS-THROUGH RADIOPHARM * * AND ACCUMULATE TOTAL PT RADIOPHARM LINES & CHARGES * *-------------------------------------------------------------* PERFORM 10680-SET-PTRADIO-LINE-FLAG THRU 10680-SET-PTRADIO-LINE-FL-EXIT. IF PTRADIO-LINE-FLAG = 'Y' MOVE 'Y' TO PTRADIO-CLAIM-FLAG ADD 1 TO H-PTRADIO-HCPCS-CNT MOVE OPPS-SUB-CHRG (LN-SUB) TO H-SUB-CHRG COMPUTE H-PTRADIO-TOT-CHRGS ROUNDED = H-PTRADIO-TOT-CHRGS + H-SUB-CHRG END-IF. *-------------------------------------------------------------* * FLAG CLAIM WHEN AT LEAST 1 LINE IS A PASS-THROUGH CONTRAST * * AGENT AND ACCUMULATE TOTAL PT CONTRAST AGENT LINES & * * CHARGES, SUM BY LINE ITEM DATE OF SERVICE, & CREATE A * * RECORD FOR EACH DAY IN THE PASS-THROUGH CONTRAST AGENT * * DAY TABLE * *-------------------------------------------------------------* PERFORM 10681-SET-PTCA-LINE-FLAG THRU 10681-SET-PTCA-LINE-FL-EXIT. IF PTCA-LINE-FLAG = 'Y' MOVE 'Y' TO PTCA-CLAIM-FLAG MOVE OPPS-SUB-CHRG (LN-SUB) TO H-SUB-CHRG PERFORM 10130-LOAD-PTCA-DAY-TABLE THRU 10130-LOAD-PTCA-DAY-TABLE-EXIT END-IF. *-------------------------------------------------------------* * FLAG CLAIM WHEN AT LEAST 1 LINE IS A PASS-THROUGH DEVICE * * ON THE CLAIM AND CREATE A RECORD FOR THE PT DEVICE HCPCS * * LINE IN THE PT DEVICE HCPCS TABLE * *-------------------------------------------------------------* PERFORM 10682-SET-PTDO-LINE-FLAG THRU 10682-SET-PTDO-LINE-FL-EXIT. IF PTDO-LINE-FLAG = 'Y' MOVE 'Y' TO PTDO-CLAIM-FLAG MOVE OPPS-SUB-CHRG (LN-SUB) TO H-SUB-CHRG MOVE OPPS-SRVC-UNITS (LN-SUB) TO H-SRVC-UNITS PERFORM 10132-LOAD-PTDO-HCPCS-TBL THRU 10132-LOAD-PTDO-HCPCS-TBL-EXIT END-IF. *-------------------------------------------------------------* * FLAG CLAIM WHEN ALL LINES HAVE A HCPCS BETWEEN 80000-89999 * * INCLUSIVE (LAB CODES), INDICATES BILL TYPE 14X * * 05/09/2011 - LOGIC ADDED * *-------------------------------------------------------------* IF (OPPS-HCPCS (LN-SUB) >= '80000' AND <= '89999') IF BILL14X-FLAG NOT = 'N' MOVE 'Y' TO BILL14X-FLAG END-IF ELSE MOVE 'N' TO BILL14X-FLAG END-IF. 10125-INIT-EXIT. EXIT. *************************************************************** * * * ACCUMULATE PASS-THROUGH CONTRAST AGENT HCPCS COUNT AND * * CHARGES FOR EACH DAY WITH A PASS-THROUGH CONTRAST AGENT * * * *************************************************************** * * * ORDER SERVICE LINES BY LINE ITEM DATE OF SERVICE (LIDOS) - * * EARLIEST TO LATEST DATE * * * * EACH PT CONTRAST AGENT HCPCS LINE'S CHARGES ARE ADDED TO * * THE TOTAL FOR ITS LIDOS. THESE CHARGES ARE LATER USED * * TO DETERMINE THE PROPORTION OF THE DAY'S TOTAL CONTRAST * * PROCEDURE OFFSET THAT SHOULD BE SUBTRACTED FROM A GIVEN PT * * CONTRAST AGENT HCPCS'S LINE PAYMENT. * * * * 11/16/2009 - LOGIC ADDED FOR CY 2010 * * * *************************************************************** 10130-LOAD-PTCA-DAY-TABLE. *-------------------------------------------------------------* * GET THE LINE'S SERVICE DATE & CHARGES FOR TABLE SEARCH * *-------------------------------------------------------------* MOVE OPPS-LITEM-DOS (LN-SUB) TO H-PTCA-LIDOS. MOVE OPPS-SUB-CHRG (LN-SUB) TO H-SUB-CHRG. *-------------------------------------------------------------* * ADD OR UPDATE CONTRAST AGENT DAY ENTRY FOR THE LIDOS * *-------------------------------------------------------------* PERFORM 10130-SEARCH-PTCA-LIDOS THRU 10130-SEARCH-PTCA-LIDOS-EXIT. 10130-LOAD-PTCA-DAY-TABLE-EXIT. EXIT. *************************************************************** * * * DETERMINE WHETHER A NEW PT CONTRAST AGENT DAY TABLE RECORD * * SHOULD BE ADDED OR IF AN EXISITING RECORD MUST BE UPDATED * * * *************************************************************** 10130-SEARCH-PTCA-LIDOS. *-------------------------------------------------------------* * SEARCH PT CONTRAST AGENT DAY TABLE STARTING AT ENTRY #1 * *-------------------------------------------------------------* SET W-PTCA-DAY-INDX TO 1. SEARCH W-PTCA-DAY-ENTRY VARYING W-PTCA-DAY-INDX *-------------------------------------------------------------* * IF THE SERVICE LINE'S LIDOS IS NOT ALREADY IN THE TABLE, * * ADD IT * *-------------------------------------------------------------* AT END PERFORM 10130-ADD-ENTRY THRU 10130-ADD-ENTRY-EXIT *-------------------------------------------------------------* * IF THE SERVICE LINE'S LIDOS IS ALREADY IN THE TABLE, * * UPDATE THE ENTRY * *-------------------------------------------------------------* WHEN W-PTCA-DAY-LIDOS (W-PTCA-DAY-INDX) = H-PTCA-LIDOS PERFORM 10130-UPDATE-ENTRY THRU 10130-UPDATE-ENTRY-EXIT. 10130-SEARCH-PTCA-LIDOS-EXIT. EXIT. *************************************************************** * * * INSERT THE NEW PT CONTRAST AGENT DAY RECORD IN THE CORRECT * * POSITION (LOWEST TO HIGHEST CAF) OF THE COMPOSITE APC TABLE * * * *************************************************************** 10130-ADD-ENTRY. *-------------------------------------------------------------* * INCREASE THE TOTAL NUMBER OF TABLE RECORDS FOR NEW ENTRY * *-------------------------------------------------------------* ADD 1 TO W-PTCA-DAY-MAX. *-------------------------------------------------------------* * MOVE TO THE NEW ENTRY POSITION (EMPTY RECORD) * *-------------------------------------------------------------* SET W-PTCA-DAY-INDX TO W-PTCA-DAY-MAX. INITIALIZE W-PTCA-DAY-ENTRY (W-PTCA-DAY-INDX). *-------------------------------------------------------------* * DETERMINE WHERE THE NEW PT CONTRAST AGENT DAY ENTRY FOR THE * * CURRENT SERVICE LINE SHOULD BE ENTERED INTO THE TABLE * * ACCORDING TO ITS LIDOS - EARLIEST TO LATEST LIDOS * *-------------------------------------------------------------* PERFORM 10130-STAGE-PTCA-DAY-ENTRY THRU 10130-STAGE-PTCA-DAY-ENTRY-EXT UNTIL W-PTCA-DAY-INDX = 1 OR H-PTCA-LIDOS NOT < W-PTCA-DAY-LIDOS (W-PTCA-DAY-INDX - 1). *-------------------------------------------------------------* * POPULATE THE EMPTY RECORD WITH THE NEW SERVICE LINE'S DATA * *-------------------------------------------------------------* MOVE H-PTCA-LIDOS TO W-PTCA-DAY-LIDOS (W-PTCA-DAY-INDX). MOVE 1 TO W-PTCA-DAY-HCPCS-CNT (W-PTCA-DAY-INDX). MOVE H-SUB-CHRG TO W-PTCA-DAY-TOT-CHRGS (W-PTCA-DAY-INDX). 10130-ADD-ENTRY-EXIT. EXIT. *************************************************************** * * * UPDATE THE EXISTING PT CONTRAST AGENT DAY RECORD WITH THE * * SAME LIDOS AS THE CURRENT SERVICE LINE * * * *************************************************************** 10130-UPDATE-ENTRY. *-------------------------------------------------------------* * ACCUMULATE THE LIDOS'S TOTAL SUBMITTED CHARGES & HCPCS COUNT* *-------------------------------------------------------------* ADD 1 TO W-PTCA-DAY-HCPCS-CNT (W-PTCA-DAY-INDX). ADD H-SUB-CHRG TO W-PTCA-DAY-TOT-CHRGS (W-PTCA-DAY-INDX). 10130-UPDATE-ENTRY-EXIT. EXIT. *************************************************************** * * * MOVE THE EXISTING PT CONTRAST AGENT DAY RECORD WITH A LATER * * LIDOS DOWN ONE RECORD POSITION AND SET THE EMPTY RECORD FOR * * THE NEW ENTRY'S INDEX TO THE NEXT HIGHER RECORD POSITION. * * * *************************************************************** 10130-STAGE-PTCA-DAY-ENTRY. MOVE W-PTCA-DAY-ENTRY (W-PTCA-DAY-INDX - 1) TO W-PTCA-DAY-ENTRY (W-PTCA-DAY-INDX). SET W-PTCA-DAY-INDX DOWN BY 1. 10130-STAGE-PTCA-DAY-ENTRY-EXT. EXIT. *************************************************************** * * * POPULATE PASS-THROUGH DEVICE HCPCS TABLE WITH PASS-THROUGH * * DEVICE LINE INFORMATION * * * *************************************************************** * * * ORDER SERVICE LINES BY SUBMITTED CHARGE * * HIGHEST TO LOWEST, * * THEN BY LINE UNITS * * HIGHEST TO LOWEST * * * * THESE RECORDS ARE LATER USED TO DETERMINE THE PASS-THROUGH * * DEVICE OFFSET AMOUNT IF APPLICABLE. * * * * 08/02/2010 - LOGIC ADDED FOR OCT 2010 * * * *************************************************************** 10132-LOAD-PTDO-HCPCS-TBL. *-------------------------------------------------------------* * POPULATE VARIABLES FOR TABLE SORTING * *-------------------------------------------------------------* MOVE H-SUB-CHRG TO H-PTDO-CHRG. MOVE H-SRVC-UNITS TO H-PTDO-UNITS. *-------------------------------------------------------------* * ADD THE CURRENT PASS-THROUGH DEVICE HCPCS LINE TO TABLE * *-------------------------------------------------------------* PERFORM 10132-ADD-ENTRY THRU 10132-ADD-ENTRY-EXIT. 10132-LOAD-PTDO-HCPCS-TBL-EXIT. EXIT. *************************************************************** * * * INSERT THE NEW PT DEVICE HCPCS RECORD IN THE CORRECT * * POSITION (HIGHEST TO LOWEST SUBMITTED CHARGE & THEN HIGHEST * * TO LOWEST LINE UNITS) * * * *************************************************************** 10132-ADD-ENTRY. *-------------------------------------------------------------* * INCREASE THE TOTAL NUMBER OF TABLE RECORDS FOR NEW ENTRY * *-------------------------------------------------------------* ADD 1 TO W-PTDO-HCPCS-MAX. *-------------------------------------------------------------* * MOVE TO THE NEW ENTRY POSITION (EMPTY RECORD) * *-------------------------------------------------------------* SET W-PTDO-HCPCS-INDX TO W-PTDO-HCPCS-MAX. INITIALIZE W-PTDO-HCPCS-ENTRY (W-PTDO-HCPCS-INDX). *-------------------------------------------------------------* * DETERMINE WHERE THE NEW PT DEVICE HCPCS ENTRY FOR THE * * CURRENT SERVICE LINE SHOULD BE ENTERED INTO THE TABLE * * ACCORDING TO ITS SUBMITTED CHARGES & LINE UNITS (BOTH * * HIGHEST TO LOWEST) * *-------------------------------------------------------------* PERFORM 10132-STAGE-PTDO-HCPCS-ENTRY THRU 10132-STAGE-PTDO-HCPCS-ENTRY-X UNTIL W-PTDO-HCPCS-INDX = 1 OR H-PTDO-CHRGUNIT NOT > W-PTDO-HCPCS-CHRGUNIT (W-PTDO-HCPCS-INDX - 1). *-------------------------------------------------------------* * POPULATE THE EMPTY RECORD WITH THE NEW SERVICE LINE'S DATA * *-------------------------------------------------------------* MOVE OPPS-HCPCS (LN-SUB) TO W-PTDO-HCPCS-HCPCS (W-PTDO-HCPCS-INDX). MOVE LN-SUB TO W-PTDO-HCPCS-LNSUB (W-PTDO-HCPCS-INDX). MOVE H-PTDO-CHRG TO W-PTDO-HCPCS-SUB-CHRG (W-PTDO-HCPCS-INDX). MOVE H-PTDO-UNITS TO W-PTDO-HCPCS-UNITS (W-PTDO-HCPCS-INDX). MOVE 0 TO W-PTDO-HCPCS-PROC-CNT (W-PTDO-HCPCS-INDX). MOVE SPACES TO W-PTDO-HCPCS-PROC-APC (W-PTDO-HCPCS-INDX). MOVE 0 TO W-PTDO-HCPCS-PROC-LNSUB (W-PTDO-HCPCS-INDX). 10132-ADD-ENTRY-EXIT. EXIT. *************************************************************** * * * MOVE THE EXISTING PT CONTRAST AGENT DAY RECORD WITH A LATER * * LIDOS DOWN ONE RECORD POSITION AND SET THE EMPTY RECORD FOR * * THE NEW ENTRY'S INDEX TO THE NEXT HIGHER RECORD POSITION. * * * *************************************************************** 10132-STAGE-PTDO-HCPCS-ENTRY. MOVE W-PTDO-HCPCS-ENTRY (W-PTDO-HCPCS-INDX - 1) TO W-PTDO-HCPCS-ENTRY (W-PTDO-HCPCS-INDX). SET W-PTDO-HCPCS-INDX DOWN BY 1. 10132-STAGE-PTDO-HCPCS-ENTRY-X. EXIT. *************************************************************** * * * VALIDATE CLAIM LINES, CALCULATE LINE DISCOUNTS & OFFSETS, * * ACCUMULATE CLAIM TOTALS, SET FLAGS, POPULATE COINSURANCE & * * BLOOD DEDUCTIBLE TABLES WITH VALID SERVICE LINES, POPULATE * * COMPOSITE APC TABLE WITH NON-PRIME COMPOSITE LINE CHARGES, * * AND CALCULATE TOTAL PACKAGED MENTAL HEALTH CHARGES. * * CREATE PASS-THROUGH CONTRAST AGENT PROC TABLE (NEW CY2010) * * CREATE PASS-THROUGH DEVICE PROC TABLE (NEW OCT 2010) * * * * ** UPDATE PARTIAL HOSPITALIZATION (PHP) & MENTAL HEALTH * * (MH) TABLE REFERENCES EVERY JANUARY * * * *************************************************************** * * * VALIDATION RULES & RETURN CODES: * * -------------------------------- * * * * 1. VERIFY THE SERVICE INDICATOR PASSED BY THE OCE * * - IF INVALID SET RETURN CODE TO '40' * * - DISCONTINUE LINE PROCESSING * * - IF VALID SET RETURN CODE TO '01' * * - CONTINUE LINE PROCESSING * * 2. PROCESS LINES AND LOAD WORK TABLE ACCORDING TO PRICE * * RANKING * * 3. CHECK OCE EDIT INDICATORS AND SET RETURN CODES IF * * INDICATORS ARE INVALID. * * - VALID RETURN CODES FOR EDIT INDICATORS * * - '41' - SERVICE INDICATOR INVALID FOR OPPS PRICER * * - '42' - APC = '00000' OR (PACKAGING FLAG = 1, 2,OR 4)* * - '43' - PAYMENT INDICATOR NOT = TO 1 OR 5 THRU 9 * * - '44' - SERVICE INDICATOR = 'H' BUT PAYMENT * * INDICATOR NOT = TO 6 * * - '45' - PACKAGING FLAG NOT = TO 0, 1, 2, 3, OR 4 * * - '46' - (LINE ITEM DENIAL/REJECT FLAG NOT = TO 0 * * OR LINE ITEM DENIAL/REJECT FLAG = TO 1 * * AND (NOT A PARTIAL HOSPITALIZATION OR * * MENTAL HEALTH HCPCS)) * * OR LINE ITEM ACTION FLAG NOT = TO 1 * * - '47' - LINE ITEM ACTION FLAG = 2 OR 3 * * - '48' - PAYMENT ADJUSTMENT FLAG NOT VALID * * - '49' - SITE OF SERVICE FLAG NOT = TO 0 * * - OR (PARTIAL HOSP. APC IS NOT ON THE CLAIM * * AND SERVICE INDICATOR = 'P' * * OR PARTIAL HOSPITALIZATION HCPCS) * * 4. IF OCE INDICATORS ARE VALID, SEARCH APC TABLE * * - IF MISSING, DELETED OR INVALID APC * * - SET RETURN CODE TO '30' * * - DISCONTINUE LINE PROCESSING * * * *************************************************************** 10150-INIT. *************************************************************** * INITIALIZE LINE RETURN CODE TO VALID VALUE * *************************************************************** MOVE 01 TO A-RETURN-CODE (LN-SUB). *************************************************************** * OVERRIDE SERVICE UNITS FOR APC 0339 - EFFECTIVE 04/01/2002 * *************************************************************** IF OPPS-APC (LN-SUB) = '0339' MOVE 1 TO OPPS-SRVC-UNITS (LN-SUB). *************************************************************** * CALCULATE DISCOUNT RATE (FOR REDUCED COIN & OFFSET CALCS) * *************************************************************** MOVE OPPS-SRVC-UNITS (LN-SUB) TO H-SRVC-UNITS. PERFORM 10250-CALC-DISCOUNT THRU 10250-CALC-DISCOUNT-EXIT. IF A-RETURN-CODE (LN-SUB) = 42 GO TO 10150-INIT-EXIT. *************************************************************** * FLAG LINE IF THE LINE APC IS A RADIOPHARM APC * * ** NEW LIST EVERY JANUARY ** * *-------------------------------------------------------------* * 11/13/2008 - LOGIC ADDED B/C THERAP. RADIO. LINES MUST BE * * EXCLUDED FROM SI=H DEVICE UNIT CALCULATION * * 11/16/2009 - LOGIC REMOVED BECAUSE THERAP. RADIO NO LONGER * * HAVE AN SI=H (NOT PAID AT COST) * *************************************************************** * PERFORM 10660-SET-RADIOPH-APC-FLAG * THRU 10660-SET-RADIOPH-APC-FLAG-EXIT. *************************************************************** * ACCUMULATE TOTAL CLAIM DEVICE SERVICE UNITS -AND- * * FLAG CLAIMS THAT HAVE AT LEAST ONE DEVICE LINE * * - SI = H IDENTIFIES DEVICE LINES * * - EFFECTIVE AS OF 04-01-2002 * *-------------------------------------------------------------* * 11/16/2009 - RADIOPH-APC-FLAG CHECK REMOVED B/C NO THX * * RADIOPHARMS HAVE SI=H FOR CY 2010 * * 08/11/2010 - DISABLED & REPLACED BY REVISED LOGIC * *************************************************************** * IF OPPS-SRVC-IND (LN-SUB) = ' H' * MOVE 'Y' TO C-FLAG * COMPUTE H-TOT-HTD-UNITS = * H-TOT-HTD-UNITS + H-SRVC-UNITS. *************************************************************** * ACCUMULATE CLAIM TOTAL OFFSET AMOUNT & OFFSET UNITS * * WHEN PASS-THROUGH/OFFSET DEVICE APPEARS ON THE CLAIM * *-------------------------------------------------------------* * - HCPCS C1820 EXPIRES FROM PASS-THRU PMT 01-01-2008. THERE * * ARE NO OFFSET DEVICES FOR CY 2008; LOGIC RETAINED & ALL * * OFFSET AMOUNTS IN OFFSET TABLE SET TO $0. * * - THERE ARE NO PASS-THROUGH/OFFSET DEVICES FOR CY 2009 * * C1820-OFFSET-FLAG ALWAYS = 'N', OFFSET LOGIC NOT * * NEVER PERFORMED, RETAINED FOR FUTURE USE * * - 08/02/2010: DISABLED CODE, REPLACED BY REVISED LOGIC * *************************************************************** * IF C1820-OFFSET-FLAG = 'Y' * PERFORM 10160-TOTAL-OFFSET * THRU 10160-TOTAL-OFFSET-EXIT. *************************************************************** * CREATE NUCLEAR MEDICINE APC TABLE FOR PASS-THROUGH * * RADIOPHARM OFFSET WHEN PASS-THROUGH RADIOPHARM(S) ON CLAIM * * EFFECTIVE APRIL 2009 * *************************************************************** IF PTRADIO-CLAIM-FLAG = 'Y' PERFORM 10165-PROCESS-NUCLEAR-MED THRU 10165-PROCESS-NUCLEAR-MED-EXIT. *************************************************************** * CREATE CONTRAST AGENT PROCEDURE TABLE FOR PASS-THROUGH * * CONTRAST AGENT OFFSET WHEN PT CONTRAST AGENT(S) ON CLAIM * * EFFECTIVE JANUARY 2010 * *************************************************************** IF PTCA-CLAIM-FLAG = 'Y' PERFORM 10168-PROCESS-PTCA-PROC THRU 10168-PROCESS-PTCA-PROC-EXIT. *************************************************************** * CREATE PASS-THROUGH DEVICE PROCEDURE TABLE FOR PASS- * * THROUGH DEVICE OFFSET WHEN PT DEVICE(S) ON CLAIM * * EFFECTIVE OCTOBER 2010 * *************************************************************** IF PTDO-CLAIM-FLAG = 'Y' PERFORM 10169-PROCESS-PTDO-PROC THRU 10169-PROCESS-PTDO-PROC-EXIT. *************************************************************** * SET AND INTIALIZE LINE SPECIFIC DATA ITEMS * *************************************************************** *-------------------------------------------------------------* * SET COIN & BLOOD DEDUCTIBLE TABLES UP FOR CURRENT LINE * *-------------------------------------------------------------* SET W-LP-INDX TO LN-SUB. SET W-BD-INDX TO LN-SUB. INITIALIZE W-LP-ENTRY (W-LP-INDX). INITIALIZE W-BD-ENTRY (W-BD-INDX). *-------------------------------------------------------------* * INITIALIZE LINE ITEM VARIABLES TO BE PASSED BACK * *-------------------------------------------------------------* MOVE ZERO TO A-LITEM-PYMT (LN-SUB) A-LITEM-REIM (LN-SUB) A-ADJ-COIN (LN-SUB) A-RED-COIN (LN-SUB) A-TOTAL-LN-DEDUCT (LN-SUB) A-BLOOD-LN-DEDUCT (LN-SUB). *-------------------------------------------------------------* * INITIALIZE LINE FLAGS * *-------------------------------------------------------------* * 11/05/2007 - PHP-HCPCS-FLAG & MH-HCPCS-FLAG ADDED * *-------------------------------------------------------------* MOVE 'N' TO PHP-HCPCS-FLAG MH-HCPCS-FLAG. *************************************************************** * SEARCH PARTIAL HOSPITALIZATION (PHP) TABLE FOR LINE HCPCS * * (LOGIC NEW FOR CY2008; ADDED 11/5/2007) * * 11/15/2010 - FOR CY 2011, USE CY 2010 TABLE * *************************************************************** SEARCH ALL PHP-ENTRY10 AT END MOVE 'N' TO PHP-HCPCS-FLAG WHEN PHP-HCPCS10 (PHP-INDX10) = OPPS-HCPCS (LN-SUB) MOVE 'Y' TO PHP-HCPCS-FLAG. *************************************************************** * SEARCH MENTAL HEALTH (MH) TABLE FOR LINE HCPCS * * (LOGIC NEW FOR CY2008; ADDED 11/5/2007) * * 11/15/2010 - FOR CY 2011, USE CY 2010 TABLE * *************************************************************** SEARCH ALL MH-ENTRY10 AT END MOVE 'N' TO MH-HCPCS-FLAG WHEN MH-HCPCS10 (MH-INDX10) = OPPS-HCPCS (LN-SUB) MOVE 'Y' TO MH-HCPCS-FLAG. *************************************************************** * POPULATE PASS-THROUGH DEVICE TABLE W/ PASS-THROUGH * * DEVICE LINE DATA (FOR OUTLIER PAYMENT ADJUSTMENT) * *-------------------------------------------------------------* * 11/16/2009 - RADIOPH-APC-FLAG CHECK REMOVED B/C NO THX * * RADIOPHARMS HAVE SI=H FOR CY 2010 * *************************************************************** IF A-RETURN-CODE (LN-SUB) = 01 AND PTD-FLAG = 'Y' AND OPPS-SRVC-IND (LN-SUB) = ' H' PERFORM 10665-SET-PTD-LINE-FLAG THRU 10665-SET-PTD-LINE-FLAG-EXIT IF PTD-LINE-FLAG = 'Y' MOVE OPPS-HCPCS (LN-SUB) TO W-PTD-LINE-HCPCS PERFORM 10390-PASS-THRU-DEVICES THRU 10390-PASS-THRU-DEVICES-EXIT END-IF END-IF. *************************************************************** * * * ** CHECK LINE OCE VALUES FOR VALIDITY ** * * * *************************************************************** *************************************************************** * IDENTIFY ALL VALID SERVICE INDICATORS (SI) & RETURN * * ERROR CODE 40 IF THE SI IS INVALID. * *************************************************************** IF NOT (OPPS-SRVC-IND (LN-SUB) = ' A' OR ' B' OR ' C' OR ' E' OR ' F' OR ' G' OR ' H' OR ' K' OR ' L' OR ' N' OR ' P' OR ' R' OR ' S' OR ' T' OR ' U' OR ' V' OR ' X' OR ' W' OR ' Y' OR ' Z' OR ' M') THEN MOVE 40 TO A-RETURN-CODE (LN-SUB) GO TO 10150-INIT-EXIT ELSE MOVE 01 TO A-RETURN-CODE (LN-SUB). *************************************************************** * IDENTIFY SERVICE INDICATORS (SI) NOT VALID FOR THE OPPS * * PRICER & RETURN ERROR CODE 41 IF THE SI IS INVALID * * FOR THE OPPS PRICER. * *************************************************************** IF OPPS-SRVC-IND (LN-SUB) = ' A' OR ' B' OR ' C' OR ' E' OR ' F' OR ' L' OR ' W' OR ' Y' OR ' Z' OR ' M' MOVE 41 TO A-RETURN-CODE (LN-SUB) GO TO 10150-INIT-EXIT. *************************************************************** ** ** ** NOTE: ERROR CODES FOR THE VALIDATION RULES BELOW ARE ** ** ASSIGNED IN THE ELSE STATMENTS AFTER THE APC ** ** TABLE SEARCH. ** ** ** *************************************************************** *************************************************************** * IDENTIFY VALID PAYMENT INDICATORS & RETURN ERROR CODE 43 * * IF THE PAYMENT INDICATOR IS INVALID. * *************************************************************** IF OPPS-PYMT-IND (LN-SUB) = ' 1' OR ' 5' OR ' 6' OR ' 7' OR ' 8' OR ' 9' *************************************************************** * IDENTIFY VALID PACKAGING FLAGS & RETURN ERROR CODE 45 * * IF THE PACKAGING FLAG IS INVALID. * *************************************************************** IF OPPS-PKG-FLAG (LN-SUB) = '0' OR '1' OR '2' OR '3' OR '4' *************************************************************** * IDENTIFY VALID LINE ITEM DENIAL OR REJECTION (D/R) FLAGS * * AND VALID D/R FLAG-HCPCS COMBINATIONS & RETURN ERROR CODE * * 46 IF THE D/R FLAG OR D/R FLAG-HCPCS COMBO IS INVALID. * *-------------------------------------------------------------* * 11/6/2007 - CHANGED PHP/MENTAL HEALTH CODES LISTED FROM * * APCS TO HCPCS (VIA TABLE SEARCH) FOR CY 2008 * *************************************************************** *--------------------------------------------------------* * LINE IS NOT DENIED OR REJECTED * *--------------------------------------------------------* IF ( OPPS-LITEM-DR-FLAG (LN-SUB) = '0' OR *--------------------------------------------------------* * LINE IS DENIED OR REJECTED AND HAS A PHP OR MH HCPCS * *--------------------------------------------------------* OPPS-LITEM-DR-FLAG (LN-SUB) = '1' AND ( PHP-HCPCS-FLAG = 'Y' OR MH-HCPCS-FLAG = 'Y' ) ) OR *--------------------------------------------------------* * LINE ITEM DENIAL/REJECTION CODE IS IGNORED * *--------------------------------------------------------* ( OPPS-LITEM-ACT-FLAG (LN-SUB) = '1' ) *************************************************************** * IDENTIFY INVALID LINE ITEM ACTION FLAGS & RETURN ERROR * * CODE 47 IF THE LINE ITEM ACTION FLAG IS INVALID. * *************************************************************** IF NOT (OPPS-LITEM-ACT-FLAG (LN-SUB) EQUAL '2' OR '3') *************************************************************** * IDENTIFY VALID PAYMENT ADJUSTMENT FLAGS (PAF) & RETURN * * ERROR CODE 48 IF THE PAF IS INVALID. * *-------------------------------------------------------------* * 10/31/2007 - ADDED ' 8' AS A VALID PAF FOR CY 2008 * * 12/06/2007 - ADDED PAFS 91 - 99 FOR COMPOSITES FOR CY 2008 * * 11/03/2008 - REMOVED PAFS 91 - 99 FOR COMPOSITES FOR CY 2009* * 04/11/2011 - ADDED ' 9' & '10' AS VALID PAFS FOR CY 2011 * *************************************************************** IF OPPS-PYMT-ADJ-FLAG (LN-SUB) = ' 0' OR ' 1' OR ' 2' OR ' 3' OR ' 4' OR ' 5' OR ' 6' OR ' 7' OR ' 8' OR ' 9' OR '10' *************************************************************** * IDENTIFY VALID SITE OF SERVICE (SOS) FLAG AND CASES * * WHERE THE SOS FLAG IS IGNORED & RETURN ERROR CODE 49 IF * * THE SOS FLAG IS INVALID AND NOT IGNORED. * * * * ** SITE OF SERVICE FLAG = PAYMENT METHOD FLAG IN OCE ** * * * * NOTE: PHP = PARTIAL HOSPITALIZATION * * WHEN SI = 'P', PHP APC IS ON THE CURRENT LINE * *-------------------------------------------------------------* * 11/06/2007 - CHANGED PHP HEALTH CODES LISTED FROM * * APCS TO HCPCS (VIA TABLE SEARCH) FOR CY 2008 * * 11/03/2008 - CHANGED PARTIAL HOSPITALIZATION APC FROM * * 0033 TO 0172 & 0173 FOR CY 2009, FLAG CHANGED * * FROM APC33-FLAG TO PHP-APC-FLAG * *************************************************************** *-------------------------------------------------------------* * LINE SOS FLAG IS VALID * *-------------------------------------------------------------* IF (OPPS-SITE-SRVC-FLAG (LN-SUB) = '0') OR *-------------------------------------------------------------* * LINE SOS FLAG INVALID & PHP APC ON CLAIM - CHECK FURTHER * *-------------------------------------------------------------* ( (PHP-APC-FLAG = 'Y') AND *-------------------------------------------------------------* * LINE SOS FLAG INVALID, PHP APC ON CLAIM, & LINE APC IS PHP* *-------------------------------------------------------------* ( (OPPS-SRVC-IND (LN-SUB) = ' P') OR *-------------------------------------------------------------* * LINE SOS FLAG INVALID, PHP APC ON CLAIM, & LINE PHP HCPCS * *-------------------------------------------------------------* (PHP-HCPCS-FLAG = 'Y') ) ) *************************************************************** * * * ** ACCUMULATE TOTAL CHARGES OF ALL LINES THAT PASS ** * * ** VALIDATION RULES ** * * * *************************************************************** MOVE OPPS-SUB-CHRG (LN-SUB) TO H-SUB-CHRG COMPUTE H-TOT-CHRG = H-TOT-CHRG + H-SUB-CHRG *-------------------------------------------------------------* * EXCLUDE LINES THAT RECEIVE EXTERNAL LINE ITEM ADJ. * *-------------------------------------------------------------* IF OPPS-LITEM-ACT-FLAG (LN-SUB) = '4' COMPUTE H-TOT-CHRG = H-TOT-CHRG - H-SUB-CHRG END-IF *-------------------------------------------------------------* * ACCUMULATE PACKAGED LINE TOTAL CHARGES & SET CLAIM N-FLAG * * EXCLUDE ALL PACKAGED COMPOSITE LINES * *-------------------------------------------------------------* * 11/28/2007 - LOGIC ADDED TO EXCLUDE COMPOSITE & MENTAL * * HEALTH LINES (APC34-FLAG INDICATES MH) * * 08/08/2008 - LOGIC CORRECTED TO ADD CHARGES OF PACKAGED * * LINES WITH A PACKAGING FLAG OF '1' OR '4' TO * * THE CLAIM'S TOTAL DISTRIBUTED PACKAGED * * CHARGES WHEN A CLAIM HAS APC 34 (MENTAL * * HEALTH) ON IT - EFFECTIVE RETROCTIVE TO * * JANUARY 1, 2008. * * 11/12/2008 - CHANGED LOGIC THAT EXCLUDES ALL COMPOSITE * * LINES & MENTAL HEALTH PKG LINES TO USE THE * * COMPOSITE ADJUSTMENT FLAG INSTEAD OF PAYMENT * * ADJUSTMENT FLAG VALUES 91 - 99 * *-------------------------------------------------------------* IF (OPPS-PKG-FLAG (LN-SUB) = '1' OR '2' OR '4') AND (OPPS-COMP-ADJ-FLAG (LN-SUB) = '00') COMPUTE H-TOT-N-CHRG = H-SUB-CHRG + H-TOT-N-CHRG MOVE 'Y' TO N-FLAG END-IF *-------------------------------------------------------------* * ACCUMULATE PACKAGED MENTAL HEALTH LINE CHARGES * *-------------------------------------------------------------* * 11/28/2007 - LOGIC ADDED FOR CY 2008 * * 11/12/2008 - LOGIC DISABLED B/C MENTAL HEALTH COMPOSITE * * LINES ARE NOW IDENTIFIED WITH THE COMPOSITE * * ADJUSTMENT FLAG JUST AS ALL OTHER COMPOSITES * * (MENTAL HEALTH COMPOSITE LINES NOW HAVE A * * PACKAGING FLAG OF '1' (CY 2009) * *-------------------------------------------------------------* * IF (APC34-FLAG = 'Y') AND * (OPPS-SRVC-IND (LN-SUB) = ' N') AND * (OPPS-PKG-FLAG (LN-SUB) = '1') * COMPUTE H-TOT-MH-CHRG = H-SUB-CHRG + * H-TOT-MH-CHRG * END-IF *-------------------------------------------------------------* * ACCUMULATE NON-PRIME (PACKAGED) COMPOSITE APC CHARGES * * FOR EACH COMPOSITE APC BY THE COMPOSITE ADJUSTMENT FLAG * * (POPULATE COMPOSITE TABLE) * *-------------------------------------------------------------* * 11/28/2007 - LOGIC ADDED FOR CY 2008 * * 11/12/2007 - LOGIC REVISED FOR CY 2009 TO IDENTIFY ALL * * COMPOSITE LINES USING THE COMPOSITE * * ADJUSTMENT FLAG INSTEAD OF PAYMENT * * ADJUSTMENT FLAG VALUES 91 - 99 * * (INCLUDES PROCESSING FOR MENTAL HEALTH * * COMPOSITES) * *-------------------------------------------------------------* IF OPPS-COMP-ADJ-FLAG (LN-SUB) NOT = "00" AND OPPS-COMP-ADJ-FLAG (LN-SUB) NOT = " " AND OPPS-SRVC-IND (LN-SUB) = ' N' PERFORM 10170-COMPOSITES THRU 10170-COMPOSITES-EXIT END-IF *-------------------------------------------------------------* * RETURN ERROR CODE WHEN PACKAGED LINE OR LINE APC = 0000 * *-------------------------------------------------------------* IF (OPPS-APC (LN-SUB) = '0000') OR (OPPS-PKG-FLAG (LN-SUB) = '1' OR '2' OR '4') MOVE 42 TO A-RETURN-CODE (LN-SUB) GO TO 10150-INIT-EXIT END-IF *************************************************************** * * * ** LOOK-UP LINE APC IN APC TABLE FOR ALL LINES THAT ** * * ** PASS VALIDATION RULES ** * * * *************************************************************** SEARCH ALL WAA-ENTRY AT END MOVE 30 TO A-RETURN-CODE (LN-SUB) GO TO 10150-INIT-EXIT WHEN WAA-APC (WAA-INDX) = OPPS-GRP (LN-SUB) *-------------------------------------------------------------* * START SEARCH AT THE APC'S MOST CURRENT RECORD * *-------------------------------------------------------------* MOVE WAA-PTR (WAA-INDX) TO W-SUB2 *-------------------------------------------------------------* * GET APC DATA FROM THE REC WITH THE CORRECT EFFECTIVE DATE * *-------------------------------------------------------------* PERFORM 10175-APC-LOOKUP *-------------------------------------------------------------* * REDUCE APC PMT BY REDUCED UPDATE RATIO WHEN APPROPRIATE * * 11/13/2009 - NEW FOR CY 2009 (QUALITY) * *-------------------------------------------------------------* PERFORM 10180-REDUCE-APC-PYMT THRU 10180-REDUCE-APC-PYMT-EXIT *************************************************************** * * * ** RETURN ERROR CODE AND STOP PROCESSING LINES ** * * ** THAT FAIL OCE VALIDATION RULES ** * * * *************************************************************** ELSE MOVE 49 TO A-RETURN-CODE (LN-SUB) GO TO 10150-INIT-EXIT ELSE MOVE 48 TO A-RETURN-CODE (LN-SUB) GO TO 10150-INIT-EXIT ELSE MOVE 47 TO A-RETURN-CODE (LN-SUB) GO TO 10150-INIT-EXIT ELSE MOVE 46 TO A-RETURN-CODE (LN-SUB) GO TO 10150-INIT-EXIT ELSE MOVE 45 TO A-RETURN-CODE (LN-SUB) GO TO 10150-INIT-EXIT ELSE MOVE 43 TO A-RETURN-CODE (LN-SUB) GO TO 10150-INIT-EXIT. *************************************************************** * PROCESS BLOOD DEDUCTIBLE (EFFECTIVE AS OF 07-01-2005) * * - TOTAL BLOOD CODE CHARGES WHEN PAF = '5' OR '6' * * 5: BLOOD/BLOOD PRODUCT USED IN BLOOD DEDUC CALC * * 6: BLOOD PROCESS/STORAGE (LABOR) NOT SBJ TO BLD DEDUC * *************************************************************** IF OPPS-PYMT-ADJ-FLAG (LN-SUB) = ' 5' COMPUTE H-TOT-38X = OPPS-SUB-CHRG (LN-SUB) + H-TOT-38X. IF OPPS-PYMT-ADJ-FLAG (LN-SUB) = ' 5' OR ' 6' COMPUTE H-TOT-38X-39X = OPPS-SUB-CHRG (LN-SUB) + H-TOT-38X-39X. *************************************************************** * POPULATE COINSURANCE DEDUCTIBLE TABLE W/ ALL VALID LINES * * ORDERED LOWEST TO HIGHEST RANK FROM APC TABLE * *************************************************************** IF A-RETURN-CODE (LN-SUB) = 01 OR 11 PERFORM 10300-COIN-DEDUCT THRU 10300-COIN-DEDUCT-EXIT. *************************************************************** * POPULATE BLOOD DEDUCTIBLE TABLE W/ BLOOD DEDUC LINES * * ORDERED EARLIEST TO LATEST DATE OF SERVICE AND THEN * * LOWEST TO HIGHEST RANK FROM BLOOD DEDUCTIBLE TABLE * * (APPLIES WHEN HCPCS IS IN BLOOD DEDUCTIBLE RANKING TABLE) * * * * 05/11/2009 - ADDED THE REQUIREMENT PAF = 5 OR 6 TO BLOOD * * DEDUCTIBLE LOGIC TO CORRECT PRICING ERROR. * * FIX EFFECTIVE RETROACTIVE TO 01/01/2009. * *************************************************************** IF A-RETURN-CODE (LN-SUB) = 01 OR 11 SET W11BD-INDX TO 1 SEARCH W11BD-ENTRY VARYING W11BD-INDX AT END GO TO 10150-INIT-EXIT WHEN W-2011-BLOOD-HCPCS (W11BD-INDX) = OPPS-HCPCS (LN-SUB) IF OPPS-PYMT-ADJ-FLAG (LN-SUB) = (' 5' OR ' 6') MOVE W-2011-BLOOD-RANK (W11BD-INDX) TO H-BLOOD-RANK MOVE OPPS-LITEM-DOS (LN-SUB) TO H-BLD-DOS PERFORM 10375-BLOOD-DEDUCT THRU 10375-BLOOD-DEDUCT-EXIT END-IF. 10150-INIT-EXIT. EXIT. *************************************************************** * * * ACCUMULATE CLAIM TOTAL OFFSET AMT FROM CURRENT OFFSET TABLE * * FOR PASS-THRU ITEMS * * * * *** DISABLED 08/10/2010 & REPLACED WITH REVISED LOGIC *** * * * *************************************************************** * * * - SEARCH TABLE OPPSOF09 FOR LINE APC. * * - CALCULATE TOTAL OFFSET & TOTAL OFFSET UNITS IF APC * * OFFSET AMOUNT IN TABLE NOT EQUAL TO 0. * * * NOTE: C1820 EXPIRES FROM PASS-THRU PAYMENT IN 2009. * * ALL OFFSET AMOUNTS IN THE 2009 TABLE = $0. * * THIS LOGIC KEPT FOR FUTURE OFFSET CODES. * * * * EFFECTIVE AS OF 01-01-2003 * * - CONTINUE FOR 01-01-2004 * * - CONTINUE FOR 01-01-2005 * * - CONTINUE FOR 01-01-2006 * * - CONTINUE FOR 01-01-2007 * * - CONTINUE FOR 01-01-2008 (ALL OFFSETS IN TBL = $0) * * - CONTINUE FOR 01-01-2009 (ALL OFFSETS IN TBL = $0) * * - THIS LOGIC NOT USED FOR CY 2010, REVISED PASS-THROUGH* * OFFSET LOGIC TO BE ADDED WHEN DEVICES ARE APPROVED * * * *************************************************************** *9160-TOTAL-OFFSET. * * MOVE OPPS-GRP (LN-SUB) TO W-OFF-APC. * SEARCH ALL WOO-ENTRY8 * AT END * GO TO 9160-TOTAL-OFFSET-EXIT * WHEN WOO-APC8 (WOO-INDX8) = W-OFF-APC * PERFORM 9161-TOTAL-OFFSET-AMT * THRU 9161-TOTAL-OFFSET-AMT-EXIT. * *9160-TOTAL-OFFSET-EXIT. * EXIT. * * *************************************************************** * * * ACCUMULATE CLAIM TOTAL OFFSET AND OFFSET UNITS * * * *************************************************************** *9161-TOTAL-OFFSET-AMT. * * IF WOO-OFFSET8 (WOO-INDX8) EQUAL 0 * GO TO 9161-TOTAL-OFFSET-AMT-EXIT. * * COMPUTE H-TOTAL-OFFSET = H-TOTAL-OFFSET * + (WOO-OFFSET8 (WOO-INDX8) * H-DISC-RATE * H-SRVC-UNITS). * * COMPUTE H-TOT-OFF-UNITS = H-TOT-OFF-UNITS + H-SRVC-UNITS. * * IF H-TOTAL-OFFSET < 0 * MOVE 0 TO H-TOTAL-OFFSET. * *9161-TOTAL-OFFSET-AMT-EXIT. * EXIT. *************************************************************** * * * PROCESS LINES WITH A NUCLEAR MEDICINE APC FOR THE * * PASS-THROUGH RADIOPHARM OFFSET * * * *************************************************************** * * * - SEARCH TABLE PTROFFST FOR LINE APC & LINE YEAR * * - IF FOUND, ADD A RECORD TO TABLE W-NUCMED-APC-TBL * * FOR EVERY UNIT. * * * * 02/10/2009 - LOGIC ADDED EFFECTIVE STARTING APRIL 2009 * * * *************************************************************** 10165-PROCESS-NUCLEAR-MED. *-------------------------------------------------------------* * HOLD THE LINE'S APC, UNITS, & SERVICE FROM DATE * *-------------------------------------------------------------* MOVE OPPS-GRP (LN-SUB) TO W-NUCMED-LINE-APC. MOVE OPPS-SRVC-UNITS (LN-SUB) TO W-NUCMED-UNIT-CNT. MOVE OPPS-LITEM-DOS (LN-SUB) TO W-LINE-SRVC-DATE. *-------------------------------------------------------------* * SEARCH PT RADIOPHARM OFFSET TABLE FOR THE APC & YEAR * *-------------------------------------------------------------* SET PTRO-INDX TO 1. SEARCH PTRO-ENTRY AT END GO TO 10165-PROCESS-NUCLEAR-MED-EXIT *-------------------------------------------------------------* * WHEN APC & YEAR FOUND, WAGE ADJUST OFFSET & ADD NEW RECORD * * TO NUCLEAR MEDICINE TABLE FOR EVERY UNIT * *-------------------------------------------------------------* WHEN PTRO-NUCMED-APC (PTRO-INDX) = W-NUCMED-LINE-APC AND PTRO-EFF-YEAR (PTRO-INDX) = W-LINE-SRVC-YEAR MOVE PTRO-OFFSET-AMT (PTRO-INDX) TO W-NUCMED-OFFSET COMPUTE W-NUCMED-WA-OFFSET ROUNDED = W-NUCMED-OFFSET * (.6 * A-WINX + .4) PERFORM 10166-LOAD-NUCMED-TABLE THRU 10166-LOAD-NUCMED-TABLE-EXIT VARYING W-NUCMED-SUB FROM 1 BY 1 UNTIL W-NUCMED-SUB > W-NUCMED-UNIT-CNT. 10165-PROCESS-NUCLEAR-MED-EXIT. EXIT. *************************************************************** * * * LOAD A NUCLEAR MEDICINE APC TABLE RECORD FOR EVERY UNIT OF * * THE NUCLEAR MEDICINE LINE AND WAGE ADJUST 60% OF THE OFFSET * * (INSERT THE NEW RECORD IN THE CORRECT TABLE POSITION - * * HIGHEST TO LOWEST OFFSET) * * * *************************************************************** 10166-LOAD-NUCMED-TABLE. *-------------------------------------------------------------* * INCREASE THE TOTAL NUMBER OF TABLE RECORDS FOR NEW ENTRY * *-------------------------------------------------------------* ADD 1 TO W-NUCMED-MAX. *-------------------------------------------------------------* * MOVE TO THE NEW (LAST) ENTRY POSITION (EMPTY RECORD) * *-------------------------------------------------------------* SET W-NUCMED-INDX TO W-NUCMED-MAX. INITIALIZE W-NUCMED-APC-ENTRY (W-NUCMED-INDX). *-------------------------------------------------------------* * DETERMINE WHERE THE NEW NUCMED APC ENTRY FOR THE CURRENT * * SERVICE LINE SHOULD BE ENTERED INTO THE TABLE ACCORDING TO * * ITS OFFSET VALUE - HIGHEST TO LOWEST OFFSET * *-------------------------------------------------------------* PERFORM 10167-STAGE-NUCMED-ENTRY THRU 10167-STAGE-NUCMED-ENTRY-EXIT UNTIL W-NUCMED-INDX = 1 OR W-NUCMED-WA-OFFSET NOT > W-NUCMED-WAGE-ADJ-OFFSET (W-NUCMED-INDX - 1) *-------------------------------------------------------------* * POPULATE THE EMPTY RECORD WITH THE NEW SERVICE LINE'S DATA * *-------------------------------------------------------------* MOVE W-NUCMED-LINE-APC TO W-NUCMED-APC (W-NUCMED-INDX). MOVE W-NUCMED-WA-OFFSET TO W-NUCMED-WAGE-ADJ-OFFSET (W-NUCMED-INDX). 10166-LOAD-NUCMED-TABLE-EXIT. EXIT. *************************************************************** * * * MOVE THE EXISTING NUCMED APC RECORD WITH A HIGHER OFFSET * * DOWN ONE RECORD POSITION AND SET THE EMPTY RECORD FOR THE * * NEW ENTRY'S INDEX TO THE NEXT HIGHER RECORD POSITION. * * * *************************************************************** 10167-STAGE-NUCMED-ENTRY. MOVE W-NUCMED-APC-ENTRY (W-NUCMED-INDX - 1) TO W-NUCMED-APC-ENTRY (W-NUCMED-INDX). SET W-NUCMED-INDX DOWN BY 1. 10167-STAGE-NUCMED-ENTRY-EXIT. EXIT. *************************************************************** * * * PROCESS LINES WITH A PASS-THROUGH CONTRAST AGENT PROCEDURE * * APC FOR THE PASS-THROUGH CONTRAST AGENT OFFSET * * * *************************************************************** * * * - SEARCH TABLE PTCOFFST FOR LINE APC & LINE YEAR * * - IF FOUND, ADD A RECORD TO TABLE W-CAPROC-APC-TBL * * FOR EVERY UNIT. * * * * 11/16/2009 - LOGIC ADDED EFFECTIVE STARTING JANUARY 2010 * * * *************************************************************** 10168-PROCESS-PTCA-PROC. *-------------------------------------------------------------* * HOLD THE LINE'S APC, UNITS, & LINE ITEM DATE OF SERVICE * *-------------------------------------------------------------* MOVE OPPS-GRP (LN-SUB) TO W-CAPROC-LINE-APC. MOVE OPPS-SRVC-UNITS (LN-SUB) TO W-CAPROC-UNIT-CNT. MOVE OPPS-LITEM-DOS (LN-SUB) TO W-CAPROC-SRVC-DATE. *-------------------------------------------------------------* * SEARCH PT CONTRAST AGENT OFFSET TABLE FOR THE APC & YEAR * *-------------------------------------------------------------* SET PTCO-INDX TO 1. SEARCH PTCO-ENTRY AT END GO TO 10168-PROCESS-PTCA-PROC-EXIT *-------------------------------------------------------------* * WHEN APC & YEAR FOUND, WAGE ADJUST OFFSET & ADD NEW RECORD * * TO PT CONTRAST PROCEDURE APC TABLE FOR EVERY UNIT * *-------------------------------------------------------------* WHEN PTCO-CONTR-APC (PTCO-INDX) = W-CAPROC-LINE-APC AND PTCO-EFF-YEAR (PTCO-INDX) = W-CAPROC-SRVC-YEAR MOVE PTCO-OFFSET-AMT (PTCO-INDX) TO W-CAPROC-OFFSET COMPUTE W-CAPROC-WA-OFFSET ROUNDED = W-CAPROC-OFFSET * (.6 * H-WINX1 + .4) PERFORM 10168-LOAD-PTCA-PROC-TABLE THRU 10168-LOAD-PTCA-PROC-TABLE-EXT VARYING W-CAPROC-SUB FROM 1 BY 1 UNTIL W-CAPROC-SUB > W-CAPROC-UNIT-CNT. 10168-PROCESS-PTCA-PROC-EXIT. EXIT. *************************************************************** * * * LOAD A PT CONTRAST AGENT PROCEDURE APC TABLE RECORD FOR * * EVERY UNIT OF THE PT CONTRAST AGENT PROCEDURE LINE * * (INSERT THE NEW RECORD IN THE CORRECT TABLE POSITION - * * EARLIEST TO LATEST LIDOS, THEN HIGHEST TO LOWEST OFFSET) * * * *************************************************************** 10168-LOAD-PTCA-PROC-TABLE. *-------------------------------------------------------------* * INCREASE THE TOTAL NUMBER OF TABLE RECORDS FOR NEW ENTRY * *-------------------------------------------------------------* ADD 1 TO W-CAPROC-MAX. *-------------------------------------------------------------* * MOVE TO THE NEW (LAST) ENTRY POSITION (EMPTY RECORD) * *-------------------------------------------------------------* SET W-CAPROC-INDX TO W-CAPROC-MAX. INITIALIZE W-CAPROC-APC-ENTRY (W-CAPROC-INDX). *-------------------------------------------------------------* * DETERMINE WHERE THE NEW CAPROC APC ENTRY FOR THE CURRENT * * SERVICE LINE SHOULD BE ENTERED INTO THE TABLE ACCORDING TO * * ITS LIDOS & OFFSET VALUE (EARLIEST TO LATEST, HIGHEST TO * * LOWEST) * *-------------------------------------------------------------* PERFORM 10168-STAGE-PTCA-PROC-ENTRY THRU 10168-STAGE-PTCA-PROC-ENTRY-EX UNTIL W-CAPROC-INDX = 1 OR W-CAPROC-KEY NOT > W-CAPROC-TBL-KEY (W-CAPROC-INDX - 1) *-------------------------------------------------------------* * POPULATE THE EMPTY RECORD WITH THE NEW SERVICE LINE'S DATA * *-------------------------------------------------------------* MOVE W-CAPROC-LINE-APC TO W-CAPROC-APC (W-CAPROC-INDX). MOVE W-CAPROC-KEY TO W-CAPROC-TBL-KEY (W-CAPROC-INDX). 10168-LOAD-PTCA-PROC-TABLE-EXT. EXIT. *************************************************************** * * * MOVE THE EXISTING NUCMED APC RECORD WITH A HIGHER OFFSET * * DOWN ONE RECORD POSITION AND SET THE EMPTY RECORD FOR THE * * NEW ENTRY'S INDEX TO THE NEXT HIGHER RECORD POSITION. * * * *************************************************************** 10168-STAGE-PTCA-PROC-ENTRY. MOVE W-CAPROC-APC-ENTRY (W-CAPROC-INDX - 1) TO W-CAPROC-APC-ENTRY (W-CAPROC-INDX). SET W-CAPROC-INDX DOWN BY 1. 10168-STAGE-PTCA-PROC-ENTRY-EX. EXIT. *************************************************************** * * * PROCESS LINES WITH A PASS-THROUGH DEVICE PROCEDURE * * APC FOR THE PASS-THROUGH DEVICE OFFSET * * * *************************************************************** * * * - SEARCH TABLE OPPSPTDO FOR LINE APC * * - IF FOUND, DETERMINE IF IT MAPS TO A PASS-THROUGH * * DEVICE HCPCS, HOW MANY IT MAPS TO, IF SOM STORE * * IT IN THE PASS-THROUGH DEVICE OFFSET PROCEDURE TABLE * * * * 08/02/2010 - LOGIC ADDED EFFECTIVE STARTING OCTOBER 2010 * * 12/20/2011 - LOGIC REVISED TO INCLUDE TERMINATION DATE * * AS A VALID DATE OF SERVICE * * * *************************************************************** 10169-PROCESS-PTDO-PROC. *-------------------------------------------------------------* * INITIALIZE VARIBLES SPECIFIC TO THE CURRENT PROCEDURE LINE * *-------------------------------------------------------------* MOVE 1 TO W-DOPROC-SUB. PERFORM UNTIL W-DOPROC-SUB > W-PTDO-ASSOC-HCPCS-MAX INITIALIZE W-PTDO-ASSOC-HCPCS-HCPCS (W-DOPROC-SUB) INITIALIZE W-PTDO-ASSOC-HCPCS-IND (W-DOPROC-SUB) ADD 1 TO W-DOPROC-SUB END-PERFORM. SET W-PTDO-ASSOC-HCPCS-INDX TO 1. MOVE 0 TO W-PTDO-ASSOC-HCPCS-MAX. MOVE 'N' TO W-PTDO-EOF-SWITCH. INITIALIZE H-PTDO-ASSOC-HCPCS-CTR. INITIALIZE H-PTDO-PROC-KEY. INITIALIZE W-PTDO-DARRAY-MAX. SET PTDO-INDX TO 1. *-------------------------------------------------------------* * HOLD THE LINE'S APC, UNITS, & LINE ITEM DATE OF SERVICE * *-------------------------------------------------------------* MOVE OPPS-GRP (LN-SUB) TO W-DOPROC-LINE-APC. MOVE OPPS-SRVC-UNITS (LN-SUB) TO H-PTDO-PROC-UNITS. MOVE OPPS-LITEM-DOS (LN-SUB) TO W-DOPROC-SRVC-DATE. *-------------------------------------------------------------* * SEARCH PT DEVICE OFFSET TBL FOR EVERY OCCURANCE OF THE APC * * AND CAPTURE EACH ASSOCIATED DEVICE HCPCS * *-------------------------------------------------------------* PERFORM UNTIL W-PTDO-EOF-SWITCH = 'Y' SEARCH PTDO-ENTRY AT END MOVE 'Y' TO W-PTDO-EOF-SWITCH *-------------------------------------------------------------* * EACH TIME A CURRENT RECORD FOR THE APC IS FOUND, ADD THE * * ASSOCIATED HCPCS TO A TABLE, HOLD THE OFFSET AMOUNT, AND * * SEARCH FOR ANOTHER CURRENT RECORD * *-------------------------------------------------------------* WHEN (PTDO-PROC-APC (PTDO-INDX) = W-DOPROC-LINE-APC) AND (PTDO-EFF-DATE (PTDO-INDX) <= W-DOPROC-SRVC-DATE) AND (PTDO-TERM-DATE (PTDO-INDX) = 0 OR PTDO-TERM-DATE (PTDO-INDX) >= W-DOPROC-SRVC-DATE) MOVE 'N' TO W-PTDO-EOF-SWITCH COMPUTE H-PTDO-PROC-WA-OFFSET = ((PTDO-OFFSET-AMT (PTDO-INDX) * .60) * H-WINX1) + (PTDO-OFFSET-AMT (PTDO-INDX) * .40) PERFORM 10169-LOAD-ASSOC-PTD-HCPCS THRU 10169-LOAD-ASSOC-PTD-HCPCS-EXT SET PTDO-INDX UP BY 1 END-SEARCH END-PERFORM. *-------------------------------------------------------------* * SEARCH THE DEVICE OFFSET HCPCS TABLE FOR EACH HCPCS IN * * THE PT DEVICE ASSOCIATED HCPCS TABLE & TRY TO MAP THE HCPCS * * TO THE PROCEDURE APC * *-------------------------------------------------------------* IF W-PTDO-ASSOC-HCPCS-MAX > 0 PERFORM 10169-COUNT-PTDO-MAPPINGS THRU 10169-COUNT-PTDO-MAPPINGS-EXIT VARYING W-DOPROC-SUB FROM 1 BY 1 UNTIL W-DOPROC-SUB > W-PTDO-ASSOC-HCPCS-MAX END-IF. *-------------------------------------------------------------* * CREATE RECORD IN THE OFFSET PROCEDURE APC TABLE IF * * PROCEDURE HAS >= 1 ASSOCIATED DEVICE HCPCS ON THE CLAIM * *-------------------------------------------------------------* IF H-PTDO-ASSOC-HCPCS-CTR > 0 PERFORM 10169-LOAD-PTDO-PROC-TABLE THRU 10169-LOAD-PTDO-PROC-TABLE-EXT END-IF. 10169-PROCESS-PTDO-PROC-EXIT. EXIT. *************************************************************** * * * LOAD THE PASS-THROUGH DEVICE HCPCS ON THE RECORD INTO THE * * PTDO ASSOCIATED HCPCS TABLE * * * *************************************************************** 10169-LOAD-ASSOC-PTD-HCPCS. *-------------------------------------------------------------* * DETERMINE IF THE RECORD'S PTDO HCPCS IS ALREADY IN THE TBL * * IF IT'S NOT IN THE TBL, ADD IT, IF IT IS, DO NOT ADD IT * *-------------------------------------------------------------* SET W-PTDO-ASSOC-HCPCS-INDX TO 1. SEARCH W-PTDO-ASSOC-HCPCS-ENTRY AT END MOVE PTDO-DEV-HCPCS (PTDO-INDX) TO W-PTDO-ASSOC-HCPCS-HCPCS (W-PTDO-ASSOC-HCPCS-INDX) ADD 1 TO W-PTDO-ASSOC-HCPCS-MAX ADD 1 TO W-PTDO-DARRAY-MAX WHEN W-PTDO-ASSOC-HCPCS-HCPCS(W-PTDO-ASSOC-HCPCS-INDX) = PTDO-DEV-HCPCS (PTDO-INDX) GO TO 10169-LOAD-ASSOC-PTD-HCPCS-EXT END-SEARCH. 10169-LOAD-ASSOC-PTD-HCPCS-EXT. EXIT. *************************************************************** * * * DETERMINE HOW MANY PT DEVICE OFFSET HCPCS MAP TO THE OFFSET * * PROCEDURE, AND HOW MANY PROCEDURES MAP TO THE DEVICE HCPCS * * * *************************************************************** 10169-COUNT-PTDO-MAPPINGS. *-------------------------------------------------------------* * SEARCH PT DEVICE OFFSET HCPCS TBL FOR THE CURRENT DEVICE * * HCPCS (IN THE ASSOC. HCPCS TBL) * *-------------------------------------------------------------* SET W-PTDO-HCPCS-INDX TO 1. SEARCH W-PTDO-HCPCS-ENTRY AT END MOVE 'N' TO W-PTDO-ASSOC-HCPCS-IND(W-DOPROC-SUB) WHEN W-PTDO-HCPCS-HCPCS (W-PTDO-HCPCS-INDX) = W-PTDO-ASSOC-HCPCS-HCPCS(W-DOPROC-SUB) MOVE 'Y' TO W-PTDO-ASSOC-HCPCS-IND(W-DOPROC-SUB) ADD 1 TO H-PTDO-ASSOC-HCPCS-CTR ADD 1 TO W-PTDO-HCPCS-PROC-CNT(W-PTDO-HCPCS-INDX). 10169-COUNT-PTDO-MAPPINGS-EXIT. EXIT. *************************************************************** * * * LOAD A PT DEVICE OFFSET PROCEDURE APC TABLE RECORD FOR * * THE CURRENT PROCEDURE LINE IF THERE IS AT LEAST ONE * * ASSOCIATED PT DEVICE ON THE CLAIM * * (INSERT THE NEW RECORD IN THE CORRECT TABLE POSITION - * * HIGHEST TO LOWEST OFFSET, THEN HIGHEST TO LOWEST UNITS) * * * *************************************************************** 10169-LOAD-PTDO-PROC-TABLE. *-------------------------------------------------------------* * INCREASE THE TOTAL NUMBER OF TABLE RECORDS FOR NEW ENTRY * *-------------------------------------------------------------* ADD 1 TO W-PTDO-PROC-MAX. *-------------------------------------------------------------* * MOVE TO THE NEW (LAST) ENTRY POSITION (EMPTY RECORD) * *-------------------------------------------------------------* SET W-PTDO-PROC-INDX TO W-PTDO-PROC-MAX. * INITIALIZE W-PTDO-PROC-ENTRY (W-PTDO-PROC-INDX). *-------------------------------------------------------------* * DETERMINE WHERE THE NEW PROC APC ENTRY FOR THE CURRENT * * SERVICE LINE SHOULD BE ENTERED INTO THE TABLE ACCORDING TO * * ITS OFFSET & UNITS (HIGHEST TO LOWEST, HIGHEST TO LOWEST) * *-------------------------------------------------------------* PERFORM 10169-STAGE-PTDO-PROC-ENTRY THRU 10169-STAGE-PTDO-PROC-ENTRY-EX UNTIL W-PTDO-PROC-INDX = 1 OR H-PTDO-PROC-KEY NOT > W-PTDO-PROC-KEY (W-PTDO-PROC-INDX - 1) *-------------------------------------------------------------* * POPULATE THE EMPTY RECORD WITH THE NEW SERVICE LINE'S DATA * *-------------------------------------------------------------* MOVE W-DOPROC-LINE-APC TO W-PTDO-PROC-APC (W-PTDO-PROC-INDX). MOVE LN-SUB TO W-PTDO-PROC-LNSUB (W-PTDO-PROC-INDX). MOVE H-PTDO-PROC-UNITS TO W-PTDO-PROC-UNITS (W-PTDO-PROC-INDX). MOVE H-PTDO-PROC-WA-OFFSET TO W-PTDO-PROC-WA-OFFSET (W-PTDO-PROC-INDX). MOVE 0 TO W-PTDO-PROC-DEVICE-CNT (W-PTDO-PROC-INDX). MOVE 0 TO W-PTDO-PROC-TOT-DCHRGS (W-PTDO-PROC-INDX). MOVE 0 TO W-PTDO-PROC-TOT-DUNITS (W-PTDO-PROC-INDX). MOVE SPACES TO W-PTDO-PROC-USED (W-PTDO-PROC-INDX). *------------------------------------------------------------* * LOAD HCPCS IN ASSOCIATED HCPCS TABLE INTO THE EMPTY RECORD * *------------------------------------------------------------* MOVE 1 TO W-DOPROC-SUB. MOVE 0 TO W-PTDO-DARRAY-SIZE (W-PTDO-PROC-INDX). PERFORM UNTIL W-DOPROC-SUB > W-PTDO-ASSOC-HCPCS-MAX IF W-PTDO-ASSOC-HCPCS-IND (W-DOPROC-SUB) = 'Y' MOVE W-PTDO-ASSOC-HCPCS-HCPCS (W-DOPROC-SUB) TO W-PTDO-PROC-DHCPCS (W-PTDO-PROC-INDX, W-DOPROC-SUB) ADD 1 TO W-PTDO-DARRAY-SIZE (W-PTDO-PROC-INDX) END-IF ADD 1 TO W-DOPROC-SUB END-PERFORM. 10169-LOAD-PTDO-PROC-TABLE-EXT. EXIT. *************************************************************** * * * MOVE THE EXISTING PROCEDURE RECORD WITH A LOWER OFFSET & * * LOWER UNITS DOWN ONE RECORD POSITION AND SET THE EMPTY * * RECORD FOR THE NEW ENTRY'S INDEX TO THE NEXT HIGHER RECORD * * POSITION. * * * *************************************************************** 10169-STAGE-PTDO-PROC-ENTRY. MOVE W-PTDO-PROC-ENTRY (W-PTDO-PROC-INDX - 1) TO W-PTDO-PROC-ENTRY (W-PTDO-PROC-INDX). SET W-PTDO-PROC-INDX DOWN BY 1. 10169-STAGE-PTDO-PROC-ENTRY-EX. EXIT. *************************************************************** * * * ACCUMULATE NON-PRIME COMPOSITE APC CHARGES FOR EACH * * COMPOSITE APC USING PACKAGED LINES WITH COMPOSITE * * ADJUSTMENT FLAG NOT = '00' & POPULATE COMPOSITE APC TABLE * * * *************************************************************** * * * ORDER SERVICE LINES BY COMPOSITE ADJUSTMENT FLAG (CAF) - * * LOWEST TO HIGHEST FLAG VALUE (01 - NN) * * * * EACH NON-PRIME COMPOSITE PACKAGED LINE'S CHARGES ARE ADDED * * TO THE TOTAL NON-PRIME CHARGES FOR EACH CAF, WHICH * * CORRESPONDS TO THE PRIME LINE'S APC. THESE CHARGES ARE * * LATER ADDED TO THE PRIME LINE'S CHARGES TO CALCULATE THE * * OUTLIER PAYMENT. * * * * 11/28/2007 - LOGIC ADDED FOR CY 2008 * * 11/12/2008 - LOGIC REVISED FOR CY 2009 TO USE THE * * COMPOSITE ADJUSTMENT FLAG INSTEAD OF THE * * PAYMENT ADJUSTMENT FLAG, VARIABLE H-CMP-CAF * * HOLDS COMPOSITE ADJUSTMENT FLAG, VARIABLE * * W-CMP-PAF RETAINED AND NOW HOLDS THE CAF * * (RETAINED TO CONTINUE USE OF EXISTING TABLE) * * * *************************************************************** 10170-COMPOSITES. *-------------------------------------------------------------* * GET THE LINE'S COMPOSITE ADJUSTMENT FLAG FOR TABLE SEARCH * *-------------------------------------------------------------* MOVE OPPS-COMP-ADJ-FLAG (LN-SUB) TO H-CMP-CAF. *-------------------------------------------------------------* * ADD OR UPDATE COMPOSITE APC TABLE ENTRY FOR THE CAF * *-------------------------------------------------------------* PERFORM 10171-SEARCH-CAF THRU 10171-SEARCH-CAF-EXIT. 10170-COMPOSITES-EXIT. EXIT. *************************************************************** * * * DETERMINE WHETHER A NEW COMPOSITE APC TABLE RECORD SHOULD * * BE ADDED OR IF AN EXISITING RECORD NEEDS TO BE UPDATED * * * *************************************************************** 10171-SEARCH-CAF. *-------------------------------------------------------------* * SEARCH COMPOSITE APC TABLE STARTING AT ENTRY #1 * *-------------------------------------------------------------* SET W-CMP-INDX TO 1. SEARCH W-CMP-ENTRY VARYING W-CMP-INDX *-------------------------------------------------------------* * IF THE SERVICE LINE'S COMPOSITE ADJUSTMENT FLAG IS NOT * * ALREADY IN THE TABLE, ADD IT * *-------------------------------------------------------------* AT END PERFORM 10172-ADD-ENTRY THRU 10172-ADD-ENTRY-EXIT *-------------------------------------------------------------* * IF THE SERVICE LINE'S COMPOSITE ADJUSTMENT FLAG IS ALREADY * * IN THE TABLE, UPDATE THE ENTRY * *-------------------------------------------------------------* WHEN W-CMP-PAF (W-CMP-INDX) = H-CMP-CAF PERFORM 10173-UPDATE-ENTRY THRU 10173-UPDATE-ENTRY-EXIT. 10171-SEARCH-CAF-EXIT. EXIT. *************************************************************** * * * INSERT THE NEW COMPOSITE APC RECORD IN THE CORRECT POSITION * * (LOWEST TO HIGHEST CAF) OF THE COMPOSITE APC TABLE * * * *************************************************************** 10172-ADD-ENTRY. *-------------------------------------------------------------* * INCREASE THE TOTAL NUMBER OF TABLE RECORDS FOR NEW ENTRY * *-------------------------------------------------------------* ADD 1 TO W-CMP-MAX. *-------------------------------------------------------------* * MOVE TO THE NEW ENTRY POSITION (EMPTY RECORD) * *-------------------------------------------------------------* SET W-CMP-INDX TO W-CMP-MAX. *-------------------------------------------------------------* * DETERMINE WHERE THE NEW COMPOSITE APC ENTRY FOR THE CURRENT * * SERVICE LINE SHOULD BE ENTERED INTO THE TABLE ACCORDING TO * * ITS COMPOSITE ADJUSTMENT FLAG (CAF) - LOWEST TO HIGHEST CAF * *-------------------------------------------------------------* PERFORM 10174-STAGE-CMP-ENTRY THRU 10174-STAGE-CMP-ENTRY-EXIT UNTIL W-CMP-INDX = 1 OR H-CMP-CAF NOT < W-CMP-PAF (W-CMP-INDX - 1). *-------------------------------------------------------------* * POPULATE THE EMPTY RECORD WITH THE NEW SERVICE LINE'S DATA * *-------------------------------------------------------------* MOVE H-CMP-CAF TO W-CMP-PAF (W-CMP-INDX). MOVE H-SUB-CHRG TO W-CMP-TOT-SUB-CHRG (W-CMP-INDX). 10172-ADD-ENTRY-EXIT. EXIT. *************************************************************** * * * UPDATE THE EXISTING COMPOSITE APC RECORD WITH THE SAME * * COMPOSITE ADJUSTMENT FLAG OF THE CURRENT SERVICE LINE * * * *************************************************************** 10173-UPDATE-ENTRY. *-------------------------------------------------------------* * ACCUMULATE THE CAF'S TOTAL NON-PRIME SUBMITTED CHARGES * *-------------------------------------------------------------* ADD H-SUB-CHRG TO W-CMP-TOT-SUB-CHRG (W-CMP-INDX). 10173-UPDATE-ENTRY-EXIT. EXIT. *************************************************************** * * * MOVE THE EXISTING COMPOSITE APC RECORD WITH A HIGHER CAF * * UP ONE RECORD POSITION AND SET THE EMPTY RECORD FOR THE * * NEW ENTRY'S INDEX TO THE NEXT LOWER RECORD POSITION. * * * *************************************************************** 10174-STAGE-CMP-ENTRY. MOVE W-CMP-ENTRY (W-CMP-INDX - 1) TO W-CMP-ENTRY (W-CMP-INDX). SET W-CMP-INDX DOWN BY 1. 10174-STAGE-CMP-ENTRY-EXIT. EXIT. *************************************************************** * * * LOCATE THE APC RECORD WITH THE APPROPRIATE EFFECTIVE DATE * * - MOVE APC DATA TO HOLD AREA FOR PROCESSING WHEN FOUND * * - ADJUST TOTAL CHARGES FOR DELETED APCS & RETURN ERROR * * - RETURN ERROR WHEN USABLE EFFECTIVE DATE NOT FOUND * * * *************************************************************** 10175-APC-LOOKUP. *************************************************************** * APC RECORD EFFECTIVE DATE IS BEFORE OR ON THE LATEST * * EFFECTIVE DATE THE CLAIM CAN USE (SEARCH STARTS AT THE * * MOST CURRENT RECORD FOR THE APC) * *************************************************************** IF WAR-DTCD (W-SUB2) NOT > WAD-DTCD (WAD-SUB) *-------------------------------------------------------------* * APC RECORD EFFECTIVE DATE CORRECT, APC DELETED - ERROR * *-------------------------------------------------------------* IF WAR-RATEX (W-SUB2) = 'DELETED' MOVE 30 TO A-RETURN-CODE (LN-SUB) COMPUTE H-TOT-CHRG = H-TOT-CHRG - H-SUB-CHRG *-------------------------------------------------------------* * APC RECORD EFFECTIVE DATE CORRECT, APC ACTIVE - ACCEPT REC * *-------------------------------------------------------------* ELSE MOVE WAR-RATE (W-SUB2) TO H-APC-PYMT MOVE WAR-RANK (W-SUB2) TO H-RANK MOVE WAR-MINC (W-SUB2) TO H-MIN-COIN MOVE WAR-COIN (W-SUB2) TO H-NAT-COIN MOVE WAR-PPCT (W-SUB2) TO H-PPCT *************************************************************** * APC RECORD EFFECTIVE DATE IS AFTER THE LATEST EFFECTIVE * * DATE THE CLAIM CAN USE. GO TO THE PREVIOUS RECORD IN THE * * APC TABLE. * *************************************************************** ELSE SUBTRACT 1 FROM W-SUB2 *-------------------------------------------------------------* * PREVIOUS REC BELONGS TO THE LINE APC, TEST EFFECTIVE DATE * *-------------------------------------------------------------* IF W-SUB2 > WAA-PTR (WAA-INDX - 1) GO TO 10175-APC-LOOKUP *-------------------------------------------------------------* * THERE IS NO RECORD FOR THE LINE APC WITH AN ACCEPTABLE * * EFFECTIVE DATE FOR THE LINE. RETURN ZEROS. * *-------------------------------------------------------------* ELSE MOVE 0 TO H-APC-PYMT H-RANK H-MIN-COIN H-NAT-COIN H-PPCT. 10175-APC-LOOKUP-EXIT. EXIT. *************************************************************** * * * REDUCE APC PAYMENT OF LINES FROM PROVIDERS WITH A * * SPACE IN THE QUALITY INDICATOR FIELD OF THE OPSF * * * * LOCATE THE APC RECORD WITH THE APPROPRIATE EFFECTIVE DATE * * - MOVE APC DATA TO HOLD AREA FOR PROCESSING WHEN FOUND * * - ADJUST TOTAL CHARGES FOR DELETED APCS & RETURN ERROR * * - RETURN ERROR WHEN USABLE EFFECTIVE DATE NOT FOUND * * * * 11/16/2010 - ADDED SI = U (BRACHY) TO LOGIC * * * *************************************************************** 10180-REDUCE-APC-PYMT. *-------------------------------------------------------------* * SPECIFY LINES ELIGIBLE FOR REDUCTION * *-------------------------------------------------------------* IF ( L-PSF-HOSP-QUAL-IND = ' ' ) AND ( (OPPS-SRVC-IND (LN-SUB) = ' P') OR (OPPS-SRVC-IND (LN-SUB) = ' R') OR (OPPS-SRVC-IND (LN-SUB) = ' S' AND NOT (OPPS-GRP (LN-SUB) >= '01491' AND OPPS-GRP (LN-SUB) <= '01537')) OR (OPPS-SRVC-IND (LN-SUB) = ' T' AND NOT (OPPS-GRP (LN-SUB) >= '01539' AND OPPS-GRP (LN-SUB) <= '01574')) OR (OPPS-SRVC-IND (LN-SUB) = ' U') OR (OPPS-SRVC-IND (LN-SUB) = ' V') OR (OPPS-SRVC-IND (LN-SUB) = ' X') ) THEN COMPUTE H-APC-PYMT ROUNDED = H-APC-PYMT * 0.980 MOVE 11 TO A-RETURN-CODE (LN-SUB) END-IF. 10180-REDUCE-APC-PYMT-EXIT. EXIT. *************************************************************** * * * DELETED CODE: * * IF DATE OF SERVICE BETWEEN 12/31/2002 AND 04/01/2003 * * IF HCPCS CODE = C9114 OR C9115 ADJUST PAYMENT AND * * COINSURANCE AMOUNTS - LOGIC REMOVED FOR 20050101 * * * *************************************************************** *************************************************************** * * * SEARCH WAGE INDEX TABLE FOR THE CBSA IN THE PROVIDER * * SPECIFIC FILE (PSF) * * * *************************************************************** * * * IF CBSA NOT LOCATED * * - SET CLAIM RETURN CODE TO '50' * * - DISCONTINUE CLAIM PROCESSING * * IF WAGE INDEX EQUALS ZERO * * - SET CLAIM RETURN CODE TO '51' * * - DISCONTINUE CLAIM PROCESSING * * * *************************************************************** 10200-CALC-WAGEINDX. *************************************************************** * STARTING AT THE LAST DATE IN THE TABLE, SEARCH WAGE INDEX * * DATE TABLE FOR THE MOST CURRENT EFFECTIVE DATE THAT CAN BE * * USED BY THE CLAIM * *************************************************************** MOVE WCD-MAX TO WCD-SUB. PERFORM UNTIL L-SERVICE-FROM-DATE NOT < WCD-DATE (WCD-SUB) SUBTRACT 1 FROM WCD-SUB END-PERFORM. *************************************************************** * SEARCH CBSA TABLE FOR THE PSF CBSA * *************************************************************** SEARCH ALL WCM-ENTRY *-------------------------------------------------------------* * PSF CBSA NOT FOUND IN CBSA TABLE, RETURN ERROR * *-------------------------------------------------------------* AT END MOVE 50 TO A-CLM-RTN-CODE GO TO 10200-CALC-WAGEINDX-EXIT *-------------------------------------------------------------* * PSF CBSA FOUND IN CBSA TABLE * *-------------------------------------------------------------* WHEN WCM-CBSA (WCM-INDX) = H-PSF-CBSA *-------------------------------------------------------------* * START SEARCH AT THE MOST CURRENT RECORD FOR THE CBSA * *-------------------------------------------------------------* MOVE WCM-PTR (WCM-INDX) TO W-SUB3 *-------------------------------------------------------------* * GET WAGE INDEX FROM THE REC W/ THE CORRECT EFFECTIVE DATE * *-------------------------------------------------------------* PERFORM 10210-WAGE-LOOKUP. *-------------------------------------------------------------* * ADJUST THE WAGE INDEX BY THE APPROPRIATE STATE SPECIFIC * * RURAL FLOOR BUDGET NEUTRALILTY FACTOR (SSRFBN) * * 11/10/2008 - NEW FOR CY 2009 * * 05/13/2010 - ADDED SECOND SET OF PARAGRAPHS TO APPLY * * DIFFERENT SSRFBN FACTORS FOR 2ND HALF OF YR * * 11/15/2010 - NO SSRFBN TABLE FOR CY 2010; DISABLED * *-------------------------------------------------------------* * IF L-SERVICE-FROM-DATE < 20100701 * PERFORM 10220-APPLY-SSRFBN * THRU 10220-EXIT * ELSE * PERFORM 10226-APPLY-SSRFBN-2ND-HALF * THRU 10226-EXIT * END-IF. *************************************************************** * RETURN ERROR IF WAGE INDEX = 0 OR NOT NUMERIC * *************************************************************** IF H-WINX1 = 0 OR H-WINX1 NOT NUMERIC THEN MOVE 51 TO A-CLM-RTN-CODE. 10200-CALC-WAGEINDX-EXIT. EXIT. *************************************************************** * * * LOCATE THE CBSA RECORD WITH THE APPROPRIATE EFFECTIVE DATE * * WHEN FOUND, SELECT THE APPLICABLE WAGE INDEX VALUE * * * *************************************************************** 10210-WAGE-LOOKUP. *************************************************************** * WAGE INDEX RECORD EFFECTIVE DATE IS BEFORE OR ON THE * * LATEST EFFECTIVE DATE THE CLAIM CAN USE - CORRECT * * (SEARCH STARTS AT THE MOST CURRENT RECORD FOR THE CBSA) * *************************************************************** IF WCW-DTCD (W-SUB3) NOT > WCD-DTCD (WCD-SUB) *-------------------------------------------------------------* * THIS PROVIDER HAS RECLASSIFIED, USE THE WAGE INDEX IN THE * * SECOND COLUMN FOR RECLASSIFYING PROVIDERS. * *-------------------------------------------------------------* IF L-PSF-SPEC-PYMT-IND = 'Y' MOVE WCW-WINX2 (W-SUB3) TO H-WINX1 *-------------------------------------------------------------* * THIS PROVIDER HAS NOT RECLASSIFIED, USE THE WAGE INDEX IN * * THE FIRST COLUMN FOR AREA PROVIDERS. * *-------------------------------------------------------------* ELSE MOVE WCW-WINX1 (W-SUB3) TO H-WINX1 *************************************************************** * WAGE INDEX RECORD EFFECTIVE DATE IS AFTER LATEST EFFECTIVE * * DATE THE CLAIM CAN USE. GO TO THE PREVIOUS RECORD IN THE * * CBSA WAGE INDEX TABLE. * *************************************************************** ELSE SUBTRACT 1 FROM W-SUB3 *-------------------------------------------------------------* * PREVIOUS REC BELONGS TO THE PSF CBSA, TEST EFFECTIVE DATE * *-------------------------------------------------------------* IF W-SUB3 > WCM-PTR (WCM-INDX - 1) GO TO 10210-WAGE-LOOKUP *-------------------------------------------------------------* * THERE IS NO RECORD FOR THE PSF CBSA WITH AN ACCEPTABLE * * EFFECTIVE DATE FOR THE LINE. RETURN ZERO. * *-------------------------------------------------------------* ELSE MOVE 0 TO H-WINX1. 10210-WAGE-LOOKUP-EXIT. EXIT. *************************************************************** * * * ADJUST THE WAGE INDEX BY THE STATE SPECIFIC * * RURAL FLOOR BUDGET NEUTRALITY FACTOR (SSRFBN) * * (NO SSRFBN TABLE FOR CY 2010 - DISABLED) * * * *************************************************************** *10220-APPLY-SSRFBN. * *-------------------------------------------------------------* * THE PROVIDER'S STATE IS THE SSRFBN TABLE SEARCH KEY; * * SEARCH SSRFBN TABLE FOR APPROPRIATE FACTOR * *-------------------------------------------------------------* * MOVE L-PSF-PROV-ST TO MES-PPS-STATE-10. * PERFORM 10225-FIND-SSRFBN * THRU 10225-EXIT. * *-------------------------------------------------------------* * ADJUST THE WAGE INDEX BY THE SSRFBN FACTOR FOUND IN THE TBL * *-------------------------------------------------------------* * IF H-WINX1 NOT = 0 AND * H-WINX1 IS NUMERIC AND * A-CLM-RTN-CODE NOT = 51 * COMPUTE H-WINX1 ROUNDED = * H-WINX1 * MES-SSRFBN-RATE-10 * END-IF. * *10220-EXIT. * EXIT. *************************************************************** * * * FIND THE STATE SPECIFIC RURAL FLOOR BUDGET * * NEUTRALITY FACTOR (SSRFBN) * * (CY 2010 - 1ST HALF 1/1 - 6/30) * * * *************************************************************** *10225-FIND-SSRFBN. * *----------------------------------------------------------------* * SEARCH SSRFBN STARTING WITH THE FIRST RECORD * *----------------------------------------------------------------* * SET SSRFBN-IDX10 TO 1. * SEARCH SSRFBN-TAB-10 VARYING SSRFBN-IDX10 * *----------------------------------------------------------------* * PROVIDER STATE NOT FOUND IN SSRFBN TABLE, ASSIGN ERROR CODE * *----------------------------------------------------------------* * AT END * MOVE 51 TO A-CLM-RTN-CODE * GO TO 10225-EXIT * *----------------------------------------------------------------* * PROVIDER STATE FOUND, CAPTURE SSRFBN FACTOR * *----------------------------------------------------------------* * WHEN WK-SSRFBN-STATE-10 (SSRFBN-IDX10) = MES-PPS-STATE-10 * MOVE WK-SSRFBN-REASON-ALL-10 (SSRFBN-IDX10) * TO MES-SSRFBN-10. * *10225-EXIT. * EXIT. *************************************************************** * * * ADJUST THE WAGE INDEX BY THE STATE SPECIFIC * * RURAL FLOOR BUDGET NEUTRALITY FACTOR (SSRFBN) * * (NO SSRFBN TABLE FOR CY 2010 - DISABLED) * * * *************************************************************** *10226-APPLY-SSRFBN-2ND-HALF. * *-------------------------------------------------------------* * THE PROVIDER'S STATE IS THE SSRFBN TABLE SEARCH KEY; * * SEARCH SSRFBN TABLE FOR APPROPRIATE FACTOR * *-------------------------------------------------------------* * MOVE L-PSF-PROV-ST TO MES-PPS-STATE-10B. * PERFORM 10227-FIND-SSRFBN-2ND-HALF * THRU 10227-EXIT. * *-------------------------------------------------------------* * ADJUST THE WAGE INDEX BY THE SSRFBN FACTOR FOUND IN THE TBL * *-------------------------------------------------------------* * IF H-WINX1 NOT = 0 AND * H-WINX1 IS NUMERIC AND * A-CLM-RTN-CODE NOT = 51 * COMPUTE H-WINX1 ROUNDED = * H-WINX1 * MES-SSRFBN-RATE-10B * END-IF. * *10226-EXIT. * EXIT. *************************************************************** * * * FIND THE STATE SPECIFIC RURAL FLOOR BUDGET * * NEUTRALITY FACTOR (SSRFBN) * * (NO SSRFBN TABLE FOR CY 2010 - DISABLED) * * * *************************************************************** *10227-FIND-SSRFBN-2ND-HALF. * *----------------------------------------------------------------* * SEARCH SSRFBN STARTING WITH THE FIRST RECORD * *----------------------------------------------------------------* * SET SSRFBN-IDX10B TO 1. * SEARCH SSRFBN-TAB-10B VARYING SSRFBN-IDX10B * *----------------------------------------------------------------* * PROVIDER STATE NOT FOUND IN SSRFBN TABLE, ASSIGN ERROR CODE * *----------------------------------------------------------------* * AT END * MOVE 51 TO A-CLM-RTN-CODE * GO TO 10227-EXIT * *----------------------------------------------------------------* * PROVIDER STATE FOUND, CAPTURE SSRFBN FACTOR * *----------------------------------------------------------------* * WHEN WK-SSRFBN-STATE-10B (SSRFBN-IDX10B) = * MES-PPS-STATE-10B * MOVE WK-SSRFBN-REASON-ALL-10B (SSRFBN-IDX10B) * TO MES-SSRFBN-10B. * *10227-EXIT. * EXIT. *************************************************************** * * * CALCULATE DISCOUNT RATE BASED ON THE DISCOUNT * * FACTOR PASSED BY THE OCE: VALUES 1 - 9 * * * * IF MISSING OR INVALID DISCOUNT FACTOR * * - SET RETURN CODE TO '38' * * - DISCONTINUE LINE PROCESSING * * * *************************************************************** * * * 11/1/2007 - NEW DISCOUNT INDICATOR 9 ADDED FOR CY 2008 * * * *************************************************************** 10250-CALC-DISCOUNT. IF (H-SRVC-UNITS = 0 AND OPPS-APC (LN-SUB) = '0000') MOVE 42 TO A-RETURN-CODE (LN-SUB) GO TO 10250-CALC-DISCOUNT-EXIT ELSE IF (H-SRVC-UNITS = 0 AND OPPS-APC (LN-SUB) > '0000') MOVE 1 TO H-SRVC-UNITS. IF OPPS-DISC-FACT (LN-SUB) = 1 THEN MOVE 1 TO H-DISC-RATE ELSE IF OPPS-DISC-FACT (LN-SUB) = 2 THEN COMPUTE H-DISC-RATE = (1 + DISC-FRACTION * (H-SRVC-UNITS - 1)) / H-SRVC-UNITS ELSE IF OPPS-DISC-FACT (LN-SUB) = 3 THEN COMPUTE H-DISC-RATE = TERM-PROC-DISC / H-SRVC-UNITS ELSE IF OPPS-DISC-FACT (LN-SUB) = 4 THEN COMPUTE H-DISC-RATE = (1 + DISC-FRACTION) / H-SRVC-UNITS ELSE IF OPPS-DISC-FACT (LN-SUB) = 5 THEN COMPUTE H-DISC-RATE = DISC-FRACTION ELSE IF OPPS-DISC-FACT (LN-SUB) = 6 THEN COMPUTE H-DISC-RATE = (TERM-PROC-DISC * DISC-FRACTION) / H-SRVC-UNITS ELSE IF OPPS-DISC-FACT (LN-SUB) = 7 THEN COMPUTE H-DISC-RATE = (DISC-FRACTION * (1 + DISC-FRACTION) / H-SRVC-UNITS) ELSE IF OPPS-DISC-FACT (LN-SUB) = 8 THEN MOVE 2 TO H-DISC-RATE ELSE IF OPPS-DISC-FACT (LN-SUB) = 9 THEN COMPUTE H-DISC-RATE = 1 / H-SRVC-UNITS ELSE MOVE 38 TO A-RETURN-CODE (LN-SUB). 10250-CALC-DISCOUNT-EXIT. EXIT. *************************************************************** * * * POPULATE COINSURANCE DEDUCTIBLE TABLE WITH SERVICE LINES * * * *************************************************************** * * * ORDER SERVICES LINES BY THE DEDUCTIBLE SEQUENCE - * * LOWEST TO HIGHEST APC RANK FROM APC TABLE * * * * DEDUCTIBLE WILL BE TAKEN FROM OPPS SERVICES FIRST, * * THEN FROM ANY OTHER TYPES OF SERVICES FROM THE CLAIM. * * ALL VALID SERVICE LINES APPEAR IN THIS TABLE IN THE * * ORDER OF THEIR RANK FROM LOWEST TO HIGHEST. * * - THE LOWER THE RANK, THE HIGHER % THE NATIONAL * * UNADJUSTED COINSURANCE IS OF THE APC PAYMENT RATE * * - MOVE ALL LINE PRICING VARIABLES TO STAGING AREA * * (NEW COINSURANCE DEDUCTIBLE TABLE RECORD) * * * * NOTE: THE PURPOSE OF APC RANKING IS TO ENSURE THAT THE * * BENEFICIARY DEDUCTIBLE GOES TOWARD LINES WITH * * HIGHER COINSURANCE %S FIRST. THIS RESULTS IN THE * * BENEFICIARY PAYING LESS TOTAL COINSURANCE FOR THE * * CLAIM. * * * *************************************************************** 10300-COIN-DEDUCT. *-------------------------------------------------------------* * ADD 1 TO THE TOTAL TABLE RECORDS FOR THE NEW ENTRY * *-------------------------------------------------------------* ADD 1 TO W-LNC-MAX. *-------------------------------------------------------------* * MOVE TO THE NEW ENTRY POSITION (EMPTY RECORD) * *-------------------------------------------------------------* SET W-LP-INDX TO W-LNC-MAX. *-------------------------------------------------------------* * DETERMINE WHERE THE NEW SERVICE LINE SHOULD BE ENTERED INTO * * THE TABLE ACCORDING TO ITS RANK AND THE RANK OF THE RECORDS * * ALREADY IN THE TABLE - LOWEST TO HIGHEST RANK. * *-------------------------------------------------------------* PERFORM 10350-STAGE-ENTRY THRU 10350-STAGE-ENTRY-EXIT UNTIL W-LP-INDX = 1 OR H-RANK NOT < W-RANK (W-LP-INDX - 1). *-------------------------------------------------------------* * POPULATE THE EMPTY RECORD WITH THE NEW SERVICE LINE'S DATA * *-------------------------------------------------------------* MOVE LN-SUB TO W-LP-SUB (W-LP-INDX). MOVE H-NAT-COIN TO W-NAT-COIN (W-LP-INDX). MOVE H-MIN-COIN TO W-MIN-COIN (W-LP-INDX). MOVE H-SUB-CHRG TO W-SUB-CHRG (W-LP-INDX). MOVE H-APC-PYMT TO W-APC-PYMT (W-LP-INDX). MOVE H-WINX1 TO W-WINX1 (W-LP-INDX). MOVE H-RANK TO W-RANK (W-LP-INDX). MOVE H-PPCT TO W-PPCT (W-LP-INDX). MOVE H-DISC-RATE TO W-DISC-RATE (W-LP-INDX). *-------------------------------------------------------------* * PARTIAL HOSPITALIZATION LINES RECEIVE 1 SERVICE UNIT * *-------------------------------------------------------------* IF OPPS-SRVC-IND (LN-SUB) = ' P' THEN MOVE 1 TO W-SRVC-UNITS (W-LP-INDX) *-------------------------------------------------------------* * NON-PARTIAL HOSPITALIZATION LINES RECEIVE INPUT SVC UNITS * *-------------------------------------------------------------* ELSE MOVE H-SRVC-UNITS TO W-SRVC-UNITS (W-LP-INDX). *-------------------------------------------------------------* * SEARCH PROVIDER SPECIFIC FILE FOR THE LINE APC. * * IF FOUND, CALCULATE THE REDUCED COINSURANCE AMOUNT FOR * * THE LINE, ENTER IT INTO THE NEW COIN DEDUC TABLE REC, & * * RETURN CODE 25 * *-------------------------------------------------------------* MOVE 0 TO W-RED-COIN (W-LP-INDX). PERFORM VARYING PS-SUB FROM 1 BY 1 UNTIL PS-SUB > L-PSF-APC-LINE-CNT IF L-PSF-APC (PS-SUB) = OPPS-APC (LN-SUB) COMPUTE W-RED-COIN (W-LP-INDX) ROUNDED = L-PSF-RED-COIN (PS-SUB) * H-SRVC-UNITS * H-DISC-RATE MOVE 25 TO A-RETURN-CODE (LN-SUB) MOVE L-PSF-APC-LINE-CNT TO PS-SUB END-IF END-PERFORM. 10300-COIN-DEDUCT-EXIT. EXIT. *************************************************************** * * * MOVE THE EXISTING COINSURANCE DEDUCTIBLE RECORD WITH A * * HIGHER RANK UP ONE RECORD POSITION AND SET THE INDEX OF * * THE EMPTY RECORD FOR THE NEW ENTRY TO THE NEXT LOWER * * RECORD POSITION. * * * *************************************************************** 10350-STAGE-ENTRY. MOVE W-LP-ENTRY (W-LP-INDX - 1) TO W-LP-ENTRY (W-LP-INDX). SET W-LP-INDX DOWN BY 1. 10350-STAGE-ENTRY-EXIT. EXIT. *************************************************************** * * * POPULATE BLOOD DEDUCTIBLE TABLE WITH SERVICE LINES * * THAT HAVE A BLOOD DEDUCTIBLE HCPCS * * * *************************************************************** * * * ORDER SERVICES LINES BY DEDUCTIBLE SEQUENCE - * * 1. EARLIEST TO LATEST DATE OF SERVICE * * 2. LOWEST TO HIGHEST BLOOD RANK FROM BLOOD DEDUC TABLE * * * * DEDUCTIBLES WILL PAID FOR LINES IN THE ORDER OF DATE OF * * SERVICE (EARLIEST TO LATEST) AND THEN BY COST (LEAST TO * * MOST EXPENSIVE). ONLY VALID LINES WITH A HCPCS IN THE * * BLOOD DEDUCTIBLE RANKING TABLE APPEAR IN THIS TABLE. * * - BLOOD RANK OF 1 IS ASSIGNED TO THE LEAST EXPENSIVE * * BLOOD CODE * * - MOVE ALL LINE PRICING VARIABLES TO STAGING AREA * * (NEW BLOOD DEDUCTIBLE TABLE RECORD) * * * * NOTE: THE PURPOSE OF BLOOD LINE RANKING IS TO ENSURE * * THAT THE BENEFICIARY PAYS DEDUCTIBLES FOR THE * * THREE LEAST EXPENSIVE BLOOD PRODUCTS. * * * *************************************************************** 10375-BLOOD-DEDUCT. *-------------------------------------------------------------* * ADD 1 TO THE TOTAL TABLE RECORDS FOR THE NEW ENTRY * *-------------------------------------------------------------* ADD 1 TO W-BLD-MAX. *-------------------------------------------------------------* * MOVE TO THE NEW ENTRY POSITION (EMPTY RECORD) * *-------------------------------------------------------------* SET W-BD-INDX TO W-BLD-MAX. *-------------------------------------------------------------* * DETERMINE WHERE THE NEW SERVICE LINE SHOULD BE ENTERED INTO * * THE TABLE ACCORDING TO ITS RANK AND THE RANK OF THE RECORDS * * ALREADY IN THE TABLE - LOWEST TO HIGHEST RANK. * * (RANK IS THE DATE OF SERVICE & BLOOD RANK) * *-------------------------------------------------------------* PERFORM 10385-STAGE-ENTRY THRU 10385-STAGE-ENTRY-EXIT UNTIL W-BD-INDX = 1 OR H-BLD-RNK NOT < W-BD-RNK (W-BD-INDX - 1). *-------------------------------------------------------------* * POPULATE THE EMPTY RECORD WITH THE NEW SERVICE LINE'S DATA * *-------------------------------------------------------------* MOVE LN-SUB TO W-BD-SUB (W-BD-INDX). MOVE H-NAT-COIN TO W-BD-NAT-COIN (W-BD-INDX). MOVE H-MIN-COIN TO W-BD-MIN-COIN (W-BD-INDX). MOVE H-SUB-CHRG TO W-BD-SUB-CHRG (W-BD-INDX). MOVE H-APC-PYMT TO W-BD-APC-PYMT (W-BD-INDX). MOVE H-WINX1 TO W-BD-WINX1 (W-BD-INDX). MOVE H-BLOOD-RANK TO W-BD-RANK (W-BD-INDX). MOVE H-BLD-DOS TO W-BD-DOS (W-BD-INDX). MOVE H-PPCT TO W-BD-PPCT (W-BD-INDX). MOVE H-DISC-RATE TO W-BD-DISC-RATE (W-BD-INDX). MOVE H-SRVC-UNITS TO W-BD-SRVC-UNITS (W-BD-INDX). *-------------------------------------------------------------* * SEARCH PROVIDER SPECIFIC FILE FOR THE LINE APC. * * IF FOUND, CALCULATE THE REDUCED COINSURANCE AMOUNT FOR * * THE LINE, ENTER IT INTO THE NEW COIN DEDUC TABLE REC, & * * RETURN CODE 25 * *-------------------------------------------------------------* MOVE 0 TO W-BD-RED-COIN (W-BD-INDX). PERFORM VARYING PS-SUB FROM 1 BY 1 UNTIL PS-SUB > L-PSF-APC-LINE-CNT IF L-PSF-APC (PS-SUB) = OPPS-APC (LN-SUB) COMPUTE W-BD-RED-COIN (W-BD-INDX) ROUNDED = L-PSF-RED-COIN (PS-SUB) * H-SRVC-UNITS * H-DISC-RATE MOVE 25 TO A-RETURN-CODE (LN-SUB) MOVE L-PSF-APC-LINE-CNT TO PS-SUB END-IF END-PERFORM. 10375-BLOOD-DEDUCT-EXIT. EXIT. *************************************************************** * * * MOVE THE EXISTING BLOOD DEDUCTIBLE RECORD WITH A * * HIGHER RANK UP ONE RECORD POSITION AND SET THE INDEX OF * * THE EMPTY RECORD FOR THE NEW ENTRY TO THE NEXT LOWER * * RECORD POSITION. * * * *************************************************************** 10385-STAGE-ENTRY. MOVE W-BD-ENTRY (W-BD-INDX - 1) TO W-BD-ENTRY (W-BD-INDX). SET W-BD-INDX DOWN BY 1. 10385-STAGE-ENTRY-EXIT. EXIT. *************************************************************** * * * POPULATE PASS-THROUGH DEVICE TABLE * * (FOR ASSOCIATED PROCEDURE PAYMENT & CHARGE * * ADJUSTMENTS IN THE OUTLIER ROUTINE) * * (IMPLEMENTED IN APRIL 2008 PRICER) * * * *************************************************************** * * * ORDER RECORDS AS FOLLOWS - * * 1. HCPCS, ASCENDING * * 2. LOWEST TO HIGHEST LINE SUBSCRIPT * * * * 02/11/2008 - LOGIC ADDED FOR CY 2008, QTR 2 * * 11/12/2008 - LOGIC NOT CHANGED, NO CY 2009 PT DEVICES * * * *************************************************************** 10390-PASS-THRU-DEVICES. *-------------------------------------------------------------* * ADD 1 TO THE TOTAL TABLE RECORDS FOR THE NEW ENTRY * *-------------------------------------------------------------* ADD 1 TO W-PTD-MAX. *-------------------------------------------------------------* * MOVE TO THE NEW ENTRY POSITION (EMPTY RECORD) * *-------------------------------------------------------------* SET W-PTD-INDX TO W-PTD-MAX. INITIALIZE W-PTD-ENTRY (W-PTD-INDX). *-------------------------------------------------------------* * DETERMINE WHERE THE NEW RECORD SHOULD BE ENTERED INTO THE * * TABLE ACCORDING TO ITS HCPCS AND THE HCPCS OF THE RECORDS * * ALREADY IN THE TABLE - LOWEST TO HIGHEST HCPCS * *-------------------------------------------------------------* PERFORM 10391-STAGE-ENTRY THRU 10391-STAGE-ENTRY-EXIT UNTIL W-PTD-INDX = 1 OR W-PTD-LINE-HCPCS NOT < W-PTD-HCPCS (W-PTD-INDX - 1). *-------------------------------------------------------------* * POPULATE THE EMPTY RECORD WITH THE NEW SERVICE LINE'S DATA * *-------------------------------------------------------------* MOVE OPPS-HCPCS (LN-SUB) TO W-PTD-HCPCS (W-PTD-INDX). MOVE LN-SUB TO W-PTD-SUB (W-PTD-INDX). MOVE OPPS-SUB-CHRG (LN-SUB) TO W-PTD-SUB-CHRG (W-PTD-INDX). 10390-PASS-THRU-DEVICES-EXIT. EXIT. *************************************************************** * * * MOVE THE EXISTING PASS-THROUGH DEVICE RECORD WITH A * * HIGHER HCPCS UP ONE RECORD POSITION AND SET THE INDEX OF * * THE EMPTY RECORD FOR THE NEW ENTRY TO THE NEXT LOWER * * RECORD POSITION. * * * *************************************************************** 10391-STAGE-ENTRY. MOVE W-PTD-ENTRY (W-PTD-INDX - 1) TO W-PTD-ENTRY (W-PTD-INDX). SET W-PTD-INDX DOWN BY 1. 10391-STAGE-ENTRY-EXIT. EXIT. *************************************************************** * * * UPDATE PASS-THROUGH DEVICE TABLE WITH PROCEDURE DATA * * (IMPLEMENTED IN APRIL 2008 PRICER) * * * *************************************************************** * * * 02/11/2008 - LOGIC ADDED FOR CY 2008, QTR 2 * * * *************************************************************** 10392-PASS-THRU-DEV-PROCS. *-------------------------------------------------------------* * LOOP THROUGH ELIGIBLE PROCEDURE'S PASS-THROUGH DEVICE TABLE * *-------------------------------------------------------------* PERFORM 10393-PERFORM-SEARCH THRU 10393-PERFORM-SEARCH-EXIT VARYING W-PTD-PROC-SUB FROM 1 BY 1 UNTIL W-PTD-PROC-SUB > W-PTD-CNT. 10392-PASS-THRU-DEV-PROCS-EXIT. EXIT. *************************************************************** * * * SEARCH FOR THE PASS-THROUGH DEVICE FOR WHICH THE PROCEDURE * * IS ELIGIBLE IN THE TABLE * * * *************************************************************** 10393-PERFORM-SEARCH. *-------------------------------------------------------------* * SEARCH PTD TABLE STARTING AT ENTRY #1 FOR ALL OCCURANCES * * OF THE PASS-THRU DEVICE HCPCS IN THE PASS-THRU DEVICE TABLE.* * THIS IS DONE FOR ALL PASS-THROUGH DEVICES THE PROCEDURE IS * * ELIGIBLE FOR. * *-------------------------------------------------------------* MOVE 'N' TO W-END-OF-PTD-TBL. IF W-PTD-PROC-HCPCS (W-PTD-PROC-SUB) NOT = ' ' SET W-PTD-INDX TO 1 PERFORM 10394-SEARCH-PTD-HCPCS THRU 10394-SEARCH-PTD-HCPCS-EXIT UNTIL W-END-OF-PTD-TBL = 'Y' END-IF. 10393-PERFORM-SEARCH-EXIT. EXIT. *************************************************************** * * * SEARCH FOR THE PASS-THROUGH DEVICE FOR WHICH THE PROCEDURE * * IS ELIGIBLE IN THE TABLE * * * *************************************************************** 10394-SEARCH-PTD-HCPCS. MOVE 'N' TO W-END-OF-PTD-TBL. *-------------------------------------------------------------* * SEARCH PASS-THROUGH DEVICE TABLE * *-------------------------------------------------------------* SEARCH W-PTD-ENTRY VARYING W-PTD-INDX *-------------------------------------------------------------* * IF THERE ARE NO MORE OCCURANCES OF THE PASS-THROUGH DEVICE, * * STOP THE SEARCH AND INDICATE END OF FILE * *-------------------------------------------------------------* AT END MOVE 'Y' TO W-END-OF-PTD-TBL GO TO 10394-SEARCH-PTD-HCPCS-EXIT *-------------------------------------------------------------* * IF THE PASS-THROUGH DEVICE IS FOUND, INDICATE NOT END OF * * FILE AND UPDATE THE DEVICE'S RECORD WITH THE PROCEDURE DATA * *-------------------------------------------------------------* WHEN W-PTD-HCPCS (W-PTD-INDX) = W-PTD-PROC-HCPCS (W-PTD-PROC-SUB) MOVE 'N' TO W-END-OF-PTD-TBL PERFORM 10395-UPDATE-ENTRY THRU 10395-UPDATE-ENTRY-EXIT SET W-PTD-INDX UP BY 1 END-SEARCH. 10394-SEARCH-PTD-HCPCS-EXIT. EXIT. *************************************************************** * * * UPDATE THE EXISTING PASS-THROUGH DEVICE RECORD WITH THE * * CURRENT ELIGIBLE PROCEDURE'S DATA * * * *************************************************************** 10395-UPDATE-ENTRY. *-------------------------------------------------------------* * UPDATE PASS-THROUGH DEVICE RECORD * *-------------------------------------------------------------* ADD 1 TO W-PTD-PROC-CNT (W-PTD-INDX). ADD OPPS-SRVC-UNITS (LN-SUB) TO W-PTD-TOTAL-PROC-UNITS (W-PTD-INDX). 10395-UPDATE-ENTRY-EXIT. EXIT. *************************************************************** * * * SUM PASS-THROUGH CONTRAST AGENT OFFSET AMOUNT(S) FOR EACH * * DAY ON WHICH A PASS-THROUGH CONTRAST AGENT APPEARS * * * *************************************************************** 10396-TOTAL-DAY-PTCA-OFFS. *-------------------------------------------------------------* * CAPTURE DATE OF SERVICE FROM PT CONTRAST AGENT DAY TABLE * *-------------------------------------------------------------* MOVE W-PTCA-DAY-LIDOS (W-PTCA-DAY-INDX) TO W-CAPROC-SRVC-DATE. *-------------------------------------------------------------* * MOVE TO FIRST RECORD IN PT CONTRAST AGENT PROCEDURE APC TBL * *-------------------------------------------------------------* SET W-CAPROC-INDX TO 1. *-------------------------------------------------------------* * START COUNTER THAT MONITORS THE # OF OFFSETS ADDED * *-------------------------------------------------------------* MOVE 1 TO W-CAPROC-UNIT-CNT. SEARCH W-CAPROC-APC-ENTRY *-------------------------------------------------------------* * DATE OF SERVICE NOT FOUND IN TABLE, STOP PROCESS * *-------------------------------------------------------------* AT END GO TO 10396-TOTAL-DAY-PTCA-OFFS-EXIT *-------------------------------------------------------------* * DATE OF SERVICE FOUND IN TABLE, ACCUMULATE OFFSETS * *-------------------------------------------------------------* WHEN W-CAPROC-LIDOS (W-CAPROC-INDX) = W-CAPROC-SRVC-DATE PERFORM UNTIL * *-------------------------------------------------------* * * STOP SEARCH WHEN END OF TABLE REACHED * * *-------------------------------------------------------* (W-CAPROC-INDX > W-CAPROC-MAX) OR * *-------------------------------------------------------* * * STOP SEARCH WHEN NUMBER OF DAY'S HCPCS LINES EXCEEDED * * *-------------------------------------------------------* (W-CAPROC-UNIT-CNT > W-PTCA-DAY-HCPCS-CNT (W-PTCA-DAY-INDX)) OR * *-------------------------------------------------------* * * STOP SEARCH WHEN DATE OF SERVICE CHANGES * * *-------------------------------------------------------* (W-CAPROC-LIDOS (W-CAPROC-INDX) NOT = W-CAPROC-SRVC-DATE) * *-------------------------------------------------------* * * ADD PT CONTRAST AGENT PROCEDURE OFFSET TO DAY TOTAL * * *-------------------------------------------------------* COMPUTE W-PTCA-DAY-TOT-OFFSET (W-PTCA-DAY-INDX) ROUNDED = W-PTCA-DAY-TOT-OFFSET (W-PTCA-DAY-INDX) + W-CAPROC-WAGE-ADJ-OFFSET (W-CAPROC-INDX) * *-------------------------------------------------------* * * SET POINTER TO NEXT PROCEDURE RECORD * * *-------------------------------------------------------* SET W-CAPROC-INDX UP BY 1 ADD 1 TO W-CAPROC-UNIT-CNT END-PERFORM END-SEARCH. 10396-TOTAL-DAY-PTCA-OFFS-EXIT. EXIT. *************************************************************** * * * MAP EACH PT DEVICE HCPCS ON THE CLAIM TO AN OFFSET * * PROCEDURE WHEN POSSIBLE - FIRST PASS: ASSIGN EACH PROCEDURE * * ONLY ONE PT DEVICE * * * *************************************************************** 10397-PTDO-MAPPINGS-1. *-------------------------------------------------------------* * INITIALIZE VARIABLES SPECIFIC TO THIS PT HCPCS RECORD * *-------------------------------------------------------------* MOVE 'N' TO W-PTDO-EOF-SWITCH. SET W-PTDO-PROC-INDX TO 1. *-------------------------------------------------------------* * SEARCH PTDO PROCEDURE TABLE FOR A PROCEDURE THAT MAPS TO * * THE CURRENT PT DEVICE * *-------------------------------------------------------------* PERFORM UNTIL W-PTDO-EOF-SWITCH = 'Y' SEARCH W-PTDO-PROC-ENTRY AT END MOVE 'Y' TO W-PTDO-EOF-SWITCH GO TO 10397-PTDO-MAPPINGS-1-EXIT *-------------------------------------------------------------* * PROCEDURE NOT ASSIGNED TO A PT DEVICE, SEE IF IT MAPS * *-------------------------------------------------------------* WHEN W-PTDO-PROC-USED (W-PTDO-PROC-INDX) NOT = 'Y' SET W-PTDO-DARRAY-INDX TO 1 MOVE W-PTDO-DARRAY-SIZE (W-PTDO-PROC-INDX) TO W-PTDO-DARRAY-MAX SEARCH W-PTDO-PROC-DARRAY AT END CONTINUE *-------------------------------------------------------------* * PROCEDURE MAPS TO CURRENT PT DEVICE HCPCS * *-------------------------------------------------------------* WHEN W-PTDO-PROC-DHCPCS (W-PTDO-PROC-INDX, W-PTDO-DARRAY-INDX) = W-PTDO-HCPCS-HCPCS (W-PTDO-HCPCS-INDX) MOVE W-PTDO-PROC-APC (W-PTDO-PROC-INDX) TO W-PTDO-HCPCS-PROC-APC (W-PTDO-HCPCS-INDX) MOVE W-PTDO-PROC-LNSUB (W-PTDO-PROC-INDX) TO W-PTDO-HCPCS-PROC-LNSUB (W-PTDO-HCPCS-INDX) MOVE 'Y' TO W-PTDO-PROC-USED (W-PTDO-PROC-INDX) MOVE 1 TO W-PTDO-PROC-DEVICE-CNT (W-PTDO-PROC-INDX) MOVE W-PTDO-HCPCS-SUB-CHRG (W-PTDO-HCPCS-INDX) TO W-PTDO-PROC-TOT-DCHRGS (W-PTDO-PROC-INDX) MOVE W-PTDO-HCPCS-UNITS (W-PTDO-HCPCS-INDX) TO W-PTDO-PROC-TOT-DUNITS (W-PTDO-PROC-INDX) GO TO 10397-PTDO-MAPPINGS-1-EXIT END-SEARCH SET W-PTDO-PROC-INDX UP BY 1 END-SEARCH END-PERFORM. 10397-PTDO-MAPPINGS-1-EXIT. EXIT. *************************************************************** * * * MAP EACH PT DEVICE HCPCS ON THE CLAIM TO AN OFFSET * * PROCEDURE WHEN POSSIBLE - SECOND PASS: ASSIGN PROCEDURES * * ADDITIONAL PT DEVICES WHEN NECESSARY * * * *************************************************************** 10397-PTDO-MAPPINGS-2. *-------------------------------------------------------------* * DETERMINE WHETHER THE PT DEVICE HCPCS NEEDS A PROCEDURE * *-------------------------------------------------------------* IF W-PTDO-HCPCS-PROC-CNT (W-PTDO-HCPCS-INDX) > 0 AND W-PTDO-HCPCS-PROC-APC (W-PTDO-HCPCS-INDX) = SPACES CONTINUE ELSE GO TO 10397-PTDO-MAPPINGS-2-EXIT END-IF. SET W-PTDO-PROC-INDX TO 1. *-------------------------------------------------------------* * INITIALIZE VARIABLES SPECIFIC TO THIS PT HCPCS RECORD * *-------------------------------------------------------------* MOVE 'N' TO W-PTDO-EOF-SWITCH. *-------------------------------------------------------------* * SEARCH PTDO PROCEDURE TABLE FOR A PROCEDURE THAT MAPS TO * * THE CURRENT PT DEVICE * *-------------------------------------------------------------* PERFORM UNTIL W-PTDO-EOF-SWITCH = 'Y' SEARCH W-PTDO-PROC-ENTRY AT END MOVE 'Y' TO W-PTDO-EOF-SWITCH GO TO 10397-PTDO-MAPPINGS-2-EXIT *-------------------------------------------------------------* * PROCEDURE ALREADY ASSIGNED TO PT DEVICE(S) * *-------------------------------------------------------------* WHEN W-PTDO-PROC-USED (W-PTDO-PROC-INDX) = 'Y' OR W-PTDO-PROC-USED (W-PTDO-PROC-INDX) = 'S' SET W-PTDO-DARRAY-INDX TO 1 MOVE W-PTDO-DARRAY-SIZE (W-PTDO-PROC-INDX) TO W-PTDO-DARRAY-MAX SEARCH W-PTDO-PROC-DARRAY AT END CONTINUE *-------------------------------------------------------------* * PROCEDURE MAPS TO CURRENT PT DEVICE HCPCS, SEE IF IT MAPS * *-------------------------------------------------------------* WHEN W-PTDO-PROC-DHCPCS (W-PTDO-PROC-INDX, W-PTDO-DARRAY-INDX) = W-PTDO-HCPCS-HCPCS (W-PTDO-HCPCS-INDX) MOVE W-PTDO-PROC-APC (W-PTDO-PROC-INDX) TO W-PTDO-HCPCS-PROC-APC (W-PTDO-HCPCS-INDX) MOVE W-PTDO-PROC-LNSUB (W-PTDO-PROC-INDX) TO W-PTDO-HCPCS-PROC-LNSUB (W-PTDO-HCPCS-INDX) MOVE 'S' TO W-PTDO-PROC-USED (W-PTDO-PROC-INDX) ADD 1 TO W-PTDO-PROC-DEVICE-CNT (W-PTDO-PROC-INDX) COMPUTE W-PTDO-PROC-TOT-DCHRGS (W-PTDO-PROC-INDX) = W-PTDO-PROC-TOT-DCHRGS (W-PTDO-PROC-INDX) + W-PTDO-HCPCS-SUB-CHRG (W-PTDO-HCPCS-INDX) COMPUTE W-PTDO-PROC-TOT-DUNITS (W-PTDO-PROC-INDX) = W-PTDO-PROC-TOT-DUNITS (W-PTDO-PROC-INDX) + W-PTDO-HCPCS-UNITS (W-PTDO-HCPCS-INDX) GO TO 10397-PTDO-MAPPINGS-2-EXIT END-SEARCH SET W-PTDO-PROC-INDX UP BY 1 END-SEARCH END-PERFORM. 10397-PTDO-MAPPINGS-2-EXIT. EXIT. *************************************************************** * * * CALCULATE LINE PYMNTS, DEDUCTIBLES, REIM., & COINSURANCE, * * ACCUMULATE CLAIM TOTALS, POPULATE DRUG DEDUCTIBLE TABLE, * * UPDATE PASS-THROUGH DEVICE TABLE WITH PROCEDURE & DEVICE * * LINE DATA, MOVE LINE VALUES TO VARIABLES TO BE PASSED BACK * * * *************************************************************** * * * LOOP THROUGH THE COINSURANCE DEDUCTIBLE TABLE TO DO THE * * FOLLOWING FOR EACH SERVICE LINE: * * * * - CHECK ALL APPROPRIATE FLAGS AND INDICATORS FROM OCE * * - SET RETURN CODES TO INDICATE ERRORS OR STATUS * * '20' - LINE PROCESSED BUT PAYMENT = 0, * * BENE DEDUCTIBLE => ADJUSTED PAYMENT * * - CALCULATE & ACCUMULATE LINE AND CLAIM LEVEL ITEMS * * - POPULATE DRUG COINSURANCE TABLE * * - MOVE LINE VARIABLE VALUES TO VARIABLES TO BE PASSED BACK * * * *************************************************************** 10400-CALCULATE. *-------------------------------------------------------------* * SET THE SERVICE LINE SUBSCRIPT TO THE CLAIM SERVICE LINE # * * ASSOCIATED WITH THE COINSURANCE DEDUCTIBLE TABLE RECORD * *-------------------------------------------------------------* MOVE W-LP-SUB (W-LP-INDX) TO LN-SUB. *-------------------------------------------------------------* * STOP PROCESSING LINE IF ERROR CODE * *-------------------------------------------------------------* IF A-RETURN-CODE (LN-SUB) > 25 GO TO 10400-CALCULATE-EXIT. *-------------------------------------------------------------* * CALCULATE THE FOLLOWING FOR VALID LINES IN THE COINSURANCE * * DEDUCTIBLE TABLE WITH A PAYABLE STATUS: * * - LINE ITEM PAYMENT (BASED ON LINE SERVICE INDICATOR) * * - BENEFICIARY DEDUCTIBLE (IN ORDER OF APC RANK) * * - MINIMUM, MAXIMUM, AND REDUCED COINSURANCE AMOUNTS * * - LINE ITEM REIMBURSEMENT IF MAX COIN LIMIT EXCEEDED * *-------------------------------------------------------------* IF OPPS-PYMT-IND (LN-SUB) = ' 1' OR ' 5' OR ' 6' OR ' 7' OR ' 8' PERFORM 10550-CALC-STANDARD THRU 10550-CALC-STANDARD-EXIT ELSE GO TO 10400-CALCULATE-EXIT. *-------------------------------------------------------------* * POPULATE DRUG COINSURANCE TABLE FOR LATER PROCESSING * * - ENFORCE INPATIENT COINSURANCE LIMIT * * - SET GJK-FLAG WHEN SERVICE = G OR K * *-------------------------------------------------------------* IF (A-RETURN-CODE (LN-SUB) < 30) PERFORM 10450-ADJ-PROC-COIN THRU 10450-ADJ-PROC-COIN-EXIT ELSE NEXT SENTENCE. *-------------------------------------------------------------* * FLAG CLAIMS WITH ARTIFICIAL CHARGES AND TOTAL PAYMENTS & * * CHARGES FOR ARTIFICIAL CHARGE AND PACKAGING PROCESSING * *-------------------------------------------------------------* PERFORM 10500-ADJ-CHRGS THRU 10500-ADJ-CHRGS-EXIT. *-------------------------------------------------------------* * UPDATE PASS-THROUGH DEVICE TABLE W/ ELIGIBLE PROCEDURE * * LINE DATA (FOR ASSOCIATED PROCEDURE OUTLIER CALC) * * EFFECTIVE CY 2008 QTR 2, LOGIC ADDED 02/12/2008 * *-------------------------------------------------------------* IF A-RETURN-CODE (LN-SUB) < 30 AND PTD-FLAG = 'Y' AND OPPS-SRVC-IND (LN-SUB) = ' S' OR ' T' OR ' V' OR ' X' PERFORM 10670-SET-PTD-PROC-FLAG THRU 10670-SET-PTD-PROC-FLAG-EXIT IF PTD-PROC-FLAG = 'Y' PERFORM 10392-PASS-THRU-DEV-PROCS THRU 10392-PASS-THRU-DEV-PROCS-EXIT END-IF END-IF. *-------------------------------------------------------------* * ACCUMULATE CLAIM TOTALS USING DATA FROM THE CURRENT VALID * * SERVICE LINE (IN THE COINSURANCE DEDUCTIBLE TABLE) * *-------------------------------------------------------------* IF A-RETURN-CODE (LN-SUB) < 30 COMPUTE A-TOTAL-CLM-DEDUCT = H-TOTAL-LN-DEDUCT + A-TOTAL-CLM-DEDUCT COMPUTE H-TOT-PYMT = H-TOT-PYMT + H-LITEM-PYMT COMPUTE A-BLOOD-DEDUCT-DUE = A-BLOOD-DEDUCT-DUE + H-LN-BLOOD-DEDUCT *-------------------------------------------------------------* * MOVE LINE VALUES TO VARIABLES TO BE PASSED BACK * * - THE LINE REIM. & ADJ-COIN IS ADJUSTED LATER (IF NEEDED) * * FOR THE INPATIENT DAILY LIMIT IN 10840-PROCESS-TYPE2 * *-------------------------------------------------------------* MOVE H-LITEM-PYMT TO A-LITEM-PYMT (LN-SUB) MOVE H-LITEM-REIM TO A-LITEM-REIM (LN-SUB) MOVE H-TOTAL-LN-DEDUCT TO A-TOTAL-LN-DEDUCT (LN-SUB) MOVE H-LN-BLOOD-DEDUCT TO A-BLOOD-LN-DEDUCT (LN-SUB) MOVE H-NAT-COIN TO A-ADJ-COIN (LN-SUB) MOVE H-RED-COIN TO A-RED-COIN (LN-SUB) IF H-RED-COIN > H-NAT-COIN MOVE H-NAT-COIN TO A-RED-COIN (LN-SUB) END-IF IF OPPS-LITEM-ACT-FLAG (LN-SUB) = '4' MOVE 0 TO A-LITEM-PYMT (LN-SUB) MOVE 0 TO A-LITEM-REIM (LN-SUB) COMPUTE H-TOT-PYMT = H-TOT-PYMT - H-LITEM-PYMT END-IF END-IF. *-------------------------------------------------------------* * INITIALIZE LINE VARIABLES FOR THE NEXT SERVICE LINE IN THE * * COINSURANCE DEDUCTIBLE TABLE * *-------------------------------------------------------------* MOVE ZERO TO LINE-HOLD-ITEMS. 10400-CALCULATE-EXIT. EXIT. *************************************************************** * * * POPULATE DRUG COINSURANCE ROLL-UP TABLE WITH THE * * COINSURANCE AMOUNTS OF SERVICE LINES IN THE COINSURANCE * * DEDUCTIBLE TABLE * * * *************************************************************** * * * ORDER LINES BY: * * 1. DATE OF SERVICE (EARLIEST TO LATEST) * * 2. DCP-CODE - TYPE OF ENTRY BASED ON SERVICE INDICATOR * * DCP-CODE OF 1: DAY SUMMARY * * DCP-CODE OF 2: DRUG / BLOOD LINE * * THERE IS ONE TYPE 1 RECORD PER DAY; THERE MAY BE MULTIPLE * * TYPE 2 RECORDS PER DAY - ONE FOR EVERY DRUG LINE * * ("DRUG" REFERS TO ANY SI = G OR K LINE FOR SIMPLICITY) * * * * DRUG COINSURANCE RECORD COMBINATIONS: * * - TYPE 1, COIN1 = 0, COIN2 > 0, & SI = X => * * DRUG(S) ADMINISTERED INDEPENDENT OF A PROCEDURE VISIT * * ON THE DATE OF SERVICE * * - TYPE 1, COIN1 > 0, COIN2 = 0, & SI = S, V, OR T => * * PROCEDURE / VISIT WITH NO DRUG(S) ADMINISTERED ON THE * * DATE OF SERVICE * * - TYPE 1, COIN1 > 0, COIN2 > 0, & SI = S, V, OR T => * * PROCEDURE / VISIT WITH DRUG(S) ADMINISTERED ON THE * * DATE OF SERVICE * * - TYPE 2, COIN1 = 0, COIN2 > 0, & SI = G OR K => * * DRUG ADMINSTERED ON THE DATE OF SERVICE * * * *************************************************************** 10450-ADJ-PROC-COIN. *************************************************************** * MOVE LINE DATE OF SERVICE TO DATE OF SERVICE HOLD AREA * *************************************************************** MOVE OPPS-LITEM-DOS (LN-SUB) TO H-DCP-DOS. *************************************************************** * * * PROCESS SI = S, T, OR V LINES (PROCEDURE OR VISIT) * * * *************************************************************** IF OPPS-SRVC-IND (LN-SUB) = ' S' OR ' T' OR ' V' *-------------------------------------------------------------* * CALCULATE WAGE ADJUSTED LINE NATIONAL COINSURANCE AMOUNT * *-------------------------------------------------------------* COMPUTE H-NEW-WGNAT ROUNDED = W-NAT-COIN (W-LP-INDX) * (.6 * W-WINX1 (W-LP-INDX) + .4) *-------------------------------------------------------------* * ENFORCE INPATIENT LIMIT ON NATIONAL COINSURANCE AMOUNT * *-------------------------------------------------------------* IF H-NEW-WGNAT > H-IP-LIMIT MOVE H-IP-LIMIT TO H-NEW-WGNAT END-IF *-------------------------------------------------------------* * CALCULATE LINE NEW COINSURANCE AMOUNT (ACTUAL COIN DUE) * *-------------------------------------------------------------* COMPUTE H-NEW-COIN = H-LITEM-PYMT - H-TOTAL-LN-DEDUCT - H-LITEM-REIM - H-LN-BLOOD-DEDUCT *-------------------------------------------------------------* * INDICATE TYPE 1 RECORD (ONE TYPE 1 RECORD PER DAY) * *-------------------------------------------------------------* MOVE 1 TO H-DCP-CODE *-------------------------------------------------------------* * ADD OR UPDATE DRUG COINSURANCE TABLE ENTRY FOR THE DOS * *-------------------------------------------------------------* PERFORM 10455-SEARCH-KEY THRU 10455-SEARCH-KEY-EXIT *************************************************************** * * * PROCESS SI = G, K, & R LINES ("DRUG" & BLOOD) * * * *************************************************************** ELSE IF OPPS-SRVC-IND (LN-SUB) = ' G' OR ' K' OR ' R' *-------------------------------------------------------------* * CALCULATE LINE NEW COINSURANCE AMOUNT (ACTUAL COIN DUE) * *-------------------------------------------------------------* COMPUTE H-NEW-COIN = H-LITEM-PYMT - H-TOTAL-LN-DEDUCT - H-LITEM-REIM - H-LN-BLOOD-DEDUCT *-------------------------------------------------------------* * SET GJK-FLAG TO INDICATE "DRUG" LINE * *-------------------------------------------------------------* MOVE 'Y' TO GJK-FLAG *-------------------------------------------------------------* * INDICATE TYPE 1 RECORD (ONE TYPE 1 RECORD PER DAY) * *-------------------------------------------------------------* MOVE 1 TO H-DCP-CODE *-------------------------------------------------------------* * ADD OR UPDATE DRUG COINSURANCE TABLE ENTRY FOR THE DOS * *-------------------------------------------------------------* PERFORM 10455-SEARCH-KEY THRU 10455-SEARCH-KEY-EXIT *-------------------------------------------------------------* * INDICATE TYPE 2 RECORD (ONE TYPE 2 REC FOR EVERY DRUG LINE) * *-------------------------------------------------------------* MOVE 2 TO H-DCP-CODE *-------------------------------------------------------------* * INCREASE THE TOTAL NUMBER OF TABLE RECORDS FOR NEW ENTRY * *-------------------------------------------------------------* ADD 1 TO W-DCP-MAX *-------------------------------------------------------------* * MOVE TO THE NEW ENTRY POSITION (EMPTY RECORD) * * A NEW TYPE 2 RECORD ENTRY IS CREATED FOR EVERY SI = G OR K * * SERVICE LINE REGARDLESS OF THE DATE OF SERVICE * *-------------------------------------------------------------* SET W-DCP-INDX TO W-DCP-MAX *-------------------------------------------------------------* * DETERMINE WHERE THE NEW DRUG / DEVICE COINSURANCE ENTRY * * FOR THE CURRENT SERVICE LINE SHOULD BE ENTERED INTO THE * * TABLE ACCORDING TO ITS DATE OF SERVICE AND RECORD TYPE * * COMBO KEY - LOWEST TO HIGHEST KEY. (RECORD TYPE 2 ONLY) * *-------------------------------------------------------------* PERFORM 10475-STAGE-DCP-ENTRY THRU 10475-STAGE-DCP-ENTRY-EXIT UNTIL W-DCP-INDX = 1 OR H-DCP-STAGE NOT < W-DCP-STAGE (W-DCP-INDX - 1) *-------------------------------------------------------------* * POPULATE THE EMPTY RECORD WITH THE NEW SERVICE LINE'S DATA * * RECORD TYPE 2, "DRUG" * *-------------------------------------------------------------* MOVE LN-SUB TO W-DCP-SUB (W-DCP-INDX) MOVE H-DCP-STAGE TO W-DCP-STAGE (W-DCP-INDX) MOVE ZERO TO W-DCP-COIN1 (W-DCP-INDX) MOVE ZERO TO W-DCP-WGNAT (W-DCP-INDX) MOVE H-NEW-COIN TO W-DCP-COIN2 (W-DCP-INDX) MOVE OPPS-SRVC-IND (LN-SUB) TO W-DCP-SRVC-IND (W-DCP-INDX). 10450-ADJ-PROC-COIN-EXIT. EXIT. *************************************************************** * * * DETERMINE WHETHER A NEW DRUG/DEVICE COINSURANCE TABLE * * RECORD SHOULD BE ADDED OR IF AN EXISITING RECORD NEEDS TO * * BE UPDATED * * * * (RECORD KEY IS DATE OF SERVICE & RECORD TYPE) * * * *************************************************************** 10455-SEARCH-KEY. *-------------------------------------------------------------* * SEARCH DRUG/DEVICE COINSURANCE TABLE STARTING AT ENTRY #1 * *-------------------------------------------------------------* SET W-DCP-INDX TO 1. SEARCH W-DCP-ENTRY VARYING W-DCP-INDX *-------------------------------------------------------------* * IF THE SERVICE LINE'S DATE OF SERVICE AND RECORD TYPE COMBO * * IS NOT ALREADY IN THE TABLE, ADD IT * *-------------------------------------------------------------* AT END PERFORM 10460-ADD-ENTRY THRU 10460-ADD-ENTRY-EXIT *-------------------------------------------------------------* * IF THE SERVICE LINE'S DATE OF SERVICE AND RECORD TYPE COMBO * * IS ALREADY IN THE TABLE, UPDATE THE ENTRY * *-------------------------------------------------------------* WHEN W-DCP-STAGE (W-DCP-INDX) = H-DCP-STAGE PERFORM 10465-UPDATE-ENTRY THRU 10465-UPDATE-ENTRY-EXIT. 10455-SEARCH-KEY-EXIT. EXIT. *************************************************************** * * * INSERT THE NEW COINSURANCE RECORD INTO THE CORRECT POSITION * * (LOWEST TO HIGHEST DATE OF SERVICE - RECORD TYPR COMBO) OF * * THE DRUG / DEVICE COINSURANCE TABLE * * (ONLY PROCESSES TYPE 1 RECORDS) * * * *************************************************************** 10460-ADD-ENTRY. *-------------------------------------------------------------* * INCREASE THE TOTAL NUMBER OF TABLE RECORDS FOR NEW ENTRY * *-------------------------------------------------------------* ADD 1 TO W-DCP-MAX. *-------------------------------------------------------------* * MOVE TO THE NEW ENTRY POSITION (EMPTY RECORD) * *-------------------------------------------------------------* SET W-DCP-INDX TO W-DCP-MAX. *-------------------------------------------------------------* * DETERMINE WHERE THE NEW DRUG / DEVICE COINSURANCE ENTRY * * FOR THE CURRENT SERVICE LINE SHOULD BE ENTERED INTO THE * * TABLE ACCORDING TO ITS DATE OF SERVICE AND RECORD TYPE * * COMBO KEY - LOWEST TO HIGHEST KEY. (TYPE 1 RECORDS ONLY) * *-------------------------------------------------------------* PERFORM 10475-STAGE-DCP-ENTRY THRU 10475-STAGE-DCP-ENTRY-EXIT UNTIL W-DCP-INDX = 1 OR H-DCP-STAGE NOT < W-DCP-STAGE (W-DCP-INDX - 1). *-------------------------------------------------------------* * POPULATE THE EMPTY RECORD WITH THE NEW SERVICE LINE'S DATA * * RECORD TYPE 1, "DRUG" * *-------------------------------------------------------------* IF OPPS-SRVC-IND (LN-SUB) = ' G' OR ' K' OR ' R' MOVE ZERO TO W-DCP-SUB (W-DCP-INDX) MOVE H-DCP-STAGE TO W-DCP-STAGE (W-DCP-INDX) MOVE ZERO TO W-DCP-COIN1 (W-DCP-INDX) MOVE ZERO TO W-DCP-WGNAT (W-DCP-INDX) MOVE H-NEW-COIN TO W-DCP-COIN2 (W-DCP-INDX) MOVE ' X' TO W-DCP-SRVC-IND (W-DCP-INDX) *-------------------------------------------------------------* * POPULATE THE EMPTY RECORD WITH THE NEW SERVICE LINE'S DATA * * RECORD TYPE 1, PROCEDURE OR VISIT * *-------------------------------------------------------------* ELSE MOVE LN-SUB TO W-DCP-SUB (W-DCP-INDX) MOVE H-DCP-STAGE TO W-DCP-STAGE (W-DCP-INDX) MOVE H-NEW-COIN TO W-DCP-COIN1 (W-DCP-INDX) MOVE H-NEW-WGNAT TO W-DCP-WGNAT (W-DCP-INDX) MOVE ZERO TO W-DCP-COIN2 (W-DCP-INDX) MOVE OPPS-SRVC-IND (LN-SUB) TO W-DCP-SRVC-IND (W-DCP-INDX). 10460-ADD-ENTRY-EXIT. EXIT. *************************************************************** * * * UPDATE THE EXISTING DRUG COINSURANCE RECORD WITH THE SAME * * DATE OF SERVICE AND RECORD TYPE OF THE CURRENT SERVICE LINE * * (ONLY PROCESSES TYPE 1 RECORDS) * * * *************************************************************** 10465-UPDATE-ENTRY. *-------------------------------------------------------------* * FOR "DRUG" LINES - ACCUMULATE DAY'S TOTAL "DRUG" COIN DUE * *-------------------------------------------------------------* IF OPPS-SRVC-IND (LN-SUB) = ' G' OR ' K' OR ' R' ADD H-NEW-COIN TO W-DCP-COIN2 (W-DCP-INDX) *-------------------------------------------------------------* * FOR PROCEDURE & VISIT LINES - WHEN THE EXISITING RECORD WAS * * WAS INITIALLY CREATED FOR A "DRUG" LINE, UPDATE THE RECORD * *-------------------------------------------------------------* ELSE IF W-DCP-SRVC-IND (W-DCP-INDX) = ' X' PERFORM 10485-REPLACE-TYPE1 THRU 10485-REPLACE-TYPE1-EXIT *-------------------------------------------------------------* * FOR PROCEDURE & VISIT LINES - WHEN THE EXISTING RECORD HAS * * DATA FROM ANOTHER PROCEDURE / VISIT, ENSURE THE PROC/VISIT * * WITH THE HIGHEST WAGE ADJUSTED NATIONAL COIN IS IN THE TBL * *-------------------------------------------------------------* ELSE PERFORM 10480-RANK-COIN THRU 10480-RANK-COIN-EXIT. 10465-UPDATE-ENTRY-EXIT. EXIT. *************************************************************** * * * MOVE THE EXISTING DRUG COINSURANCE RECORD WITH A HIGHER * * RANK UP ONE RECORD POSITION AND SET THE INDEX OF THE EMPTY * * RECORD FOR THE NEW ENTRY TO THE NEXT LOWER RECORD POSITION. * * * *************************************************************** 10475-STAGE-DCP-ENTRY. MOVE W-DCP-ENTRY (W-DCP-INDX - 1) TO W-DCP-ENTRY (W-DCP-INDX). SET W-DCP-INDX DOWN BY 1. 10475-STAGE-DCP-ENTRY-EXIT. EXIT. *************************************************************** * * * ENSURE THAT THE PROCEDURE/VISIT WITH THE HIGHEST WAGE ADJ. * * NATIONAL COINSURANCE AMOUNT IS IN THE TABLE WHEN THERE ARE * * MULTIPLE PROCEDURES/VISITS ON THE SAME DATE OF SERVICE. * * ONLY ONE PROCEDURE/VISIT'S DATA PER DAY APPEARS IN THE TBL. * * (ONLY PROCESSES TYPE 1 RECORDS) * * * *************************************************************** 10480-RANK-COIN. IF H-NEW-WGNAT > W-DCP-WGNAT (W-DCP-INDX) MOVE LN-SUB TO W-DCP-SUB (W-DCP-INDX) MOVE H-NEW-COIN TO W-DCP-COIN1 (W-DCP-INDX) MOVE H-NEW-WGNAT TO W-DCP-WGNAT (W-DCP-INDX) MOVE OPPS-SRVC-IND (LN-SUB) TO W-DCP-SRVC-IND (W-DCP-INDX). 10480-RANK-COIN-EXIT. EXIT. *************************************************************** * * * ENTER VALUES FROM THE CURRENT SI = S, V, OR T SERVICE LINE * * INTO AN EXISITING RECORD THAT WAS FORMERLY AN SI = G OR K * * ONLY ENTRY. * * - SERVICE LINE REFERENCES CURRENT PROCEDURE / VISIT LINE * * - COIN1 = PROCEDURE / VISIT LINE NEW COINSURANCE AMOUNT * * - COIN2 = DRUG / BLOOD LINE NEW COINSURANCE AMOUNT(S) * * - WAGE ADJUSTED NATIONAL COIN OF CURRENT LINE ENTERED * * - SERVICE INDICATOR = SI OF CURRENT LINE (S, V, OR T) * * * *************************************************************** 10485-REPLACE-TYPE1. MOVE LN-SUB TO W-DCP-SUB (W-DCP-INDX) MOVE H-NEW-COIN TO W-DCP-COIN1 (W-DCP-INDX) MOVE H-NEW-WGNAT TO W-DCP-WGNAT (W-DCP-INDX) MOVE OPPS-SRVC-IND (LN-SUB) TO W-DCP-SRVC-IND (W-DCP-INDX). 10485-REPLACE-TYPE1-EXIT. EXIT. *************************************************************** * * * IDENTIFY CLAIMS THAT HAVE SIGNIFICANT PROCEDURE (SURGERY) * * LINE(S) WITH ARTIFICIAL CHARGES FOR FURTHER PROCESSING, * * ACCUMULATE TOTAL CLAIM PAYMENTS AND CHARGES FOR SIGNIFICANT * * PROCEDURE LINES, AND ACCUMULATE TOTAL CLAIM CHARGES OF ALL * * SEPARATELY PAYABLE LINES. (THE FLAG AND CLAIM TOTALS ARE * * USED IN PARAGRAPH 10600-ADJ-CHRG-OUTL.) * * * *************************************************************** 10500-ADJ-CHRGS. *************************************************************** ** NEW LOGIC INSERTED FOR WEB USE ONLY * *************************************************************** *-------------------------------------------------------------* * FLAG CLAIM WHEN A SIGNIFICANT PROCEDURE LINE HAS ARTIFICIAL * * CHARGES ($1 OR LESS) - FLAGS ENTIRE CLAIM * *-------------------------------------------------------------* * NOTE: LINES WITH CHARGES < $1.01 ARE FIXED BY FISS BEFORE * * ENTERING THE PRICER. THEREFORE, THIS LOGIC IS NO * * LONGER NECESSARY. THIS LOGIC WAS NECESSARY BEFORE * * FISS IMPLEMENTED THE FIX. * *-------------------------------------------------------------* IF ((OPPS-SRVC-IND (LN-SUB) = ' T') OR ((OPPS-SRVC-IND (LN-SUB) = ' S') AND (OPPS-HCPCS (LN-SUB) > '09999' AND OPPS-HCPCS (LN-SUB) < '70000'))) AND (W-SUB-CHRG (W-LP-INDX) < 1.01) MOVE 'Y' TO ST0-FLAG. *-------------------------------------------------------------* * ACCUMULATE TOTAL CLAIM CHARGES AND PAYMENTS FROM UNPACKAGED * * SIGNIFICANT PROCEDURE (SURGERY) LINES * *-------------------------------------------------------------* IF ((OPPS-SRVC-IND (LN-SUB) = ' T') OR ((OPPS-SRVC-IND (LN-SUB) = ' S') AND (OPPS-HCPCS (LN-SUB) > '09999' AND OPPS-HCPCS (LN-SUB) < '70000'))) AND (OPPS-PKG-FLAG (LN-SUB) = '0' OR '3') COMPUTE H-TOT-ST-CHRG = W-SUB-CHRG (W-LP-INDX) + H-TOT-ST-CHRG COMPUTE H-TOT-ST-PYMT = H-LITEM-PYMT + H-TOT-ST-PYMT. *-------------------------------------------------------------* * ACCUMULATE TOTAL CLAIM PAYMENTS FROM UNPACKAGED SEPARATELY * * PAYABLE LINES (FOR PACKAGING LATER) * *-------------------------------------------------------------* * 12/18/2009 - ADD SIS R & U, WHICH ARE ELIGIBLE FOR OUTLIER * *-------------------------------------------------------------* IF (OPPS-SRVC-IND (LN-SUB) = ' S' OR ' T' OR ' V' OR ' X' OR ' P' OR ' R' OR ' U') AND (OPPS-PKG-FLAG (LN-SUB) = '0' OR '3') COMPUTE H-TOT-STVX-PYMT = H-LITEM-PYMT + H-TOT-STVX-PYMT. 10500-ADJ-CHRGS-EXIT. EXIT. *************************************************************** * * * CALCULATE THE FOLLOWING FOR VALID LINES IN THE COINSURANCE * * DEDUCTIBLE TABLE WITH A PAYABLE STATUS: * * - LINE ITEM PAYMENT (BASED ON LINE SERVICE INDICATOR) * * - BENEFICIARY DEDUCTIBLE (IN ORDER OF APC RANK) * * - MINIMUM, MAXIMUM, AND REDUCED COINSURANCE AMOUNTS * * * *************************************************************** * * * 1. CALCULATE STANDARD LINE ITEM PAYMENT (LINE PRICE) * * (APC PAYMENT * WAGE INDEX * SERVICE UNITS * * * DISCOUNT FACTOR) * * WAGE ADJUST 60% OF THE APC PAYMENT FOR SI = S, V, T, P, * * OR X LINES, THESE ARE ELIGIBLE FOR THE SCH ADJUSTMENT * * 2. APPLY DEDUCTIBLE TO HIGHEST NATIONAL COINSURANCE AMOUNT * * DESCENDING UNTIL DEDUCTIBLE = 0. * * 3. ADD LINE PRICE TO OUTLIER HOLD AREA * * 4. CALCULATE THE LINE PRICE FOR DESIGNATED DEVICES * * AND DRUGS & TAKE PT DEVICE OFFSET WHEN APPLICABLE * * 5. CALCULATE DEVICE REDUCTIONS * * * *************************************************************** 10550-CALC-STANDARD. *************************************************************** * INITIALIZE & SET LINE VARIABLES AND FLAGS * *************************************************************** *-------------------------------------------------------------* * INITIALIZE VARIABLE FOR LINES ELIGIBLE FOR BLOOD DEDUCTIBLE * *-------------------------------------------------------------* MOVE 0 TO H-BLOOD-FRACTION. *-------------------------------------------------------------* * FLAG LINE IF THE LINE APC IS A BRACHYTHERAPY APC * * ** NEW LIST EVERY JANUARY ** * *-------------------------------------------------------------* * 11/13/2007 - BRACHY APC CHECK ADDED * * 12/28/2007 - LOGIC MOVED HERE * * 11/12/2008 - LOGIC DISABLED, BRACHYTHERAPY LINES IDENTIFIED * * WITH A STATUS INDICATOR OF ' U' FOR CY 2009 * *-------------------------------------------------------------* * PERFORM 10650-SET-BRACHY-APC-FLAG * THRU 10650-SET-BRACHY-APC-FLAG-EXIT. *-------------------------------------------------------------* * FLAG LINE IF THE LINE HCPCS IS A BLOOD DEDUCTIBLE HCPCS * * ** NEW LIST EVERY JANUARY ** * *-------------------------------------------------------------* * 11/13/2007 - HCPCS LIST MOVED FROM 7550-CALC-GJK TO HERE * * 12/04/2007 - LIST MOVED TO 7655-SET-BD-HCPCS-FLAG * * 12/28/2007 - LOGIC MOVED HERE * *-------------------------------------------------------------* PERFORM 10655-SET-BD-HCPCS-FLAG THRU 10655-SET-BD-HCPCS-FLAG-EXIT. *-------------------------------------------------------------* * FLAG LINE IF THE LINE APC IS A RADIOPHARM APC * * ** NEW LIST EVERY JANUARY ** * *-------------------------------------------------------------* * 12/27/2007 - RADIOPHARM APC CHECK ADDED * * 12/28/2007 - LOGIC MOVED HERE * * 11/16/2009 - LOGIC REMOVED BECAUSE THERAP. RADIO NO LONGER * * HAVE AN SI=H (NOT PAID AT COST) - CY 2010 * *-------------------------------------------------------------* * PERFORM 10660-SET-RADIOPH-APC-FLAG * THRU 10660-SET-RADIOPH-APC-FLAG-EXIT. *-------------------------------------------------------------* * FLAG LINE IF LINE HCPCS IS A PASS-THROUGH RADIOPHARM HCPCS * * ** QUARTERLY UPDATES TO TABLE ** * *-------------------------------------------------------------* * 02/10/2009 - PT RADIOPHARM HCPCS CHECK ADDED * *-------------------------------------------------------------* PERFORM 10680-SET-PTRADIO-LINE-FLAG THRU 10680-SET-PTRADIO-LINE-FL-EXIT. *-------------------------------------------------------------* * FLAG LINE IF LINE HCPCS IS A PASS-THROUGH CONTRAST AGENT * * HCPCS ** QUARTERLY UPDATES TO TABLE ** * *-------------------------------------------------------------* * 11/16/2009 - PT CONTRAST AGENT HCPCS CHECK ADDED * *-------------------------------------------------------------* PERFORM 10681-SET-PTCA-LINE-FLAG THRU 10681-SET-PTCA-LINE-FL-EXIT. *************************************************************** * CALCULATE MAXIMUM COINSURANCE AMOUNT (INPATIENT LIMIT) * *************************************************************** COMPUTE H-MAX-COIN ROUNDED = (H-IP-LIMIT * W-SRVC-UNITS (W-LP-INDX) * W-DISC-RATE (W-LP-INDX)). *************************************************************** * CALCULATE FULL AND PARTIAL CREDIT DEVICE REDUCTIONS AND * * REDUCE THE APC PAYMENT BY THE REDUCTION AMOUNT * * PAYMENT ADJUSTMENT FLAGS: 7 = FULL, 8 = PARTIAL CREDIT * *-------------------------------------------------------------* * 11/1/2007 - PYMT ADJ FLAG 8 ADDED FOR PARTIAL CREDIT * * DEDUCTIONS - NEW FOR CY 2008 * *************************************************************** IF OPPS-PYMT-ADJ-FLAG (LN-SUB) = ' 7' OR ' 8' PERFORM 10550-DEVICE-REDUC THRU 10550-DEVICE-REDUC-EXIT. *************************************************************** * CALCULATE PAYMENT FOR SI = S, V, T, P, OR X LINES * * THE APC PAYMENT IS 60% WAGE ADJUSTED * *-------------------------------------------------------------* * 11/13/2007 - ADDED PERFORM 7560-CALC-BENE-DEDUCT * * (REMOVED FROM PARAGRAPH 7550-SCH-ADJ) * *************************************************************** IF (OPPS-SRVC-IND (LN-SUB) = ' S' OR ' V' OR ' T' OR ' P' OR ' X') THEN PERFORM 10550-SCH-ADJ THRU 10550-SCH-ADJ-EXIT PERFORM 10560-CALC-BENE-DEDUCT THRU 10560-CALC-BENE-DEDUCT-EXIT IF OPPS-SRVC-IND (LN-SUB) = ' P' THEN PERFORM 10550-PHP-PMT-FOR-OUTL THRU 10550-PHP-PMT-FOR-OUTL-EXIT END-IF *************************************************************** * CALCULATE PAYMENT FOR SI = H (DEVICE) LINES, PAYMENT IND. * * SHOULD BE 6 FOR THESE LINES (BASED ON CHARGE ADJ. TO COST) * * RETURN ERROR CODE 44 IF THIS IS NOT THE CASE * *-------------------------------------------------------------* * 01/01/2009 - BRACHYTHERAPY SERVICES ADDED FOR CY 2009 * * 11/15/2009 - BRACHYTHERAPY SERVICES (SI=U) REMOVED CY 2010 * * - THERAPEUTIC RADIOPHARMS' SI NOT 'H' FOR CY2010 * * 08/11/2010 - NEW PASS-THROUGH DEVICE OFFSET LOGIC ADDED IN * * PARAGRAPH 10555-CALC-H-STANDARD * *************************************************************** ELSE IF (OPPS-SRVC-IND (LN-SUB) = ' H') THEN IF (OPPS-SRVC-IND (LN-SUB) = ' H' AND OPPS-PYMT-IND (LN-SUB) = ' 6') PERFORM 10555-CALC-H-STANDARD THRU 10555-CALC-H-STANDARD-EXIT PERFORM 10560-CALC-BENE-DEDUCT THRU 10560-CALC-BENE-DEDUCT-EXIT ELSE MOVE 44 TO A-RETURN-CODE (LN-SUB) GO TO 10550-CALC-STANDARD-EXIT END-IF *************************************************************** * CALCULATE PAYMENT FOR SI = G, K, R & U LINES; THE PMT. IND. * * SHOULD BE 1, 5, OR 7 FOR THESE LINES (PAY STANDARD AMOUNT) * * RETURN ERROR CODE 41 IF INVALID SI - PYMT IND. COMBO * *-------------------------------------------------------------* * 12/31/2007 - REMOVED REDUNDANT H-BLOOD-FRAC. INITIALIZATION * * 11/15/2009 - ADDED BRACHYTHERAPY SERVICES (SI=U) FOR CY2010 * * THERAPEUTIC RADIOPHARMS' SI=K FOR CY 2010 * * 11/16/2009 - ADD LOGIC TO ADJUST PT CONTRAST AGENT HCPCS * * LINE PAYMENT BY OFFSET * *************************************************************** ELSE IF OPPS-SRVC-IND (LN-SUB) = ' G' OR ' K' OR ' R' OR ' U' THEN IF OPPS-PYMT-IND (LN-SUB) = ' 1' OR ' 5' OR ' 7' THEN PERFORM 10550-CALC-GJK THRU 10550-CALC-GJK-EXIT IF PTRADIO-LINE-FLAG = 'Y' AND H-NUCMED-TOT-OFFSET > 0 THEN PERFORM 10550-PTRADIO-OFFSET THRU 10550-PTRADIO-OFFSET-EXIT END-IF IF PTCA-LINE-FLAG = 'Y' AND W-PTCA-DAY-MAX > 0 AND W-CAPROC-MAX > 0 THEN PERFORM 10550-PTCA-OFFSET THRU 10550-PTCA-OFFSET-EXIT END-IF PERFORM 10560-CALC-BENE-DEDUCT THRU 10560-CALC-BENE-DEDUCT-EXIT ELSE MOVE 41 TO A-RETURN-CODE (LN-SUB) GO TO 10550-CALC-STANDARD-EXIT END-IF END-IF END-IF END-IF. *************************************************************** * CALCULATE LINE REIMBURSEMENT * *-------------------------------------------------------------* * 11/01/2007 - PERFORMS FOR PARAGRAPHS 7550-PD-AT-CST-JAN07 * * AND 7550-PD-AT-CST-JUL07 WERE DELETED (THE PARAGRAPHS * * WERE ALSO DELETED). THERE IS NO PAID AT COST TABLE FOR * * 2008. UNDER THE ORIGINAL 2008 LEGISLATION, DIAGNOSIS * * RADIOPHARM LINES WERE PACKAGED (SI=' N') AND THERAPEUTIC * * RADIOPHARM AND BRACHYTHERAPY LINES WERE SEPARATELY * * PAYABLE (SI=' K'). THEREFORE, PAID AT COST LOGIC WAS NOT * * NEEDED. * * * * 12/06/2007 - LINE REIMBURSEMENT AND NATIONAL COINSURANCE * * CALCULATIONS, AND MINIMUM COINSURANCE MOVE INSERTED * * (TAKEN FROM 6550-PD-AT-CST-JAN07). * * * * 12/27/2007 - PAID AT COST LOGIC REINSTATED FOR RADIOPHARM * * AND BRACHYTHERAPY LINES WITH A STATUS INDICATOR = ' H'. * * PAID AT COST LOGIC REVISED: NO TABLE OR TABLE SEARCH; * * FLAGS ARE USED INSTEAD. (REINSTATEMENT IS DUE TO A * * CHANGE IN LEGISLATION; ALL RADIO. & BRACHY SI = ' H'.) * * * * 05/14/2008 - PAID AT COST LOGIC NO LONGER APPLIED TO * * RADIOPHARM AND BRACHYTHERAPY LINES AS OF JULY 1, 2008. * * THESE LINES ARE ASSIGNED A SI OF ' K' EFFECTIVE JULY 1, * * 2008, SO THEY WILL AUTOMATICALLY BY-PASS THE LOGIC AND * * RECEIVE THE STANDARD REIM. PAID AT COST LOGIC RETAINED * * FOR PREVIOUS QUARTERS (JANUARY 1 - JUNE 30, 2008). * * * * 08/07/2008 - DUE TO LEGISLATION, THERAPEUTIC RADIOPHARMS & * * BRACHYTHERAPY SOURCE'S SI CHANGED FROM 'K' BACK TO 'H'; * * THEY CONTINUE TO BE PAID AT COST (EFFECTIVE 7/1/2008) * * * * 11/12/2008 - BRACHYTHERAPY SOURCE'S STATUS INDICATOR = ' U' * * EFFECTIVE 1/1/2009 * * * * 11/16/2009 - REMOVED LOGIC FOR THERAPEUTIC RADIOPHARMS & * * BRACHYTHERAPY SOURCES B/C THESE ARE NOT PAID * * AT COST FOR CY 2010 * * * * 04/11/2011 - ADDED LOGIC TO PREVENT LINES WITH PAFS 9 OR 10 * * FROM RECEIVING COINSURANCE & MODIFIED * * REIMBURSEMENT CALCULATION FOR THESE LINES * * * *************************************************************** *-------------------------------------------------------------* * CALCULATE REIMBURSEMENT AND SET COINSURANCE AMOUNTS TO $0 * * FOR LINES WITH A PAF= 9 OR 10 * *-------------------------------------------------------------* IF OPPS-PYMT-ADJ-FLAG (LN-SUB) = (' 9' OR '10') COMPUTE H-LITEM-REIM ROUNDED = H-LITEM-PYMT - H-TOTAL-LN-DEDUCT MOVE 0 TO H-NAT-COIN H-MIN-COIN H-MAX-COIN H-RED-COIN GO TO 10550-CALC-STANDARD-EXIT END-IF. *-------------------------------------------------------------* * STANDARD LINE REIMBURSEMENT CALCULATION * *-------------------------------------------------------------* COMPUTE H-LITEM-REIM ROUNDED = ((H-LITEM-PYMT - H-TOTAL-LN-DEDUCT) - H-LN-BLOOD-DEDUCT) * W-PPCT (W-LP-INDX). *************************************************************** * CALCULATE NATIONAL COINSURANCE * *-------------------------------------------------------------* * 12/6/2007 - LOGIC ADDED (TAKEN FROM 6550-PD-AT-CST-JAN07) * *************************************************************** COMPUTE H-NAT-COIN = H-LITEM-PYMT - H-TOTAL-LN-DEDUCT - H-LITEM-REIM - H-LN-BLOOD-DEDUCT. *************************************************************** * ADJUST MINIMUM COINSURANCE AMOUNT * * (REPLACES WHAT WAS IN THE APC TABLE IF > 0) * *************************************************************** MOVE W-MIN-COIN (W-LP-INDX) TO H-MIN-COIN. IF H-MIN-COIN > 0 *-------------------------------------------------------------* * DRUGS, DEVICES, BRACHYTHERAPY, THERAP. RADIO, & BLOOD * * (SI = G AND H LINES HAVE A MIN-COIN = 0, WON'T ENTER LOGIC) * *-------------------------------------------------------------* IF OPPS-SRVC-IND (LN-SUB) = ' G' OR ' H' OR ' K' OR ' R' OR ' U' COMPUTE H-MIN-COIN ROUNDED = H-MIN-COIN * (W-SRVC-UNITS (W-LP-INDX) - (W-SRVC-UNITS (W-LP-INDX) * H-BLOOD-FRACTION)) * W-DISC-RATE (W-LP-INDX) *-------------------------------------------------------------* * APCS 0158 & 0159'S MIN COINSURANCE = 25% OF LINE PMT * *-------------------------------------------------------------* ELSE IF OPPS-APC (LN-SUB) = '0158' OR '0159' COMPUTE H-MIN-COIN ROUNDED = H-LITEM-PYMT * .25 *-------------------------------------------------------------* * OTHER SERVICE TYPES AND APCS' MIN COIN = 20% OF LINE PMT * *-------------------------------------------------------------* ELSE COMPUTE H-MIN-COIN ROUNDED = H-LITEM-PYMT * .2 END-IF END-IF END-IF. *************************************************************** * ADJUST REDUCED COINSURANCE WHEN NECESSARY & ADJUST CLAIM * * TOTAL LINE ITEM REIMBURSEMENT WHEN THE REDUCED AND/OR * * NATIONAL COINSURANCE AMOUNTS EXCEED THE MAXIMUM COINSURANCE * * (PROVIDER MAY ELECT TO REDUCE COINSURANCE) * *************************************************************** MOVE W-RED-COIN (W-LP-INDX) TO H-RED-COIN. IF (H-RED-COIN > 0 AND < H-MIN-COIN) MOVE H-MIN-COIN TO H-RED-COIN ELSE IF H-RED-COIN < H-NAT-COIN AND > H-MIN-COIN AND > H-MAX-COIN COMPUTE H-LITEM-REIM = H-LITEM-REIM + (H-RED-COIN - H-MAX-COIN) END-IF END-IF. IF H-NAT-COIN > H-MAX-COIN AND H-RED-COIN = 0 THEN COMPUTE H-LITEM-REIM = H-LITEM-REIM + (H-NAT-COIN - H-MAX-COIN) MOVE H-MAX-COIN TO H-NAT-COIN. 10550-CALC-STANDARD-EXIT. EXIT. *************************************************************** * * * DELETED CODE: * * PAID AT COST WITH COINSURANCE TABLE SEARCH REMOVED * * 11/1/2007 FOR CY 2008. THERE IS NO NEW PAID AT COST * * TABLE FOR 2008. PARAGRAPHS REMOVED: * * - 7550-PD-AT-CST-JAN07, * * - 7550-PD-AT-CST-JAN07-EXIT, * * - 7550-PD-AT-CST-JUL07, * * - 7550-PD-AT-CST-JUL07-EXIT. * * * *************************************************************** *************************************************************** * * * DEVICE REDUCTION PROCESSING * * * *************************************************************** * * * SEARCH THE DEVICE REDUCTION TABLE TO SEE IF THERE IS AN APC * * MATCH; IF SO, REDUCE THE PYMT BY THE REDUCTION AMOUNT * * BECAUSE THIS IS A FREE OR REPLACEMENT DEVICE -OR- A PARTIAL * * CREDIT DEVICE. * * * * * BE SURE TO UPDATE THE TABLE REFERENCES EACH YEAR * * * * *-------------------------------------------------------------* * * * 11/1/2007 - PARTIAL CREDIT DEVICE PROCESSING ADDED * * NEW FOR CY 2008 * * * *************************************************************** 10550-DEVICE-REDUC. SEARCH ALL DEV-RED11 AT END GO TO 10550-DEVICE-REDUC-EXIT WHEN DEV-APC11 (DEV-INDX11) = OPPS-APC (LN-SUB) PERFORM 10550-DEVICE-COMPUTE THRU 10550-DEVICE-COMPUTE-EXIT. 10550-DEVICE-REDUC-EXIT. EXIT. *************************************************************** * * * IF THE DEVICE IS FOUND, AND REDUCTION AMOUNT IS LESS THAN * * PAYMENT AMOUNT, SUBTRACT REDUCTION AMOUNT FROM THE PAYMENT * * * * * BE SURE TO UPDATE THE TABLE REFERENCES EACH YEAR * * * * *-------------------------------------------------------------* * * * 11/1/2007 - PARTIAL CREDIT DEVICE PROCESSING ADDED * * NEW FOR CY 2008 * * * *************************************************************** 10550-DEVICE-COMPUTE. *-------------------------------------------------------------* * PROCESS FULL DEVICE REDUCTION (PAF = 7, FB MODIFER) * *-------------------------------------------------------------* IF OPPS-PYMT-ADJ-FLAG (LN-SUB) = ' 7' IF W-APC-PYMT (W-LP-INDX) NUMERIC IF W-APC-PYMT (W-LP-INDX) > DEV-REDUC11 (DEV-INDX11) COMPUTE W-APC-PYMT (W-LP-INDX) = (W-APC-PYMT (W-LP-INDX) - DEV-REDUC11 (DEV-INDX11)). *-------------------------------------------------------------* * PROCESS PARTIAL CREDIT DEVICE REDUCTION (PAF = 8, FC MOD) * *-------------------------------------------------------------* IF OPPS-PYMT-ADJ-FLAG (LN-SUB) = ' 8' IF W-APC-PYMT (W-LP-INDX) NUMERIC IF W-APC-PYMT (W-LP-INDX) > (DEV-REDUC11 (DEV-INDX11) / 2) COMPUTE W-APC-PYMT (W-LP-INDX) = (W-APC-PYMT (W-LP-INDX) - (DEV-REDUC11 (DEV-INDX11) / 2)). 10550-DEVICE-COMPUTE-EXIT. EXIT. *************************************************************** * * * CALCULATE WAGE ADJUSTED LINE ITEM PAYMENT WITH RURAL * * SOLE COMMUNITY HOSPITAL (SCH) ADJUSTMENT WHEN APPLICABLE * * * * FOR LINES WITH A SI OF S, V, T, P, X, R, OR U * * * *************************************************************** * * * THE SCH ADJUSTMENT IS MADE WHEN THE FOLLOWING IS TRUE: * * EITHER THE L-PSF-GEO-CBSA OR THE L-PSF-WI-CBSA MUST BE A * * VALUE OF ' 01' THRU ' 99' AND THE L-PSF-PROV-TYPE * * MUST BE A '16' OR '17' OR '21' OR '22'. * * * * EACH YEAR, CHECK WHETHER THE SCH ADJUSTMENT HARDCODED BELOW * * HAS CHANGED. * * CYS 2006 - 2009: SCH ADJ = 7.1% (1.071) * * * * * * 11/08/2007 - PROCESSING FOR BRACHY & BLOOD CODES WITH AN SI * * = K ADDED FOR CY 2008 * * 11/13/2007 - PROCESSING FOR BRACHY & BLOOD CODES REVISED. * * BLD-DEDUC-HCPCS-FLAG ADDED TO LOGIC. * * 11/13/2007 - PARAGRAPH 7560-CALC-BENE-DEDUCT PERFORM * * DELETED & MOVED TO PAR. 7550-CALC-STANDARD * * 05/14/2008 - BRACHYTHERAPY LINES PROCESSED IN THIS * * PARAGRAPH STARTING 7/1/2008 BECAUSE SI CHANGED * * TO ' K' ON THIS DATE. * * 08/07/2008 - DUE TO LEGISLATION, THERAPEUTIC RADIOPHARMS & * * BRACHYTHERAPY SOURCE'S SI CHANGED FROM 'K' * * BACK TO 'H' EFFECTIVE 7/1/2008; THESE LINES * * ARE NOT YET PROCESSED IN THIS PARAGRAPH * * 11/13/2008 - FOR CY 2009, BLOOD DEDUCTIBLE LINES (SI=R) * * ADDED TO LOGIC. BRACHY LINES NOT PROCESSED IN * * PARAGRAPH & NOW HAVE A SI = U, SI = K LOGIC * * REMOVED FROM THIS PARAGRAPH. * * 05/11/2009 - ADDED THE REQUIREMENT PAF = 5 OR 6 TO BLOOD * * DEDUCTIBLE LOGIC TO CORRECT PRICING ERROR. * * FIX EFFECTIVE RETROACTIVE TO 01/01/2009. * * 11/17/2009 - BRACHYTHERAPY LINES NOW PROCESSED IN THIS * * PARAGRAPH FOR CY 2010 (SI=U), DO NOT RECEIVE * * WAGE ADJUSTMENT * * 05/09/2011 - REVISED LOGIC TO EXCLUDE BILL TYPE 14X FROM * * RECEIVING THE SCH ADD-ON * * * *************************************************************** 10550-SCH-ADJ. MOVE L-PSF-GEO-CBSA TO GEO-CBSA-FLAG. MOVE L-PSF-WI-CBSA TO WI-CBSA-FLAG. *************************************************************** * CALCULATE THE SCH PAYMENT * * - FOR SCHS = APC OR BLOOD APC PAYMENT ADJUSTED BY 7.1% * * - FOR NON-SCHS = UNADJUSTED APC OR BLOOD APC PAYMENT * *************************************************************** IF ((RURAL-GEO OR RURAL-WI) AND (L-PSF-PROV-TYPE = '16' OR '17' OR '21' OR '22') AND (BILL14X-FLAG = 'N')) *-------------------------------------------------------------* * SCH, BLOOD DEDUCTIBLE HCPCS LINE * *-------------------------------------------------------------* IF OPPS-SRVC-IND (LN-SUB) = ' R' AND BLD-DEDUC-HCPCS-FLAG = 'Y' AND OPPS-PYMT-ADJ-FLAG (LN-SUB) = (' 5' OR ' 6') COMPUTE H-SCH-PYMT ROUNDED = (W-BD-APC-PYMT (W-BD-INDX) * 1.071) *-------------------------------------------------------------* * SCH, NOT A LINE WITH A BLOOD DEDUCTIBLE HCPCS * *-------------------------------------------------------------* ELSE COMPUTE H-SCH-PYMT ROUNDED = (W-APC-PYMT (W-LP-INDX) * 1.071) END-IF *-------------------------------------------------------------* * NON-SCH, BLOOD DEDUCTIBLE HCPCS LINE * *-------------------------------------------------------------* ELSE IF OPPS-SRVC-IND (LN-SUB) = ' R' AND BLD-DEDUC-HCPCS-FLAG = 'Y' AND OPPS-PYMT-ADJ-FLAG (LN-SUB) = (' 5' OR ' 6') MOVE W-BD-APC-PYMT (W-BD-INDX) TO H-SCH-PYMT *-------------------------------------------------------------* * NON-SCH, NOT A LINE WITH A BLOOD DEDUCTIBLE HCPCS * *-------------------------------------------------------------* ELSE MOVE W-APC-PYMT (W-LP-INDX) TO H-SCH-PYMT END-IF END-IF. *************************************************************** * CALCULATE THE LINE ITEM PAYMENT * *************************************************************** *-------------------------------------------------------------* * SI = R (BLOOD) OR U (BRACHY) LINES ARE NOT WAGE-ADJUSTED * *-------------------------------------------------------------* IF OPPS-SRVC-IND (LN-SUB) = ' R' OR ' U' IF OPPS-SRVC-IND (LN-SUB) = ' R' AND BLD-DEDUC-HCPCS-FLAG = 'Y' AND OPPS-PYMT-ADJ-FLAG (LN-SUB) = (' 5' OR ' 6') COMPUTE H-LITEM-PYMT ROUNDED = H-SCH-PYMT * W-BD-SRVC-UNITS (W-BD-INDX) * W-BD-DISC-RATE (W-BD-INDX) ELSE COMPUTE H-LITEM-PYMT ROUNDED = H-SCH-PYMT * W-SRVC-UNITS (W-LP-INDX) * W-DISC-RATE (W-LP-INDX) END-IF *-------------------------------------------------------------* * SI = S, V, T, P, OR X LINES ARE WAGE-ADJUSTED (60%) * *-------------------------------------------------------------* ELSE COMPUTE H-LITEM-PYMT ROUNDED = (((H-SCH-PYMT * .60) * W-WINX1 (W-LP-INDX)) + (H-SCH-PYMT * .40)) * W-SRVC-UNITS (W-LP-INDX) * W-DISC-RATE (W-LP-INDX) END-IF. 10550-SCH-ADJ-EXIT. EXIT. *************************************************************** * * * SET PARTIAL HOSPITALIZATION (PHP) "CAP" APC * * FOR USE IN THE OUTLIER CALCULATION * * (FOR SI = P LINES ONLY) * * * * ** ASK POLICY FOR THE PHP "CAP" APC ANUALLY ** * * * *-------------------------------------------------------------* * * * 11/13/2008 - THIS PARAGRAPH IS NEW FOR CY 2009, * * CY 2009 PHP "CAP" APC = 0173 * * 11/15/2010 - MODIFIED LOGIC TO ASSIGN CMHCS APC 00173 & * * HOSPITALS APC 00176 * * 11/04/2011 - MODIFIED LOGIC TO STOP APPLYING APC 00176 * * CAP TO PHP HOSPITAL LINES * * * *************************************************************** 10550-PHP-PMT-FOR-OUTL. *-------------------------------------------------------------* * ** FOR CMHC CLAIMS ONLY - USE APC 00173 * * LOOK-UP PHP "CAP" APC IN THE APC TABLE, STARTING AT * * THE APC'S MOST CURRENT RECORD - RETRIEVE PAYMENT RATE * *-------------------------------------------------------------* IF (L-PSF-PROV-3456 >= '1400' AND L-PSF-PROV-3456 <= '1499') OR (L-PSF-PROV-3456 >= '4600' AND L-PSF-PROV-3456 <= '4799') OR (L-PSF-PROV-3456 >= '4900' AND L-PSF-PROV-3456 <= '4999') SEARCH ALL WAA-ENTRY AT END GO TO 10550-PHP-PMT-FOR-OUTL-EXIT WHEN WAA-APC (WAA-INDX) = '00173' MOVE WAA-PTR (WAA-INDX) TO W-SUB2 PERFORM 10550-PHP-APC-LOOKUP. *-------------------------------------------------------------* * 11/04/2011 - DISABLED THIS LOGIC PER POLICY'S INSTRUCTIONS * * NOT TO CAP PHP HOSPITAL LINE PAYMENTS FOR THE * * OUTLIER CALCULATION USING APC 0176 * *-------------------------------------------------------------* * ** FOR HOSPITAL CLAIMS ONLY - USE APC 00176 * * LOOK-UP PHP "CAP" APC IN THE APC TABLE, STARTING AT * * THE APC'S MOST CURRENT RECORD - RETRIEVE PAYMENT RATE * *-------------------------------------------------------------* * ELSE * SEARCH ALL WAA-ENTRY * AT END * GO TO 10550-PHP-PMT-FOR-OUTL-EXIT * * WHEN WAA-APC (WAA-INDX) = '00176' * MOVE WAA-PTR (WAA-INDX) TO W-SUB2 * PERFORM 10550-PHP-APC-LOOKUP. *-------------------------------------------------------------* *-------------------------------------------------------------* * REDUCE APC PMT RATE BY REDUCED UPDATE RATIO WHEN APPROPRIATE* * 11/13/2009 - NEW FOR CY 2009 * *-------------------------------------------------------------* PERFORM 10180-REDUCE-APC-PYMT THRU 10180-REDUCE-APC-PYMT-EXIT. *-------------------------------------------------------------* * APPLY THE SCH ADJUSTMENT TO APC RATE WHEN APPLICABLE * * CY 2009 ADJ = 7.1% * *-------------------------------------------------------------* IF ((RURAL-GEO OR RURAL-WI) AND (L-PSF-PROV-TYPE = '16' OR '17' OR '21' OR '22')) COMPUTE H-APC-PYMT ROUNDED = (H-APC-PYMT * 1.071) END-IF. *-------------------------------------------------------------* * CALCULATE THE PHP "CAP" APC'S LINE PAYMENT (INCLUDES * * WAGE ADJUSTMENT AND SCH ADJUSTMENT IF APPLICABLE) * *-------------------------------------------------------------* COMPUTE H-PHP-LITEM-PYMT-OUTL ROUNDED = (((H-APC-PYMT * .60) * W-WINX1 (W-LP-INDX)) + (H-APC-PYMT * .40)) * W-SRVC-UNITS (W-LP-INDX) * W-DISC-RATE (W-LP-INDX). 10550-PHP-PMT-FOR-OUTL-EXIT. EXIT. *************************************************************** * * * LOOK-UP PHP "CAP" APC IN THE APC TABLE * * * *-------------------------------------------------------------* * * * 11/13/2008 - THIS PARAGRAPH IS NEW FOR CY 2009 * * * *************************************************************** 10550-PHP-APC-LOOKUP. *************************************************************** * APC RECORD EFFECTIVE DATE IS BEFORE OR ON THE LATEST * * EFFECTIVE DATE THE CLAIM CAN USE (SEARCH STARTS AT THE * * MOST CURRENT RECORD FOR THE APC) * *************************************************************** IF WAR-DTCD (W-SUB2) NOT > WAD-DTCD (WAD-SUB) *-------------------------------------------------------------* * APC RECORD EFFECTIVE DATE CORRECT, APC DELETED - ERROR * *-------------------------------------------------------------* IF WAR-RATEX (W-SUB2) = 'DELETED' MOVE ZEROS TO H-APC-PYMT *-------------------------------------------------------------* * APC RECORD EFFECTIVE DATE CORRECT, APC ACTIVE - ACCEPT REC * *-------------------------------------------------------------* ELSE MOVE WAR-RATE (W-SUB2) TO H-APC-PYMT *************************************************************** * APC RECORD EFFECTIVE DATE IS AFTER THE LATEST EFFECTIVE * * DATE THE CLAIM CAN USE. GO TO THE PREVIOUS RECORD IN THE * * APC TABLE. * *************************************************************** ELSE SUBTRACT 1 FROM W-SUB2 *-------------------------------------------------------------* * PREVIOUS REC BELONGS TO THE LINE APC, TEST EFFECTIVE DATE * *-------------------------------------------------------------* IF W-SUB2 > WAA-PTR (WAA-INDX - 1) GO TO 10550-PHP-APC-LOOKUP *-------------------------------------------------------------* * THERE IS NO RECORD FOR THE LINE APC WITH AN ACCEPTABLE * * EFFECTIVE DATE FOR THE LINE. RETURN ZEROS. * *-------------------------------------------------------------* ELSE MOVE 0 TO H-APC-PYMT. 10550-PHP-APC-LOOKUP-EXIT. EXIT. *************************************************************** * * * CALCULATE THE FOLLOWING FOR VALID SI = G, K, R, & U LINES: * * - APC PAYMENT FOR BLOOD LINES (SI = R) * * - BLOOD SPECIFIC ITEMS FOR BLOOD LINES * * - LINE ITEM PMT FOR ALL SI = G, K, OR U LINES (DRUGS, * * BIOLOGICALS, RADIOPHARMS, & BRACHYTHERAPIES) * * - SCH ADJUSTMENT APPLIED TO BLOOD & BRACHY LINES * * - BLOOD DEDUCTIBLE FOR BLOOD DEDUCTIBLE HCPCS LINES * * * *-------------------------------------------------------------* * * * - EFFECTIVE 01/01/2003, REMOVE PRO RATA REDUCTION FOR * * ALL SERVICE INDICATOR 'G' PAYMENTS. * * - 11/13/2007 - LINE ITEM PAYMENTS FOR BLOOD AND BRACHY * * LINES ARE CALCULATED IN PARAGRAPH 7550-SCH-ADJ TO APPLY * * THE SOLE COMMUNITY HOSPITAL (SCH) ADJUSTMENT WHEN * * APPLICABLE * * - 12/31/2007 - BRACHYTHERAPY & RADIOPHARM LINES' STATUS * * INDICATOR CHANGED BACK TO 'H' TEMPORARILY; THESE LINES * * WILL NOT ENTER THIS PARAGRAPH NOR PARAGRAPH 7550-SCH-ADJ * * UNTIL THEIR STATUS INDICATOR IS CHANGED BACK TO 'K' * * - 05/14/2008 - BRACHYTHERAPY & RADIOPHARM LINES' SI CHANGED * * TO ' K' EFFECTIVE 7/1/2008. THESE LINES ARE PROCESSED * * IN THIS PARAGRAPH STARTING 7/1/2008. * * - 08/07/2008 - DUE TO LEGISLATION, THERAPEUTIC RADIOPHARMS * * & BRACHYTHERAPY SOURCE'S SI CHANGED FROM 'K' BACK TO 'H' * * EFFECTIVE 7/1/2008; THESE LINES ARE NOT YET PROCESSED IN * * THIS PARAGRAPH. * * - 11/12/2008 - FOR CY 2009, BRACHYS NOT PROCESSED IN THIS * * PARAGRAPH; BRACHY LINES ASSIGNED A NEW SI OF ' U' * * - 11/13/2008 - FOR CY 2009, BLOOD DEDUCTIBLE LINES HAVE A * * SI = R * * - 12/05/2008 - MODIFIED LOGIC TO SEND BLOOD LINES WITHOUT * * A PMT ADJ FLAG = 5 OR 6 TO THE SCH ADJUSTMENT PARAGRAPH, * * INCLUDED SI = R IN THE BLOOD IDENTIFICATION LOGIC * * - 11/15/2009 - BRACHYTHERPY SERVICES (SI = U) & THERAPEUTIC * * RADIOPHARMS (SI = K) SENT TO THIS PARAGRAPH FOR CY 2010, * * LOGIC ALTERED TO PROCESS SI = U (RECEIVE REGULAR APC PMT) * * - 11/17/2009 - SEND BRACHYTHERAPY LINES TO 10550-SCH-ADJ TO * * MAKE ELIGIBLE FOR SCH ADJUSTMENT, NOT WAGE ADJUSTED * * * *************************************************************** 10550-CALC-GJK. *************************************************************** * * * CALCULATE LINE ITEM PAYMENT & BLOOD DEDUCTIBLE FOR BLOOD * * LINE WITH A HCPCS SUBJECT TO THE BLOOD DEDUCTIBLE (BD) * * * * (BLOOD DEDUCTIBLE LINES ARE PROCESSED IN THE ORDER THEY * * APPEAR IN THE BLOOD DEDUCTIBLE TABLE - EARLIEST TO LATEST * * DATE, LEAST TO MOST EXPENSIVE PAYMENT RATE. THE CURRENT * * COINSURANCE DEDUCTIBLE TABLE LINE BEING PROCESSED DOES NOT * * NECESSARILY CORRESPOND TO THE BLOOD DEDUCTIBLE LINE * * PROCESSED IN THE LOGIC BELOW.) * * * *************************************************************** IF OPPS-SRVC-IND (LN-SUB) = ' R' AND BLD-DEDUC-HCPCS-FLAG = 'Y' AND OPPS-PYMT-ADJ-FLAG (LN-SUB) = (' 5' OR ' 6') *-------------------------------------------------------------* * CALCULATE BLOOD FRACTION & BLOOD PINTS USED * *-------------------------------------------------------------* PERFORM 10550-SET-BLOOD-FRACTION THRU 10550-SET-BLOOD-FRACTION-EXIT *-------------------------------------------------------------* * ADJUST BLOOD APC PAYMENT BY BLOOD PRODUCT OR LABOR RATE * *-------------------------------------------------------------* PERFORM 10550-ADJ-BLOOD-COST THRU 10550-ADJ-BLOOD-COST-EXIT *-------------------------------------------------------------* * CALCULATE LINE ITEM PAYMENT W/ SCH ADJUSTMENT IF APPLICABLE * *-------------------------------------------------------------* * 11/14/2007 - 7550-SCH-ADJ PERFORM ADDED; LINE ITEM PAYMENT * * CALCULATION REMOVED FROM THIS SECTION * *-------------------------------------------------------------* PERFORM 10550-SCH-ADJ THRU 10550-SCH-ADJ-EXIT *-------------------------------------------------------------* * CALCULATE BLOOD DEDUCTIBLE (BD) - H-BLOOD-FRACTION IS THE * * FRACTION OF THE CURRENT LINE'S PINTS COVERED BY THE BD * *-------------------------------------------------------------* COMPUTE H-LN-BLOOD-DEDUCT ROUNDED = H-LITEM-PYMT * H-BLOOD-FRACTION *-------------------------------------------------------------* * POINT TO NEXT BLOOD DEDUCTIBLE RECORD FOR NEXT BD LINE * *-------------------------------------------------------------* SET W-BD-INDX UP BY 1 *************************************************************** * * * CALCULATE LINE ITEM PAYMENT FOR BLOOD LINE WITH A HCPCS NOT * * SUBJECT TO THE BLOOD DEDUCTIBLE, BUT PAF = 5 OR 6 * * (BLOOD PROCESSING AND PRODUCT BILLED TOGETHER) * * * *************************************************************** ELSE IF OPPS-SRVC-IND (LN-SUB) = ' R' AND OPPS-PYMT-ADJ-FLAG (LN-SUB) = (' 5' OR ' 6') *-------------------------------------------------------------* * ADJUST APC PAYMENT BY BLOOD PRODUCT OR LABOR RATE * *-------------------------------------------------------------* * 11/13/2007 - LINE ITEM PMT NO LONGER CALCULATED IN * * 7550-ADJ-PLATE-COST, BUT IN 7550-SCH-ADJ * *-------------------------------------------------------------* PERFORM 10550-ADJ-PLATE-COST THRU 10550-ADJ-PLATE-COST-EXIT *-------------------------------------------------------------* * CALCULATE LINE ITEM PAYMENT W/ SCH ADJUSTMENT IF APPLICABLE * *-------------------------------------------------------------* * 11/14/2007 - 7550-SCH-ADJ PERFORM ADDED; LINE ITEM PAYMENT * * CALCULATION REMOVED FROM THIS SECTION * *-------------------------------------------------------------* PERFORM 10550-SCH-ADJ THRU 10550-SCH-ADJ-EXIT *************************************************************** * * * CALCULATE LINE ITEM PAYMENT FOR BLOOD LINE WITH A HCPCS NOT * * SUBJECT TO THE BLOOD DEDUCTIBLE AND PAF NOT EQUAL TO 5 OR 6 * * (ONLY BLOOD PRODUCT BILLED) * * * *************************************************************** ELSE IF OPPS-SRVC-IND (LN-SUB) = ' R' *-------------------------------------------------------------* * CALCULATE LINE ITEM PAYMENT W/ SCH ADJUSTMENT IF APPLICABLE * *-------------------------------------------------------------* * 12/05/2008 - 7550-SCH-ADJ PERFORM ADDED FOR BLOOD LINES * * CALCULATION REMOVED FROM THIS SECTION * *-------------------------------------------------------------* PERFORM 10550-SCH-ADJ THRU 10550-SCH-ADJ-EXIT *************************************************************** * * * CALCULATE LINE ITEM PAYMENT FOR DRUGS, BIOLOGICALS, * * BRACHYTHERAPY SERVICES, & THERAPEUTIC RADIOPHARMS * * * *************************************************************** ELSE IF OPPS-SRVC-IND (LN-SUB) = ' G' OR ' K' COMPUTE H-LITEM-PYMT ROUNDED = W-APC-PYMT (W-LP-INDX) * W-SRVC-UNITS (W-LP-INDX) * W-DISC-RATE (W-LP-INDX) ELSE IF OPPS-SRVC-IND (LN-SUB) = ' U' PERFORM 10550-SCH-ADJ THRU 10550-SCH-ADJ-EXIT END-IF END-IF END-IF END-IF END-IF. 10550-CALC-GJK-EXIT. EXIT. *************************************************************** * * * DETERMINE THE FRACTION OF THE BLOOD LINE'S PAYMENT THAT * * WILL BE COVERED BY THE THE BENEFICIARY'S BLOOD DEDUCTIBLE * * FOR LINES WITH A HCPCS IN THE BLOOD DEDUCTIBLE LIST * * * * THE BENEFICIARY PAYS A BLOOD DEDUCTIBLE FOR THE FIRST * * 3 CHEAPEST BLOOD PINTS. MEDICARE COVERS ANY ADDITIONAL * * PINTS USED BY THE BENEFICIARY. * * * *************************************************************** 10550-SET-BLOOD-FRACTION. *-------------------------------------------------------------* * NAVIGATE TO SERVICE LINE ASSOCIATED WITH THE BLOOD ENTRY * *-------------------------------------------------------------* MOVE W-BD-SUB (W-BD-INDX) TO LN-SUB. *-------------------------------------------------------------* * BLOOD/BLOOD PRODUCT LINE * *-------------------------------------------------------------* IF OPPS-PYMT-ADJ-FLAG (LN-SUB) = ' 5' IF H-BENE-PINTS-USED > 0 *-------------------------------------------------------------* * BENEFICIARY HAS ENOUGH PINTS TO COVER ALL BLOOD LINE UNITS * * - BLOOD DEDUCTIBLE WILL COVER THE ENTIRE PYMNT (FRAC. = 1) * * - CALCULATE THE NUMBER OF DEDUCTIBLE PINTS BENE HAS LEFT * *-------------------------------------------------------------* IF W-BD-SRVC-UNITS (W-BD-INDX) <= H-BENE-PINTS-USED MOVE 1 TO H-BLOOD-FRACTION COMPUTE H-BENE-PINTS-USED = H-BENE-PINTS-USED - W-BD-SRVC-UNITS (W-BD-INDX) *-------------------------------------------------------------* * BENE. DOESN'T HAVE ENOUGH PINTS TO COVER ENTIRE BLOOD LINE * * - BLOOD DEDUCTIBLE WILL COVER A FRACTION OF THE PAYMENT * * (ACCORDING TO THE % OF PINTS COVERED) * * - BENEFICIARY HAS NO DEDUCTIBLE PINTS LEFT (PINTS = 0) * *-------------------------------------------------------------* ELSE IF W-BD-SRVC-UNITS (W-BD-INDX) > H-BENE-PINTS-USED COMPUTE H-BLOOD-FRACTION = H-BENE-PINTS-USED / W-BD-SRVC-UNITS (W-BD-INDX) MOVE 0 TO H-BENE-PINTS-USED ELSE MOVE 0 TO H-BLOOD-FRACTION *-------------------------------------------------------------* * BENEFICIARY HAS NO BLOOD DEDUCTIBLE PINTS LEFT * * THERE IS NO BLOOD DEDUCTIBLE * *-------------------------------------------------------------* ELSE MOVE 0 TO H-BLOOD-FRACTION *-------------------------------------------------------------* * BLOOD PROCESS/STORAGE LINE (PAF = 6) * * THERE IS NO BLOOD DEDUCTIBLE * *-------------------------------------------------------------* ELSE MOVE 0 TO H-BLOOD-FRACTION. 10550-SET-BLOOD-FRACTION-EXIT. EXIT. *************************************************************** * * * ADJUST APC PAYMENT BY BLOOD PRODUCT OR LABOR RATE TO * * CALCULATE THE BLOOD APC PAYMENT FOR LINES WITH A HCPCS * * IN THE BLOOD DEDUCTIBLE LIST * * * * THE RATE OF BLOOD TO BLOOD LABOR IS THE CLAIM AVERAGE. * * THE BLOOD LINE IS PAID ONLY THE PORTION OF THE APC * * PAYMENT THAT IS INDICATED BY THE PYMNT ADJUSTMENT FLAG. * * * *************************************************************** 10550-ADJ-BLOOD-COST. MOVE W-BD-SUB (W-BD-INDX) TO LN-SUB. *-------------------------------------------------------------* * CALCULATE BLOOD APC PAYMENT FOR BLOOD/BLOOD PRODUCT LINE * *-------------------------------------------------------------* IF OPPS-PYMT-ADJ-FLAG (LN-SUB) = ' 5' COMPUTE W-BD-APC-PYMT (W-BD-INDX) = W-BD-APC-PYMT (W-BD-INDX) * H-38X-39X-RATE. *-------------------------------------------------------------* * CALCULATE BLOOD APC PAYMENT FOR BLOOD PROCESS/STORAGE LINE * *-------------------------------------------------------------* IF OPPS-PYMT-ADJ-FLAG (LN-SUB) = ' 6' COMPUTE W-BD-APC-PYMT (W-BD-INDX) = W-BD-APC-PYMT (W-BD-INDX) * (1 - H-38X-39X-RATE). 10550-ADJ-BLOOD-COST-EXIT. EXIT. *************************************************************** * * * ADJUST APC PAYMENT BY BLOOD PRODUCT OR LABOR RATE TO * * CALCULATE THE BLOOD APC PAYMENT FOR BLOOD LINES WITH A * * HCPCS NOT IN THE BLOOD DEDUCTIBLE LIST * * * * THE RATE OF BLOOD TO BLOOD LABOR IS THE CLAIM AVERAGE. * * THE BLOOD LINE IS PAID ONLY THE PORTION OF THE APC * * PAYMENT THAT IS INDICATED BY THE PYMNT ADJUSTMENT FLAG. * * * *************************************************************** * * * 11/13/2007 - REMOVED LINE ITEM PAYMENT CALCULATION FROM * * THIS PARAGRAPH, NOW PERFORMED IN * * 7550-SCH-ADJ (CALLED FROM 7550-CALC-GJK) * * * *************************************************************** 10550-ADJ-PLATE-COST. *-------------------------------------------------------------* * CALCULATE BLOOD APC PAYMENT FOR BLOOD/BLOOD PRODUCT LINE * *-------------------------------------------------------------* IF OPPS-PYMT-ADJ-FLAG (LN-SUB) = ' 5' COMPUTE W-APC-PYMT (W-LP-INDX) = W-APC-PYMT (W-LP-INDX) * H-38X-39X-RATE. *-------------------------------------------------------------* * CALCULATE BLOOD APC PAYMENT FOR BLOOD PROCESS/STORAGE LINE * *-------------------------------------------------------------* IF OPPS-PYMT-ADJ-FLAG (LN-SUB) = ' 6' COMPUTE W-APC-PYMT (W-LP-INDX) = W-APC-PYMT (W-LP-INDX) * (1 - H-38X-39X-RATE). 10550-ADJ-PLATE-COST-EXIT. EXIT. *************************************************************** * * * ADJUST THE PASS-THROUGH RADIOPHARM PAYMENT BY * * ITS PROPORTION OF THE NUCLEAR MEDICINE OFFSET * * * * EFFECTIVE 04/01/2009, LOGIC ADDED 02/11/2009 * * * *************************************************************** 10550-PTRADIO-OFFSET. *-------------------------------------------------------------* * CALCULATE PROPORTION OF TOTAL OFFSET TO BE APPLIED TO LINE * *-------------------------------------------------------------* * 12/20/2009 - ADDED LOGIC TO PREVENT DIVISION BY ZERO ERROR * *-------------------------------------------------------------* MOVE OPPS-SUB-CHRG (LN-SUB) TO H-SUB-CHRG. IF H-PTRADIO-TOT-CHRGS > 0 THEN COMPUTE W-PTRADIO-CHRG-RATE ROUNDED = H-SUB-CHRG / H-PTRADIO-TOT-CHRGS ELSE MOVE 0 TO W-PTRADIO-CHRG-RATE END-IF. *-------------------------------------------------------------* * CALCULATE THE OFFSET AMOUNT TO BE APPLIED TO LINE * *-------------------------------------------------------------* COMPUTE W-PTRADIO-LINE-OFFSET ROUNDED = H-NUCMED-TOT-OFFSET * W-PTRADIO-CHRG-RATE. *-------------------------------------------------------------* * SUBTRACT THE APPLICABLE OFFSET FROM THE LINE PAYMENT * *-------------------------------------------------------------* COMPUTE H-LITEM-PYMT ROUNDED = H-LITEM-PYMT - W-PTRADIO-LINE-OFFSET. 10550-PTRADIO-OFFSET-EXIT. EXIT. *************************************************************** * * * ADJUST THE PASS-THROUGH CONTRAST AGENT PAYMENT BY * * ITS PROPORTION OF THE PT CONTRAST AGENT PROCEDURE OFFSET * * * * EFFECTIVE 01/01/2010, LOGIC ADDED 11/16/2009 * * * *************************************************************** 10550-PTCA-OFFSET. *-------------------------------------------------------------* * CAPTURE LINE DATE OF SERVICE * *-------------------------------------------------------------* MOVE OPPS-LITEM-DOS (LN-SUB) TO W-CAPROC-SRVC-DATE. *-------------------------------------------------------------* * SEARCH PT CONTRAST AGENT DAY TABLE FOR DATE OF SERVICE * *-------------------------------------------------------------* SET W-PTCA-DAY-INDX TO 1. SEARCH W-PTCA-DAY-ENTRY *-------------------------------------------------------------* * DATE OF SERVICE NOT FOUND IN TABLE, STOP PROCESS * *-------------------------------------------------------------* AT END GO TO 10550-PTCA-OFFSET-EXIT *-------------------------------------------------------------* * DATE OF SERVICE FOUND IN TABLE, TAKE OFFSET * *-------------------------------------------------------------* WHEN W-PTCA-DAY-LIDOS (W-PTCA-DAY-INDX) = W-CAPROC-SRVC-DATE *-------------------------------------------------------------* * CALCULATE PROPORTION OF TOTAL OFFSET TO BE APPLIED TO LINE * *-------------------------------------------------------------* * 12/20/2009 - ADDED LOGIC TO PREVENT DIVISION BY ZERO ERROR * *-------------------------------------------------------------* MOVE OPPS-SUB-CHRG (LN-SUB) TO H-SUB-CHRG IF W-PTCA-DAY-TOT-CHRGS (W-PTCA-DAY-INDX) > 0 COMPUTE W-PTCA-CHRG-RATE ROUNDED = H-SUB-CHRG / W-PTCA-DAY-TOT-CHRGS (W-PTCA-DAY-INDX) ELSE MOVE 0 TO W-PTCA-CHRG-RATE END-IF *-------------------------------------------------------------* * CALCULATE THE OFFSET AMOUNT TO BE APPLIED TO LINE * *-------------------------------------------------------------* COMPUTE W-PTCA-LINE-OFFSET ROUNDED = W-PTCA-DAY-TOT-OFFSET (W-PTCA-DAY-INDX) * W-PTCA-CHRG-RATE *-------------------------------------------------------------* * SUBTRACT THE APPLICABLE OFFSET FROM THE LINE PAYMENT * *-------------------------------------------------------------* IF H-LITEM-PYMT >= W-PTCA-LINE-OFFSET COMPUTE H-LITEM-PYMT ROUNDED = H-LITEM-PYMT - W-PTCA-LINE-OFFSET ELSE MOVE 0 TO H-LITEM-PYMT END-IF END-SEARCH. 10550-PTCA-OFFSET-EXIT. EXIT. *************************************************************** * * * ACCUMULATE TOTAL CLAIM CHARGES FROM DEVICE LINES * * * * *** DISABLED 08/11/2011 & REPLACED WITH NEW LOGIC *** * * * * EFFECTIVE 04/01/2002 A PRO RATA REDUCTION APPLIES TO ALL * * ALL SERVICE INDICATOR 'H' PAYMENTS (CURRENTLY .689) * * * * SERVICE INDICATOR OF 'H' = PASS-THROUGH DEVICES, * * THERAPEUTIC RADIOPHARMS * * * *************************************************************** *9555-CALC-H-TOT. * *-------------------------------------------------------------* * SET THE SERVICE LINE SUBSCRIPT TO THE CLAIM SERVICE LINE * * ASSOCIATED WITH THE COINSURANCE DEDUCTIBLE TABLE RECORD * *-------------------------------------------------------------* * MOVE W-LP-SUB (W-LP-INDX) TO LN-SUB. * *-------------------------------------------------------------* * ACCUMULATE TOTAL CLAIM DEVICE CHARGES FOR DEVICE LINES * *-------------------------------------------------------------* * 11/13/2008 - MODIFIED LOGIC TO PROCESS DEVICE LINES ONLY * * (EXCLUDE THERAPEUTIC RADIOPHARMS) * * 11/16/2009 REMOVED LOGIC THAT EXCLUDES THERAP. RADIOS * * (THERAP. RADIOS DO NOT HAVE AN SI=H CY 2010) * *-------------------------------------------------------------* * MOVE OPPS-SUB-CHRG (LN-SUB) TO H-SUB-CHRG. * * IF OPPS-SRVC-IND (LN-SUB) = ' H' AND * OPPS-PYMT-IND (LN-SUB) = ' 6' * COMPUTE H-TOT-H-CHRG = * (H-TOT-H-CHRG + H-SUB-CHRG) * END-IF. * *9555-CALC-H-TOT-EXIT. * EXIT. *************************************************************** * * * CALCULATE PAYMENT FOR PAID AT COST LINES * * (PAYMENT BASED ON CHARGE ADJUSTED TO COST) * * UPDATE PASS-THROUGH DEVICE TABLE * * * *-------------------------------------------------------------* * * * 08-11-2010 - PASS-THROUGH DEVICE OFFSET LOGIC REVISED * * * *************************************************************** 10555-CALC-H-STANDARD. *-------------------------------------------------------------* * SET LINE ITEM PAYMENT TO LINE COST - "PAID AT COST" * *-------------------------------------------------------------* MOVE OPPS-SUB-CHRG (LN-SUB) TO H-SUB-CHRG. COMPUTE T-LITEM-PYMT ROUNDED = (H-SUB-CHRG * L-PSF-OPCOST-RATIO). *-------------------------------------------------------------* * SEARCH THE PTDO HCPCS TABLE FOR THE CURRENT LINE HCPCS, * * IF FOUND APPLY THE OFFSET * *-------------------------------------------------------------* SET W-PTDO-HCPCS-INDX TO 1. SEARCH W-PTDO-HCPCS-ENTRY AT END CONTINUE WHEN W-PTDO-HCPCS-HCPCS (W-PTDO-HCPCS-INDX) = OPPS-HCPCS (LN-SUB) AND W-PTDO-HCPCS-LNSUB (W-PTDO-HCPCS-INDX) = LN-SUB PERFORM 10556-CALC-PTDO-OFFSET THRU 10556-CALC-PTDO-OFFSET-EXIT. *-------------------------------------------------------------* * CAPTURE PAYMENT AMOUNT * *-------------------------------------------------------------* IF T-LITEM-PYMT < 0 THEN MOVE 0 TO H-LITEM-PYMT ELSE MOVE T-LITEM-PYMT TO H-LITEM-PYMT. *-------------------------------------------------------------* * UPDATE PASS-THROUGH DEVICE TABLE WITH LINE ITEM PAYMENT OF * * DEVICE LINE (CHARGES CONVERTED TO COST LESS APPLICABLE * * OFFSET AMOUNT) * * WHEN PTD-FLAG = 'Y', A PASS-THROUGH DEVICE IS ON THE CLAIM * *-------------------------------------------------------------* * 11/16/2009 REMOVED LOGIC THAT EXCLUDES THERAP. RADIOS * * (THERAP. RADIOS DO NOT HAVE AN SI=H CY 2010) * *-------------------------------------------------------------* IF PTD-FLAG = 'Y' AND OPPS-SRVC-IND (LN-SUB) = ' H' PERFORM 10557-LOAD-PTD-LINE-PYMT THRU 10557-LOAD-PTD-LINE-PYMT-EXIT END-IF. *************************************************************** * OLD PASS-THROUGH DEVICE OFFSET LOGIC * * LOGIC DISABLED & REPLACED * *************************************************************** * WAGE ADJUST 60% OF THE CLAIM TOTAL DEVICE OFFSET AMOUNT * * (OFFSET AMOUNTS ARE COSTS, NOT CHARGES) * * (C-FLAG = Y MEANS THERE IS A DEVICE ON THE CLAIM) * *-------------------------------------------------------------* * 11/13/2008 - MODIFIED LOGIC TO PROCESS DEVICES ONLY * * (EXCLUDE BRACHYS & THERAPEUTIC RADIOPHARMS) * * 11/16/2009 REMOVED LOGIC THAT EXCLUDES THERAP. RADIOS * * (THERAP. RADIOS DO NOT HAVE AN SI=H CY 2010) * *-------------------------------------------------------------* * IF C-FLAG = 'Y' AND * OPPS-SRVC-IND (LN-SUB) = ' H' * *-------------------------------------------------------------* * OTHER LINES ON THE CLAIM BESIDES DEVICE LINES ARE OFFSET; * * CALCULATE DEVICE PORTION OF THE TOTAL WAGE ADJUSTED OFFSET * *-------------------------------------------------------------* * IF (H-TOT-OFF-UNITS > H-TOT-HTD-UNITS) * COMPUTE H-TOTAL-WAOFF ROUNDED = * (((H-TOTAL-OFFSET * .60) * A-WINX) + * (H-TOTAL-OFFSET * .40)) * * (H-TOT-HTD-UNITS / H-TOT-OFF-UNITS) * PERFORM 10700-CALC-H-OFFSET * THRU 10700-CALC-H-OFFSET-EXIT * ELSE * *-------------------------------------------------------------* * ONLY DEVICE LINES ON THE CLAIM ARE OFFSET; * * WAGE ADJUST THE TOTAL CLAIM OFFSET AMOUNT * *-------------------------------------------------------------* * COMPUTE H-TOTAL-WAOFF ROUNDED = * ((H-TOTAL-OFFSET * .60) * A-WINX) + * (H-TOTAL-OFFSET * .40) * PERFORM 10700-CALC-H-OFFSET * THRU 10700-CALC-H-OFFSET-EXIT * *-------------------------------------------------------------* * THERE IS NO DEVICE ON THE CLAIM * *-------------------------------------------------------------* * ELSE * NEXT SENTENCE. * * IF T-LITEM-PYMT < 0 THEN * MOVE 0 TO H-LITEM-PYMT * ELSE * MOVE T-LITEM-PYMT TO H-LITEM-PYMT. 10555-CALC-H-STANDARD-EXIT. EXIT. *************************************************************** * * * REDUCE LINE ITEM PAYMENTS OF PASS-THROUGH DEVICES THAT * * HAVE AN ASSOCIATED PROCEDURE ON THE CLAIM BY THE PROCEDURE * * WAGE-ADJUSTED OFFSET AMOUNT * * * *************************************************************** * * * ** EFFECTIVE 10/01/2010 - REVISED PT DEVICE OFFSET LOGIC * * * *************************************************************** 10556-CALC-PTDO-OFFSET. *-------------------------------------------------------------* * SEARCH PTDO PROCEDURE TABLE FOR THE PT DEVICE HCPCS LINE * *-------------------------------------------------------------* SET W-PTDO-PROC-INDX TO 1. SEARCH W-PTDO-PROC-ENTRY AT END GO TO 10556-CALC-PTDO-OFFSET-EXIT *-------------------------------------------------------------* * CURRENT PT DEVICE LINE'S ASSOCIATED PROCEDURE FOUND * *-------------------------------------------------------------* WHEN W-PTDO-PROC-APC (W-PTDO-PROC-INDX) = W-PTDO-HCPCS-PROC-APC (W-PTDO-HCPCS-INDX) AND W-PTDO-PROC-LNSUB (W-PTDO-PROC-INDX) = W-PTDO-HCPCS-PROC-LNSUB (W-PTDO-HCPCS-INDX) *-------------------------------------------------------------* * DETERMINE HOW MANY PROCEDURE UNITS WILL BE ALLOCATED * *-------------------------------------------------------------* IF W-PTDO-PROC-UNITS (W-PTDO-PROC-INDX) <= W-PTDO-PROC-TOT-DUNITS (W-PTDO-PROC-INDX) MOVE W-PTDO-PROC-UNITS (W-PTDO-PROC-INDX) TO W-DOPROC-UNITS ELSE MOVE W-PTDO-PROC-TOT-DUNITS (W-PTDO-PROC-INDX) TO W-DOPROC-UNITS END-IF *-------------------------------------------------------------* * DETERMINE WHAT % OF THE OFFSET WILL BE APPLIED * *-------------------------------------------------------------* IF W-PTDO-PROC-TOT-DCHRGS (W-PTDO-PROC-INDX) > 0 COMPUTE W-PTDO-CHRG-RATE ROUNDED = W-PTDO-HCPCS-SUB-CHRG (W-PTDO-HCPCS-INDX) / W-PTDO-PROC-TOT-DCHRGS (W-PTDO-PROC-INDX) ELSE GO TO 10556-CALC-PTDO-OFFSET-EXIT END-IF *-------------------------------------------------------------* * CALCULATE THE OFFSET AMOUNT TO BE TAKEN * *-------------------------------------------------------------* COMPUTE W-PTDO-LINE-OFFSET ROUNDED = W-PTDO-CHRG-RATE * W-DOPROC-UNITS * W-PTDO-PROC-WA-OFFSET (W-PTDO-PROC-INDX) *-------------------------------------------------------------* * SUBTRACT THE OFFSET AMOUNT FROM THE LINE PAYMENT * *-------------------------------------------------------------* IF W-PTDO-LINE-OFFSET <= T-LITEM-PYMT COMPUTE T-LITEM-PYMT ROUNDED = T-LITEM-PYMT - W-PTDO-LINE-OFFSET END-IF. 10556-CALC-PTDO-OFFSET-EXIT. EXIT. *************************************************************** * * * UPDATE PASS-THROUGH DEVICE TABLE WITH CHARGES FOR THE * * DEVICE LINE (LINE ITEM PAYMENT LESS OFFSET CONVERTED TO * * CHARGES) * * (FOR ASSOCIATED PROCEDURE OUTLIER CALCULATION) * * * *************************************************************** 10557-LOAD-PTD-LINE-PYMT. *-------------------------------------------------------------* * SEARCH PTD TABLE STARTING AT ENTRY #1 FOR THE RECORD THAT * * CORRESPONDS TO THE CURRENT SERVICE LINE * *-------------------------------------------------------------* SET W-PTD-INDX TO 1. SEARCH W-PTD-ENTRY VARYING W-PTD-INDX *-------------------------------------------------------------* * IF THE SERVICE LINE'S PAYMENT ADJUSTMENT FLAG IS NOT * * ALREADY IN THE TABLE, ADD IT * *-------------------------------------------------------------* AT END GO TO 10557-LOAD-PTD-LINE-PYMT-EXIT *-------------------------------------------------------------* * IF THE LINE'S HCPCS IS IN THE TABLE, CALCULATE THE LINE'S * * CHARGES AND PLACE INTO TABLE (FOR H LINES, THE PAYMENT IS * * CONVERTED TO COST AND OFFSET. HERE, THE PAYMENT IS * * CONVERTED BACK INTO CHARGES BY DIVIDING IT BY THE COST TO * * CHARGE RATIO.) * *-------------------------------------------------------------* WHEN W-PTD-SUB (W-PTD-INDX) = LN-SUB MOVE H-LITEM-PYMT TO W-PTD-LITEM-PYMT (W-PTD-INDX) END-SEARCH. 10557-LOAD-PTD-LINE-PYMT-EXIT. EXIT. *************************************************************** * * * CALCULATE THE BENEFICIARY DEDUCTIBLE AMOUNT THAT WILL BE * * APPLIED TO THE SERVICE LINES IN THE DEDUCTIBLE TABLE * * * * (THE DEDUCTIBLE IS APPLIED TO THE LOWEST TO HIGHEST RANKED * * APCS. THE LOWER THE RANK, THE HIGHER THE COINSURANCE %. * * THE TOTAL CLAIM BENEFICIARY COINSURANCE AMOUNT IS CHEAPER * * WHEN THE DEDUCTIBLE IS APPLIED IN THIS ORDER.) * * * *************************************************************** 10560-CALC-BENE-DEDUCT. *-------------------------------------------------------------* * LINES INELIGIBLE FOR DEDUCTIBLE SKIP DEDUCTIBLE CALCULATION * * EFF. 7/1/2009 - CLINICAL TRIAL LINES FOR MANAGED CARE BENES * * ASSIGNED A PAF = ' 4' * * - 04/11/2011 - ADDED PAF 9 FOR SERVICES WHERE THE * * DEDUCTIBLE AND CO-INSURANCE ARE NOT APPLICABLE * * (ADDED FOR PREVENTIVE SERVICES WAIVER IN CY 2011) * *-------------------------------------------------------------* IF OPPS-PYMT-ADJ-FLAG (LN-SUB) = (' 4' OR ' 9') GO TO 10560-CALC-BENE-DEDUCT-EXIT. *-------------------------------------------------------------* * BENEFICIARY HAS NOT MET HIS/HER DEDUCTIBLE LIMIT. * * CALCULATE THE "LINE BLOOD PAYMENT" * *-------------------------------------------------------------* IF H-BENE-DEDUCT > 0 THEN COMPUTE H-LN-BLD-PYMT = H-LITEM-PYMT - H-LN-BLOOD-DEDUCT *-------------------------------------------------------------* * BENEFICIARY'S DEDUCTIBLE DOES NOT COVER OR JUST COVERS THE * * ENTIRE LINE BLOOD PAYMENT: * * - BENEFICIARY'S REMAINING DEDUCTIBLE AMT APPLIED TO LINE * * - BENEFICIARY HAS REACHED HIS/HER DEDUCTIBLE LIMIT * *-------------------------------------------------------------* IF H-BENE-DEDUCT <= H-LN-BLD-PYMT THEN MOVE H-BENE-DEDUCT TO H-TOTAL-LN-DEDUCT MOVE 0 TO H-BENE-DEDUCT *-------------------------------------------------------------* * BENEFICIARY'S DEDUCTIBLE MORE THAN COVERS THE LINE BLOOD * * PAYMENT, DO THE FOLLOWING: * * - CALCULATE THE BENEFICIARY'S REMAINING DEDUCTIBLE AMOUNT * * AFTER PAYING FOR CURRENT SERVICE LINE * * - MEDICARE LINE PAYMENT = 0 * *-------------------------------------------------------------* ELSE COMPUTE H-BENE-DEDUCT = H-BENE-DEDUCT - H-LN-BLD-PYMT MOVE H-LN-BLD-PYMT TO H-TOTAL-LN-DEDUCT MOVE 20 TO A-RETURN-CODE (LN-SUB) END-IF END-IF. 10560-CALC-BENE-DEDUCT-EXIT. EXIT. *************************************************************** * * * CALCULATE OUTLIER PAYMENT * * ** CHANGE OUTLIER THRESHOLD EVERY JANUARY (HARD-CODED) ** * * * *************************************************************** * * * LOOP THROUGH THE COINSURANCE DEDUCTIBLE TABLE TO DO THE * * FOLLOWING FOR EACH SERVICE LINE: * * * * - DETERMINE IF THE LINE IS ELIGIBLE FOR AN OUTLIER PAYMENT * * - ADJUST CHARGES FOR LINES WITH ARTIFICIAL CHARGES ON CLAIM * * - DISTRIBUTE TOTAL CLAIM PACKAGED LINE CHARGES TO NON- * * PACKAGED PAYABLE LINES * * - ADJUST CHARGES OF PRIME CODE COMPOSITE APC LINES * * - ADJUST CHARGES OF MENTAL HEALTH LINES (APC = 34) * * - CALCULATE THE LINE OUTLIER PAYMENT FOR ELIGIBLE LINES * * * * * * NOTES: * * ------ * * - NEW FOR JANUARY 2004: * * - CHECK >= 20040101 AND SRVC-IND = 'K' * * - DISCONTINUE OUTLIER PROCESS * * * * - NEW FOR JANUARY 2008: * * - REVISED LOGIC FOR DETERMINING WHICH LINES WITH SRVC-IND * * = 'K' ARE ELIGIBLE FOR AN OUTLIER PAYMENT. THIS WAS * * NECESSARY B/C SOME RADIOPHARMS & ALL BRACHYTHERAPIES * * SRVC-IND = 'K' STARTING CY 2008. * * - PER LEGISLATION, BRACHYTHERAPY & RADIOPARM LINES' * * STATUS INDICATOR CHANGED BACK TO ' H' FOR CY 2008 QTR 1 * * ' K' LOGIC RETAINED B/C IT WILL NOT AFFECT PAYMENTS TO * * BRACHYTHERAPY OR RADIOPHARM LINES * * - COMPOSITE APC AND MENTAL HEALTH LINE CHARGE CALCS * * * * - NEW FOR APRIL 2008: ADD CHARGES AND PAYMENTS OF * * - PASS-THROUGH DEVICES TO THE CHARGES AND PAYMENTS OF * * PROCEDURES ELIGIBLE FOR THE DEVICES * * - A-LITEM-PYMT MOVED TO H-LITEM-PYMT-OUTL B/C PAYMENTS * * ARE ADJUSTED FOR PASS-THROUGH DEVICES FOR OUTLIER * * DETERMINATION ONLY * * * * - NEW FOR JULY 2008: BRACHYTHERAPY AND THERAPEUTIC * * RADIOPHARM LINES' SI CHANGED TO ' K'. BRACHYTHERAPY * * LINES ARE NOW ELIGIBLE FOR AN OUTLIER PAYMENT. * * * * - JULY 2008: DUE TO LEGISLATION, THERAPEUTIC RADIOPHARMS * * & BRACHYTHERAPY SOURCE'S SI CHANGED FROM 'K' BACK TO 'H' * * EFFECTIVE 7/1/2008; THESE LINES ARE NOT YET ELIGIBLE FOR * * AN OUTLIER PAYMENT. * * * * - 11/12/2008: FOR CY 2009, BRACHYS SI = U AND BLOOD SI = R * * BRACHY INELIGIBLE FOR OUTLIER, BLOOD ELIGIBLE FOR OUTLIER * * * * - 12/05/2008: ADDED SI = K TO LIST OF SIS INELIGIBLE FOR * * OUTLIER (BRACHYS & BLOOD NO LONGER HAVE SI = K) * * * * - 11/17/2009: REMOVED U FROM LIST OF SIS INELIGIBLE FOR * * OUTLIER; BRACHYS NOW ELIGIBLE B/C NOT PAID AT COST CY 2010* * * * - 12/16/2009: ADDED SIS R AND U TO LOGIC THAT DISTRIBUTES * * PACKAGED CHARGES TO PAYABLE LINES. V2010.1.2 * * * * - 11/04/2011: MODIFIED LOGIC TO APPLY THE PHP CAP ONLY TO * * PHP CMHC LINES, NOT PHP HOSPITAL LINES PER POLICY'S * * INSTRUCTIONS * * * *************************************************************** 10600-ADJ-CHRG-OUTL. *-------------------------------------------------------------* * GO TO SERVICE LINE ASSOCIATED WITH THE CURRENT COINSURANCE * * DEDUCTIBLE TABLE RECORD * *-------------------------------------------------------------* MOVE W-LP-SUB (W-LP-INDX) TO LN-SUB. *-------------------------------------------------------------* * LINES WITH SERVICE INDICATORS NOT ELIGIBLE FOR AN OUTLIER * * PAYMENT AND LINES PACKAGED AS PART OF DRUG ADMINISTRATION * * APC PAYMENT BYPASS OUTLIER CALCULATION * * (DRUGS, DEVICES, PACKAGED SERVICES, BIOLOGICALS) * *-------------------------------------------------------------* * *** ENSURE ALL SIS ELIGIBLE FOR AN OUTLIER PAYMENT ARE *** * * *** LISTED IN THE LOGIC BELOW THAT DISTRIBUTES PACKAGED *** * * *** CHARGES TO PAYABLE LINES AND IN THE SUMMING LOGIC *** * * *** IN PARAGRAPH _500-ADJ-CHRGS. *** * *-------------------------------------------------------------* * 11/12/2008 - BRACHY (SI=U) ADDED TO LIST * * 12/05/2008 - SI K ADDED TO THE LIST * * 11/16/2009 - REMOVED PAF=2 FROM BRACHY (SI=U) CRITERIA * * 11/17/2009 - REMOVE SI=U, BRACHYS ARE ELIGIBLE FOR OUTLIER * *-------------------------------------------------------------* IF (OPPS-SRVC-IND (LN-SUB) = ' G' OR ' H' OR ' N' OR ' K') OR (OPPS-PKG-FLAG (LN-SUB) = '4') GO TO 10600-ADJ-CHRG-OUTL-EXIT. *-------------------------------------------------------------* * DISTRIBUTE TOTAL CLAIM PROCEDURE CHARGES TO PROCEDURE LINES * * IN PROPORTION TO THE PROCEDURE LINES' PAYMENTS WHEN THERE * * ARE ARTIFICIAL PROCEDURE CHARGES (< $1.01) ON THE CLAIM. * * (DISTRIBUTED CHARGES REPLACE BILLED CHARGES) * *-------------------------------------------------------------* * NOTE: LINES WITH CHARGES < $1.01 ARE FIXED BY FISS BEFORE * * ENTERING THE PRICER. THEREFORE, THIS LOGIC IS NO * * LONGER NECESSARY. THIS LOGIC WAS NECESSARY BEFORE * * FISS IMPLEMENTED THE FIX. * *-------------------------------------------------------------* IF (ST0-FLAG = 'Y') AND ((OPPS-SRVC-IND (LN-SUB) = ' T') OR ((OPPS-SRVC-IND (LN-SUB) = ' S') AND (OPPS-HCPCS (LN-SUB) > '09999' AND OPPS-HCPCS (LN-SUB) < '70000'))) AND (H-TOT-ST-PYMT > 0) COMPUTE H-CHRG-RATE ROUNDED = (A-LITEM-PYMT (LN-SUB) / H-TOT-ST-PYMT) COMPUTE W-SUB-CHRG (W-LP-INDX) ROUNDED = (H-CHRG-RATE * H-TOT-ST-CHRG) *-------------------------------------------------------------* * DISTRIBUTE TOTAL CLAIM PACKAGED LINE CHARGES TO SEPARATELY * * PAYABLE LINES IN PROPORTION TO THEIR PAYMENTS WHEN THERE * * ARE NO ARTIFICIAL PROCEDURE CHARGES (< $1.01) ON THE CLAIM. * * (DISTRIBUTED CHARGES ARE ADDED TO THE BILLED CHARGES) * *-------------------------------------------------------------* * 12/16/2009 - ADDED SIS R AND U TO LOGIC * *-------------------------------------------------------------* ELSE IF (N-FLAG = 'Y' AND ST0-FLAG = 'N') AND ((OPPS-SRVC-IND (LN-SUB) = ' S' OR ' T' OR ' V' OR ' X' OR ' P' OR ' R' OR ' U') AND (OPPS-PKG-FLAG (LN-SUB) = '0' OR '3')) AND (H-TOT-STVX-PYMT > 0) COMPUTE H-CHRG-RATE ROUNDED = (A-LITEM-PYMT (LN-SUB) / H-TOT-STVX-PYMT) COMPUTE H-SUB-CHRG ROUNDED = (H-CHRG-RATE * H-TOT-N-CHRG) COMPUTE W-SUB-CHRG (W-LP-INDX) ROUNDED = W-SUB-CHRG (W-LP-INDX) + H-SUB-CHRG. *-------------------------------------------------------------* * DISTRIBUTE TOTAL CLAIM PACKAGED LINE CHARGES TO SEPARATELY * * PAYABLE LINES IN PROPORTION TO THEIR PAYMENTS WHEN THERE * * ARE ARTIFICIAL PROCEDURE CHARGES (< $1.01) ON THE CLAIM. * * (DISTRIBUTED CHARGES ARE ADDED TO THE BILLED CHARGES) * *-------------------------------------------------------------* * NOTE: LINES WITH CHARGES < $1.01 ARE FIXED BY FISS BEFORE * * ENTERING THE PRICER. THEREFORE, THIS LOGIC IS NO * * LONGER NECESSARY. THIS LOGIC WAS NECESSARY BEFORE * * FISS IMPLEMENTED THE FIX. * *-------------------------------------------------------------* * 12/16/2009 - ADDED SIS R AND U TO LOGIC * *-------------------------------------------------------------* IF (N-FLAG = 'Y' AND ST0-FLAG = 'Y') AND ((OPPS-SRVC-IND (LN-SUB) = ' S' OR ' T' OR ' V' OR ' X' OR ' P' OR ' R' OR ' U') AND (OPPS-PKG-FLAG (LN-SUB) = '0' OR '3')) AND (H-TOT-STVX-PYMT > 0) COMPUTE H-CHRG-RATE ROUNDED = (A-LITEM-PYMT (LN-SUB) / H-TOT-STVX-PYMT) COMPUTE H-SUB-CHRG ROUNDED = (H-CHRG-RATE * H-TOT-N-CHRG) COMPUTE W-SUB-CHRG (W-LP-INDX) ROUNDED = W-SUB-CHRG (W-LP-INDX) + H-SUB-CHRG. *************************************************************** * CALCULATE COMPOSITE APC CHARGES FOR PRIME CODE LINES * * * * THE CHARGES OF ALL PACKAGED LINES WITH A COMPOSITE ADJ. * * FLAG THAT INDICATES THE LINE IS A PART OF A COMPOSITE APC * * (VALUES 01 - NN...) ARE ACCUMULATED BY COMPOSITE * * ADJUSTMENT FLAG AND ADDED TO THE CORRESPONDING PRIME * * (PAYABLE) LINE'S CHARGES. * *-------------------------------------------------------------* * 11/29/2007 - LOGIC ADDED FOR CY 2008 * * 12/14/2007 - ROUNDED W-SUB-CHRG WHEN ADDING COMPOSITES * * 11/12/2008 - CHANGED LOGIC TO USE THE COMPOSITE ADJUSTMENT * * FLAG INSTEAD OF THE PAYMENT ADJUSTMENT FLAG * * VALUES 91 - 99 TO ID PRIME COMPOSITE LINES * *************************************************************** *-------------------------------------------------------------* * COMPOSITE ADJUSTMENT FLAG > 0 INDICATES COMPOSITE APC * *-------------------------------------------------------------* IF OPPS-COMP-ADJ-FLAG (LN-SUB) NOT = '00' *-------------------------------------------------------------* * SEARCH COMPOSITE APC TABLE STARTING AT ENTRY #1 * *-------------------------------------------------------------* MOVE OPPS-COMP-ADJ-FLAG (LN-SUB) TO H-CMP-CAF SET W-CMP-INDX TO 1 SEARCH W-CMP-ENTRY VARYING W-CMP-INDX *-------------------------------------------------------------* * SERVICE LINE'S PAYMENT ADJUSTMENT FLAG NOT IN TABLE * *-------------------------------------------------------------* AT END ADD 0 TO W-SUB-CHRG (W-LP-INDX) *-------------------------------------------------------------* * SERVICE LINE'S PAYMENT ADJUSTMENT FLAG IS IN TABLE, * * ADD THE PACKAGED SUBMITTED CHARGES TO THE LINE'S CHARGES * *-------------------------------------------------------------* WHEN W-CMP-PAF (W-CMP-INDX) = H-CMP-CAF COMPUTE W-SUB-CHRG (W-LP-INDX) ROUNDED = W-SUB-CHRG (W-LP-INDX) + W-CMP-TOT-SUB-CHRG (W-CMP-INDX) END-IF. *************************************************************** * CALCULATE TOTAL MENTAL HEALTH CHARGES FOR APC 34 LINES * * * * THE CHARGES OF PACKAGED LINES WITH A PACKAGING FLAG OF '2' * * ON A CLAIM WITH APC 34 (MENTAL HEALTH APC) ARE ACCUMULATED * * AND ADDED TO THE SEPARATELY PAYABLE APC 34 LINE'S CHARGES. * *-------------------------------------------------------------* * 11/29/2007 - LOGIC ADDED FOR CY 2008 * * 11/12/2008 - LOGIC DISABLED FOR CY 2009 BECAUSE MENTAL * * HEALTH COMPOSITES ARE NOW PROCESSED THE SAME * * AS ALL OTHER COMPOSITES USING THE COMPOSITE * * ADJUSTMENT FLAG * *************************************************************** * IF APC34-FLAG = 'Y' AND OPPS-APC (LN-SUB) = '0034' * COMPUTE W-SUB-CHRG (W-LP-INDX) = * W-SUB-CHRG (W-LP-INDX) + * H-TOT-MH-CHRG * END-IF. *************************************************************** * MOVE LINE PAYMENTS TO HOLD FIELD BECAUSE PAYMENTS MAY BE * * ADJUSTED FOR PASS-THROUGH DEVICES - ADDED 02/14/2008 * * NEW FOR CY 2009 - ALWAYS USE THE PHP "CAP" APC'S WAGE ADJ * * PMT FOR PHP LINES (SI=P) * *-------------------------------------------------------------* * 11/04/2011 - ONLY APPLY PHP "CAP" TO CMHC LINES; PER * * POLICY'S INSTRUCTIONS PHP HOSPITAL LINES ARE * * NOT CAPPED. * *************************************************************** MOVE ZEROS TO H-LITEM-PYMT-OUTL. IF OPPS-SRVC-IND (LN-SUB) = ' P' AND ( (L-PSF-PROV-3456 >= '1400' AND L-PSF-PROV-3456 <= '1499') OR (L-PSF-PROV-3456 >= '4600' AND L-PSF-PROV-3456 <= '4799') OR (L-PSF-PROV-3456 >= '4900' AND L-PSF-PROV-3456 <= '4999') ) MOVE H-PHP-LITEM-PYMT-OUTL TO H-LITEM-PYMT-OUTL ELSE MOVE A-LITEM-PYMT (LN-SUB) TO H-LITEM-PYMT-OUTL END-IF. *************************************************************** * CALCULATE TOTAL CHARGES AND PAYMENTS FOR PROCEDURE LINES * * ELIGIBLE FOR PASS-THROUGH DEVICE(S) * * * * THE CHARGES AND LINE PAYMENTS OF PASS-THROUGH DEVICE LINES * * ARE ADDED TO THE CHARGES AND PAYMENTS OF ALL PROCEDURES * * ELIGIBLE TO BE BILLED WITH THE PASS-THROUGH DEVICE. * * (PTD-FLAG = 'Y' INDICATES THERE IS AT LEAST ONE * * PASS-THROUGH DEVICE ON THE CLAIM) * *-------------------------------------------------------------* * 02/12/2008 - LOGIC ADDED FOR CY 2008 QTR 2 * *************************************************************** IF (PTD-FLAG = 'Y') AND (OPPS-SRVC-IND (LN-SUB) = ' S' OR ' T' OR ' V' OR ' X') *-------------------------------------------------------------* * DETERMINE WHETHER THE LINE IS ELIGIBLE FOR A PT DEVICE * *-------------------------------------------------------------* PERFORM 10670-SET-PTD-PROC-FLAG THRU 10670-SET-PTD-PROC-FLAG-EXIT *-------------------------------------------------------------* * PROCEDURE IS ELIGIBLE FOR A PASS-THROUGH DEVICE * *-------------------------------------------------------------* * 11/12/2008 - EDITED TO LOOK AT PTD-PROC-FLAG, NOT PTD-FLAG * * NO HARM DONE USING THE PTD-FLAG PREVIOUSLY * *-------------------------------------------------------------* IF PTD-PROC-FLAG = 'Y' *-------------------------------------------------------------* * LOOP THROUGH ELIGIBLE PROCEDURE'S PASS-THROUGH DEVICE TABLE * * GET THE PASS-THROUGH DEVICE HCPCS(S) FOR WHICH THE * * PROCEDURE IS ELIGIBLE & UPDATE PROCEDURE CHARGES & PAYMENTS * *-------------------------------------------------------------* PERFORM 10610-PERFORM-SEARCH THRU 10610-PERFORM-SEARCH-EXIT VARYING W-PTD-PROC-SUB FROM 1 BY 1 UNTIL W-PTD-PROC-SUB > W-PTD-CNT END-IF END-IF. *************************************************************** * * * CALCULATE THE OUTLIER PAYMENT FOR ELIGIBLE LINES * * * * -NEW FOR JANUARY 2005 * * - PROVIDER RANGE FOR CMHC * * - COMPUTE H-LITEM-OUTL-PYMT USING NEW FORMULA * * - CHANGE OUTLIER THRESHOLD AMOUNT EVERY JANUARY * * * * -NEW FOR APRIL 2008 * * - A-LITEM-PYMT (LN-SUB) CHANGED TO H-LITEM-PYMT-OUTL B/C * * PAYMENTS ARE NOW ADJUSTED FOR OUTLIER DETERMINATION * * * * -NEW FOR JANUARY 2009 * * - ALL PARTIAL HOSPITALIZATION (PHP) LINES (SI=P) USE * * THE PHP "CAP" APC'S LINE PAYMENT * * * *************************************************************** MOVE 1.75 TO H-OUTLIER-FACTOR. MOVE .50 TO H-OUTLIER-PCT. COMPUTE H-COST ROUNDED = W-SUB-CHRG (W-LP-INDX) * L-PSF-OPCOST-RATIO. COMPUTE H-APC-ADJ-PYMT ROUNDED = H-OUTLIER-FACTOR * H-LITEM-PYMT-OUTL. *-------------------------------------------------------------* * IDENTIFY COMMUNITY MENTAL HEALTH CENTER (CMHC) PROVIDERS * * FOR CMHCS, INCREASE OUTLIER FACTOR & CALC LINE OUTLIER PMT * * (CMHC PROVIDERS ONLY PROCESS PARTIAL HOSPITALIZATION LINES) * *-------------------------------------------------------------* IF (L-PSF-PROV-3456 >= '1400' AND L-PSF-PROV-3456 <= '1499') OR (L-PSF-PROV-3456 >= '4600' AND L-PSF-PROV-3456 <= '4799') OR (L-PSF-PROV-3456 >= '4900' AND L-PSF-PROV-3456 <= '4999') MOVE 3.4 TO H-OUTLIER-FACTOR COMPUTE H-LITEM-OUTL-PYMT ROUNDED = (H-COST - (H-OUTLIER-FACTOR * H-LITEM-PYMT-OUTL)) * H-OUTLIER-PCT *-------------------------------------------------------------* * FOR NON-CMHC PROVIDERS, LINE'S OUTLIER ELIGIBILITY & * * CALCULATE OUTLIER PAYMENT IF ELIGIBLE * * ** UPDATE THE LITERAL NUMBER BELOW EACH JANUARY ** * *-------------------------------------------------------------* ELSE IF (H-COST > H-APC-ADJ-PYMT) AND (H-COST > H-LITEM-PYMT-OUTL + 2025) COMPUTE H-LITEM-OUTL-PYMT ROUNDED = (H-COST - H-APC-ADJ-PYMT) * H-OUTLIER-PCT ELSE MOVE ZERO TO H-LITEM-OUTL-PYMT END-IF END-IF. *-------------------------------------------------------------* * ACCUMULATE TOTAL CLAIM OUTLIER PAYMENTS * *-------------------------------------------------------------* IF H-LITEM-OUTL-PYMT > 0 COMPUTE H-OUTLIER-PYMT = H-OUTLIER-PYMT + H-LITEM-OUTL-PYMT. *-------------------------------------------------------------* * LINES THAT RECEIVE AN EXTERNAL ADJUSTMENT ARE NOT ELIGIBLE * * FOR AN OUTLIER PAYMENT - ZERO OUT PAYMENT & REMOVE FROM * * CLAIM TOTAL * *-------------------------------------------------------------* IF OPPS-LITEM-ACT-FLAG (LN-SUB) = '4' COMPUTE H-OUTLIER-PYMT = H-OUTLIER-PYMT - H-LITEM-OUTL-PYMT MOVE 0 TO H-LITEM-OUTL-PYMT. 10600-ADJ-CHRG-OUTL-EXIT. EXIT. *************************************************************** * * * SEARCH THE PASS-THROUGH DEVICE TABLE FOR THE PASS-THROUGH * * DEVICE(S) THE PROCEDURE IS ELIGIBLE FOR * * * *************************************************************** 10610-PERFORM-SEARCH. *-------------------------------------------------------------* * SEARCH PTD TABLE STARTING AT ENTRY #1 FOR ALL OCCURANCES * * OF THE PASS-THRU DEVICE HCPCS IN THE PASS-THRU DEVICE TABLE.* * THIS IS DONE FOR ALL PASS-THROUGH DEVICES THE PROCEDURE IS * * ELIGIBLE FOR. * *-------------------------------------------------------------* MOVE 'N' TO W-END-OF-PTD-TBL. IF W-PTD-PROC-HCPCS (W-PTD-PROC-SUB) NOT = ' ' SET W-PTD-INDX TO 1 PERFORM 10611-SEARCH-PTD-HCPCS THRU 10611-SEARCH-PTD-HCPCS-EXIT UNTIL W-END-OF-PTD-TBL = 'Y' END-IF. 10610-PERFORM-SEARCH-EXIT. EXIT. *************************************************************** * * * SEARCH FOR THE PASS-THROUGH DEVICE FOR WHICH THE PROCEDURE * * IS ELIGIBLE IN THE TABLE & UPDATE PROCEDURE LINE PAYMENTS * * AND CHARGES * * * *************************************************************** 10611-SEARCH-PTD-HCPCS. MOVE 'N' TO W-END-OF-PTD-TBL. *-------------------------------------------------------------* * SEARCH PASS-THROUGH DEVICE TABLE * *-------------------------------------------------------------* SEARCH W-PTD-ENTRY VARYING W-PTD-INDX *-------------------------------------------------------------* * IF THERE ARE NO MORE OCCURANCES OF THE PASS-THROUGH DEVICE, * * STOP THE SEARCH AND INDICATE END OF FILE * *-------------------------------------------------------------* AT END MOVE 'Y' TO W-END-OF-PTD-TBL GO TO 10611-SEARCH-PTD-HCPCS-EXIT *-------------------------------------------------------------* * IF THE PASS-THROUGH DEVICE IS FOUND, INDICATE NOT END OF * * FILE AND UPDATE THE PROCEDURE'S CHARGES AND PAYMENTS * *-------------------------------------------------------------* WHEN W-PTD-HCPCS (W-PTD-INDX) = W-PTD-PROC-HCPCS (W-PTD-PROC-SUB) MOVE 'N' TO W-END-OF-PTD-TBL PERFORM 10612-UPDATE-PTD-PROC THRU 10612-UPDATE-PTD-PROC-EXIT SET W-PTD-INDX UP BY 1 END-SEARCH. *-------------------------------------------------------------* * SET UP FOR NEXT PASS-THROUGH DEVICE RECORD * *-------------------------------------------------------------* MOVE ZEROS TO H-PTD-UNIT-RATE H-PTD-SUB-CHRG H-PTD-LITEM-PYMT. 10611-SEARCH-PTD-HCPCS-EXIT. EXIT. *************************************************************** * * * UPDATE THE PROCEDURE LINE'S PAYMENTS AND CHARGES WITH THE * * PASS-THROUGH DEVICE'S PAYMENTS AND CHARGES (IN PROPORTION * * TO THE PROCEDURE'S UNITS IF OTHER PROCEDURES ARE ELIGIBLE * * FOR THE PASS-THROUGH DEVICE AS WELL) * * * *************************************************************** 10612-UPDATE-PTD-PROC. *-------------------------------------------------------------* * DETERMINE PROPORTION OF CHARGES & PAYMENTS PROCEDURE LINE * * WILL RECEIVE BASED ON ITS NUMBER OF UNITS * *-------------------------------------------------------------* IF W-PTD-TOTAL-PROC-UNITS (W-PTD-INDX) NOT = 0 COMPUTE H-PTD-UNIT-RATE ROUNDED = OPPS-SRVC-UNITS (LN-SUB) / W-PTD-TOTAL-PROC-UNITS (W-PTD-INDX) ELSE MOVE 0 TO H-PTD-UNIT-RATE END-IF. *-------------------------------------------------------------* * CALCULATE THE AMOUNT OF PASS-THROUGH DEVICE CHARGES TO BE * * ADDED TO THE PROCEDURE'S CHARGES IN PROPORTION TO UNITS * *-------------------------------------------------------------* COMPUTE H-PTD-SUB-CHRG ROUNDED = W-PTD-SUB-CHRG (W-PTD-INDX) * H-PTD-UNIT-RATE. *-------------------------------------------------------------* * ADD PASS-THROUGH DEVICE CHARGES TO PROCEDURE LINE CHARGES * *-------------------------------------------------------------* COMPUTE W-SUB-CHRG (W-LP-INDX) ROUNDED = W-SUB-CHRG (W-LP-INDX) + H-PTD-SUB-CHRG. *-------------------------------------------------------------* * CALCULATE THE AMOUNT OF PASS-THROUGH DEVICE PAYMENTS TO BE * * ADDED TO THE PROCEDURE'S PAYMENTS IN PROPORTION TO UNITS * *-------------------------------------------------------------* COMPUTE H-PTD-LITEM-PYMT ROUNDED = W-PTD-LITEM-PYMT (W-PTD-INDX) * H-PTD-UNIT-RATE. *-------------------------------------------------------------* * ADD PASS-THROUGH DEVICE PAYMENT TO PROCEDURE LINE PAYMENT * *-------------------------------------------------------------* COMPUTE H-LITEM-PYMT-OUTL ROUNDED = H-LITEM-PYMT-OUTL + H-PTD-LITEM-PYMT. 10612-UPDATE-PTD-PROC-EXIT. EXIT. *************************************************************** * * * DETERMINE WHETHER THE CURRENT APC IS A BRACHYTHERAPY APC * * - IF SO, SET BRACHY-APC-FLAG = 'Y' * * - THIS FLAG IS USED IN PARAGRAPHS 9600-ADJ-CHRG-OUTL & * * 9550-CALC-GJK TO PROCESS BRACHYS * * ** UPDATE THIS LIST EVERY JANUARY * * (CODE NEW FOR CY2008; ADDED 11/6/2007) * * * * 11/12/2008 - BRACHYTHERAPY APC LIST REMOVED FOR CY 2009; * * BRACHYTHERAPY LINES NOW IDENTIFIED BY A * * STATUS INDICATOR OF ' U' * * * *************************************************************** *9650-SET-BRACHY-APC-FLAG. * * MOVE 'N' TO BRACHY-APC-FLAG. * * IF OPPS-APC (LN-SUB) = ('2632' OR * '1716' OR * '1717' OR * '1719' OR * '2616' OR * '2634' OR * '2635' OR * '2636' OR * '2638' OR * '2639' OR * '2640' OR * '2641' OR * '2642' OR * '2643' OR * '2698' OR * '2699') * * MOVE 'Y' TO BRACHY-APC-FLAG * END-IF. * *9650-SET-BRACHY-APC-FLAG-EXIT. * EXIT. *************************************************************** * * * DETERMINE WHETHER THE CURRENT HCPCS IS A BLOOD DEDUCTIBLE * * HCPCS * * - IF SO, SET BLD-DEDUC-HCPCS-FLAG = 'Y' * * - THIS FLAG IS USED IN PARAGRAPHS 10550-CALC-GJK & * * 10550-SCH-ADJ TO PROCESS BLOOD DEDUCTIBLE LINES * * ** UPDATE THIS LIST EVERY JANUARY * * (CODE NEW FOR CY2008; ADDED 12/4/2007) * * * *************************************************************** 10655-SET-BD-HCPCS-FLAG. MOVE 'N' TO BLD-DEDUC-HCPCS-FLAG. IF OPPS-HCPCS(LN-SUB) = ('P9054' OR 'P9021' OR 'P9056' OR 'P9051' OR 'P9016' OR 'P9010' OR 'P9038' OR 'P9040' OR 'P9058' OR 'P9022' OR 'P9057' OR 'P9039' ) MOVE 'Y' TO BLD-DEDUC-HCPCS-FLAG END-IF. 10655-SET-BD-HCPCS-FLAG-EXIT. EXIT. *************************************************************** * * * DETERMINE WHETHER THE CURRENT APC IS A RADIOPHARM APC * * - IF SO, SET RADIOPH-APC-FLAG = 'Y' * * - THIS FLAG IS USED IN PARAGRAPH 9550-CALC-STANDARD * * TO PROCESS RADIOPHARM LINES * * ** UPDATE THIS LIST EVERY JANUARY * * (CODE NEW FOR CY2008; ADDED 12/27/2007) * * * * 11/16/2009 - LOGIC REMOVED BECAUSE THERAP. RADIO NO LONGER * * HAVE AN SI=H (NOT PAID AT COST) CY 2010 * * * *************************************************************** *9660-SET-RADIOPH-APC-FLAG. * * MOVE 'N' TO RADIOPH-APC-FLAG. * * IF OPPS-APC (LN-SUB) = ('1064' OR * '1150' OR * '1643' OR * '1645' OR * '1675' OR * '1676' OR * '0701' OR * '0702') * * MOVE 'Y' TO RADIOPH-APC-FLAG * END-IF. * *9660-SET-RADIOPH-APC-FLAG-EXIT. * EXIT. *************************************************************** * * * DETERMINE WHETHER THE CURRENT HCPCS IS A PASS-THROUGH * * DEVICE HCPCS (FOR OUTLIER PAYMENT ADJ) * * - IF SO, SET PTD-LINE-FLAG = 'Y' * * - THIS FLAG IS USED IN THE PASS-THROUGH DEVICE LOGIC * * TO POPULATE THE PASS-THROUGH-DEVICE TABLE * * ** UPDATE THIS LIST EVERY QUARTER * * (CODE NEW FOR CY2008 QTR 2; ADDED 02/11/2008) * * * *************************************************************** 10665-SET-PTD-LINE-FLAG. MOVE 'N' TO PTD-LINE-FLAG. *********************************************************** * 11/12/2008 - ALL LOGIC DISABLED B/C THERE ARE NO * * NO PASS-THROUGH DEVICES FOR CY 2009 * * 11/18/2009 - NO PASS-THROUGH DEVICES FOR CY 2010 * * 08/12/2010 - NEW PT DEVICE EFFECTIVE OCTOBER 1, 2010 * * 08/15/2011 - NEW PT DEVICES EFFECTIVE OCTOBER 1, 2011 * *********************************************************** *---------------------------------------------------------* * ONLY CLAIMS WITH A DATE OF SERVICE ON OR AFTER * * 10/01/2010 ARE ELIGIBLE * *---------------------------------------------------------* IF OPPS-LITEM-DOS (LN-SUB) >= 20101001 *---------------------------------------------------------* * PT DEVICE HCPCS EFFECTIVE ON AND AFTER 10/01/2010 * *---------------------------------------------------------* IF (OPPS-LITEM-DOS (LN-SUB) >= 20101001 AND OPPS-LITEM-DOS (LN-SUB) <= 20121231 AND OPPS-HCPCS (LN-SUB) = 'C1749') OR *---------------------------------------------------------* * PT DEVICE HCPCS EFFECTIVE ON AND AFTER 10/01/2011 * *---------------------------------------------------------* (OPPS-LITEM-DOS (LN-SUB) >= 20111001 AND OPPS-HCPCS (LN-SUB) = ('C1830' OR 'C1840') ) MOVE 'Y' TO PTD-LINE-FLAG END-IF END-IF. 10665-SET-PTD-LINE-FLAG-EXIT. EXIT. *************************************************************** * * * DETERMINE WHETHER THE CURRENT HCPCS IS A PROCEDURE * * ELIGIBLE FOR A PASS-THROUGH DEVICE (FOR OUTLIER PMT ADJ) * * - IF SO, SET PTD-PROC-FLAG = 'Y' * * - THIS FLAG IS USED IN THE PASS-THROUGH DEVICE LOGIC * * ** UPDATE THIS LIST EVERY QUARTER * * (CODE NEW FOR CY2008 QTR 2; ADDED 02/11/2008) * * * *************************************************************** 10670-SET-PTD-PROC-FLAG. MOVE 'N' TO PTD-PROC-FLAG. *********************************************************** * 11/12/2008 - ALL LOGIC DISABLED B/C THERE ARE NO * * NO PASS-THROUGH DEVICES FOR CY 2009 * * 11/18/2009 - NO PASS-THROUGH DEVICES FOR CY 2010 * * 08/12/2010 - NEW PT DEVICE EFFECTIVE OCTOBER 1, 2010 * * 08/15/2011 - NEW PT DEVICES EFFECTIVE OCTOBER 1, 2011 * *********************************************************** *---------------------------------------------------------* * ONLY CLAIMS WITH A DATE OF SERVICE ON OR AFTER * * 10/01/2010 ARE ELIGIBLE * *---------------------------------------------------------* IF OPPS-LITEM-DOS (LN-SUB) >= 20101001 *---------------------------------------------------------* * SPECIFY NUMBER OF ENTRIES (# OF PT DEVICES FROM POLICY)* *---------------------------------------------------------* MOVE 3 TO W-PTD-CNT *---------------------------------------------------------* * INITIALIZE PROCEDURE'S PTD HCPCS TABLE TO SPACES * *---------------------------------------------------------* PERFORM VARYING W-PTD-PROC-SUB FROM 1 BY 1 UNTIL W-PTD-PROC-SUB > W-PTD-CNT MOVE SPACES TO W-PTD-PROC-HCPCS (W-PTD-PROC-SUB) END-PERFORM *********************************************************** * PT DEVICE MAPPINGS EFFECTIVE ON AND AFTER 10/01/2010 * *********************************************************** *---------------------------------------------------------* * PROCEDURES ELIGIBLE FOR PASS-THROUGH DEVICE 1 (C1749) * *---------------------------------------------------------* IF OPPS-LITEM-DOS (LN-SUB) >= 20101001 AND OPPS-LITEM-DOS (LN-SUB) <= 20121231 AND OPPS-HCPCS (LN-SUB) = ('45378' OR '45380' OR '45381' OR '45382' OR '45383' OR '45384' OR '45385' OR 'G0105' OR 'G0121') MOVE 'Y' TO PTD-PROC-FLAG MOVE 1 TO W-PTD-PROC-SUB MOVE 'C1749' TO W-PTD-PROC-HCPCS (W-PTD-PROC-SUB) END-IF *********************************************************** * PT DEVICE MAPPINGS EFFECTIVE ON AND AFTER 10/01/2011 * *********************************************************** *---------------------------------------------------------* * PROCEDURES ELIGIBLE FOR PASS-THROUGH DEVICE 2 (C1830) * *---------------------------------------------------------* IF OPPS-LITEM-DOS (LN-SUB) >= 20111001 AND OPPS-HCPCS (LN-SUB) = ('38220' OR '38221') MOVE 'Y' TO PTD-PROC-FLAG MOVE 2 TO W-PTD-PROC-SUB MOVE 'C1830' TO W-PTD-PROC-HCPCS (W-PTD-PROC-SUB) END-IF *---------------------------------------------------------* * PROCEDURES ELIGIBLE FOR PASS-THROUGH DEVICE 3 (C1840) * *---------------------------------------------------------* IF OPPS-LITEM-DOS (LN-SUB) >= 20111001 AND OPPS-HCPCS (LN-SUB) = ('66982' OR '66984' OR '66999') MOVE 'Y' TO PTD-PROC-FLAG MOVE 3 TO W-PTD-PROC-SUB MOVE 'C1840' TO W-PTD-PROC-HCPCS (W-PTD-PROC-SUB) END-IF END-IF. *---------------------------------------------------------* * ** EXPIRED PT DEVICE MAPPINGS ** * *---------------------------------------------------------* * PROCEDURES ELIGIBLE FOR PASS-THROUGH DEVICE 2 * * ** ENABLE IF THERE ARE MULTIPLE PT DEVICES * *---------------------------------------------------------* * IF OPPS-HCPCS (LN-SUB) = ('69714' OR * '69715' OR * '69717' OR * '69718') * * MOVE 'Y' TO PTD-PROC-FLAG * MOVE 2 TO W-PTD-PROC-SUB * MOVE 'L8690' TO W-PTD-PROC-HCPCS (W-PTD-PROC-SUB) * END-IF * END-IF. 10670-SET-PTD-PROC-FLAG-EXIT. EXIT. *************************************************************** * * * DETERMINE WHETHER THE LINE HCPCS IS A CURRENT PASS-THROUGH * * RADIOPHARMACEUTICAL HCPCS * * * * - IF SO: SET PTRADIO-LINE-FLAG = 'Y', * * ADD 1 TO COUNT OF TOTAL PT RADIOPHARMS, * * ADD CHARGES TO CLAIM TOTAL PT RADIOPHARM CHRGES * * - THIS FLAG IS USED IN PARAGRAPHS 10125-INIT & * * 10550-CALC-STANDARD TO PROCESS PT RADIOPHARM LINES * * * * ** PASS-THROUGH RADOIOPHARM TABLE IS UPDATED QUARTERLY * * (CODE NEW FOR CY2009; ADDED 02/10/2009) * * * *-------------------------------------------------------------* * * * 12/20/2011 - LOGIC REVISED TO INCLUDE TERMINATION DATE * * AS A VALID DATE OF SERVICE * * * *************************************************************** 10680-SET-PTRADIO-LINE-FLAG. MOVE 'N' TO PTRADIO-LINE-FLAG. SEARCH ALL PTRH-ENTRY AT END MOVE 'N' TO PTRADIO-LINE-FLAG WHEN PTRH-PTRADIO-HCPCS (PTRH-INDX) = OPPS-HCPCS (LN-SUB) IF OPPS-LITEM-DOS (LN-SUB) >= PTRH-EFF-DATE (PTRH-INDX) AND (OPPS-LITEM-DOS (LN-SUB) <= PTRH-TERM-DATE (PTRH-INDX) OR PTRH-TERM-DATE (PTRH-INDX) = 0) THEN MOVE 'Y' TO PTRADIO-LINE-FLAG END-IF. 10680-SET-PTRADIO-LINE-FL-EXIT. EXIT. *************************************************************** * * * DETERMINE WHETHER THE LINE HCPCS IS A CURRENT PASS-THROUGH * * CONTRAST AGENT HCPCS * * * * - IF SO: SET PTCA-LINE-FLAG = 'Y', * * - THIS FLAG IS USED IN PARAGRAPHS 10125-INIT & * * 10550-CALC-STANDARD TO PROCESS PT CONTRAST AGENT LINES * * * * ** PASS-THROUGH CONTRAST AGENT TABLE IS UPDATED QUARTERLY * * (CODE NEW FOR CY2010; ADDED 11/16/2009) * * * *-------------------------------------------------------------* * * * 12/20/2011 - LOGIC REVISED TO INCLUDE TERMINATION DATE * * AS A VALID DATE OF SERVICE * * * *************************************************************** 10681-SET-PTCA-LINE-FLAG. MOVE 'N' TO PTCA-LINE-FLAG. SEARCH ALL PTCH-ENTRY AT END MOVE 'N' TO PTCA-LINE-FLAG WHEN PTCH-PTCONTR-HCPCS (PTCH-INDX) = OPPS-HCPCS (LN-SUB) IF OPPS-LITEM-DOS (LN-SUB) >= PTCH-EFF-DATE (PTCH-INDX) AND (OPPS-LITEM-DOS (LN-SUB) <= PTCH-TERM-DATE (PTCH-INDX) OR PTCH-TERM-DATE (PTCH-INDX) = 0) THEN MOVE 'Y' TO PTCA-LINE-FLAG END-IF. 10681-SET-PTCA-LINE-FL-EXIT. EXIT. *************************************************************** * * * DETERMINE WHETHER THE LINE HCPCS IS A CURRENT PASS-THROUGH * * DEVICE HCPCS (FOR OFFSET) * * * * - IF SO: SET PTDO-LINE-FLAG = 'Y', * * - THIS FLAG IS USED IN PARAGRAPHS 10125-INIT & * * 10550-CALC-STANDARD TO PROCESS PT DEVICE LINES * * * * ** PASS-THROUGH DEVICE OFFSET TABLE IS UPDATED QUARTERLY * * (CODE NEW FOR OCT 2010; ADDED 08/02/2010) * * * *-------------------------------------------------------------* * * * 12/20/2011 - LOGIC REVISED TO ACCOMMODATE DEVICES THAT HAVE * * MULTIPLE PROCEDURE PAIRINGS WITH DIFFERENT * * EFFECTIVE AND TERMINATION DATES. ALSO ENSURED * * THE TERMINATION DATE IS AFTER OR ON THE * * DATE OF SERVICE. * * * *************************************************************** 10682-SET-PTDO-LINE-FLAG. MOVE 'N' TO PTDO-LINE-FLAG. SET PTDO-INDX TO 1. SEARCH PTDO-ENTRY AT END MOVE 'N' TO PTDO-LINE-FLAG *----------------------------------------------------------------* * LINE HCPCS IS FOUND IN THE PT DEVICE OFFSET HISTORY TABLE AND * * THE DATE OF SERVICE IS WITHIN THE EFFECTIVE & TERMINATION DATE * * PARAMETERS. * *----------------------------------------------------------------* WHEN PTDO-DEV-HCPCS (PTDO-INDX) = OPPS-HCPCS (LN-SUB) AND PTDO-EFF-DATE (PTDO-INDX) <= OPPS-LITEM-DOS (LN-SUB) AND (PTDO-TERM-DATE (PTDO-INDX) >= OPPS-LITEM-DOS (LN-SUB) OR PTDO-TERM-DATE (PTDO-INDX) = 0) MOVE 'Y' TO PTDO-LINE-FLAG. *-------------------------------------------------------------* * OLD LOGIC DISABLED & REPLACED BY LOGIC ABOVE ON 12/20/2011 * *-------------------------------------------------------------* * MOVE 'N' TO PTDO-LINE-FLAG. * * SEARCH ALL PTDO-ENTRY * AT END * MOVE 'N' TO PTDO-LINE-FLAG * * WHEN PTDO-DEV-HCPCS (PTDO-INDX) = OPPS-HCPCS (LN-SUB) * IF OPPS-LITEM-DOS (LN-SUB) >= PTDO-EFF-DATE (PTDO-INDX) AND * (OPPS-LITEM-DOS (LN-SUB) < PTDO-TERM-DATE (PTDO-INDX) OR * PTDO-TERM-DATE (PTDO-INDX) = 0) THEN * MOVE 'Y' TO PTDO-LINE-FLAG * END-IF. *-------------------------------------------------------------* 10682-SET-PTDO-LINE-FL-EXIT. EXIT. *************************************************************** * * * *** PARAGRAPH COMMENTED OUT 8/11/2010, * * REPLACED WITH REVISED PT DEVICE OFFSET LOGIC ** * * * * REDUCE LINE ITEM PAYMENTS OF DEVICE LINES (SI = H) BY THE * * WAGE ADJUSTED DEVICE OFFSET AMOUNT WHEN THERE ARE DEVICE * * OFFSETS ON THE CLAIM (PASS-THROUGH DEVICES) * * * *************************************************************** * * * 1. RE-CALCULATE LINE ITEM PAYMENT FOR SERVICE INDICATOR * * TYPE H * * 2. SUBTRACT WAGE ADJUSTED OFFSET AMOUNT FROM SI TYPE 'H' * * WITH HCPCS CODE BEGINNING WITH 'C' * * ** EFFECTIVE 04/01/2002 * * * *************************************************************** *9700-CALC-H-OFFSET. * *-------------------------------------------------------------* * REDUCE EACH DEVICE LINE'S PAYMENT BY THE WAGE ADJUSTED * * OFFSET AMOUNT IN PROPORTION TO THE DEVICE LINE'S CHARGES * *-------------------------------------------------------------* * IF H-TOT-H-CHRG > 0 * COMPUTE H-OFF-RATE ROUNDED = * H-SUB-CHRG / H-TOT-H-CHRG * COMPUTE T-LITEM-PYMT ROUNDED = * T-LITEM-PYMT - (H-TOTAL-WAOFF * H-OFF-RATE) * ELSE * NEXT SENTENCE. * * IF T-LITEM-PYMT < 0 * MOVE 0 TO T-LITEM-PYMT. * *9700-CALC-H-OFFSET-EXIT. * EXIT. *************************************************************** * * * PROCESS DRUG COINSURANCE TABLE RECORDS * * * *************************************************************** * * * ADJUST THE "DRUG" LINE COINSURANCE WHEN THE PROCEDURE * * COINSURANCE AMOUNTS PLUS THE "DRUG" COINSURANCE AMOUNT(S) * * BILLED ON THE SAME DAY EXCEED THE DAILY INPATIENT * * COINSURANCE LIMIT. * * * *************************************************************** 10800-ADJ-STV-REIM. IF W-DCP-CODE (W-DCP-INDX) = 1 PERFORM 10810-PROCESS-TYPE1 THRU 10810-PROCESS-TYPE1-EXIT ELSE PERFORM 10840-PROCESS-TYPE2 THRU 10840-PROCESS-TYPE2-EXIT. 10800-ADJ-STV-REIM-EXIT. EXIT. *************************************************************** * * * FOR DAYS OF SERVICE WITH "DRUG" COINSURANCE, DETERMINE THE * * % OF TOTAL "DRUG" COINSURANCE THAT CAN BE PAID IN ADDITION * * TO THE DAY'S MOST EXPENSIVE PROCEDURE/VISIT WAGE ADJUSTED * * COINSURANCE WHILE KEEPING WITHIN THE INPATIENT DAILY * * COINSURANCE LIMIT. * * * * WHEN H-RATIO = 0, NONE OF THE DRUG COINSURANCE CAN BE PAID * * WHEN H-RATIO = 1, ALL OF THE DRUG COINSURANCE CAN BE PAID * * * * BY USING THE DAY'S MOST EXPENSIVE PROCEDURE/VIST WAGE * * ADJUSTED COINSURANCE, THE BENEFICIARY RECEIVES THE * * GREATEST BENEFIT FROM THE INPATIENT LIMITATION PROVISION. * * * *************************************************************** 10810-PROCESS-TYPE1. *-------------------------------------------------------------* * DRUGS WERE ADMINISTERED ON THE DAY * *-------------------------------------------------------------* IF W-DCP-COIN2 (W-DCP-INDX) > 0 *-------------------------------------------------------------* * GET DATE OF SERVICE & WAGE ADJUSTED COINSURANCE OF THE * * DAY'S MOST EXPENSIVE PROCEDURE/VISIT * *-------------------------------------------------------------* MOVE W-DCP-DOS (W-DCP-INDX) TO H-DCP-DOS MOVE W-DCP-WGNAT (W-DCP-INDX) TO H-TOTAL *-------------------------------------------------------------* * CALCULATE THE % OF THE DAY'S TOTAL DRUG COIN THAT CAN BE * * PAID IN ADDITION TO THE PROCEDURE/VISIT COIN WITHIN THE * * INPATIENT LIMIT * *-------------------------------------------------------------* COMPUTE H-RATIO = (H-IP-LIMIT - W-DCP-WGNAT (W-DCP-INDX)) / W-DCP-COIN2 (W-DCP-INDX) *-------------------------------------------------------------* * NONE OF THE DAY'S DRUG COIN CAN BE PAID B/C THE PROCEDURE/ * * VISIT COIN > INPATIENT COIN LIMIT * *-------------------------------------------------------------* IF H-RATIO < 0 MOVE 0 TO H-RATIO. *-------------------------------------------------------------* * THE DAY'S TOTAL DRUG COINSURANCE CAN BE PAID WITHIN THE * * INPATIENT COIN LIMIT * *-------------------------------------------------------------* IF H-RATIO > 1 MOVE 1 TO H-RATIO. 10810-PROCESS-TYPE1-EXIT. EXIT. *************************************************************** * * * REDUCE THE "DRUG" LINE'S NATIONAL COINSURANCE AMOUNT AND * * ADD THE REDUCTION AMOUNT TO THE LINE'S REIMBURSEMENT * * AMOUNT WHEN THE INPATIENT LIMIT IS EXCEEDED * * * *************************************************************** 10840-PROCESS-TYPE2. *-------------------------------------------------------------* * CURRENT TYPE 2 DRUG COIN REC HAS SAME DATE OF SERVICE AS * * THE LAST TYPE 1 RECORD PROCESSED * *-------------------------------------------------------------* IF W-DCP-DOS (W-DCP-INDX) = H-DCP-DOS *-------------------------------------------------------------* * GO TO SERVICE LINE THAT CORRESPONDS TO THE DRUG COIN RECORD * *-------------------------------------------------------------* MOVE W-DCP-SUB (W-DCP-INDX) TO LN-SUB *-------------------------------------------------------------* * CALCULATE ACTUAL COIN AMT TO BE REIMBURSED DUE TO IP LIMIT * *-------------------------------------------------------------* COMPUTE H-SHIFT = W-DCP-COIN2 (W-DCP-INDX) * (1 - H-RATIO) *-------------------------------------------------------------* * ACCUMULATE THE TOTAL NATIONAL COIN DUE FOR THE DAY * * (LESS ACTUAL COIN AMT TO BE REIMBURSED DUE TO IP LIMIT) * *-------------------------------------------------------------* COMPUTE H-TOTAL = A-ADJ-COIN (LN-SUB) + H-TOTAL - H-SHIFT *-------------------------------------------------------------* * DETERMINE HOW MUCH THE DAY'S TOTAL NATIONAL COIN DUE * * EXCEEDS THE DAILY INPATIENT LIMIT (IF IT EXCEEDS THE LIMIT) * *-------------------------------------------------------------* * OCCURS WHEN THE NATIONAL COIN OF THIS LINE AND/OR PREVIOUS * * LINES FROM THE SAME DAY IS GREATER THAN THE ACTUAL COIN DUE * * & PUSHES THE DAILY TOTAL OVER THE INPATIENT LIMIT * *-------------------------------------------------------------* IF H-TOTAL > H-IP-LIMIT COMPUTE H-SHIFT = H-SHIFT + H-TOTAL - H-IP-LIMIT END-IF *-------------------------------------------------------------* * CALCULATE THE ADJUSTED NATIONAL COIN FOR THE DRUG LINE BY * * DEDUCTING THE AMT THAT EXCEEDS THE INPATIENT LIMIT * *-------------------------------------------------------------* COMPUTE A-ADJ-COIN (LN-SUB) = A-ADJ-COIN (LN-SUB) - H-SHIFT *-------------------------------------------------------------* * ADD DRUG COIN AMT THAT EXCEEDS IP LIMIT TO LINE REIM AMT * * SET RETURN CODE TO INDICATE DAILY COINSURANCE LIMITATION * *-------------------------------------------------------------* COMPUTE A-LITEM-REIM (LN-SUB) = A-LITEM-REIM (LN-SUB) + H-SHIFT MOVE 22 TO A-RETURN-CODE (LN-SUB) END-IF. 10840-PROCESS-TYPE2-EXIT. EXIT. *************************************************************** * * * END OF CLAIM PROCESSING * * * * 1. MOVE TOTAL CLAIM CHARGE AMOUNT. * * 2. MOVE TOTAL CLAIM PAYMENT AMOUNT. * * 3. MOVE TOTAL CLAIM BLOOD PINTS USED. * * 4. CALCULATE CLAIM LEVEL OUTLIER AMOUNT. * * * *************************************************************** 10900-END-PRICE-RTN. MOVE H-TOT-CHRG TO A-TOT-CLM-CHRG. MOVE H-TOT-PYMT TO A-TOT-CLM-PYMT. *-------------------------------------------------------------* * NUMBER OF BLOOD PINTS USED FOR BLOOD DEDUCTIBLES ON CLAIM = * * INITIAL NUMBER OF BLOOD PINTS ALLOWED FOR DEDUCTIBLES - * * BLOOD PINTS STILL LEFT AFTER PROCESSING BLOOD DEDUCTIBLES * *-------------------------------------------------------------* COMPUTE A-BLOOD-PINTS-USED = H-BENE-BLOOD-PINTS - H-BENE-PINTS-USED. IF H-OUTLIER-PYMT > 0 MOVE H-OUTLIER-PYMT TO A-OUTLIER-PYMT. 10900-END-PRICE-RTN-EXIT. EXIT. ****************************************************************** ****************************************************************** *** *** ** ** ** OUTPATIENT PROSPECTIVE PAYMENT SYSTEM PRICER ** ** -------------------------------------------- ** ** SECTION 11000 FOR CALENDAR YEAR 2012 PROCESSING ** ** SERVICE FROM DATES: 1/1/2012 - 12/31/2012 ** ** ** *** *** ****************************************************************** ****************************************************************** ****************************************************************** * * * PRICING PROCESS OVERVIEW * * ------------------------ * * * * 1. GET RATES & OTHER INFORMATION FOR THE CLAIM * * 2. VALIDATE CLAIM * * 3. VALIDATE SERVICE LINES (INCLUDING DATA FROM THE OCE) * * 4. GET RATES & OTHER INFORMATION FOR THE SERVICE LINES * * 5. ACCUMULATE NON-PRIME LINE CHARGES FOR COMPOSITE APCS * * 6. ACCUMULATE PACKAGED MENTAL HEALTH CHARGES * * 7. ORDER THE SERVICE LINES IN THE SEQUENCE IN WHICH * * DEDUCTIBLES WILL BE APPLIED * * 8. ORDER BLOOD LINES IN THE SEQUENCE IN WHICH DEDUCTIBLES * * WILL BE APPLIED * * 9. CALCULATE SERVICE LINE PAYMENTS * * 10. CALCULATE DEDUCTIBLE AMOUNT APPLIED TO EACH SERVICE LINE * * 11. CALCULATE BLOOD DEDUCTIBLE AMOUNT APPLIED TO EACH BLOOD * * DEDUCTIBLE LINE * * 12. CALCULATE BENEFICIARY MAXIMUM (IP LIMIT), NATIONAL, * * MINIMUM, & REDUCED COINSURANCE FOR EACH SERVICE LINE * * 13. CALCULATE REIMBURSEMENT FOR EACH SERVICE LINE * * 14. ADJUST LINE CHARGES FOR ARTIFICAL, PACKAGED, COMPOSITE, * * AND MENTAL HEALTH CHARGES OF APPLICABLE PROCEDURES. ALSO, * * ADJUST LINE CHARGES AND PAYMENTS FOR PASS-THROUGH DEVICES * * FOR ELIGIBLE PROCEDURES. ALL ADJUSTMENTS ARE DONE FOR * * OUTLIER DETERMINATION ONLY. * * 15. CALCULATE OUTLIER PAYMENT FOR ELIGIBLE SERVICE LINES * * 16. APPLY THE DAILY INPATIENT LIMIT IN CALCULATING THE * * COINSURANCE TO BE PAID BY THE BENEFICIARY FOR DRUG LINES; * * ADD ANY COINSURANCE AMOUNT THAT EXCEEDS THE INPATIENT * * LIMIT TO THE DRUG LINE'S REIMBURSEMENT * * 17. ACCUMULATE CLAIM TOTALS * * 18. MOVE FINAL SERVICE LINE AMOUNTS TO AREA TO BE PASSED BACK * * * ****************************************************************** 11000-PROCESS-MAIN-NEW. ***************************************************************** * * * STEP 1 - INITIALIZE & SET WORKING-STORAGE VARIABLES, ASSIGN * * ------ CBSA & WAGE INDEX, PERFORM CLAIM DATE EDITS, SET * * INPATIENT DAILY COINSURANCE LIMIT (SET ANNUALLY) * * * ***************************************************************** PERFORM 11100-INIT THRU 11100-INIT-EXIT. *--------------------------------------------------------* * SET ERROR CODE IF THE WAGE INDEX = 0 * *--------------------------------------------------------* IF H-WINX1 = 0 AND A-CLM-RTN-CODE = 01 MOVE 51 TO A-CLM-RTN-CODE. *--------------------------------------------------------* * IF THE CLAIM HAS ERROR(S), STOP PROCESSING * *--------------------------------------------------------* IF A-CLM-RTN-CODE >= 50 GOBACK. *--------------------------------------------------------* * MOVE WAGE INDEX TO VARIABLE TO BE PASSED BACK * *--------------------------------------------------------* MOVE H-WINX1 TO A-WINX. ***************************************************************** * * * STEP 2 - SET CLAIM FLAGS WHEN CERTAIN CODES ARE FOUND * * ------ (LOOP THROUGH THE CLAIM) * * * * - PHP-APC-FLAG - PARTIAL HOSPITALIZATION CLAIM * * (APCS 00172, 00173, 00175, & 00176) * * - APC34-FLAG - MENTAL HEALTH CLAIM * * - PTD-FLAG - PASS-THROUGH DEVICE(S) ON CLAIM FOR OUTLIER * * - PTRADIO-CLAIM-FLAG - PASS-THROUGH RADIOPAHARM(S) ON CLAIM * * - PTCA-CLAIM-FLAG - PASS-THROUGH CONTRAST AGENT ON CLAIM * * CREATE PASS-THROUGH CONTRAST AGENT DAY TABLE * * - PTDO-CLAIM-FLAG - PASS-THROUGH DEVICE ON CLAIM FOR OFFSET * * CREATE PASS-THROUGH DEVICE HCPCS TABLE * * * * - DISABLED CY 2009: C1820-OFFSET-FLAG - DEVICE OFFSET CLAIM * * * ***************************************************************** *--------------------------------------------------------* * EMPTY PASS-THROUGH CONTRAST AGENT DAY TABLE FOR CLAIM * *--------------------------------------------------------* MOVE 0 TO W-PTCA-DAY-MAX. *--------------------------------------------------------* * EMPTY PASS-THROUGH DEVICE HCPCS TABLE FOR CLAIM * *--------------------------------------------------------* MOVE 0 TO W-PTDO-HCPCS-MAX. PERFORM 11125-INIT THRU 11125-INIT-EXIT VARYING LN-SUB FROM 1 BY 1 UNTIL LN-SUB > OPPS-LINE-CNT. ***************************************************************** * * * STEP 3 - VALIDATE CLAIM LINES, CALCULATE LINE DISCOUNTS & * * ------ OFFSETS, ACCUMULATE CLAIM TOTALS, SET FLAGS, * * POPULATE COINSURANCE & BLOOD DEDUCTIBLE TABLES * * WITH VALID SERVICE LINES, POPULATE COMPOSITE APC * * TABLE WITH NON-PRIME COMPOSITE LINE CHARGES, * * CALCULATE TOTAL PACKAGED MENTAL HEALTH CHARGES, * * CREATE PASS-THROUGH DEVICE TABLE (OUTLIER), CREATE * * NUCLEAR MEDICINE APC TABLE FOR PASS-THROUGH * * RADIOPHARMACEUTICAL OFFSET, CREATE CONTRAST * * AGENT PROCEDURE TABLE FOR PASS-THROUGH CONTRAST * * AGENT OFFSET & CREATE PASS-THROUGH DEVICE OFFSET * * PROCEDURE TABLE FOR PASS-THROUGH DEVICE OFFSET. * * (LOOP THROUGH THE CLAIM) * * * ***************************************************************** *--------------------------------------------------------* * EMPTY TABLES FOR NEW CLAIM * *--------------------------------------------------------* MOVE 0 TO W-DCP-MAX W-BLD-MAX W-CMP-MAX W-PTD-MAX W-NUCMED-MAX W-CAPROC-MAX W-PTDO-PROC-MAX. PERFORM 11150-INIT THRU 11150-INIT-EXIT VARYING LN-SUB FROM 1 BY 1 UNTIL LN-SUB > OPPS-LINE-CNT. *--------------------------------------------------------* * CALCULATE RATIO OF BLOOD PRODUCT CHARGES TO TOTAL * * BLOOD CHARGES (PRODUCT & STORAGE/PROCESSING) * *--------------------------------------------------------* IF H-TOT-38X-39X > 0 COMPUTE H-38X-39X-RATE ROUNDED = H-TOT-38X / H-TOT-38X-39X. *--------------------------------------------------------* * CALCULATE TOTAL OFFSET AMT FOR PT RADIOPHARM LINE(S) * * (# OF UNITS SUMMED LIMITED TO THE LESSER OF THE # OF * * PT RADIOPHARM HCPCS & THE # OF NUCLEAR MEDICINE UNITS)* *--------------------------------------------------------* IF W-NUCMED-MAX > 0 SET W-NUCMED-INDX TO 1 PERFORM UNTIL (W-NUCMED-INDX > W-NUCMED-MAX) OR (W-NUCMED-INDX > H-PTRADIO-HCPCS-CNT) COMPUTE H-NUCMED-TOT-OFFSET ROUNDED = H-NUCMED-TOT-OFFSET + W-NUCMED-WAGE-ADJ-OFFSET (W-NUCMED-INDX) SET W-NUCMED-INDX UP BY 1 END-PERFORM END-IF. *--------------------------------------------------------* * CALCULATE TOTAL OFFSET AMT PER DAY FOR PT CONTRAST * * AGENT LINE(S) (# OF UNITS SUMMED LIMITED TO THE LESSER * * OF THE # OF PT CONTRAST AGENT HCPCS & THE # OF PT * * CONTRAST AGENT PROCEDURE APC UNITS PER DAY) * *--------------------------------------------------------* IF W-PTCA-DAY-MAX > 0 AND W-CAPROC-MAX > 0 SET W-PTCA-DAY-INDX TO 1 PERFORM UNTIL (W-PTCA-DAY-INDX > W-PTCA-DAY-MAX) PERFORM 11396-TOTAL-DAY-PTCA-OFFS THRU 11396-TOTAL-DAY-PTCA-OFFS-EXIT SET W-PTCA-DAY-INDX UP BY 1 END-PERFORM END-IF. *--------------------------------------------------------* * MAP PASS-THROUGH DEVICE HCPCS TO THEIR CORRESPONDING * * OFFSET PROCEDURES * *--------------------------------------------------------* PERFORM 11397-PTDO-MAPPINGS-1 THRU 11397-PTDO-MAPPINGS-1-EXIT VARYING W-PTDO-HCPCS-INDX FROM 1 BY 1 UNTIL W-PTDO-HCPCS-INDX > W-PTDO-HCPCS-MAX. PERFORM 11397-PTDO-MAPPINGS-2 THRU 11397-PTDO-MAPPINGS-2-EXIT VARYING W-PTDO-HCPCS-INDX FROM 1 BY 1 UNTIL W-PTDO-HCPCS-INDX > W-PTDO-HCPCS-MAX. ***************************************************************** * * * STEP 4 - ACCUMULATE TOTAL CLAIM CHARGES FROM DEVICE LINES * * ------ (FOR DEVICES, SERVICE INDICATOR = H) * * (LOOP THROUGH THE COINSURANCE DEDUCTIBLE TABLE) * * * * *** DISABLED 08-11-2010 - NO LONGER NEEDED; REPLACED BY * * REVISED PASS-THROUGH DEVICE LOGIC * * * ***************************************************************** MOVE 0 TO W-DCP-MAX. * PERFORM 9555-CALC-H-TOT * THRU 9555-CALC-H-TOT-EXIT * VARYING W-LP-INDX FROM 1 BY 1 * UNTIL W-LP-INDX > W-LNC-MAX. ***************************************************************** * * * STEP 5 - CALCULATE LINE PAYMENTS, DEDUCTIBLES, COINSURANCE, * * ------ & REIMBURSEMENT, ACCUMULATE CLAIM TOTALS, POPULATE * * DRUG COINSURANCE TABLE, POPULATE PASS-THROUGH * * DEVICE TABLE WITH ELIGIBLE PROCEDURE DATA AND * * DEVICE LINE ITEM PAYMENT, AND MOVE LINE ITEM * * VALUES TO VARIABLES TO BE PASSED BACK * * (LOOP THROUGH THE COINSURANCE DEDUCTIBLE TABLE) * * * ***************************************************************** *--------------------------------------------------------* * POINT TO 1ST RECORD IN THE BLOOD DEDUCTIBLE TABLE * *--------------------------------------------------------* SET W-BD-INDX TO 1. *--------------------------------------------------------* * CLEAR THE DRUG COINSURANCE TABLE * *--------------------------------------------------------* MOVE 0 TO W-DCP-MAX. PERFORM 11400-CALCULATE THRU 11400-CALCULATE-EXIT VARYING W-LP-INDX FROM 1 BY 1 UNTIL W-LP-INDX > W-LNC-MAX. ***************************************************************** * * * STEP 6 - ADJUST PROCEDURE LINE CHARGES FOR ARTIFICIAL * * ------ CHARGES, PACKAGING, COMPOSITES, MENTAL HEALTH, AND * * PASS-THROUGH DEVICES, AND CALCULATE OUTLIER * * PAYMENTS * * (LOOP THROUGH THE COINSURANCE DEDUCTIBLE TABLE) * * * ***************************************************************** PERFORM 11600-ADJ-CHRG-OUTL THRU 11600-ADJ-CHRG-OUTL-EXIT VARYING W-LP-INDX FROM 1 BY 1 UNTIL W-LP-INDX > W-LNC-MAX ***************************************************************** * * * STEP 7 - CALCULATE THE COINSURANCE & REIMBURSEMENT AMOUNTS * * ------ FOR STATUS INDICATOR G & K LINES. THE DAILY INPA- * * TIENT COINSURANCE LIMIT IS APPLIED USING THE WAGE * * ADJUSTED COINSURANCE OF EACH DAY'S MOST EXPENSIVE * * PROCEDURE OR VISIT. * * (LOOP THROUGH THE DRUG COINSURANCE TABLE) * * * ***************************************************************** IF GJK-FLAG = 'Y' PERFORM 11800-ADJ-STV-REIM THRU 11800-ADJ-STV-REIM-EXIT VARYING W-DCP-INDX FROM 1 BY 1 UNTIL W-DCP-INDX > W-DCP-MAX ELSE NEXT SENTENCE. ***************************************************************** * * * STEP 8 - MOVE CLAIM TOTAL CHARGES, PAYMENTS, BLOOD PINTS * * ------ USED, AND OUTLIER PAYMENTS TO VARIABLES TO BE * * PASSED BACK. CALCULATE BLOOD PINTS USED. * * * ***************************************************************** PERFORM 11900-END-PRICE-RTN THRU 11900-END-PRICE-RTN-EXIT. 11000-PROCESS-MAIN-NEW-EXIT. EXIT. *************************************************************** * * * INITIALIZE WORKING STORAGE HOLD AREAS AND ADDITIONAL * * VARIABLES TO BE PASSED BACK TO THE STANDARD SYSTEM, * * ASSIGN CLAIM CBSA AND WAGE INDEX, & PERFORM DATE EDITS * * * * ** CHANGE EVERY JANUARY: * * - INPATIENT DAILY COINSURANCE LIMIT (H-IP-LIMIT) * * - CAL-VERSION * * * *************************************************************** * * * ERROR RETURN CODES: * * ------------------- * * - IF PROVIDER SPECIFIC FILE WAGE INDEX RECLASSIFICATION * * CODE INVALID OR MISSING * * - MOVE '52' TO CLAIM LEVEL RETURN CODE * * - DISCONTINUE CLAIM PROCESSING * * - IF SERVICE FROM DATE NOT NUMERIC OR < 20000801 * * - MOVE '53' TO CLAIM LEVEL RETURN CODE * * - DISCONTINUE CLAIM PROCESSING * * - IF SERVICE FROM DATE < PROVIDER EFFECTIVE DATE * * - MOVE '54' TO CLAIM LEVEL RETURN CODE * * - DISCONTINUE CLAIM PROCESSING * * - IF SERVICE FROM DATE > PROVIDER TERMINATION DATE * * - MOVE '54' TO CLAIM LEVEL RETURN CODE * * - DISCONTINUE CLAIM PROCESSING * * * *************************************************************** 11100-INIT. *-------------------------------------------------------------* * INITIALIZE CLAIM RETURN CODE (01 = CLAIM PROCESSED) * *-------------------------------------------------------------* MOVE 01 TO A-CLM-RTN-CODE. *-------------------------------------------------------------* * INITIALIZE CLAIM AND LINE VARIABLES * *-------------------------------------------------------------* * 11/05/2007 - PHP-HCPCS-FLAG & MH-HCPCS-FLAG ADDED * * 11/06/2007 - BRACHY-APC-FLAG ADDED * * 11/13/2007 - BLD-DEDUC-HCPCS-FLAG ADDED * * 11/28/2007 - APC34-FLAG ADDED * * 12/27/2007 - RADIOPH-APC-FLAG ADDED * * 02/11/2008 - PTD-FLAG, PTD-LINE-FLAG, PTD-PROC-FLAG ADDED * * 11/03/2008 - APC33-FLAG REPLACED BY PHP-APC-FLAG * * 11/12/2008 - BRACHY-APC-FLAG REMOVED, NOT USED FOR CY 2009 * * 02/09/2009 - PTRADIO-CLAIM-FLAG, PTRADIO-LINE-FLAG ADDED * * 11/16/2009 - RADIOPH-APC-FLAG REMOVED; PTCA-CLAIM-FLAG, * * PTCA-LINE FLAG ADDED * *-------------------------------------------------------------* MOVE 'N' TO PHP-APC-FLAG GJK-FLAG ST0-FLAG N-FLAG C-FLAG C1820-OFFSET-FLAG PHP-HCPCS-FLAG MH-HCPCS-FLAG APC34-FLAG PTD-FLAG PTD-LINE-FLAG PTD-PROC-FLAG BLD-DEDUC-HCPCS-FLAG PTRADIO-CLAIM-FLAG PTRADIO-LINE-FLAG PTCA-CLAIM-FLAG PTCA-LINE-FLAG. MOVE SPACE TO A-MSA A-CBSA BILL14X-FLAG. MOVE ZERO TO A-OUTLIER-PYMT A-TOTAL-CLM-DEDUCT A-TOT-CLM-CHRG A-TOT-CLM-PYMT A-BLOOD-DEDUCT-DUE A-BLOOD-PINTS-USED A-WINX W-LNC-MAX. INITIALIZE H-ADDITIONAL-VARIABLES. INITIALIZE LINE-HOLD-ITEMS. INITIALIZE T-LITEM-PYMT. *-------------------------------------------------------------* * VALIDATE CLAIM & PSF DATES * *-------------------------------------------------------------* IF L-SERVICE-FROM-DATE NOT NUMERIC MOVE 53 TO A-CLM-RTN-CODE GO TO 11100-INIT-EXIT ELSE IF L-SERVICE-FROM-DATE < L-PSF-EFFDT MOVE 54 TO A-CLM-RTN-CODE GO TO 11100-INIT-EXIT ELSE IF L-PSF-TERMDT > 0 IF L-SERVICE-FROM-DATE > L-PSF-TERMDT MOVE 54 TO A-CLM-RTN-CODE GO TO 11100-INIT-EXIT END-IF END-IF. *-------------------------------------------------------------* * UPDATE CAL-VERSION EVERY JANUARY * *-------------------------------------------------------------* MOVE CAL-VERSION11 TO A-CALC-VERS. *-------------------------------------------------------------* * RECEIVE BENEFICIARY SPECIFIC ITEMS FROM THE OCE * *-------------------------------------------------------------* MOVE BENE-DEDUCT TO H-BENE-DEDUCT. MOVE BENE-BLOOD-PINTS TO H-BENE-BLOOD-PINTS H-BENE-PINTS-USED. *-------------------------------------------------------------* * GET TO PROPER APC DATE BY SERVICE DATE (STARTING AT THE * * LATEST EFFECTIVE DATE IN THE APC DATE TABLE) * *-------------------------------------------------------------* MOVE WAD-MAX TO WAD-SUB. PERFORM UNTIL L-SERVICE-FROM-DATE NOT < WAD-DATE (WAD-SUB) SUBTRACT 1 FROM WAD-SUB END-PERFORM. *-------------------------------------------------------------* * DETERMINE WHICH CBSA TO USE & WHETHER TO USE THE SPECIAL * * WAGE INDEX IN THE PSF, AND SET THE INPATIENT DAILY * * COINSURANCE LIMIT (IN 2 PLACES; CHANGE EVERY JANUARY) * *-------------------------------------------------------------* IF L-PSF-SPEC-PYMT-IND = 'Y' MOVE L-PSF-WI-CBSA TO H-PSF-CBSA ELSE IF L-PSF-SPEC-PYMT-IND = ' ' MOVE L-PSF-GEO-CBSA TO H-PSF-CBSA ELSE IF L-PSF-SPEC-PYMT-IND = '1' OR '2' MOVE L-PSF-GEO-CBSA TO H-PSF-CBSA A-CBSA MOVE L-PSF-SPEC-WGIDX TO H-WINX1 MOVE 1156 TO H-IP-LIMIT GO TO 11100-INIT-EXIT ELSE MOVE 52 TO A-CLM-RTN-CODE GO TO 11100-INIT-EXIT. IF H-PSF-CBSA = SPACE MOVE 52 TO A-CLM-RTN-CODE GO TO 11100-INIT-EXIT. MOVE 1156 TO H-IP-LIMIT. *-------------------------------------------------------------* * APPLY WAGE INDEX FLOOR POLICY * * UPDATE WITH NEW FLOOR PARAGRAPH EVERY JANUARY * *-------------------------------------------------------------* PERFORM 11120-FLOOR-2012 THRU 11120-FLOOR-2012-EXIT. *-------------------------------------------------------------* * APPLY SECTION 401 WAGE INDEX POLICY * * UPDATE WITH NEW SECTION 401 PARAGRAPH EVERY JANUARY * *-------------------------------------------------------------* PERFORM 11120-SEC401-2012 THRU 11120-SEC401-2012-EXIT. *-------------------------------------------------------------* * GET THE CBSA WAGE INDEX VALUE (IF NOT ALREADY OVERRIDDEN * * BY THE PSF SPECIAL WAGE INDEX VALUE) * *-------------------------------------------------------------* MOVE H-PSF-CBSA TO A-CBSA. IF H-WINX1 = 0 PERFORM 11200-CALC-WAGEINDX THRU 11200-CALC-WAGEINDX-EXIT. 11100-INIT-EXIT. EXIT. *************************************************************** * * * NEW CY 2012 FLOOR FOR CBSA WAGE INDEX * * IPPS PRICER PGM FLOORS TAKEN FROM: PPDRV120 * * * *************************************************************** * * * SYNC ALL OF THE FOLLOWING WITH INPATIENT. * * SEE IPPS PRICER MAINTAINER. * * * * * SPECIAL NOTES * * * ------------- * * 1) CHANGE "'N'" (INPATIENT) * * TO "' '" (OUTPATIENT) * * * * 2) CHANGE 'P-NEW-CBSA-SPEC-PAY-IND' (INPATIENT) * * TO 'L-PSF-SPEC-PYMT-IND' (OUTPATIENT) * * * * 3) CHANGE 'HOLD-PROV-CBSA' (INPATIENT) * * TO 'H-PSF-CBSA' (OUTPATIENT) * * * * 4) CHANGE 'P-NEW-STATE' (INPATIENT) * * TO 'L-PSF-PROV-ST' (OUTPATIENT) * * * * 5) ADD SINGLE QUOTES AROUND L-PSF-PROV-ST VALUES * * * * BE SURE TO MAKE THESE FIVE CHANGES EVERY JANUARY * * * *************************************************************** 11120-FLOOR-2012. 378200 IF H-PSF-CBSA = ' 30' 26943900 378300 AND L-PSF-SPEC-PYMT-IND = 'Y' 26943900 378400 AND L-PSF-PROV-ST = '30' 26943900 378500 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 26943900 378600 MOVE ' 30' TO H-PSF-CBSA. 26943900 378700 26943900 378800 IF H-PSF-CBSA = ' 39' 26943900 378900 AND L-PSF-SPEC-PYMT-IND = 'Y' 26943900 379000 AND L-PSF-PROV-ST = '39' 26943900 379100 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 26943900 379200 MOVE ' 39' TO H-PSF-CBSA. 26943900 379300 26943900 379400 IF H-PSF-CBSA = ' 39' 26943900 379500 AND L-PSF-SPEC-PYMT-IND = 'Y' 26943900 379600 AND L-PSF-PROV-ST = '33' 26943900 379700 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 26943900 379800 MOVE ' 33' TO H-PSF-CBSA. 26943900 379900 26943900 380000 IF H-PSF-CBSA = '10900' 26944000 380100 AND L-PSF-PROV-ST = '31' 26944200 380200 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 26944300 380300 MOVE ' 31' TO H-PSF-CBSA. 26944400 380400 26944500 380500 IF H-PSF-CBSA = '14484' 26944600 380600 AND L-PSF-SPEC-PYMT-IND = 'Y' 26943900 380700 AND L-PSF-PROV-ST = '22' 26944800 380800 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 26944900 380900 MOVE ' 22' TO H-PSF-CBSA. 26945000 381000 26945100 381100 IF H-PSF-CBSA = '16020' 26944600 381200 AND L-PSF-SPEC-PYMT-IND = 'Y' 26943900 381300 AND L-PSF-PROV-ST = '14' 26944800 381400 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 26944900 381500 MOVE ' 14' TO H-PSF-CBSA. 26945000 381600 26945100 381700 IF H-PSF-CBSA = '21500' 26944600 381800 AND L-PSF-SPEC-PYMT-IND = 'Y' 26943900 381900 AND L-PSF-PROV-ST = '33' 26944800 382000 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 26944900 382100 MOVE ' 33' TO H-PSF-CBSA. 26945000 382200 26945100 382300 IF H-PSF-CBSA = '21500' 26944600 382400 AND L-PSF-SPEC-PYMT-IND = 'Y' 26943900 382500 AND L-PSF-PROV-ST = '39' 26944800 382600 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 26944900 382700 MOVE ' 39' TO H-PSF-CBSA. 26945000 382800 26945100 382900 IF H-PSF-CBSA = '22900' 26946400 383000 AND L-PSF-PROV-ST = '37' 26946500 383100 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 26946600 383200 MOVE ' 37' TO H-PSF-CBSA. 26946700 383300 26946800 383400 IF H-PSF-CBSA = '25180' 26948400 383500 AND L-PSF-PROV-ST = '21' 26948600 383600 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 26948700 383700 MOVE ' 21' TO H-PSF-CBSA. 26948800 383800 26948900 383900 IF H-PSF-CBSA = '25540' 26948400 384000 AND L-PSF-SPEC-PYMT-IND = 'Y' 26948500 384100 AND L-PSF-PROV-ST = '07' 26948600 384200 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 26948700 384300 MOVE ' 07' TO H-PSF-CBSA. 26948800 384400 26948900 384500 IF H-PSF-CBSA = '25540' 26948400 384600 AND L-PSF-SPEC-PYMT-IND = 'Y' 26948500 384700 AND L-PSF-PROV-ST = '22' 26948600 384800 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 26948700 384900 MOVE ' 22' TO H-PSF-CBSA. 26948800 385000 26948900 385100 IF H-PSF-CBSA = '26820' 26948400 385200 AND L-PSF-SPEC-PYMT-IND = 'Y' 26948500 385300 AND L-PSF-PROV-ST = '53' 26948600 385400 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 26948700 385500 MOVE ' 53' TO H-PSF-CBSA. 26948800 385600 26948900 385700 IF H-PSF-CBSA = '28700' 26948400 385800 AND L-PSF-PROV-ST = '44' 26948600 385900 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 26948700 386000 MOVE ' 44' TO H-PSF-CBSA. 26948800 386100 26948900 386200 IF H-PSF-CBSA = '28700' 26948400 386300 AND L-PSF-PROV-ST = '49' 26948600 386400 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 26948700 386500 MOVE ' 49' TO H-PSF-CBSA. 26948800 386600 26948900 386700 IF H-PSF-CBSA = '28700' 26948400 386800 AND L-PSF-SPEC-PYMT-IND = 'Y' 26948500 386900 AND L-PSF-PROV-ST = '18' 26948600 387000 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 26948700 387100 MOVE ' 18' TO H-PSF-CBSA. 26948800 387200 26948900 387300 IF H-PSF-CBSA = '28700' 26948400 387400 AND L-PSF-SPEC-PYMT-IND = 'Y' 26948500 387500 AND L-PSF-PROV-ST = '44' 26948600 387600 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 26948700 387700 MOVE ' 44' TO H-PSF-CBSA. 26948800 387800 26948900 387900 IF H-PSF-CBSA = '28940' 26948400 388000 AND L-PSF-SPEC-PYMT-IND = 'Y' 26948500 388100 AND L-PSF-PROV-ST = '18' 26948600 388200 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 26948700 388300 MOVE ' 18' TO H-PSF-CBSA. 26948800 388400 26948900 388500 IF H-PSF-CBSA = '35084' 26948400 388600 AND L-PSF-SPEC-PYMT-IND = 'Y' 26948500 388700 AND L-PSF-PROV-ST = '31' 26948600 388800 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 26948700 388900 MOVE ' 31' TO H-PSF-CBSA. 26948800 389000 26948900 389100 IF H-PSF-CBSA = '37620' 26954000 389200 AND L-PSF-PROV-ST = '36' 26955000 389300 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 26955100 389400 MOVE ' 36' TO H-PSF-CBSA. 26955200 389500 26955300 389600 IF H-PSF-CBSA = '37964' 26956000 389700 AND L-PSF-SPEC-PYMT-IND = 'Y' 26956100 389800 AND L-PSF-PROV-ST = '31' 26956200 389900 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 26956300 390000 MOVE ' 31' TO H-PSF-CBSA. 26956400 390100 26956500 390200 IF H-PSF-CBSA = '43580' 26956600 390300 AND L-PSF-PROV-ST = '43' 26956800 390400 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 26956900 390500 MOVE ' 43' TO H-PSF-CBSA. 26957000 390600 26957100 390700 IF H-PSF-CBSA = '44600' 26956600 390800 AND L-PSF-PROV-ST = '36' 26956800 390900 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 26956900 391000 MOVE ' 36' TO H-PSF-CBSA. 26957000 391100 26957100 391200 IF H-PSF-CBSA = '44600' 26956600 391300 AND L-PSF-PROV-ST = '51' 26956800 391400 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 26956900 391500 MOVE ' 51' TO H-PSF-CBSA. 26957000 391600 26957100 391700 IF H-PSF-CBSA = '48540' 26956600 391800 AND L-PSF-PROV-ST = '36' 26956800 391900 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 26956900 392000 MOVE ' 36' TO H-PSF-CBSA. 26957000 392100 26957100 392200 IF H-PSF-CBSA = '48540' 26956600 392300 AND L-PSF-PROV-ST = '51' 26956800 392400 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 26956900 392500 MOVE ' 51' TO H-PSF-CBSA. 26957000 392600 26957100 392700 IF H-PSF-CBSA = '48864' 26959000 392800 AND L-PSF-PROV-ST = '31' 26959200 392900 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 26959300 393000 MOVE ' 31' TO H-PSF-CBSA. 26959400 393100 26957100 393200 IF H-PSF-CBSA = '49660' 26959000 393300 AND L-PSF-PROV-ST = '36' 26959200 393400 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 26959300 393500 MOVE ' 36' TO H-PSF-CBSA. 26959400 393600 26957100 393700 IF H-PSF-CBSA = '49660' 26959000 393800 AND L-PSF-PROV-ST = '39' 26959200 393900 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 26959300 394000 MOVE ' 39' TO H-PSF-CBSA. 26959400 394100 26957100 394200 IF H-PSF-CBSA = '19060' 26961000 394300 AND L-PSF-PROV-ST = '21' 26962000 394400 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 26962100 394500 MOVE ' 21' TO H-PSF-CBSA. 26962200 394600 26962300 394700 IF H-PSF-CBSA = '22020' 26962400 394800 AND L-PSF-PROV-ST = '24' 26962600 394900 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 26962700 395000 MOVE ' 24' TO H-PSF-CBSA. 26962800 395100 26962900 395200 IF H-PSF-CBSA = '22020' 26962400 395300 AND L-PSF-PROV-ST = '35' 26962600 395400 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 26962700 395500 MOVE ' 35' TO H-PSF-CBSA. 26962800 395600 26962900 395700 IF H-PSF-CBSA = '24220' 26963000 395800 AND L-PSF-PROV-ST = '24' 26963200 395900 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 26963300 396000 MOVE ' 24' TO H-PSF-CBSA. 26963400 396100 26963500 396200 IF H-PSF-CBSA = '24220' 26963000 396300 AND L-PSF-PROV-ST = '35' 26963200 396400 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 26963300 396500 MOVE ' 35' TO H-PSF-CBSA. 26963400 396600 26963500 396700 IF H-PSF-CBSA = '30300' 26963600 396800 AND L-PSF-PROV-ST = '50' 26963800 396900 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 26963900 397000 MOVE ' 50' TO H-PSF-CBSA. 26964000 397100 26964100 397200 IF H-PSF-CBSA = '30860' 26963600 397300 AND L-PSF-PROV-ST = '46' 26963800 397400 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 26963900 397500 MOVE ' 46' TO H-PSF-CBSA. 26964000 397600 26964100 397700 IF H-PSF-CBSA = '35084' 26963600 397800 AND L-PSF-PROV-ST = '31' 26963800 397900 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 26963900 398000 MOVE ' 31' TO H-PSF-CBSA. 26964000 398100 26964100 398200 IF H-PSF-CBSA = '39300' 26964200 398300 AND L-PSF-PROV-ST = '22' 26964400 398400 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 26964500 398500 MOVE ' 22' TO H-PSF-CBSA. 26964600 398600 26964700 398700 IF H-PSF-CBSA = '45500' 26964800 398800 AND L-PSF-PROV-ST = '45' 26965000 398900 MOVE ' ' TO L-PSF-SPEC-PYMT-IND 26965100 399000 MOVE ' 45' TO H-PSF-CBSA. 26965200 11120-FLOOR-2012-EXIT. EXIT. *************************************************************** * * * NEW CY 2012 SECTION 401 HOSPITALS * * IPPS PRICER PGM SECTION 401S TAKEN FROM: PPDRV120 * * * *************************************************************** * * * SYNC ALL OF THE FOLLOWING WITH INPATIENT. * * SEE IPPS PRICER MAINTAINER. * * * * * SPECIAL NOTES * * * ------------- * * 1) CHANGE 'P-NEW-PROVIDER-NO' (INPATIENT) * * TO 'L-PSF-PROV-OSCAR' (OUTPATIENT) * * * * 2) CHANGE 'HOLD-PROV-CBSA' (INPATIENT) * * TO 'H-PSF-CBSA.' (OUTPATIENT) * * * * 3) DELETE THE P-NEW-CBSA-STAND-AMT-LOC LINES * * * * BE SURE TO MAKE THESE THREE CHANGES EVERY JANUARY * * * *************************************************************** 11120-SEC401-2012. 502100 IF (L-PSF-PROV-OSCAR = '040118') 33567001 502200 MOVE ' 04' TO H-PSF-CBSA. 33567101 502400 33558801 502500 IF (L-PSF-PROV-OSCAR = '050192' OR 33559301 502600 '050528' OR '050618') 33559401 502700 MOVE ' 05' TO H-PSF-CBSA. 33559501 502900 33566901 503000 IF (L-PSF-PROV-OSCAR = '070004') 33567001 503100 MOVE ' 07' TO H-PSF-CBSA. 33567101 503300 33566901 503400 IF (L-PSF-PROV-OSCAR = '100048' OR 33559301 503500 '100118' OR '100134') 33559401 503600 MOVE ' 10' TO H-PSF-CBSA. 33559501 503800 33567301 503900 IF (L-PSF-PROV-OSCAR = '140167') 33567001 504000 MOVE ' 14' TO H-PSF-CBSA. 33567101 504200 33567301 504300 IF (L-PSF-PROV-OSCAR = '150003') 33567001 504400 MOVE ' 15' TO H-PSF-CBSA. 33567101 504600 33567301 504700 IF (L-PSF-PROV-OSCAR = '170074' OR '170137') 33567001 504800 MOVE ' 17' TO H-PSF-CBSA. 33567101 505000 33567301 505100 IF (L-PSF-PROV-OSCAR = '180016' OR '180038') 33567001 505200 MOVE ' 18' TO H-PSF-CBSA. 33567101 505400 33567301 505500 IF (L-PSF-PROV-OSCAR = '220051') 33567001 505600 MOVE ' 22' TO H-PSF-CBSA. 33567101 505800 33567301 505900 IF (L-PSF-PROV-OSCAR = '230040' OR '230078') 33567001 506000 MOVE ' 23' TO H-PSF-CBSA. 33567101 506200 33567301 506300 IF (L-PSF-PROV-OSCAR = '260006' OR '260034' OR 33567001 506400 '260047' OR '260195') 33559401 506500 MOVE ' 26' TO H-PSF-CBSA. 33567101 506700 33567301 506800 IF (L-PSF-PROV-OSCAR = '300023') 33567001 506900 MOVE ' 30' TO H-PSF-CBSA. 33567101 507100 33567301 507200 IF (L-PSF-PROV-OSCAR = '330013' OR '330057' OR 33567001 507300 '330108' OR '330164' OR 33567001 507400 '330215' OR '330235' OR 33567001 507500 '330268' OR '330285') 33567001 507600 MOVE ' 33' TO H-PSF-CBSA. 33567101 507800 33567301 507900 IF (L-PSF-PROV-OSCAR = '340010') 33567001 508000 MOVE ' 34' TO H-PSF-CBSA. 33567101 508200 33567301 508300 IF (L-PSF-PROV-OSCAR = '360125') 33567001 508400 MOVE ' 36' TO H-PSF-CBSA. 33567101 508600 33567301 508700 IF (L-PSF-PROV-OSCAR = '370054') 33567001 508800 MOVE ' 37' TO H-PSF-CBSA. 33567101 509000 33567301 509100 IF (L-PSF-PROV-OSCAR = '380040') 33567001 509200 MOVE ' 38' TO H-PSF-CBSA. 33567101 509400 33567301 509500 IF (L-PSF-PROV-OSCAR = '390130' OR '390183' OR 33567001 509600 '390233') 33559401 509700 MOVE ' 39' TO H-PSF-CBSA. 33567101 509900 33567301 510000 IF (L-PSF-PROV-OSCAR = '420038') 33567001 510100 MOVE ' 42' TO H-PSF-CBSA. 33567101 510300 33567301 510400 IF (L-PSF-PROV-OSCAR = '450052' OR '450078' OR 33567001 510500 '450243' OR '450348') 33559401 510600 MOVE ' 45' TO H-PSF-CBSA. 33567101 510800 33567301 510900 IF (L-PSF-PROV-OSCAR = '490116' OR '490116') 33567001 511000 MOVE ' 49' TO H-PSF-CBSA. 33567101 511200 33567301 511300 IF (L-PSF-PROV-OSCAR = '500148') 33567001 511400 MOVE ' 50' TO H-PSF-CBSA. 33567101 11120-SEC401-2012-EXIT. EXIT. *************************************************************** * * * LOOP THROUGH ALL CLAIM LINES TO FIND AN APC / HCPCS * * * * - SET FLAG IF APC = 0172/0173/0175/0176 (PARTIAL HOSP.) * * - SET FLAG IF APC = 0034 (FOR MENTAL HEALTH CHARGES) * * (NEW FOR CY 2008 - ADDED 11/28/2007) * * - SET FLAG IF PASS-THROUGH DEVICE(S) ON CLAIM: FOR OUTLIER * * (NEW FOR CY 2008 - ADDED 02/11/2008) * * - SET FLAG IF PASS-THROUGH RADIOPHARMS(S) ON CLAIM * * (NEW FOR APRIL CY 2009 - ADDED 02/10/2009) * * - SET FLAG IF PASS-THROUGH CONTRAST AGENT(S) ON CLAIM * * (NEW FOR JANUARY CY 2010 - ADDED 11/15/2009) * * - SET FLAG IF PASS-THROUGH DEVICE(S) ON CLAIM: FOR OFFSET * * (NEW FOR OCTOBER CY 2010 - ADDED 08/02/2010) * * * * - DISABLED: SET FLAG IF HCPCS = C1820 (FOR DEVICE OFFSETS) * * * *-------------------------------------------------------------* * * * 11/03/2008 - CHANGED PARTIAL HOSPITALIZATION HCPCS FROM * * 0033 TO 0172 & 0173 FOR CY 2009 * * * * 11/12/2008 - HCPCS C1820 EXPIRED FROM PASS-THROUGH STATUS * * DECEMBER 2007, OFFSET FLAG LOGIC DISABLED * * * * 08/02/2010 - ADDED LOGIC TO SET PASS-THOUGH DEVICE FLAG FOR * * DEVICE OFFSETS AND POPULATE THE CORRESPONDING * * TABLE * * 11/15/2010 - ADDED APCS 0175 & 0176 TO LIST OF PHP APCS * * * *************************************************************** 11125-INIT. *-------------------------------------------------------------* * FLAG CLAIM WHEN AT LEAST 1 LINE HAS A PHP APC (PARTIAL HOSP)* *-------------------------------------------------------------* IF OPPS-APC (LN-SUB) = '0172' OR OPPS-APC (LN-SUB) = '0173' OR OPPS-APC (LN-SUB) = '0175' OR OPPS-APC (LN-SUB) = '0176' MOVE 'Y' TO PHP-APC-FLAG. *-------------------------------------------------------------* * FLAG CLAIM WHEN AT LEAST 1 LINE HAS APC 0034 * *-------------------------------------------------------------* IF OPPS-APC (LN-SUB) = '0034' MOVE 'Y' TO APC34-FLAG. *-------------------------------------------------------------* * FOR CY 2010, NO HCPCS HAVE PASS-THROUGH STATUS * * ** FOR OLD PT DEVICE LOGIC, REPLACED BY NEW LOGIC * *-------------------------------------------------------------* * IF OPPS-HCPCS (LN-SUB) = 'C1820' * MOVE 'Y' TO C1820-OFFSET-FLAG. *-------------------------------------------------------------* * FLAG CLAIM WHEN AT LEAST ONE LINE IS A PASS-THROUGH DEVICE * * (FOR OUTLIER PAYMENT CALCULATION) * *-------------------------------------------------------------* PERFORM 11665-SET-PTD-LINE-FLAG THRU 11665-SET-PTD-LINE-FLAG-EXIT. IF PTD-LINE-FLAG = 'Y' MOVE 'Y' TO PTD-FLAG END-IF. *-------------------------------------------------------------* * FLAG CLAIM WHEN AT LEAST 1 LINE IS PASS-THROUGH RADIOPHARM * * AND ACCUMULATE TOTAL PT RADIOPHARM LINES & CHARGES * *-------------------------------------------------------------* PERFORM 11680-SET-PTRADIO-LINE-FLAG THRU 11680-SET-PTRADIO-LINE-FL-EXIT. IF PTRADIO-LINE-FLAG = 'Y' MOVE 'Y' TO PTRADIO-CLAIM-FLAG ADD 1 TO H-PTRADIO-HCPCS-CNT MOVE OPPS-SUB-CHRG (LN-SUB) TO H-SUB-CHRG COMPUTE H-PTRADIO-TOT-CHRGS ROUNDED = H-PTRADIO-TOT-CHRGS + H-SUB-CHRG END-IF. *-------------------------------------------------------------* * FLAG CLAIM WHEN AT LEAST 1 LINE IS A PASS-THROUGH CONTRAST * * AGENT AND ACCUMULATE TOTAL PT CONTRAST AGENT LINES & * * CHARGES, SUM BY LINE ITEM DATE OF SERVICE, & CREATE A * * RECORD FOR EACH DAY IN THE PASS-THROUGH CONTRAST AGENT * * DAY TABLE * *-------------------------------------------------------------* PERFORM 11681-SET-PTCA-LINE-FLAG THRU 11681-SET-PTCA-LINE-FL-EXIT. IF PTCA-LINE-FLAG = 'Y' MOVE 'Y' TO PTCA-CLAIM-FLAG MOVE OPPS-SUB-CHRG (LN-SUB) TO H-SUB-CHRG PERFORM 11130-LOAD-PTCA-DAY-TABLE THRU 11130-LOAD-PTCA-DAY-TABLE-EXIT END-IF. *-------------------------------------------------------------* * FLAG CLAIM WHEN AT LEAST 1 LINE IS A PASS-THROUGH DEVICE * * ON THE CLAIM AND CREATE A RECORD FOR THE PT DEVICE HCPCS * * LINE IN THE PT DEVICE HCPCS TABLE * *-------------------------------------------------------------* PERFORM 11682-SET-PTDO-LINE-FLAG THRU 11682-SET-PTDO-LINE-FL-EXIT. IF PTDO-LINE-FLAG = 'Y' MOVE 'Y' TO PTDO-CLAIM-FLAG MOVE OPPS-SUB-CHRG (LN-SUB) TO H-SUB-CHRG MOVE OPPS-SRVC-UNITS (LN-SUB) TO H-SRVC-UNITS PERFORM 11132-LOAD-PTDO-HCPCS-TBL THRU 11132-LOAD-PTDO-HCPCS-TBL-EXIT END-IF. *-------------------------------------------------------------* * FLAG CLAIM WHEN ALL LINES HAVE A HCPCS BETWEEN 80000-89999 * * INCLUSIVE (LAB CODES), INDICATES BILL TYPE 14X * * 05/09/2011 - LOGIC ADDED * *-------------------------------------------------------------* IF (OPPS-HCPCS (LN-SUB) >= '80000' AND <= '89999') IF BILL14X-FLAG NOT = 'N' MOVE 'Y' TO BILL14X-FLAG END-IF ELSE MOVE 'N' TO BILL14X-FLAG END-IF. 11125-INIT-EXIT. EXIT. *************************************************************** * * * ACCUMULATE PASS-THROUGH CONTRAST AGENT HCPCS COUNT AND * * CHARGES FOR EACH DAY WITH A PASS-THROUGH CONTRAST AGENT * * * *************************************************************** * * * ORDER SERVICE LINES BY LINE ITEM DATE OF SERVICE (LIDOS) - * * EARLIEST TO LATEST DATE * * * * EACH PT CONTRAST AGENT HCPCS LINE'S CHARGES ARE ADDED TO * * THE TOTAL FOR ITS LIDOS. THESE CHARGES ARE LATER USED * * TO DETERMINE THE PROPORTION OF THE DAY'S TOTAL CONTRAST * * PROCEDURE OFFSET THAT SHOULD BE SUBTRACTED FROM A GIVEN PT * * CONTRAST AGENT HCPCS'S LINE PAYMENT. * * * * 11/16/2009 - LOGIC ADDED FOR CY 2010 * * * *************************************************************** 11130-LOAD-PTCA-DAY-TABLE. *-------------------------------------------------------------* * GET THE LINE'S SERVICE DATE & CHARGES FOR TABLE SEARCH * *-------------------------------------------------------------* MOVE OPPS-LITEM-DOS (LN-SUB) TO H-PTCA-LIDOS. MOVE OPPS-SUB-CHRG (LN-SUB) TO H-SUB-CHRG. *-------------------------------------------------------------* * ADD OR UPDATE CONTRAST AGENT DAY ENTRY FOR THE LIDOS * *-------------------------------------------------------------* PERFORM 11130-SEARCH-PTCA-LIDOS THRU 11130-SEARCH-PTCA-LIDOS-EXIT. 11130-LOAD-PTCA-DAY-TABLE-EXIT. EXIT. *************************************************************** * * * DETERMINE WHETHER A NEW PT CONTRAST AGENT DAY TABLE RECORD * * SHOULD BE ADDED OR IF AN EXISITING RECORD MUST BE UPDATED * * * *************************************************************** 11130-SEARCH-PTCA-LIDOS. *-------------------------------------------------------------* * SEARCH PT CONTRAST AGENT DAY TABLE STARTING AT ENTRY #1 * *-------------------------------------------------------------* SET W-PTCA-DAY-INDX TO 1. SEARCH W-PTCA-DAY-ENTRY VARYING W-PTCA-DAY-INDX *-------------------------------------------------------------* * IF THE SERVICE LINE'S LIDOS IS NOT ALREADY IN THE TABLE, * * ADD IT * *-------------------------------------------------------------* AT END PERFORM 11130-ADD-ENTRY THRU 11130-ADD-ENTRY-EXIT *-------------------------------------------------------------* * IF THE SERVICE LINE'S LIDOS IS ALREADY IN THE TABLE, * * UPDATE THE ENTRY * *-------------------------------------------------------------* WHEN W-PTCA-DAY-LIDOS (W-PTCA-DAY-INDX) = H-PTCA-LIDOS PERFORM 11130-UPDATE-ENTRY THRU 11130-UPDATE-ENTRY-EXIT. 11130-SEARCH-PTCA-LIDOS-EXIT. EXIT. *************************************************************** * * * INSERT THE NEW PT CONTRAST AGENT DAY RECORD IN THE CORRECT * * POSITION (LOWEST TO HIGHEST CAF) OF THE COMPOSITE APC TABLE * * * *************************************************************** 11130-ADD-ENTRY. *-------------------------------------------------------------* * INCREASE THE TOTAL NUMBER OF TABLE RECORDS FOR NEW ENTRY * *-------------------------------------------------------------* ADD 1 TO W-PTCA-DAY-MAX. *-------------------------------------------------------------* * MOVE TO THE NEW ENTRY POSITION (EMPTY RECORD) * *-------------------------------------------------------------* SET W-PTCA-DAY-INDX TO W-PTCA-DAY-MAX. INITIALIZE W-PTCA-DAY-ENTRY (W-PTCA-DAY-INDX). *-------------------------------------------------------------* * DETERMINE WHERE THE NEW PT CONTRAST AGENT DAY ENTRY FOR THE * * CURRENT SERVICE LINE SHOULD BE ENTERED INTO THE TABLE * * ACCORDING TO ITS LIDOS - EARLIEST TO LATEST LIDOS * *-------------------------------------------------------------* PERFORM 11130-STAGE-PTCA-DAY-ENTRY THRU 11130-STAGE-PTCA-DAY-ENTRY-EXT UNTIL W-PTCA-DAY-INDX = 1 OR H-PTCA-LIDOS NOT < W-PTCA-DAY-LIDOS (W-PTCA-DAY-INDX - 1). *-------------------------------------------------------------* * POPULATE THE EMPTY RECORD WITH THE NEW SERVICE LINE'S DATA * *-------------------------------------------------------------* MOVE H-PTCA-LIDOS TO W-PTCA-DAY-LIDOS (W-PTCA-DAY-INDX). MOVE 1 TO W-PTCA-DAY-HCPCS-CNT (W-PTCA-DAY-INDX). MOVE H-SUB-CHRG TO W-PTCA-DAY-TOT-CHRGS (W-PTCA-DAY-INDX). 11130-ADD-ENTRY-EXIT. EXIT. *************************************************************** * * * UPDATE THE EXISTING PT CONTRAST AGENT DAY RECORD WITH THE * * SAME LIDOS AS THE CURRENT SERVICE LINE * * * *************************************************************** 11130-UPDATE-ENTRY. *-------------------------------------------------------------* * ACCUMULATE THE LIDOS'S TOTAL SUBMITTED CHARGES & HCPCS COUNT* *-------------------------------------------------------------* ADD 1 TO W-PTCA-DAY-HCPCS-CNT (W-PTCA-DAY-INDX). ADD H-SUB-CHRG TO W-PTCA-DAY-TOT-CHRGS (W-PTCA-DAY-INDX). 11130-UPDATE-ENTRY-EXIT. EXIT. *************************************************************** * * * MOVE THE EXISTING PT CONTRAST AGENT DAY RECORD WITH A LATER * * LIDOS DOWN ONE RECORD POSITION AND SET THE EMPTY RECORD FOR * * THE NEW ENTRY'S INDEX TO THE NEXT HIGHER RECORD POSITION. * * * *************************************************************** 11130-STAGE-PTCA-DAY-ENTRY. MOVE W-PTCA-DAY-ENTRY (W-PTCA-DAY-INDX - 1) TO W-PTCA-DAY-ENTRY (W-PTCA-DAY-INDX). SET W-PTCA-DAY-INDX DOWN BY 1. 11130-STAGE-PTCA-DAY-ENTRY-EXT. EXIT. *************************************************************** * * * POPULATE PASS-THROUGH DEVICE HCPCS TABLE WITH PASS-THROUGH * * DEVICE LINE INFORMATION * * * *************************************************************** * * * ORDER SERVICE LINES BY SUBMITTED CHARGE * * HIGHEST TO LOWEST, * * THEN BY LINE UNITS * * HIGHEST TO LOWEST * * * * THESE RECORDS ARE LATER USED TO DETERMINE THE PASS-THROUGH * * DEVICE OFFSET AMOUNT IF APPLICABLE. * * * * 08/02/2010 - LOGIC ADDED FOR OCT 2010 * * * *************************************************************** 11132-LOAD-PTDO-HCPCS-TBL. *-------------------------------------------------------------* * POPULATE VARIABLES FOR TABLE SORTING * *-------------------------------------------------------------* MOVE H-SUB-CHRG TO H-PTDO-CHRG. MOVE H-SRVC-UNITS TO H-PTDO-UNITS. *-------------------------------------------------------------* * ADD THE CURRENT PASS-THROUGH DEVICE HCPCS LINE TO TABLE * *-------------------------------------------------------------* PERFORM 11132-ADD-ENTRY THRU 11132-ADD-ENTRY-EXIT. 11132-LOAD-PTDO-HCPCS-TBL-EXIT. EXIT. *************************************************************** * * * INSERT THE NEW PT DEVICE HCPCS RECORD IN THE CORRECT * * POSITION (HIGHEST TO LOWEST SUBMITTED CHARGE & THEN HIGHEST * * TO LOWEST LINE UNITS) * * * *************************************************************** 11132-ADD-ENTRY. *-------------------------------------------------------------* * INCREASE THE TOTAL NUMBER OF TABLE RECORDS FOR NEW ENTRY * *-------------------------------------------------------------* ADD 1 TO W-PTDO-HCPCS-MAX. *-------------------------------------------------------------* * MOVE TO THE NEW ENTRY POSITION (EMPTY RECORD) * *-------------------------------------------------------------* SET W-PTDO-HCPCS-INDX TO W-PTDO-HCPCS-MAX. INITIALIZE W-PTDO-HCPCS-ENTRY (W-PTDO-HCPCS-INDX). *-------------------------------------------------------------* * DETERMINE WHERE THE NEW PT DEVICE HCPCS ENTRY FOR THE * * CURRENT SERVICE LINE SHOULD BE ENTERED INTO THE TABLE * * ACCORDING TO ITS SUBMITTED CHARGES & LINE UNITS (BOTH * * HIGHEST TO LOWEST) * *-------------------------------------------------------------* PERFORM 11132-STAGE-PTDO-HCPCS-ENTRY THRU 11132-STAGE-PTDO-HCPCS-ENTRY-X UNTIL W-PTDO-HCPCS-INDX = 1 OR H-PTDO-CHRGUNIT NOT > W-PTDO-HCPCS-CHRGUNIT (W-PTDO-HCPCS-INDX - 1). *-------------------------------------------------------------* * POPULATE THE EMPTY RECORD WITH THE NEW SERVICE LINE'S DATA * *-------------------------------------------------------------* MOVE OPPS-HCPCS (LN-SUB) TO W-PTDO-HCPCS-HCPCS (W-PTDO-HCPCS-INDX). MOVE LN-SUB TO W-PTDO-HCPCS-LNSUB (W-PTDO-HCPCS-INDX). MOVE H-PTDO-CHRG TO W-PTDO-HCPCS-SUB-CHRG (W-PTDO-HCPCS-INDX). MOVE H-PTDO-UNITS TO W-PTDO-HCPCS-UNITS (W-PTDO-HCPCS-INDX). MOVE 0 TO W-PTDO-HCPCS-PROC-CNT (W-PTDO-HCPCS-INDX). MOVE SPACES TO W-PTDO-HCPCS-PROC-APC (W-PTDO-HCPCS-INDX). MOVE 0 TO W-PTDO-HCPCS-PROC-LNSUB (W-PTDO-HCPCS-INDX). 11132-ADD-ENTRY-EXIT. EXIT. *************************************************************** * * * MOVE THE EXISTING PT CONTRAST AGENT DAY RECORD WITH A LATER * * LIDOS DOWN ONE RECORD POSITION AND SET THE EMPTY RECORD FOR * * THE NEW ENTRY'S INDEX TO THE NEXT HIGHER RECORD POSITION. * * * *************************************************************** 11132-STAGE-PTDO-HCPCS-ENTRY. MOVE W-PTDO-HCPCS-ENTRY (W-PTDO-HCPCS-INDX - 1) TO W-PTDO-HCPCS-ENTRY (W-PTDO-HCPCS-INDX). SET W-PTDO-HCPCS-INDX DOWN BY 1. 11132-STAGE-PTDO-HCPCS-ENTRY-X. EXIT. *************************************************************** * * * VALIDATE CLAIM LINES, CALCULATE LINE DISCOUNTS & OFFSETS, * * ACCUMULATE CLAIM TOTALS, SET FLAGS, POPULATE COINSURANCE & * * BLOOD DEDUCTIBLE TABLES WITH VALID SERVICE LINES, POPULATE * * COMPOSITE APC TABLE WITH NON-PRIME COMPOSITE LINE CHARGES, * * AND CALCULATE TOTAL PACKAGED MENTAL HEALTH CHARGES. * * CREATE PASS-THROUGH CONTRAST AGENT PROC TABLE (NEW CY2010) * * CREATE PASS-THROUGH DEVICE PROC TABLE (NEW OCT 2010) * * * * ** UPDATE PARTIAL HOSPITALIZATION (PHP) & MENTAL HEALTH * * (MH) TABLE REFERENCES EVERY JANUARY * * * *************************************************************** * * * VALIDATION RULES & RETURN CODES: * * -------------------------------- * * * * 1. VERIFY THE SERVICE INDICATOR PASSED BY THE OCE * * - IF INVALID SET RETURN CODE TO '40' * * - DISCONTINUE LINE PROCESSING * * - IF VALID SET RETURN CODE TO '01' * * - CONTINUE LINE PROCESSING * * 2. PROCESS LINES AND LOAD WORK TABLE ACCORDING TO PRICE * * RANKING * * 3. CHECK OCE EDIT INDICATORS AND SET RETURN CODES IF * * INDICATORS ARE INVALID. * * - VALID RETURN CODES FOR EDIT INDICATORS * * - '41' - SERVICE INDICATOR INVALID FOR OPPS PRICER * * - '42' - APC = '00000' OR (PACKAGING FLAG = 1, 2,OR 4)* * - '43' - PAYMENT INDICATOR NOT = TO 1 OR 5 THRU 9 * * - '44' - SERVICE INDICATOR = 'H' BUT PAYMENT * * INDICATOR NOT = TO 6 * * - '45' - PACKAGING FLAG NOT = TO 0, 1, 2, 3, OR 4 * * - '46' - (LINE ITEM DENIAL/REJECT FLAG NOT = TO 0 * * OR LINE ITEM DENIAL/REJECT FLAG = TO 1 * * AND (NOT A PARTIAL HOSPITALIZATION OR * * MENTAL HEALTH HCPCS)) * * OR LINE ITEM ACTION FLAG NOT = TO 1 * * - '47' - LINE ITEM ACTION FLAG = 2 OR 3 * * - '48' - PAYMENT ADJUSTMENT FLAG NOT VALID * * - '49' - SITE OF SERVICE FLAG NOT = TO 0 * * - OR (PARTIAL HOSP. APC IS NOT ON THE CLAIM * * AND SERVICE INDICATOR = 'P' * * OR PARTIAL HOSPITALIZATION HCPCS) * * 4. IF OCE INDICATORS ARE VALID, SEARCH APC TABLE * * - IF MISSING, DELETED OR INVALID APC * * - SET RETURN CODE TO '30' * * - DISCONTINUE LINE PROCESSING * * * *************************************************************** 11150-INIT. *************************************************************** * INITIALIZE LINE RETURN CODE TO VALID VALUE * *************************************************************** MOVE 01 TO A-RETURN-CODE (LN-SUB). *************************************************************** * OVERRIDE SERVICE UNITS FOR APC 0339 - EFFECTIVE 04/01/2002 * *************************************************************** IF OPPS-APC (LN-SUB) = '0339' MOVE 1 TO OPPS-SRVC-UNITS (LN-SUB). *************************************************************** * CALCULATE DISCOUNT RATE (FOR REDUCED COIN & OFFSET CALCS) * *************************************************************** MOVE OPPS-SRVC-UNITS (LN-SUB) TO H-SRVC-UNITS. PERFORM 11250-CALC-DISCOUNT THRU 11250-CALC-DISCOUNT-EXIT. IF A-RETURN-CODE (LN-SUB) = 42 GO TO 11150-INIT-EXIT. *************************************************************** * FLAG LINE IF THE LINE APC IS A RADIOPHARM APC * * ** NEW LIST EVERY JANUARY ** * *-------------------------------------------------------------* * 11/13/2008 - LOGIC ADDED B/C THERAP. RADIO. LINES MUST BE * * EXCLUDED FROM SI=H DEVICE UNIT CALCULATION * * 11/16/2009 - LOGIC REMOVED BECAUSE THERAP. RADIO NO LONGER * * HAVE AN SI=H (NOT PAID AT COST) * *************************************************************** * PERFORM 11660-SET-RADIOPH-APC-FLAG * THRU 11660-SET-RADIOPH-APC-FLAG-EXIT. *************************************************************** * ACCUMULATE TOTAL CLAIM DEVICE SERVICE UNITS -AND- * * FLAG CLAIMS THAT HAVE AT LEAST ONE DEVICE LINE * * - SI = H IDENTIFIES DEVICE LINES * * - EFFECTIVE AS OF 04-01-2002 * *-------------------------------------------------------------* * 11/16/2009 - RADIOPH-APC-FLAG CHECK REMOVED B/C NO THX * * RADIOPHARMS HAVE SI=H FOR CY 2010 * * 08/11/2010 - DISABLED & REPLACED BY REVISED LOGIC * *************************************************************** * IF OPPS-SRVC-IND (LN-SUB) = ' H' * MOVE 'Y' TO C-FLAG * COMPUTE H-TOT-HTD-UNITS = * H-TOT-HTD-UNITS + H-SRVC-UNITS. *************************************************************** * ACCUMULATE CLAIM TOTAL OFFSET AMOUNT & OFFSET UNITS * * WHEN PASS-THROUGH/OFFSET DEVICE APPEARS ON THE CLAIM * *-------------------------------------------------------------* * - HCPCS C1820 EXPIRES FROM PASS-THRU PMT 01-01-2008. THERE * * ARE NO OFFSET DEVICES FOR CY 2008; LOGIC RETAINED & ALL * * OFFSET AMOUNTS IN OFFSET TABLE SET TO $0. * * - THERE ARE NO PASS-THROUGH/OFFSET DEVICES FOR CY 2009 * * C1820-OFFSET-FLAG ALWAYS = 'N', OFFSET LOGIC NOT * * NEVER PERFORMED, RETAINED FOR FUTURE USE * * - 08/02/2010: DISABLED CODE, REPLACED BY REVISED LOGIC * *************************************************************** * IF C1820-OFFSET-FLAG = 'Y' * PERFORM 11160-TOTAL-OFFSET * THRU 11160-TOTAL-OFFSET-EXIT. *************************************************************** * CREATE NUCLEAR MEDICINE APC TABLE FOR PASS-THROUGH * * RADIOPHARM OFFSET WHEN PASS-THROUGH RADIOPHARM(S) ON CLAIM * * EFFECTIVE APRIL 2009 * *************************************************************** IF PTRADIO-CLAIM-FLAG = 'Y' PERFORM 11165-PROCESS-NUCLEAR-MED THRU 11165-PROCESS-NUCLEAR-MED-EXIT. *************************************************************** * CREATE CONTRAST AGENT PROCEDURE TABLE FOR PASS-THROUGH * * CONTRAST AGENT OFFSET WHEN PT CONTRAST AGENT(S) ON CLAIM * * EFFECTIVE JANUARY 2010 * *************************************************************** IF PTCA-CLAIM-FLAG = 'Y' PERFORM 11168-PROCESS-PTCA-PROC THRU 11168-PROCESS-PTCA-PROC-EXIT. *************************************************************** * CREATE PASS-THROUGH DEVICE PROCEDURE TABLE FOR PASS- * * THROUGH DEVICE OFFSET WHEN PT DEVICE(S) ON CLAIM * * EFFECTIVE OCTOBER 2010 * *************************************************************** IF PTDO-CLAIM-FLAG = 'Y' PERFORM 11169-PROCESS-PTDO-PROC THRU 11169-PROCESS-PTDO-PROC-EXIT. *************************************************************** * SET AND INTIALIZE LINE SPECIFIC DATA ITEMS * *************************************************************** *-------------------------------------------------------------* * SET COIN & BLOOD DEDUCTIBLE TABLES UP FOR CURRENT LINE * *-------------------------------------------------------------* SET W-LP-INDX TO LN-SUB. SET W-BD-INDX TO LN-SUB. INITIALIZE W-LP-ENTRY (W-LP-INDX). INITIALIZE W-BD-ENTRY (W-BD-INDX). *-------------------------------------------------------------* * INITIALIZE LINE ITEM VARIABLES TO BE PASSED BACK * *-------------------------------------------------------------* MOVE ZERO TO A-LITEM-PYMT (LN-SUB) A-LITEM-REIM (LN-SUB) A-ADJ-COIN (LN-SUB) A-RED-COIN (LN-SUB) A-TOTAL-LN-DEDUCT (LN-SUB) A-BLOOD-LN-DEDUCT (LN-SUB). *-------------------------------------------------------------* * INITIALIZE LINE FLAGS * *-------------------------------------------------------------* * 11/05/2007 - PHP-HCPCS-FLAG & MH-HCPCS-FLAG ADDED * *-------------------------------------------------------------* MOVE 'N' TO PHP-HCPCS-FLAG MH-HCPCS-FLAG. *************************************************************** * SEARCH PARTIAL HOSPITALIZATION (PHP) TABLE FOR LINE HCPCS * * (LOGIC NEW FOR CY2008; ADDED 11/5/2007) * * 11/15/2010 - FOR CY 2011, USE CY 2010 TABLE * *************************************************************** SEARCH ALL PHP-ENTRY10 AT END MOVE 'N' TO PHP-HCPCS-FLAG WHEN PHP-HCPCS10 (PHP-INDX10) = OPPS-HCPCS (LN-SUB) MOVE 'Y' TO PHP-HCPCS-FLAG. *************************************************************** * SEARCH MENTAL HEALTH (MH) TABLE FOR LINE HCPCS * * (LOGIC NEW FOR CY2008; ADDED 11/5/2007) * * 11/15/2010 - FOR CY 2011, USE CY 2010 TABLE * * 11/04/2011 - FOR CY 2012, USE CY 2012 TABLE * *************************************************************** SEARCH ALL MH-ENTRY12 AT END MOVE 'N' TO MH-HCPCS-FLAG WHEN MH-HCPCS12 (MH-INDX12) = OPPS-HCPCS (LN-SUB) MOVE 'Y' TO MH-HCPCS-FLAG. *************************************************************** * POPULATE PASS-THROUGH DEVICE TABLE W/ PASS-THROUGH * * DEVICE LINE DATA (FOR OUTLIER PAYMENT ADJUSTMENT) * *-------------------------------------------------------------* * 11/16/2009 - RADIOPH-APC-FLAG CHECK REMOVED B/C NO THX * * RADIOPHARMS HAVE SI=H FOR CY 2010 * *************************************************************** IF A-RETURN-CODE (LN-SUB) = 01 AND PTD-FLAG = 'Y' AND OPPS-SRVC-IND (LN-SUB) = ' H' PERFORM 11665-SET-PTD-LINE-FLAG THRU 11665-SET-PTD-LINE-FLAG-EXIT IF PTD-LINE-FLAG = 'Y' MOVE OPPS-HCPCS (LN-SUB) TO W-PTD-LINE-HCPCS PERFORM 11390-PASS-THRU-DEVICES THRU 11390-PASS-THRU-DEVICES-EXIT END-IF END-IF. *************************************************************** * * * ** CHECK LINE OCE VALUES FOR VALIDITY ** * * * *************************************************************** *************************************************************** * IDENTIFY ALL VALID SERVICE INDICATORS (SI) & RETURN * * ERROR CODE 40 IF THE SI IS INVALID. * *************************************************************** IF NOT (OPPS-SRVC-IND (LN-SUB) = ' A' OR ' B' OR ' C' OR ' E' OR ' F' OR ' G' OR ' H' OR ' K' OR ' L' OR ' N' OR ' P' OR ' R' OR ' S' OR ' T' OR ' U' OR ' V' OR ' X' OR ' W' OR ' Y' OR ' Z' OR ' M') THEN MOVE 40 TO A-RETURN-CODE (LN-SUB) GO TO 11150-INIT-EXIT ELSE MOVE 01 TO A-RETURN-CODE (LN-SUB). *************************************************************** * IDENTIFY SERVICE INDICATORS (SI) NOT VALID FOR THE OPPS * * PRICER & RETURN ERROR CODE 41 IF THE SI IS INVALID * * FOR THE OPPS PRICER. * *************************************************************** IF OPPS-SRVC-IND (LN-SUB) = ' A' OR ' B' OR ' C' OR ' E' OR ' F' OR ' L' OR ' W' OR ' Y' OR ' Z' OR ' M' MOVE 41 TO A-RETURN-CODE (LN-SUB) GO TO 11150-INIT-EXIT. *************************************************************** ** ** ** NOTE: ERROR CODES FOR THE VALIDATION RULES BELOW ARE ** ** ASSIGNED IN THE ELSE STATMENTS AFTER THE APC ** ** TABLE SEARCH. ** ** ** *************************************************************** *************************************************************** * IDENTIFY VALID PAYMENT INDICATORS & RETURN ERROR CODE 43 * * IF THE PAYMENT INDICATOR IS INVALID. * *************************************************************** IF OPPS-PYMT-IND (LN-SUB) = ' 1' OR ' 5' OR ' 6' OR ' 7' OR ' 8' OR ' 9' *************************************************************** * IDENTIFY VALID PACKAGING FLAGS & RETURN ERROR CODE 45 * * IF THE PACKAGING FLAG IS INVALID. * *************************************************************** IF OPPS-PKG-FLAG (LN-SUB) = '0' OR '1' OR '2' OR '3' OR '4' *************************************************************** * IDENTIFY VALID LINE ITEM DENIAL OR REJECTION (D/R) FLAGS * * AND VALID D/R FLAG-HCPCS COMBINATIONS & RETURN ERROR CODE * * 46 IF THE D/R FLAG OR D/R FLAG-HCPCS COMBO IS INVALID. * *-------------------------------------------------------------* * 11/6/2007 - CHANGED PHP/MENTAL HEALTH CODES LISTED FROM * * APCS TO HCPCS (VIA TABLE SEARCH) FOR CY 2008 * *************************************************************** *--------------------------------------------------------* * LINE IS NOT DENIED OR REJECTED * *--------------------------------------------------------* IF ( OPPS-LITEM-DR-FLAG (LN-SUB) = '0' OR *--------------------------------------------------------* * LINE IS DENIED OR REJECTED AND HAS A PHP OR MH HCPCS * *--------------------------------------------------------* OPPS-LITEM-DR-FLAG (LN-SUB) = '1' AND ( PHP-HCPCS-FLAG = 'Y' OR MH-HCPCS-FLAG = 'Y' ) ) OR *--------------------------------------------------------* * LINE ITEM DENIAL/REJECTION CODE IS IGNORED * *--------------------------------------------------------* ( OPPS-LITEM-ACT-FLAG (LN-SUB) = '1' ) *************************************************************** * IDENTIFY INVALID LINE ITEM ACTION FLAGS & RETURN ERROR * * CODE 47 IF THE LINE ITEM ACTION FLAG IS INVALID. * *************************************************************** IF NOT (OPPS-LITEM-ACT-FLAG (LN-SUB) EQUAL '2' OR '3') *************************************************************** * IDENTIFY VALID PAYMENT ADJUSTMENT FLAGS (PAF) & RETURN * * ERROR CODE 48 IF THE PAF IS INVALID. * *-------------------------------------------------------------* * 10/31/2007 - ADDED ' 8' AS A VALID PAF FOR CY 2008 * * 12/06/2007 - ADDED PAFS 91 - 99 FOR COMPOSITES FOR CY 2008 * * 11/03/2008 - REMOVED PAFS 91 - 99 FOR COMPOSITES FOR CY 2009* * 04/11/2011 - ADDED ' 9' & '10' AS VALID PAFS FOR CY 2011 * *************************************************************** IF OPPS-PYMT-ADJ-FLAG (LN-SUB) = ' 0' OR ' 1' OR ' 2' OR ' 3' OR ' 4' OR ' 5' OR ' 6' OR ' 7' OR ' 8' OR ' 9' OR '10' *************************************************************** * IDENTIFY VALID SITE OF SERVICE (SOS) FLAG AND CASES * * WHERE THE SOS FLAG IS IGNORED & RETURN ERROR CODE 49 IF * * THE SOS FLAG IS INVALID AND NOT IGNORED. * * * * ** SITE OF SERVICE FLAG = PAYMENT METHOD FLAG IN OCE ** * * * * NOTE: PHP = PARTIAL HOSPITALIZATION * * WHEN SI = 'P', PHP APC IS ON THE CURRENT LINE * *-------------------------------------------------------------* * 11/06/2007 - CHANGED PHP HEALTH CODES LISTED FROM * * APCS TO HCPCS (VIA TABLE SEARCH) FOR CY 2008 * * 11/03/2008 - CHANGED PARTIAL HOSPITALIZATION APC FROM * * 0033 TO 0172 & 0173 FOR CY 2009, FLAG CHANGED * * FROM APC33-FLAG TO PHP-APC-FLAG * *************************************************************** *-------------------------------------------------------------* * LINE SOS FLAG IS VALID * *-------------------------------------------------------------* IF (OPPS-SITE-SRVC-FLAG (LN-SUB) = '0') OR *-------------------------------------------------------------* * LINE SOS FLAG INVALID & PHP APC ON CLAIM - CHECK FURTHER * *-------------------------------------------------------------* ( (PHP-APC-FLAG = 'Y') AND *-------------------------------------------------------------* * LINE SOS FLAG INVALID, PHP APC ON CLAIM, & LINE APC IS PHP* *-------------------------------------------------------------* ( (OPPS-SRVC-IND (LN-SUB) = ' P') OR *-------------------------------------------------------------* * LINE SOS FLAG INVALID, PHP APC ON CLAIM, & LINE PHP HCPCS * *-------------------------------------------------------------* (PHP-HCPCS-FLAG = 'Y') ) ) *************************************************************** * * * ** ACCUMULATE TOTAL CHARGES OF ALL LINES THAT PASS ** * * ** VALIDATION RULES ** * * * *************************************************************** MOVE OPPS-SUB-CHRG (LN-SUB) TO H-SUB-CHRG COMPUTE H-TOT-CHRG = H-TOT-CHRG + H-SUB-CHRG *-------------------------------------------------------------* * EXCLUDE LINES THAT RECEIVE EXTERNAL LINE ITEM ADJ. * *-------------------------------------------------------------* IF OPPS-LITEM-ACT-FLAG (LN-SUB) = '4' COMPUTE H-TOT-CHRG = H-TOT-CHRG - H-SUB-CHRG END-IF *-------------------------------------------------------------* * ACCUMULATE PACKAGED LINE TOTAL CHARGES & SET CLAIM N-FLAG * * EXCLUDE ALL PACKAGED COMPOSITE LINES * *-------------------------------------------------------------* * 11/28/2007 - LOGIC ADDED TO EXCLUDE COMPOSITE & MENTAL * * HEALTH LINES (APC34-FLAG INDICATES MH) * * 08/08/2008 - LOGIC CORRECTED TO ADD CHARGES OF PACKAGED * * LINES WITH A PACKAGING FLAG OF '1' OR '4' TO * * THE CLAIM'S TOTAL DISTRIBUTED PACKAGED * * CHARGES WHEN A CLAIM HAS APC 34 (MENTAL * * HEALTH) ON IT - EFFECTIVE RETROCTIVE TO * * JANUARY 1, 2008. * * 11/12/2008 - CHANGED LOGIC THAT EXCLUDES ALL COMPOSITE * * LINES & MENTAL HEALTH PKG LINES TO USE THE * * COMPOSITE ADJUSTMENT FLAG INSTEAD OF PAYMENT * * ADJUSTMENT FLAG VALUES 91 - 99 * *-------------------------------------------------------------* IF (OPPS-PKG-FLAG (LN-SUB) = '1' OR '2' OR '4') AND (OPPS-COMP-ADJ-FLAG (LN-SUB) = '00') COMPUTE H-TOT-N-CHRG = H-SUB-CHRG + H-TOT-N-CHRG MOVE 'Y' TO N-FLAG END-IF *-------------------------------------------------------------* * ACCUMULATE PACKAGED MENTAL HEALTH LINE CHARGES * *-------------------------------------------------------------* * 11/28/2007 - LOGIC ADDED FOR CY 2008 * * 11/12/2008 - LOGIC DISABLED B/C MENTAL HEALTH COMPOSITE * * LINES ARE NOW IDENTIFIED WITH THE COMPOSITE * * ADJUSTMENT FLAG JUST AS ALL OTHER COMPOSITES * * (MENTAL HEALTH COMPOSITE LINES NOW HAVE A * * PACKAGING FLAG OF '1' (CY 2009) * *-------------------------------------------------------------* * IF (APC34-FLAG = 'Y') AND * (OPPS-SRVC-IND (LN-SUB) = ' N') AND * (OPPS-PKG-FLAG (LN-SUB) = '1') * COMPUTE H-TOT-MH-CHRG = H-SUB-CHRG + * H-TOT-MH-CHRG * END-IF *-------------------------------------------------------------* * ACCUMULATE NON-PRIME (PACKAGED) COMPOSITE APC CHARGES * * FOR EACH COMPOSITE APC BY THE COMPOSITE ADJUSTMENT FLAG * * (POPULATE COMPOSITE TABLE) * *-------------------------------------------------------------* * 11/28/2007 - LOGIC ADDED FOR CY 2008 * * 11/12/2007 - LOGIC REVISED FOR CY 2009 TO IDENTIFY ALL * * COMPOSITE LINES USING THE COMPOSITE * * ADJUSTMENT FLAG INSTEAD OF PAYMENT * * ADJUSTMENT FLAG VALUES 91 - 99 * * (INCLUDES PROCESSING FOR MENTAL HEALTH * * COMPOSITES) * *-------------------------------------------------------------* IF OPPS-COMP-ADJ-FLAG (LN-SUB) NOT = "00" AND OPPS-COMP-ADJ-FLAG (LN-SUB) NOT = " " AND OPPS-SRVC-IND (LN-SUB) = ' N' PERFORM 11170-COMPOSITES THRU 11170-COMPOSITES-EXIT END-IF *-------------------------------------------------------------* * RETURN ERROR CODE WHEN PACKAGED LINE OR LINE APC = 0000 * *-------------------------------------------------------------* IF (OPPS-APC (LN-SUB) = '0000') OR (OPPS-PKG-FLAG (LN-SUB) = '1' OR '2' OR '4') MOVE 42 TO A-RETURN-CODE (LN-SUB) GO TO 11150-INIT-EXIT END-IF *************************************************************** * * * ** LOOK-UP LINE APC IN APC TABLE FOR ALL LINES THAT ** * * ** PASS VALIDATION RULES ** * * * *************************************************************** SEARCH ALL WAA-ENTRY AT END MOVE 30 TO A-RETURN-CODE (LN-SUB) GO TO 11150-INIT-EXIT WHEN WAA-APC (WAA-INDX) = OPPS-GRP (LN-SUB) *-------------------------------------------------------------* * START SEARCH AT THE APC'S MOST CURRENT RECORD * *-------------------------------------------------------------* MOVE WAA-PTR (WAA-INDX) TO W-SUB2 *-------------------------------------------------------------* * GET APC DATA FROM THE REC WITH THE CORRECT EFFECTIVE DATE * *-------------------------------------------------------------* PERFORM 11175-APC-LOOKUP *-------------------------------------------------------------* * REDUCE APC PMT BY REDUCED UPDATE RATIO WHEN APPROPRIATE * * 11/13/2009 - NEW FOR CY 2009 (QUALITY) * *-------------------------------------------------------------* PERFORM 11180-REDUCE-APC-PYMT THRU 11180-REDUCE-APC-PYMT-EXIT *************************************************************** * * * ** RETURN ERROR CODE AND STOP PROCESSING LINES ** * * ** THAT FAIL OCE VALIDATION RULES ** * * * *************************************************************** ELSE MOVE 49 TO A-RETURN-CODE (LN-SUB) GO TO 11150-INIT-EXIT ELSE MOVE 48 TO A-RETURN-CODE (LN-SUB) GO TO 11150-INIT-EXIT ELSE MOVE 47 TO A-RETURN-CODE (LN-SUB) GO TO 11150-INIT-EXIT ELSE MOVE 46 TO A-RETURN-CODE (LN-SUB) GO TO 11150-INIT-EXIT ELSE MOVE 45 TO A-RETURN-CODE (LN-SUB) GO TO 11150-INIT-EXIT ELSE MOVE 43 TO A-RETURN-CODE (LN-SUB) GO TO 11150-INIT-EXIT. *************************************************************** * PROCESS BLOOD DEDUCTIBLE (EFFECTIVE AS OF 07-01-2005) * * - TOTAL BLOOD CODE CHARGES WHEN PAF = '5' OR '6' * * 5: BLOOD/BLOOD PRODUCT USED IN BLOOD DEDUC CALC * * 6: BLOOD PROCESS/STORAGE (LABOR) NOT SBJ TO BLD DEDUC * *************************************************************** IF OPPS-PYMT-ADJ-FLAG (LN-SUB) = ' 5' COMPUTE H-TOT-38X = OPPS-SUB-CHRG (LN-SUB) + H-TOT-38X. IF OPPS-PYMT-ADJ-FLAG (LN-SUB) = ' 5' OR ' 6' COMPUTE H-TOT-38X-39X = OPPS-SUB-CHRG (LN-SUB) + H-TOT-38X-39X. *************************************************************** * POPULATE COINSURANCE DEDUCTIBLE TABLE W/ ALL VALID LINES * * ORDERED LOWEST TO HIGHEST RANK FROM APC TABLE * *************************************************************** IF A-RETURN-CODE (LN-SUB) = 01 OR 11 PERFORM 11300-COIN-DEDUCT THRU 11300-COIN-DEDUCT-EXIT. *************************************************************** * POPULATE BLOOD DEDUCTIBLE TABLE W/ BLOOD DEDUC LINES * * ORDERED EARLIEST TO LATEST DATE OF SERVICE AND THEN * * LOWEST TO HIGHEST RANK FROM BLOOD DEDUCTIBLE TABLE * * (APPLIES WHEN HCPCS IS IN BLOOD DEDUCTIBLE RANKING TABLE) * * * * 05/11/2009 - ADDED THE REQUIREMENT PAF = 5 OR 6 TO BLOOD * * DEDUCTIBLE LOGIC TO CORRECT PRICING ERROR. * * FIX EFFECTIVE RETROACTIVE TO 01/01/2009. * *************************************************************** IF A-RETURN-CODE (LN-SUB) = 01 OR 11 SET W11BD-INDX TO 1 SEARCH W11BD-ENTRY VARYING W11BD-INDX AT END GO TO 11150-INIT-EXIT WHEN W-2011-BLOOD-HCPCS (W11BD-INDX) = OPPS-HCPCS (LN-SUB) IF OPPS-PYMT-ADJ-FLAG (LN-SUB) = (' 5' OR ' 6') MOVE W-2011-BLOOD-RANK (W11BD-INDX) TO H-BLOOD-RANK MOVE OPPS-LITEM-DOS (LN-SUB) TO H-BLD-DOS PERFORM 11375-BLOOD-DEDUCT THRU 11375-BLOOD-DEDUCT-EXIT END-IF. 11150-INIT-EXIT. EXIT. *************************************************************** * * * ACCUMULATE CLAIM TOTAL OFFSET AMT FROM CURRENT OFFSET TABLE * * FOR PASS-THRU ITEMS * * * * *** DISABLED 08/10/2010 & REPLACED WITH REVISED LOGIC *** * * * *************************************************************** * * * - SEARCH TABLE OPPSOF09 FOR LINE APC. * * - CALCULATE TOTAL OFFSET & TOTAL OFFSET UNITS IF APC * * OFFSET AMOUNT IN TABLE NOT EQUAL TO 0. * * * NOTE: C1820 EXPIRES FROM PASS-THRU PAYMENT IN 2009. * * ALL OFFSET AMOUNTS IN THE 2009 TABLE = $0. * * THIS LOGIC KEPT FOR FUTURE OFFSET CODES. * * * * EFFECTIVE AS OF 01-01-2003 * * - CONTINUE FOR 01-01-2004 * * - CONTINUE FOR 01-01-2005 * * - CONTINUE FOR 01-01-2006 * * - CONTINUE FOR 01-01-2007 * * - CONTINUE FOR 01-01-2008 (ALL OFFSETS IN TBL = $0) * * - CONTINUE FOR 01-01-2009 (ALL OFFSETS IN TBL = $0) * * - THIS LOGIC NOT USED FOR CY 2010, REVISED PASS-THROUGH* * OFFSET LOGIC TO BE ADDED WHEN DEVICES ARE APPROVED * * * *************************************************************** *9160-TOTAL-OFFSET. * * MOVE OPPS-GRP (LN-SUB) TO W-OFF-APC. * SEARCH ALL WOO-ENTRY8 * AT END * GO TO 9160-TOTAL-OFFSET-EXIT * WHEN WOO-APC8 (WOO-INDX8) = W-OFF-APC * PERFORM 9161-TOTAL-OFFSET-AMT * THRU 9161-TOTAL-OFFSET-AMT-EXIT. * *9160-TOTAL-OFFSET-EXIT. * EXIT. * * *************************************************************** * * * ACCUMULATE CLAIM TOTAL OFFSET AND OFFSET UNITS * * * *************************************************************** *9161-TOTAL-OFFSET-AMT. * * IF WOO-OFFSET8 (WOO-INDX8) EQUAL 0 * GO TO 9161-TOTAL-OFFSET-AMT-EXIT. * * COMPUTE H-TOTAL-OFFSET = H-TOTAL-OFFSET * + (WOO-OFFSET8 (WOO-INDX8) * H-DISC-RATE * H-SRVC-UNITS). * * COMPUTE H-TOT-OFF-UNITS = H-TOT-OFF-UNITS + H-SRVC-UNITS. * * IF H-TOTAL-OFFSET < 0 * MOVE 0 TO H-TOTAL-OFFSET. * *9161-TOTAL-OFFSET-AMT-EXIT. * EXIT. *************************************************************** * * * PROCESS LINES WITH A NUCLEAR MEDICINE APC FOR THE * * PASS-THROUGH RADIOPHARM OFFSET * * * *************************************************************** * * * - SEARCH TABLE PTROFFST FOR LINE APC & LINE YEAR * * - IF FOUND, ADD A RECORD TO TABLE W-NUCMED-APC-TBL * * FOR EVERY UNIT. * * * * 02/10/2009 - LOGIC ADDED EFFECTIVE STARTING APRIL 2009 * * * *************************************************************** 11165-PROCESS-NUCLEAR-MED. *-------------------------------------------------------------* * HOLD THE LINE'S APC, UNITS, & SERVICE FROM DATE * *-------------------------------------------------------------* MOVE OPPS-GRP (LN-SUB) TO W-NUCMED-LINE-APC. MOVE OPPS-SRVC-UNITS (LN-SUB) TO W-NUCMED-UNIT-CNT. MOVE OPPS-LITEM-DOS (LN-SUB) TO W-LINE-SRVC-DATE. *-------------------------------------------------------------* * SEARCH PT RADIOPHARM OFFSET TABLE FOR THE APC & YEAR * *-------------------------------------------------------------* SET PTRO-INDX TO 1. SEARCH PTRO-ENTRY AT END GO TO 11165-PROCESS-NUCLEAR-MED-EXIT *-------------------------------------------------------------* * WHEN APC & YEAR FOUND, WAGE ADJUST OFFSET & ADD NEW RECORD * * TO NUCLEAR MEDICINE TABLE FOR EVERY UNIT * *-------------------------------------------------------------* WHEN PTRO-NUCMED-APC (PTRO-INDX) = W-NUCMED-LINE-APC AND PTRO-EFF-YEAR (PTRO-INDX) = W-LINE-SRVC-YEAR MOVE PTRO-OFFSET-AMT (PTRO-INDX) TO W-NUCMED-OFFSET COMPUTE W-NUCMED-WA-OFFSET ROUNDED = W-NUCMED-OFFSET * (.6 * A-WINX + .4) PERFORM 11166-LOAD-NUCMED-TABLE THRU 11166-LOAD-NUCMED-TABLE-EXIT VARYING W-NUCMED-SUB FROM 1 BY 1 UNTIL W-NUCMED-SUB > W-NUCMED-UNIT-CNT. 11165-PROCESS-NUCLEAR-MED-EXIT. EXIT. *************************************************************** * * * LOAD A NUCLEAR MEDICINE APC TABLE RECORD FOR EVERY UNIT OF * * THE NUCLEAR MEDICINE LINE AND WAGE ADJUST 60% OF THE OFFSET * * (INSERT THE NEW RECORD IN THE CORRECT TABLE POSITION - * * HIGHEST TO LOWEST OFFSET) * * * *************************************************************** 11166-LOAD-NUCMED-TABLE. *-------------------------------------------------------------* * INCREASE THE TOTAL NUMBER OF TABLE RECORDS FOR NEW ENTRY * *-------------------------------------------------------------* ADD 1 TO W-NUCMED-MAX. *-------------------------------------------------------------* * MOVE TO THE NEW (LAST) ENTRY POSITION (EMPTY RECORD) * *-------------------------------------------------------------* SET W-NUCMED-INDX TO W-NUCMED-MAX. INITIALIZE W-NUCMED-APC-ENTRY (W-NUCMED-INDX). *-------------------------------------------------------------* * DETERMINE WHERE THE NEW NUCMED APC ENTRY FOR THE CURRENT * * SERVICE LINE SHOULD BE ENTERED INTO THE TABLE ACCORDING TO * * ITS OFFSET VALUE - HIGHEST TO LOWEST OFFSET * *-------------------------------------------------------------* PERFORM 11167-STAGE-NUCMED-ENTRY THRU 11167-STAGE-NUCMED-ENTRY-EXIT UNTIL W-NUCMED-INDX = 1 OR W-NUCMED-WA-OFFSET NOT > W-NUCMED-WAGE-ADJ-OFFSET (W-NUCMED-INDX - 1) *-------------------------------------------------------------* * POPULATE THE EMPTY RECORD WITH THE NEW SERVICE LINE'S DATA * *-------------------------------------------------------------* MOVE W-NUCMED-LINE-APC TO W-NUCMED-APC (W-NUCMED-INDX). MOVE W-NUCMED-WA-OFFSET TO W-NUCMED-WAGE-ADJ-OFFSET (W-NUCMED-INDX). 11166-LOAD-NUCMED-TABLE-EXIT. EXIT. *************************************************************** * * * MOVE THE EXISTING NUCMED APC RECORD WITH A HIGHER OFFSET * * DOWN ONE RECORD POSITION AND SET THE EMPTY RECORD FOR THE * * NEW ENTRY'S INDEX TO THE NEXT HIGHER RECORD POSITION. * * * *************************************************************** 11167-STAGE-NUCMED-ENTRY. MOVE W-NUCMED-APC-ENTRY (W-NUCMED-INDX - 1) TO W-NUCMED-APC-ENTRY (W-NUCMED-INDX). SET W-NUCMED-INDX DOWN BY 1. 11167-STAGE-NUCMED-ENTRY-EXIT. EXIT. *************************************************************** * * * PROCESS LINES WITH A PASS-THROUGH CONTRAST AGENT PROCEDURE * * APC FOR THE PASS-THROUGH CONTRAST AGENT OFFSET * * * *************************************************************** * * * - SEARCH TABLE PTCOFFST FOR LINE APC & LINE YEAR * * - IF FOUND, ADD A RECORD TO TABLE W-CAPROC-APC-TBL * * FOR EVERY UNIT. * * * * 11/16/2009 - LOGIC ADDED EFFECTIVE STARTING JANUARY 2010 * * * *************************************************************** 11168-PROCESS-PTCA-PROC. *-------------------------------------------------------------* * HOLD THE LINE'S APC, UNITS, & LINE ITEM DATE OF SERVICE * *-------------------------------------------------------------* MOVE OPPS-GRP (LN-SUB) TO W-CAPROC-LINE-APC. MOVE OPPS-SRVC-UNITS (LN-SUB) TO W-CAPROC-UNIT-CNT. MOVE OPPS-LITEM-DOS (LN-SUB) TO W-CAPROC-SRVC-DATE. *-------------------------------------------------------------* * SEARCH PT CONTRAST AGENT OFFSET TABLE FOR THE APC & YEAR * *-------------------------------------------------------------* SET PTCO-INDX TO 1. SEARCH PTCO-ENTRY AT END GO TO 11168-PROCESS-PTCA-PROC-EXIT *-------------------------------------------------------------* * WHEN APC & YEAR FOUND, WAGE ADJUST OFFSET & ADD NEW RECORD * * TO PT CONTRAST PROCEDURE APC TABLE FOR EVERY UNIT * *-------------------------------------------------------------* WHEN PTCO-CONTR-APC (PTCO-INDX) = W-CAPROC-LINE-APC AND PTCO-EFF-YEAR (PTCO-INDX) = W-CAPROC-SRVC-YEAR MOVE PTCO-OFFSET-AMT (PTCO-INDX) TO W-CAPROC-OFFSET COMPUTE W-CAPROC-WA-OFFSET ROUNDED = W-CAPROC-OFFSET * (.6 * H-WINX1 + .4) PERFORM 11168-LOAD-PTCA-PROC-TABLE THRU 11168-LOAD-PTCA-PROC-TABLE-EXT VARYING W-CAPROC-SUB FROM 1 BY 1 UNTIL W-CAPROC-SUB > W-CAPROC-UNIT-CNT. 11168-PROCESS-PTCA-PROC-EXIT. EXIT. *************************************************************** * * * LOAD A PT CONTRAST AGENT PROCEDURE APC TABLE RECORD FOR * * EVERY UNIT OF THE PT CONTRAST AGENT PROCEDURE LINE * * (INSERT THE NEW RECORD IN THE CORRECT TABLE POSITION - * * EARLIEST TO LATEST LIDOS, THEN HIGHEST TO LOWEST OFFSET) * * * *************************************************************** 11168-LOAD-PTCA-PROC-TABLE. *-------------------------------------------------------------* * INCREASE THE TOTAL NUMBER OF TABLE RECORDS FOR NEW ENTRY * *-------------------------------------------------------------* ADD 1 TO W-CAPROC-MAX. *-------------------------------------------------------------* * MOVE TO THE NEW (LAST) ENTRY POSITION (EMPTY RECORD) * *-------------------------------------------------------------* SET W-CAPROC-INDX TO W-CAPROC-MAX. INITIALIZE W-CAPROC-APC-ENTRY (W-CAPROC-INDX). *-------------------------------------------------------------* * DETERMINE WHERE THE NEW CAPROC APC ENTRY FOR THE CURRENT * * SERVICE LINE SHOULD BE ENTERED INTO THE TABLE ACCORDING TO * * ITS LIDOS & OFFSET VALUE (EARLIEST TO LATEST, HIGHEST TO * * LOWEST) * *-------------------------------------------------------------* PERFORM 11168-STAGE-PTCA-PROC-ENTRY THRU 11168-STAGE-PTCA-PROC-ENTRY-EX UNTIL W-CAPROC-INDX = 1 OR W-CAPROC-KEY NOT > W-CAPROC-TBL-KEY (W-CAPROC-INDX - 1) *-------------------------------------------------------------* * POPULATE THE EMPTY RECORD WITH THE NEW SERVICE LINE'S DATA * *-------------------------------------------------------------* MOVE W-CAPROC-LINE-APC TO W-CAPROC-APC (W-CAPROC-INDX). MOVE W-CAPROC-KEY TO W-CAPROC-TBL-KEY (W-CAPROC-INDX). 11168-LOAD-PTCA-PROC-TABLE-EXT. EXIT. *************************************************************** * * * MOVE THE EXISTING NUCMED APC RECORD WITH A HIGHER OFFSET * * DOWN ONE RECORD POSITION AND SET THE EMPTY RECORD FOR THE * * NEW ENTRY'S INDEX TO THE NEXT HIGHER RECORD POSITION. * * * *************************************************************** 11168-STAGE-PTCA-PROC-ENTRY. MOVE W-CAPROC-APC-ENTRY (W-CAPROC-INDX - 1) TO W-CAPROC-APC-ENTRY (W-CAPROC-INDX). SET W-CAPROC-INDX DOWN BY 1. 11168-STAGE-PTCA-PROC-ENTRY-EX. EXIT. *************************************************************** * * * PROCESS LINES WITH A PASS-THROUGH DEVICE PROCEDURE * * APC FOR THE PASS-THROUGH DEVICE OFFSET * * * *************************************************************** * * * - SEARCH TABLE OPPSPTDO FOR LINE APC * * - IF FOUND, DETERMINE IF IT MAPS TO A PASS-THROUGH * * DEVICE HCPCS, HOW MANY IT MAPS TO, IF SOM STORE * * IT IN THE PASS-THROUGH DEVICE OFFSET PROCEDURE TABLE * * * * 08/02/2010 - LOGIC ADDED EFFECTIVE STARTING OCTOBER 2010 * * 12/20/2011 - LOGIC REVISED TO INCLUDE TERMINATION DATE * * AS A VALID DATE OF SERVICE * * * *************************************************************** 11169-PROCESS-PTDO-PROC. *-------------------------------------------------------------* * INITIALIZE VARIBLES SPECIFIC TO THE CURRENT PROCEDURE LINE * *-------------------------------------------------------------* MOVE 1 TO W-DOPROC-SUB. PERFORM UNTIL W-DOPROC-SUB > W-PTDO-ASSOC-HCPCS-MAX INITIALIZE W-PTDO-ASSOC-HCPCS-HCPCS (W-DOPROC-SUB) INITIALIZE W-PTDO-ASSOC-HCPCS-IND (W-DOPROC-SUB) ADD 1 TO W-DOPROC-SUB END-PERFORM. SET W-PTDO-ASSOC-HCPCS-INDX TO 1. MOVE 0 TO W-PTDO-ASSOC-HCPCS-MAX. MOVE 'N' TO W-PTDO-EOF-SWITCH. INITIALIZE H-PTDO-ASSOC-HCPCS-CTR. INITIALIZE H-PTDO-PROC-KEY. INITIALIZE W-PTDO-DARRAY-MAX. SET PTDO-INDX TO 1. *-------------------------------------------------------------* * HOLD THE LINE'S APC, UNITS, & LINE ITEM DATE OF SERVICE * *-------------------------------------------------------------* MOVE OPPS-GRP (LN-SUB) TO W-DOPROC-LINE-APC. MOVE OPPS-SRVC-UNITS (LN-SUB) TO H-PTDO-PROC-UNITS. MOVE OPPS-LITEM-DOS (LN-SUB) TO W-DOPROC-SRVC-DATE. *-------------------------------------------------------------* * SEARCH PT DEVICE OFFSET TBL FOR EVERY OCCURANCE OF THE APC * * AND CAPTURE EACH ASSOCIATED DEVICE HCPCS * *-------------------------------------------------------------* PERFORM UNTIL W-PTDO-EOF-SWITCH = 'Y' SEARCH PTDO-ENTRY AT END MOVE 'Y' TO W-PTDO-EOF-SWITCH *-------------------------------------------------------------* * EACH TIME A CURRENT RECORD FOR THE APC IS FOUND, ADD THE * * ASSOCIATED HCPCS TO A TABLE, HOLD THE OFFSET AMOUNT, AND * * SEARCH FOR ANOTHER CURRENT RECORD * *-------------------------------------------------------------* WHEN (PTDO-PROC-APC (PTDO-INDX) = W-DOPROC-LINE-APC) AND (PTDO-EFF-DATE (PTDO-INDX) <= W-DOPROC-SRVC-DATE) AND (PTDO-TERM-DATE (PTDO-INDX) = 0 OR PTDO-TERM-DATE (PTDO-INDX) >= W-DOPROC-SRVC-DATE) MOVE 'N' TO W-PTDO-EOF-SWITCH COMPUTE H-PTDO-PROC-WA-OFFSET = ((PTDO-OFFSET-AMT (PTDO-INDX) * .60) * H-WINX1) + (PTDO-OFFSET-AMT (PTDO-INDX) * .40) PERFORM 11169-LOAD-ASSOC-PTD-HCPCS THRU 11169-LOAD-ASSOC-PTD-HCPCS-EXT SET PTDO-INDX UP BY 1 END-SEARCH END-PERFORM. *-------------------------------------------------------------* * SEARCH THE DEVICE OFFSET HCPCS TABLE FOR EACH HCPCS IN * * THE PT DEVICE ASSOCIATED HCPCS TABLE & TRY TO MAP THE HCPCS * * TO THE PROCEDURE APC * *-------------------------------------------------------------* IF W-PTDO-ASSOC-HCPCS-MAX > 0 PERFORM 11169-COUNT-PTDO-MAPPINGS THRU 11169-COUNT-PTDO-MAPPINGS-EXIT VARYING W-DOPROC-SUB FROM 1 BY 1 UNTIL W-DOPROC-SUB > W-PTDO-ASSOC-HCPCS-MAX END-IF. *-------------------------------------------------------------* * CREATE RECORD IN THE OFFSET PROCEDURE APC TABLE IF * * PROCEDURE HAS >= 1 ASSOCIATED DEVICE HCPCS ON THE CLAIM * *-------------------------------------------------------------* IF H-PTDO-ASSOC-HCPCS-CTR > 0 PERFORM 11169-LOAD-PTDO-PROC-TABLE THRU 11169-LOAD-PTDO-PROC-TABLE-EXT END-IF. 11169-PROCESS-PTDO-PROC-EXIT. EXIT. *************************************************************** * * * LOAD THE PASS-THROUGH DEVICE HCPCS ON THE RECORD INTO THE * * PTDO ASSOCIATED HCPCS TABLE * * * *************************************************************** 11169-LOAD-ASSOC-PTD-HCPCS. *-------------------------------------------------------------* * DETERMINE IF THE RECORD'S PTDO HCPCS IS ALREADY IN THE TBL * * IF IT'S NOT IN THE TBL, ADD IT, IF IT IS, DO NOT ADD IT * *-------------------------------------------------------------* SET W-PTDO-ASSOC-HCPCS-INDX TO 1. SEARCH W-PTDO-ASSOC-HCPCS-ENTRY AT END MOVE PTDO-DEV-HCPCS (PTDO-INDX) TO W-PTDO-ASSOC-HCPCS-HCPCS (W-PTDO-ASSOC-HCPCS-INDX) ADD 1 TO W-PTDO-ASSOC-HCPCS-MAX ADD 1 TO W-PTDO-DARRAY-MAX WHEN W-PTDO-ASSOC-HCPCS-HCPCS(W-PTDO-ASSOC-HCPCS-INDX) = PTDO-DEV-HCPCS (PTDO-INDX) GO TO 11169-LOAD-ASSOC-PTD-HCPCS-EXT END-SEARCH. 11169-LOAD-ASSOC-PTD-HCPCS-EXT. EXIT. *************************************************************** * * * DETERMINE HOW MANY PT DEVICE OFFSET HCPCS MAP TO THE OFFSET * * PROCEDURE, AND HOW MANY PROCEDURES MAP TO THE DEVICE HCPCS * * * *************************************************************** 11169-COUNT-PTDO-MAPPINGS. *-------------------------------------------------------------* * SEARCH PT DEVICE OFFSET HCPCS TBL FOR THE CURRENT DEVICE * * HCPCS (IN THE ASSOC. HCPCS TBL) * *-------------------------------------------------------------* SET W-PTDO-HCPCS-INDX TO 1. SEARCH W-PTDO-HCPCS-ENTRY AT END MOVE 'N' TO W-PTDO-ASSOC-HCPCS-IND(W-DOPROC-SUB) WHEN W-PTDO-HCPCS-HCPCS (W-PTDO-HCPCS-INDX) = W-PTDO-ASSOC-HCPCS-HCPCS(W-DOPROC-SUB) MOVE 'Y' TO W-PTDO-ASSOC-HCPCS-IND(W-DOPROC-SUB) ADD 1 TO H-PTDO-ASSOC-HCPCS-CTR ADD 1 TO W-PTDO-HCPCS-PROC-CNT(W-PTDO-HCPCS-INDX). 11169-COUNT-PTDO-MAPPINGS-EXIT. EXIT. *************************************************************** * * * LOAD A PT DEVICE OFFSET PROCEDURE APC TABLE RECORD FOR * * THE CURRENT PROCEDURE LINE IF THERE IS AT LEAST ONE * * ASSOCIATED PT DEVICE ON THE CLAIM * * (INSERT THE NEW RECORD IN THE CORRECT TABLE POSITION - * * HIGHEST TO LOWEST OFFSET, THEN HIGHEST TO LOWEST UNITS) * * * *************************************************************** 11169-LOAD-PTDO-PROC-TABLE. *-------------------------------------------------------------* * INCREASE THE TOTAL NUMBER OF TABLE RECORDS FOR NEW ENTRY * *-------------------------------------------------------------* ADD 1 TO W-PTDO-PROC-MAX. *-------------------------------------------------------------* * MOVE TO THE NEW (LAST) ENTRY POSITION (EMPTY RECORD) * *-------------------------------------------------------------* SET W-PTDO-PROC-INDX TO W-PTDO-PROC-MAX. * INITIALIZE W-PTDO-PROC-ENTRY (W-PTDO-PROC-INDX). *-------------------------------------------------------------* * DETERMINE WHERE THE NEW PROC APC ENTRY FOR THE CURRENT * * SERVICE LINE SHOULD BE ENTERED INTO THE TABLE ACCORDING TO * * ITS OFFSET & UNITS (HIGHEST TO LOWEST, HIGHEST TO LOWEST) * *-------------------------------------------------------------* PERFORM 11169-STAGE-PTDO-PROC-ENTRY THRU 11169-STAGE-PTDO-PROC-ENTRY-EX UNTIL W-PTDO-PROC-INDX = 1 OR H-PTDO-PROC-KEY NOT > W-PTDO-PROC-KEY (W-PTDO-PROC-INDX - 1) *-------------------------------------------------------------* * POPULATE THE EMPTY RECORD WITH THE NEW SERVICE LINE'S DATA * *-------------------------------------------------------------* MOVE W-DOPROC-LINE-APC TO W-PTDO-PROC-APC (W-PTDO-PROC-INDX). MOVE LN-SUB TO W-PTDO-PROC-LNSUB (W-PTDO-PROC-INDX). MOVE H-PTDO-PROC-UNITS TO W-PTDO-PROC-UNITS (W-PTDO-PROC-INDX). MOVE H-PTDO-PROC-WA-OFFSET TO W-PTDO-PROC-WA-OFFSET (W-PTDO-PROC-INDX). MOVE 0 TO W-PTDO-PROC-DEVICE-CNT (W-PTDO-PROC-INDX). MOVE 0 TO W-PTDO-PROC-TOT-DCHRGS (W-PTDO-PROC-INDX). MOVE 0 TO W-PTDO-PROC-TOT-DUNITS (W-PTDO-PROC-INDX). MOVE SPACES TO W-PTDO-PROC-USED (W-PTDO-PROC-INDX). *------------------------------------------------------------* * LOAD HCPCS IN ASSOCIATED HCPCS TABLE INTO THE EMPTY RECORD * *------------------------------------------------------------* MOVE 1 TO W-DOPROC-SUB. MOVE 0 TO W-PTDO-DARRAY-SIZE (W-PTDO-PROC-INDX). PERFORM UNTIL W-DOPROC-SUB > W-PTDO-ASSOC-HCPCS-MAX IF W-PTDO-ASSOC-HCPCS-IND (W-DOPROC-SUB) = 'Y' MOVE W-PTDO-ASSOC-HCPCS-HCPCS (W-DOPROC-SUB) TO W-PTDO-PROC-DHCPCS (W-PTDO-PROC-INDX, W-DOPROC-SUB) ADD 1 TO W-PTDO-DARRAY-SIZE (W-PTDO-PROC-INDX) END-IF ADD 1 TO W-DOPROC-SUB END-PERFORM. 11169-LOAD-PTDO-PROC-TABLE-EXT. EXIT. *************************************************************** * * * MOVE THE EXISTING PROCEDURE RECORD WITH A LOWER OFFSET & * * LOWER UNITS DOWN ONE RECORD POSITION AND SET THE EMPTY * * RECORD FOR THE NEW ENTRY'S INDEX TO THE NEXT HIGHER RECORD * * POSITION. * * * *************************************************************** 11169-STAGE-PTDO-PROC-ENTRY. MOVE W-PTDO-PROC-ENTRY (W-PTDO-PROC-INDX - 1) TO W-PTDO-PROC-ENTRY (W-PTDO-PROC-INDX). SET W-PTDO-PROC-INDX DOWN BY 1. 11169-STAGE-PTDO-PROC-ENTRY-EX. EXIT. *************************************************************** * * * ACCUMULATE NON-PRIME COMPOSITE APC CHARGES FOR EACH * * COMPOSITE APC USING PACKAGED LINES WITH COMPOSITE * * ADJUSTMENT FLAG NOT = '00' & POPULATE COMPOSITE APC TABLE * * * *************************************************************** * * * ORDER SERVICE LINES BY COMPOSITE ADJUSTMENT FLAG (CAF) - * * LOWEST TO HIGHEST FLAG VALUE (01 - NN) * * * * EACH NON-PRIME COMPOSITE PACKAGED LINE'S CHARGES ARE ADDED * * TO THE TOTAL NON-PRIME CHARGES FOR EACH CAF, WHICH * * CORRESPONDS TO THE PRIME LINE'S APC. THESE CHARGES ARE * * LATER ADDED TO THE PRIME LINE'S CHARGES TO CALCULATE THE * * OUTLIER PAYMENT. * * * * 11/28/2007 - LOGIC ADDED FOR CY 2008 * * 11/12/2008 - LOGIC REVISED FOR CY 2009 TO USE THE * * COMPOSITE ADJUSTMENT FLAG INSTEAD OF THE * * PAYMENT ADJUSTMENT FLAG, VARIABLE H-CMP-CAF * * HOLDS COMPOSITE ADJUSTMENT FLAG, VARIABLE * * W-CMP-PAF RETAINED AND NOW HOLDS THE CAF * * (RETAINED TO CONTINUE USE OF EXISTING TABLE) * * * *************************************************************** 11170-COMPOSITES. *-------------------------------------------------------------* * GET THE LINE'S COMPOSITE ADJUSTMENT FLAG FOR TABLE SEARCH * *-------------------------------------------------------------* MOVE OPPS-COMP-ADJ-FLAG (LN-SUB) TO H-CMP-CAF. *-------------------------------------------------------------* * ADD OR UPDATE COMPOSITE APC TABLE ENTRY FOR THE CAF * *-------------------------------------------------------------* PERFORM 11171-SEARCH-CAF THRU 11171-SEARCH-CAF-EXIT. 11170-COMPOSITES-EXIT. EXIT. *************************************************************** * * * DETERMINE WHETHER A NEW COMPOSITE APC TABLE RECORD SHOULD * * BE ADDED OR IF AN EXISITING RECORD NEEDS TO BE UPDATED * * * *************************************************************** 11171-SEARCH-CAF. *-------------------------------------------------------------* * SEARCH COMPOSITE APC TABLE STARTING AT ENTRY #1 * *-------------------------------------------------------------* SET W-CMP-INDX TO 1. SEARCH W-CMP-ENTRY VARYING W-CMP-INDX *-------------------------------------------------------------* * IF THE SERVICE LINE'S COMPOSITE ADJUSTMENT FLAG IS NOT * * ALREADY IN THE TABLE, ADD IT * *-------------------------------------------------------------* AT END PERFORM 11172-ADD-ENTRY THRU 11172-ADD-ENTRY-EXIT *-------------------------------------------------------------* * IF THE SERVICE LINE'S COMPOSITE ADJUSTMENT FLAG IS ALREADY * * IN THE TABLE, UPDATE THE ENTRY * *-------------------------------------------------------------* WHEN W-CMP-PAF (W-CMP-INDX) = H-CMP-CAF PERFORM 11173-UPDATE-ENTRY THRU 11173-UPDATE-ENTRY-EXIT. 11171-SEARCH-CAF-EXIT. EXIT. *************************************************************** * * * INSERT THE NEW COMPOSITE APC RECORD IN THE CORRECT POSITION * * (LOWEST TO HIGHEST CAF) OF THE COMPOSITE APC TABLE * * * *************************************************************** 11172-ADD-ENTRY. *-------------------------------------------------------------* * INCREASE THE TOTAL NUMBER OF TABLE RECORDS FOR NEW ENTRY * *-------------------------------------------------------------* ADD 1 TO W-CMP-MAX. *-------------------------------------------------------------* * MOVE TO THE NEW ENTRY POSITION (EMPTY RECORD) * *-------------------------------------------------------------* SET W-CMP-INDX TO W-CMP-MAX. *-------------------------------------------------------------* * DETERMINE WHERE THE NEW COMPOSITE APC ENTRY FOR THE CURRENT * * SERVICE LINE SHOULD BE ENTERED INTO THE TABLE ACCORDING TO * * ITS COMPOSITE ADJUSTMENT FLAG (CAF) - LOWEST TO HIGHEST CAF * *-------------------------------------------------------------* PERFORM 11174-STAGE-CMP-ENTRY THRU 11174-STAGE-CMP-ENTRY-EXIT UNTIL W-CMP-INDX = 1 OR H-CMP-CAF NOT < W-CMP-PAF (W-CMP-INDX - 1). *-------------------------------------------------------------* * POPULATE THE EMPTY RECORD WITH THE NEW SERVICE LINE'S DATA * *-------------------------------------------------------------* MOVE H-CMP-CAF TO W-CMP-PAF (W-CMP-INDX). MOVE H-SUB-CHRG TO W-CMP-TOT-SUB-CHRG (W-CMP-INDX). 11172-ADD-ENTRY-EXIT. EXIT. *************************************************************** * * * UPDATE THE EXISTING COMPOSITE APC RECORD WITH THE SAME * * COMPOSITE ADJUSTMENT FLAG OF THE CURRENT SERVICE LINE * * * *************************************************************** 11173-UPDATE-ENTRY. *-------------------------------------------------------------* * ACCUMULATE THE CAF'S TOTAL NON-PRIME SUBMITTED CHARGES * *-------------------------------------------------------------* ADD H-SUB-CHRG TO W-CMP-TOT-SUB-CHRG (W-CMP-INDX). 11173-UPDATE-ENTRY-EXIT. EXIT. *************************************************************** * * * MOVE THE EXISTING COMPOSITE APC RECORD WITH A HIGHER CAF * * UP ONE RECORD POSITION AND SET THE EMPTY RECORD FOR THE * * NEW ENTRY'S INDEX TO THE NEXT LOWER RECORD POSITION. * * * *************************************************************** 11174-STAGE-CMP-ENTRY. MOVE W-CMP-ENTRY (W-CMP-INDX - 1) TO W-CMP-ENTRY (W-CMP-INDX). SET W-CMP-INDX DOWN BY 1. 11174-STAGE-CMP-ENTRY-EXIT. EXIT. *************************************************************** * * * LOCATE THE APC RECORD WITH THE APPROPRIATE EFFECTIVE DATE * * - MOVE APC DATA TO HOLD AREA FOR PROCESSING WHEN FOUND * * - ADJUST TOTAL CHARGES FOR DELETED APCS & RETURN ERROR * * - RETURN ERROR WHEN USABLE EFFECTIVE DATE NOT FOUND * * * *************************************************************** 11175-APC-LOOKUP. *************************************************************** * APC RECORD EFFECTIVE DATE IS BEFORE OR ON THE LATEST * * EFFECTIVE DATE THE CLAIM CAN USE (SEARCH STARTS AT THE * * MOST CURRENT RECORD FOR THE APC) * *************************************************************** IF WAR-DTCD (W-SUB2) NOT > WAD-DTCD (WAD-SUB) *-------------------------------------------------------------* * APC RECORD EFFECTIVE DATE CORRECT, APC DELETED - ERROR * *-------------------------------------------------------------* IF WAR-RATEX (W-SUB2) = 'DELETED' MOVE 30 TO A-RETURN-CODE (LN-SUB) COMPUTE H-TOT-CHRG = H-TOT-CHRG - H-SUB-CHRG *-------------------------------------------------------------* * APC RECORD EFFECTIVE DATE CORRECT, APC ACTIVE - ACCEPT REC * *-------------------------------------------------------------* ELSE MOVE WAR-RATE (W-SUB2) TO H-APC-PYMT MOVE WAR-RANK (W-SUB2) TO H-RANK MOVE WAR-MINC (W-SUB2) TO H-MIN-COIN MOVE WAR-COIN (W-SUB2) TO H-NAT-COIN MOVE WAR-PPCT (W-SUB2) TO H-PPCT *************************************************************** * APC RECORD EFFECTIVE DATE IS AFTER THE LATEST EFFECTIVE * * DATE THE CLAIM CAN USE. GO TO THE PREVIOUS RECORD IN THE * * APC TABLE. * *************************************************************** ELSE SUBTRACT 1 FROM W-SUB2 *-------------------------------------------------------------* * PREVIOUS REC BELONGS TO THE LINE APC, TEST EFFECTIVE DATE * *-------------------------------------------------------------* IF W-SUB2 > WAA-PTR (WAA-INDX - 1) GO TO 11175-APC-LOOKUP *-------------------------------------------------------------* * THERE IS NO RECORD FOR THE LINE APC WITH AN ACCEPTABLE * * EFFECTIVE DATE FOR THE LINE. RETURN ZEROS. * *-------------------------------------------------------------* ELSE MOVE 0 TO H-APC-PYMT H-RANK H-MIN-COIN H-NAT-COIN H-PPCT. 11175-APC-LOOKUP-EXIT. EXIT. *************************************************************** * * * REDUCE APC PAYMENT OF LINES FROM PROVIDERS WITH A * * SPACE IN THE QUALITY INDICATOR FIELD OF THE OPSF * * * * LOCATE THE APC RECORD WITH THE APPROPRIATE EFFECTIVE DATE * * - MOVE APC DATA TO HOLD AREA FOR PROCESSING WHEN FOUND * * - ADJUST TOTAL CHARGES FOR DELETED APCS & RETURN ERROR * * - RETURN ERROR WHEN USABLE EFFECTIVE DATE NOT FOUND * * * * 11/16/2010 - ADDED SI = U (BRACHY) TO LOGIC * * * *************************************************************** 11180-REDUCE-APC-PYMT. *-------------------------------------------------------------* * SPECIFY LINES ELIGIBLE FOR REDUCTION * *-------------------------------------------------------------* IF ( L-PSF-HOSP-QUAL-IND = ' ' ) AND ( (OPPS-SRVC-IND (LN-SUB) = ' P') OR (OPPS-SRVC-IND (LN-SUB) = ' R') OR (OPPS-SRVC-IND (LN-SUB) = ' S' AND NOT (OPPS-GRP (LN-SUB) >= '01491' AND OPPS-GRP (LN-SUB) <= '01537')) OR (OPPS-SRVC-IND (LN-SUB) = ' T' AND NOT (OPPS-GRP (LN-SUB) >= '01539' AND OPPS-GRP (LN-SUB) <= '01574')) OR (OPPS-SRVC-IND (LN-SUB) = ' U') OR (OPPS-SRVC-IND (LN-SUB) = ' V') OR (OPPS-SRVC-IND (LN-SUB) = ' X') ) THEN COMPUTE H-APC-PYMT ROUNDED = H-APC-PYMT * 0.980 MOVE 11 TO A-RETURN-CODE (LN-SUB) END-IF. 11180-REDUCE-APC-PYMT-EXIT. EXIT. *************************************************************** * * * DELETED CODE: * * IF DATE OF SERVICE BETWEEN 12/31/2002 AND 04/01/2003 * * IF HCPCS CODE = C9114 OR C9115 ADJUST PAYMENT AND * * COINSURANCE AMOUNTS - LOGIC REMOVED FOR 20050101 * * * *************************************************************** *************************************************************** * * * SEARCH WAGE INDEX TABLE FOR THE CBSA IN THE PROVIDER * * SPECIFIC FILE (PSF) * * * *************************************************************** * * * IF CBSA NOT LOCATED * * - SET CLAIM RETURN CODE TO '50' * * - DISCONTINUE CLAIM PROCESSING * * IF WAGE INDEX EQUALS ZERO * * - SET CLAIM RETURN CODE TO '51' * * - DISCONTINUE CLAIM PROCESSING * * * *************************************************************** 11200-CALC-WAGEINDX. *************************************************************** * STARTING AT THE LAST DATE IN THE TABLE, SEARCH WAGE INDEX * * DATE TABLE FOR THE MOST CURRENT EFFECTIVE DATE THAT CAN BE * * USED BY THE CLAIM * *************************************************************** MOVE WCD-MAX TO WCD-SUB. PERFORM UNTIL L-SERVICE-FROM-DATE NOT < WCD-DATE (WCD-SUB) SUBTRACT 1 FROM WCD-SUB END-PERFORM. *************************************************************** * SEARCH CBSA TABLE FOR THE PSF CBSA * *************************************************************** SEARCH ALL WCM-ENTRY *-------------------------------------------------------------* * PSF CBSA NOT FOUND IN CBSA TABLE, RETURN ERROR * *-------------------------------------------------------------* AT END MOVE 50 TO A-CLM-RTN-CODE GO TO 11200-CALC-WAGEINDX-EXIT *-------------------------------------------------------------* * PSF CBSA FOUND IN CBSA TABLE * *-------------------------------------------------------------* WHEN WCM-CBSA (WCM-INDX) = H-PSF-CBSA *-------------------------------------------------------------* * START SEARCH AT THE MOST CURRENT RECORD FOR THE CBSA * *-------------------------------------------------------------* MOVE WCM-PTR (WCM-INDX) TO W-SUB3 *-------------------------------------------------------------* * GET WAGE INDEX FROM THE REC W/ THE CORRECT EFFECTIVE DATE * *-------------------------------------------------------------* PERFORM 11210-WAGE-LOOKUP. *-------------------------------------------------------------* * ADJUST THE WAGE INDEX BY THE APPROPRIATE STATE SPECIFIC * * RURAL FLOOR BUDGET NEUTRALILTY FACTOR (SSRFBN) * * 11/10/2008 - NEW FOR CY 2009 * * 05/13/2010 - ADDED SECOND SET OF PARAGRAPHS TO APPLY * * DIFFERENT SSRFBN FACTORS FOR 2ND HALF OF YR * * 11/15/2010 - NO SSRFBN TABLE FOR CY 2011; DISABLED * * 11/01/2011 - NO SSRFBN TABLE FOR CY 2012; STAYS DISABLED * *-------------------------------------------------------------* * IF L-SERVICE-FROM-DATE < 20100701 * PERFORM 11220-APPLY-SSRFBN * THRU 11220-EXIT * ELSE * PERFORM 11226-APPLY-SSRFBN-2ND-HALF * THRU 11226-EXIT * END-IF. *************************************************************** * RETURN ERROR IF WAGE INDEX = 0 OR NOT NUMERIC * *************************************************************** IF H-WINX1 = 0 OR H-WINX1 NOT NUMERIC THEN MOVE 51 TO A-CLM-RTN-CODE. 11200-CALC-WAGEINDX-EXIT. EXIT. *************************************************************** * * * LOCATE THE CBSA RECORD WITH THE APPROPRIATE EFFECTIVE DATE * * WHEN FOUND, SELECT THE APPLICABLE WAGE INDEX VALUE * * * *************************************************************** 11210-WAGE-LOOKUP. *************************************************************** * WAGE INDEX RECORD EFFECTIVE DATE IS BEFORE OR ON THE * * LATEST EFFECTIVE DATE THE CLAIM CAN USE - CORRECT * * (SEARCH STARTS AT THE MOST CURRENT RECORD FOR THE CBSA) * *************************************************************** IF WCW-DTCD (W-SUB3) NOT > WCD-DTCD (WCD-SUB) *-------------------------------------------------------------* * THIS PROVIDER HAS RECLASSIFIED, USE THE WAGE INDEX IN THE * * SECOND COLUMN FOR RECLASSIFYING PROVIDERS. * *-------------------------------------------------------------* IF L-PSF-SPEC-PYMT-IND = 'Y' MOVE WCW-WINX2 (W-SUB3) TO H-WINX1 *-------------------------------------------------------------* * THIS PROVIDER HAS NOT RECLASSIFIED, USE THE WAGE INDEX IN * * THE FIRST COLUMN FOR AREA PROVIDERS. * *-------------------------------------------------------------* ELSE MOVE WCW-WINX1 (W-SUB3) TO H-WINX1 *************************************************************** * WAGE INDEX RECORD EFFECTIVE DATE IS AFTER LATEST EFFECTIVE * * DATE THE CLAIM CAN USE. GO TO THE PREVIOUS RECORD IN THE * * CBSA WAGE INDEX TABLE. * *************************************************************** ELSE SUBTRACT 1 FROM W-SUB3 *-------------------------------------------------------------* * PREVIOUS REC BELONGS TO THE PSF CBSA, TEST EFFECTIVE DATE * *-------------------------------------------------------------* IF W-SUB3 > WCM-PTR (WCM-INDX - 1) GO TO 11210-WAGE-LOOKUP *-------------------------------------------------------------* * THERE IS NO RECORD FOR THE PSF CBSA WITH AN ACCEPTABLE * * EFFECTIVE DATE FOR THE LINE. RETURN ZERO. * *-------------------------------------------------------------* ELSE MOVE 0 TO H-WINX1. 11210-WAGE-LOOKUP-EXIT. EXIT. *************************************************************** * * * ADJUST THE WAGE INDEX BY THE STATE SPECIFIC * * RURAL FLOOR BUDGET NEUTRALITY FACTOR (SSRFBN) * * (NO SSRFBN TABLE FOR CY 2012 - DISABLED) * * * *************************************************************** *10220-APPLY-SSRFBN. * *-------------------------------------------------------------* * THE PROVIDER'S STATE IS THE SSRFBN TABLE SEARCH KEY; * * SEARCH SSRFBN TABLE FOR APPROPRIATE FACTOR * *-------------------------------------------------------------* * MOVE L-PSF-PROV-ST TO MES-PPS-STATE-10. * PERFORM 10225-FIND-SSRFBN * THRU 10225-EXIT. * *-------------------------------------------------------------* * ADJUST THE WAGE INDEX BY THE SSRFBN FACTOR FOUND IN THE TBL * *-------------------------------------------------------------* * IF H-WINX1 NOT = 0 AND * H-WINX1 IS NUMERIC AND * A-CLM-RTN-CODE NOT = 51 * COMPUTE H-WINX1 ROUNDED = * H-WINX1 * MES-SSRFBN-RATE-10 * END-IF. * *10220-EXIT. * EXIT. *************************************************************** * * * FIND THE STATE SPECIFIC RURAL FLOOR BUDGET * * NEUTRALITY FACTOR (SSRFBN) * * (CY 2010 - 1ST HALF 1/1 - 6/30) * * (NO SSRFBN TABLE FOR CY 2012 - DISABLED) * * * *************************************************************** *10225-FIND-SSRFBN. * *----------------------------------------------------------------* * SEARCH SSRFBN STARTING WITH THE FIRST RECORD * *----------------------------------------------------------------* * SET SSRFBN-IDX10 TO 1. * SEARCH SSRFBN-TAB-10 VARYING SSRFBN-IDX10 * *----------------------------------------------------------------* * PROVIDER STATE NOT FOUND IN SSRFBN TABLE, ASSIGN ERROR CODE * *----------------------------------------------------------------* * AT END * MOVE 51 TO A-CLM-RTN-CODE * GO TO 10225-EXIT * *----------------------------------------------------------------* * PROVIDER STATE FOUND, CAPTURE SSRFBN FACTOR * *----------------------------------------------------------------* * WHEN WK-SSRFBN-STATE-10 (SSRFBN-IDX10) = MES-PPS-STATE-10 * MOVE WK-SSRFBN-REASON-ALL-10 (SSRFBN-IDX10) * TO MES-SSRFBN-10. * *10225-EXIT. * EXIT. *************************************************************** * * * ADJUST THE WAGE INDEX BY THE STATE SPECIFIC * * RURAL FLOOR BUDGET NEUTRALITY FACTOR (SSRFBN) * * (NO SSRFBN TABLE FOR CY 2012 - DISABLED) * * * *************************************************************** *10226-APPLY-SSRFBN-2ND-HALF. * *-------------------------------------------------------------* * THE PROVIDER'S STATE IS THE SSRFBN TABLE SEARCH KEY; * * SEARCH SSRFBN TABLE FOR APPROPRIATE FACTOR * *-------------------------------------------------------------* * MOVE L-PSF-PROV-ST TO MES-PPS-STATE-10B. * PERFORM 10227-FIND-SSRFBN-2ND-HALF * THRU 10227-EXIT. * *-------------------------------------------------------------* * ADJUST THE WAGE INDEX BY THE SSRFBN FACTOR FOUND IN THE TBL * *-------------------------------------------------------------* * IF H-WINX1 NOT = 0 AND * H-WINX1 IS NUMERIC AND * A-CLM-RTN-CODE NOT = 51 * COMPUTE H-WINX1 ROUNDED = * H-WINX1 * MES-SSRFBN-RATE-10B * END-IF. * *10226-EXIT. * EXIT. *************************************************************** * * * FIND THE STATE SPECIFIC RURAL FLOOR BUDGET * * NEUTRALITY FACTOR (SSRFBN) * * (NO SSRFBN TABLE FOR CY 2012 - DISABLED) * * * *************************************************************** *10227-FIND-SSRFBN-2ND-HALF. * *----------------------------------------------------------------* * SEARCH SSRFBN STARTING WITH THE FIRST RECORD * *----------------------------------------------------------------* * SET SSRFBN-IDX10B TO 1. * SEARCH SSRFBN-TAB-10B VARYING SSRFBN-IDX10B * *----------------------------------------------------------------* * PROVIDER STATE NOT FOUND IN SSRFBN TABLE, ASSIGN ERROR CODE * *----------------------------------------------------------------* * AT END * MOVE 51 TO A-CLM-RTN-CODE * GO TO 10227-EXIT * *----------------------------------------------------------------* * PROVIDER STATE FOUND, CAPTURE SSRFBN FACTOR * *----------------------------------------------------------------* * WHEN WK-SSRFBN-STATE-10B (SSRFBN-IDX10B) = * MES-PPS-STATE-10B * MOVE WK-SSRFBN-REASON-ALL-10B (SSRFBN-IDX10B) * TO MES-SSRFBN-10B. * *10227-EXIT. * EXIT. *************************************************************** * * * CALCULATE DISCOUNT RATE BASED ON THE DISCOUNT * * FACTOR PASSED BY THE OCE: VALUES 1 - 9 * * * * IF MISSING OR INVALID DISCOUNT FACTOR * * - SET RETURN CODE TO '38' * * - DISCONTINUE LINE PROCESSING * * * *************************************************************** * * * 11/1/2007 - NEW DISCOUNT INDICATOR 9 ADDED FOR CY 2008 * * * *************************************************************** 11250-CALC-DISCOUNT. IF (H-SRVC-UNITS = 0 AND OPPS-APC (LN-SUB) = '0000') MOVE 42 TO A-RETURN-CODE (LN-SUB) GO TO 11250-CALC-DISCOUNT-EXIT ELSE IF (H-SRVC-UNITS = 0 AND OPPS-APC (LN-SUB) > '0000') MOVE 1 TO H-SRVC-UNITS. IF OPPS-DISC-FACT (LN-SUB) = 1 THEN MOVE 1 TO H-DISC-RATE ELSE IF OPPS-DISC-FACT (LN-SUB) = 2 THEN COMPUTE H-DISC-RATE = (1 + DISC-FRACTION * (H-SRVC-UNITS - 1)) / H-SRVC-UNITS ELSE IF OPPS-DISC-FACT (LN-SUB) = 3 THEN COMPUTE H-DISC-RATE = TERM-PROC-DISC / H-SRVC-UNITS ELSE IF OPPS-DISC-FACT (LN-SUB) = 4 THEN COMPUTE H-DISC-RATE = (1 + DISC-FRACTION) / H-SRVC-UNITS ELSE IF OPPS-DISC-FACT (LN-SUB) = 5 THEN COMPUTE H-DISC-RATE = DISC-FRACTION ELSE IF OPPS-DISC-FACT (LN-SUB) = 6 THEN COMPUTE H-DISC-RATE = (TERM-PROC-DISC * DISC-FRACTION) / H-SRVC-UNITS ELSE IF OPPS-DISC-FACT (LN-SUB) = 7 THEN COMPUTE H-DISC-RATE = (DISC-FRACTION * (1 + DISC-FRACTION) / H-SRVC-UNITS) ELSE IF OPPS-DISC-FACT (LN-SUB) = 8 THEN MOVE 2 TO H-DISC-RATE ELSE IF OPPS-DISC-FACT (LN-SUB) = 9 THEN COMPUTE H-DISC-RATE = 1 / H-SRVC-UNITS ELSE MOVE 38 TO A-RETURN-CODE (LN-SUB). 11250-CALC-DISCOUNT-EXIT. EXIT. *************************************************************** * * * POPULATE COINSURANCE DEDUCTIBLE TABLE WITH SERVICE LINES * * * *************************************************************** * * * ORDER SERVICES LINES BY THE DEDUCTIBLE SEQUENCE - * * LOWEST TO HIGHEST APC RANK FROM APC TABLE * * * * DEDUCTIBLE WILL BE TAKEN FROM OPPS SERVICES FIRST, * * THEN FROM ANY OTHER TYPES OF SERVICES FROM THE CLAIM. * * ALL VALID SERVICE LINES APPEAR IN THIS TABLE IN THE * * ORDER OF THEIR RANK FROM LOWEST TO HIGHEST. * * - THE LOWER THE RANK, THE HIGHER % THE NATIONAL * * UNADJUSTED COINSURANCE IS OF THE APC PAYMENT RATE * * - MOVE ALL LINE PRICING VARIABLES TO STAGING AREA * * (NEW COINSURANCE DEDUCTIBLE TABLE RECORD) * * * * NOTE: THE PURPOSE OF APC RANKING IS TO ENSURE THAT THE * * BENEFICIARY DEDUCTIBLE GOES TOWARD LINES WITH * * HIGHER COINSURANCE %S FIRST. THIS RESULTS IN THE * * BENEFICIARY PAYING LESS TOTAL COINSURANCE FOR THE * * CLAIM. * * * *************************************************************** 11300-COIN-DEDUCT. *-------------------------------------------------------------* * ADD 1 TO THE TOTAL TABLE RECORDS FOR THE NEW ENTRY * *-------------------------------------------------------------* ADD 1 TO W-LNC-MAX. *-------------------------------------------------------------* * MOVE TO THE NEW ENTRY POSITION (EMPTY RECORD) * *-------------------------------------------------------------* SET W-LP-INDX TO W-LNC-MAX. *-------------------------------------------------------------* * DETERMINE WHERE THE NEW SERVICE LINE SHOULD BE ENTERED INTO * * THE TABLE ACCORDING TO ITS RANK AND THE RANK OF THE RECORDS * * ALREADY IN THE TABLE - LOWEST TO HIGHEST RANK. * *-------------------------------------------------------------* PERFORM 11350-STAGE-ENTRY THRU 11350-STAGE-ENTRY-EXIT UNTIL W-LP-INDX = 1 OR H-RANK NOT < W-RANK (W-LP-INDX - 1). *-------------------------------------------------------------* * POPULATE THE EMPTY RECORD WITH THE NEW SERVICE LINE'S DATA * *-------------------------------------------------------------* MOVE LN-SUB TO W-LP-SUB (W-LP-INDX). MOVE H-NAT-COIN TO W-NAT-COIN (W-LP-INDX). MOVE H-MIN-COIN TO W-MIN-COIN (W-LP-INDX). MOVE H-SUB-CHRG TO W-SUB-CHRG (W-LP-INDX). MOVE H-APC-PYMT TO W-APC-PYMT (W-LP-INDX). MOVE H-WINX1 TO W-WINX1 (W-LP-INDX). MOVE H-RANK TO W-RANK (W-LP-INDX). MOVE H-PPCT TO W-PPCT (W-LP-INDX). MOVE H-DISC-RATE TO W-DISC-RATE (W-LP-INDX). *-------------------------------------------------------------* * PARTIAL HOSPITALIZATION LINES RECEIVE 1 SERVICE UNIT * *-------------------------------------------------------------* IF OPPS-SRVC-IND (LN-SUB) = ' P' THEN MOVE 1 TO W-SRVC-UNITS (W-LP-INDX) *-------------------------------------------------------------* * NON-PARTIAL HOSPITALIZATION LINES RECEIVE INPUT SVC UNITS * *-------------------------------------------------------------* ELSE MOVE H-SRVC-UNITS TO W-SRVC-UNITS (W-LP-INDX). *-------------------------------------------------------------* * SEARCH PROVIDER SPECIFIC FILE FOR THE LINE APC. * * IF FOUND, CALCULATE THE REDUCED COINSURANCE AMOUNT FOR * * THE LINE, ENTER IT INTO THE NEW COIN DEDUC TABLE REC, & * * RETURN CODE 25 * *-------------------------------------------------------------* MOVE 0 TO W-RED-COIN (W-LP-INDX). PERFORM VARYING PS-SUB FROM 1 BY 1 UNTIL PS-SUB > L-PSF-APC-LINE-CNT IF L-PSF-APC (PS-SUB) = OPPS-APC (LN-SUB) COMPUTE W-RED-COIN (W-LP-INDX) ROUNDED = L-PSF-RED-COIN (PS-SUB) * H-SRVC-UNITS * H-DISC-RATE MOVE 25 TO A-RETURN-CODE (LN-SUB) MOVE L-PSF-APC-LINE-CNT TO PS-SUB END-IF END-PERFORM. 11300-COIN-DEDUCT-EXIT. EXIT. *************************************************************** * * * MOVE THE EXISTING COINSURANCE DEDUCTIBLE RECORD WITH A * * HIGHER RANK UP ONE RECORD POSITION AND SET THE INDEX OF * * THE EMPTY RECORD FOR THE NEW ENTRY TO THE NEXT LOWER * * RECORD POSITION. * * * *************************************************************** 11350-STAGE-ENTRY. MOVE W-LP-ENTRY (W-LP-INDX - 1) TO W-LP-ENTRY (W-LP-INDX). SET W-LP-INDX DOWN BY 1. 11350-STAGE-ENTRY-EXIT. EXIT. *************************************************************** * * * POPULATE BLOOD DEDUCTIBLE TABLE WITH SERVICE LINES * * THAT HAVE A BLOOD DEDUCTIBLE HCPCS * * * *************************************************************** * * * ORDER SERVICES LINES BY DEDUCTIBLE SEQUENCE - * * 1. EARLIEST TO LATEST DATE OF SERVICE * * 2. LOWEST TO HIGHEST BLOOD RANK FROM BLOOD DEDUC TABLE * * * * DEDUCTIBLES WILL PAID FOR LINES IN THE ORDER OF DATE OF * * SERVICE (EARLIEST TO LATEST) AND THEN BY COST (LEAST TO * * MOST EXPENSIVE). ONLY VALID LINES WITH A HCPCS IN THE * * BLOOD DEDUCTIBLE RANKING TABLE APPEAR IN THIS TABLE. * * - BLOOD RANK OF 1 IS ASSIGNED TO THE LEAST EXPENSIVE * * BLOOD CODE * * - MOVE ALL LINE PRICING VARIABLES TO STAGING AREA * * (NEW BLOOD DEDUCTIBLE TABLE RECORD) * * * * NOTE: THE PURPOSE OF BLOOD LINE RANKING IS TO ENSURE * * THAT THE BENEFICIARY PAYS DEDUCTIBLES FOR THE * * THREE LEAST EXPENSIVE BLOOD PRODUCTS. * * * *************************************************************** 11375-BLOOD-DEDUCT. *-------------------------------------------------------------* * ADD 1 TO THE TOTAL TABLE RECORDS FOR THE NEW ENTRY * *-------------------------------------------------------------* ADD 1 TO W-BLD-MAX. *-------------------------------------------------------------* * MOVE TO THE NEW ENTRY POSITION (EMPTY RECORD) * *-------------------------------------------------------------* SET W-BD-INDX TO W-BLD-MAX. *-------------------------------------------------------------* * DETERMINE WHERE THE NEW SERVICE LINE SHOULD BE ENTERED INTO * * THE TABLE ACCORDING TO ITS RANK AND THE RANK OF THE RECORDS * * ALREADY IN THE TABLE - LOWEST TO HIGHEST RANK. * * (RANK IS THE DATE OF SERVICE & BLOOD RANK) * *-------------------------------------------------------------* PERFORM 11385-STAGE-ENTRY THRU 11385-STAGE-ENTRY-EXIT UNTIL W-BD-INDX = 1 OR H-BLD-RNK NOT < W-BD-RNK (W-BD-INDX - 1). *-------------------------------------------------------------* * POPULATE THE EMPTY RECORD WITH THE NEW SERVICE LINE'S DATA * *-------------------------------------------------------------* MOVE LN-SUB TO W-BD-SUB (W-BD-INDX). MOVE H-NAT-COIN TO W-BD-NAT-COIN (W-BD-INDX). MOVE H-MIN-COIN TO W-BD-MIN-COIN (W-BD-INDX). MOVE H-SUB-CHRG TO W-BD-SUB-CHRG (W-BD-INDX). MOVE H-APC-PYMT TO W-BD-APC-PYMT (W-BD-INDX). MOVE H-WINX1 TO W-BD-WINX1 (W-BD-INDX). MOVE H-BLOOD-RANK TO W-BD-RANK (W-BD-INDX). MOVE H-BLD-DOS TO W-BD-DOS (W-BD-INDX). MOVE H-PPCT TO W-BD-PPCT (W-BD-INDX). MOVE H-DISC-RATE TO W-BD-DISC-RATE (W-BD-INDX). MOVE H-SRVC-UNITS TO W-BD-SRVC-UNITS (W-BD-INDX). *-------------------------------------------------------------* * SEARCH PROVIDER SPECIFIC FILE FOR THE LINE APC. * * IF FOUND, CALCULATE THE REDUCED COINSURANCE AMOUNT FOR * * THE LINE, ENTER IT INTO THE NEW COIN DEDUC TABLE REC, & * * RETURN CODE 25 * *-------------------------------------------------------------* MOVE 0 TO W-BD-RED-COIN (W-BD-INDX). PERFORM VARYING PS-SUB FROM 1 BY 1 UNTIL PS-SUB > L-PSF-APC-LINE-CNT IF L-PSF-APC (PS-SUB) = OPPS-APC (LN-SUB) COMPUTE W-BD-RED-COIN (W-BD-INDX) ROUNDED = L-PSF-RED-COIN (PS-SUB) * H-SRVC-UNITS * H-DISC-RATE MOVE 25 TO A-RETURN-CODE (LN-SUB) MOVE L-PSF-APC-LINE-CNT TO PS-SUB END-IF END-PERFORM. 11375-BLOOD-DEDUCT-EXIT. EXIT. *************************************************************** * * * MOVE THE EXISTING BLOOD DEDUCTIBLE RECORD WITH A * * HIGHER RANK UP ONE RECORD POSITION AND SET THE INDEX OF * * THE EMPTY RECORD FOR THE NEW ENTRY TO THE NEXT LOWER * * RECORD POSITION. * * * *************************************************************** 11385-STAGE-ENTRY. MOVE W-BD-ENTRY (W-BD-INDX - 1) TO W-BD-ENTRY (W-BD-INDX). SET W-BD-INDX DOWN BY 1. 11385-STAGE-ENTRY-EXIT. EXIT. *************************************************************** * * * POPULATE PASS-THROUGH DEVICE TABLE * * (FOR ASSOCIATED PROCEDURE PAYMENT & CHARGE * * ADJUSTMENTS IN THE OUTLIER ROUTINE) * * (IMPLEMENTED IN APRIL 2008 PRICER) * * * *************************************************************** * * * ORDER RECORDS AS FOLLOWS - * * 1. HCPCS, ASCENDING * * 2. LOWEST TO HIGHEST LINE SUBSCRIPT * * * * 02/11/2008 - LOGIC ADDED FOR CY 2008, QTR 2 * * 11/12/2008 - LOGIC NOT CHANGED, NO CY 2009 PT DEVICES * * * *************************************************************** 11390-PASS-THRU-DEVICES. *-------------------------------------------------------------* * ADD 1 TO THE TOTAL TABLE RECORDS FOR THE NEW ENTRY * *-------------------------------------------------------------* ADD 1 TO W-PTD-MAX. *-------------------------------------------------------------* * MOVE TO THE NEW ENTRY POSITION (EMPTY RECORD) * *-------------------------------------------------------------* SET W-PTD-INDX TO W-PTD-MAX. INITIALIZE W-PTD-ENTRY (W-PTD-INDX). *-------------------------------------------------------------* * DETERMINE WHERE THE NEW RECORD SHOULD BE ENTERED INTO THE * * TABLE ACCORDING TO ITS HCPCS AND THE HCPCS OF THE RECORDS * * ALREADY IN THE TABLE - LOWEST TO HIGHEST HCPCS * *-------------------------------------------------------------* PERFORM 11391-STAGE-ENTRY THRU 11391-STAGE-ENTRY-EXIT UNTIL W-PTD-INDX = 1 OR W-PTD-LINE-HCPCS NOT < W-PTD-HCPCS (W-PTD-INDX - 1). *-------------------------------------------------------------* * POPULATE THE EMPTY RECORD WITH THE NEW SERVICE LINE'S DATA * *-------------------------------------------------------------* MOVE OPPS-HCPCS (LN-SUB) TO W-PTD-HCPCS (W-PTD-INDX). MOVE LN-SUB TO W-PTD-SUB (W-PTD-INDX). MOVE OPPS-SUB-CHRG (LN-SUB) TO W-PTD-SUB-CHRG (W-PTD-INDX). 11390-PASS-THRU-DEVICES-EXIT. EXIT. *************************************************************** * * * MOVE THE EXISTING PASS-THROUGH DEVICE RECORD WITH A * * HIGHER HCPCS UP ONE RECORD POSITION AND SET THE INDEX OF * * THE EMPTY RECORD FOR THE NEW ENTRY TO THE NEXT LOWER * * RECORD POSITION. * * * *************************************************************** 11391-STAGE-ENTRY. MOVE W-PTD-ENTRY (W-PTD-INDX - 1) TO W-PTD-ENTRY (W-PTD-INDX). SET W-PTD-INDX DOWN BY 1. 11391-STAGE-ENTRY-EXIT. EXIT. *************************************************************** * * * UPDATE PASS-THROUGH DEVICE TABLE WITH PROCEDURE DATA * * (IMPLEMENTED IN APRIL 2008 PRICER) * * * *************************************************************** * * * 02/11/2008 - LOGIC ADDED FOR CY 2008, QTR 2 * * * *************************************************************** 11392-PASS-THRU-DEV-PROCS. *-------------------------------------------------------------* * LOOP THROUGH ELIGIBLE PROCEDURE'S PASS-THROUGH DEVICE TABLE * *-------------------------------------------------------------* PERFORM 11393-PERFORM-SEARCH THRU 11393-PERFORM-SEARCH-EXIT VARYING W-PTD-PROC-SUB FROM 1 BY 1 UNTIL W-PTD-PROC-SUB > W-PTD-CNT. 11392-PASS-THRU-DEV-PROCS-EXIT. EXIT. *************************************************************** * * * SEARCH FOR THE PASS-THROUGH DEVICE FOR WHICH THE PROCEDURE * * IS ELIGIBLE IN THE TABLE * * * *************************************************************** 11393-PERFORM-SEARCH. *-------------------------------------------------------------* * SEARCH PTD TABLE STARTING AT ENTRY #1 FOR ALL OCCURANCES * * OF THE PASS-THRU DEVICE HCPCS IN THE PASS-THRU DEVICE TABLE.* * THIS IS DONE FOR ALL PASS-THROUGH DEVICES THE PROCEDURE IS * * ELIGIBLE FOR. * *-------------------------------------------------------------* MOVE 'N' TO W-END-OF-PTD-TBL. IF W-PTD-PROC-HCPCS (W-PTD-PROC-SUB) NOT = ' ' SET W-PTD-INDX TO 1 PERFORM 11394-SEARCH-PTD-HCPCS THRU 11394-SEARCH-PTD-HCPCS-EXIT UNTIL W-END-OF-PTD-TBL = 'Y' END-IF. 11393-PERFORM-SEARCH-EXIT. EXIT. *************************************************************** * * * SEARCH FOR THE PASS-THROUGH DEVICE FOR WHICH THE PROCEDURE * * IS ELIGIBLE IN THE TABLE * * * *************************************************************** 11394-SEARCH-PTD-HCPCS. MOVE 'N' TO W-END-OF-PTD-TBL. *-------------------------------------------------------------* * SEARCH PASS-THROUGH DEVICE TABLE * *-------------------------------------------------------------* SEARCH W-PTD-ENTRY VARYING W-PTD-INDX *-------------------------------------------------------------* * IF THERE ARE NO MORE OCCURANCES OF THE PASS-THROUGH DEVICE, * * STOP THE SEARCH AND INDICATE END OF FILE * *-------------------------------------------------------------* AT END MOVE 'Y' TO W-END-OF-PTD-TBL GO TO 11394-SEARCH-PTD-HCPCS-EXIT *-------------------------------------------------------------* * IF THE PASS-THROUGH DEVICE IS FOUND, INDICATE NOT END OF * * FILE AND UPDATE THE DEVICE'S RECORD WITH THE PROCEDURE DATA * *-------------------------------------------------------------* WHEN W-PTD-HCPCS (W-PTD-INDX) = W-PTD-PROC-HCPCS (W-PTD-PROC-SUB) MOVE 'N' TO W-END-OF-PTD-TBL PERFORM 11395-UPDATE-ENTRY THRU 11395-UPDATE-ENTRY-EXIT SET W-PTD-INDX UP BY 1 END-SEARCH. 11394-SEARCH-PTD-HCPCS-EXIT. EXIT. *************************************************************** * * * UPDATE THE EXISTING PASS-THROUGH DEVICE RECORD WITH THE * * CURRENT ELIGIBLE PROCEDURE'S DATA * * * *************************************************************** 11395-UPDATE-ENTRY. *-------------------------------------------------------------* * UPDATE PASS-THROUGH DEVICE RECORD * *-------------------------------------------------------------* ADD 1 TO W-PTD-PROC-CNT (W-PTD-INDX). ADD OPPS-SRVC-UNITS (LN-SUB) TO W-PTD-TOTAL-PROC-UNITS (W-PTD-INDX). 11395-UPDATE-ENTRY-EXIT. EXIT. *************************************************************** * * * SUM PASS-THROUGH CONTRAST AGENT OFFSET AMOUNT(S) FOR EACH * * DAY ON WHICH A PASS-THROUGH CONTRAST AGENT APPEARS * * * *************************************************************** 11396-TOTAL-DAY-PTCA-OFFS. *-------------------------------------------------------------* * CAPTURE DATE OF SERVICE FROM PT CONTRAST AGENT DAY TABLE * *-------------------------------------------------------------* MOVE W-PTCA-DAY-LIDOS (W-PTCA-DAY-INDX) TO W-CAPROC-SRVC-DATE. *-------------------------------------------------------------* * MOVE TO FIRST RECORD IN PT CONTRAST AGENT PROCEDURE APC TBL * *-------------------------------------------------------------* SET W-CAPROC-INDX TO 1. *-------------------------------------------------------------* * START COUNTER THAT MONITORS THE # OF OFFSETS ADDED * *-------------------------------------------------------------* MOVE 1 TO W-CAPROC-UNIT-CNT. SEARCH W-CAPROC-APC-ENTRY *-------------------------------------------------------------* * DATE OF SERVICE NOT FOUND IN TABLE, STOP PROCESS * *-------------------------------------------------------------* AT END GO TO 11396-TOTAL-DAY-PTCA-OFFS-EXIT *-------------------------------------------------------------* * DATE OF SERVICE FOUND IN TABLE, ACCUMULATE OFFSETS * *-------------------------------------------------------------* WHEN W-CAPROC-LIDOS (W-CAPROC-INDX) = W-CAPROC-SRVC-DATE PERFORM UNTIL * *-------------------------------------------------------* * * STOP SEARCH WHEN END OF TABLE REACHED * * *-------------------------------------------------------* (W-CAPROC-INDX > W-CAPROC-MAX) OR * *-------------------------------------------------------* * * STOP SEARCH WHEN NUMBER OF DAY'S HCPCS LINES EXCEEDED * * *-------------------------------------------------------* (W-CAPROC-UNIT-CNT > W-PTCA-DAY-HCPCS-CNT (W-PTCA-DAY-INDX)) OR * *-------------------------------------------------------* * * STOP SEARCH WHEN DATE OF SERVICE CHANGES * * *-------------------------------------------------------* (W-CAPROC-LIDOS (W-CAPROC-INDX) NOT = W-CAPROC-SRVC-DATE) * *-------------------------------------------------------* * * ADD PT CONTRAST AGENT PROCEDURE OFFSET TO DAY TOTAL * * *-------------------------------------------------------* COMPUTE W-PTCA-DAY-TOT-OFFSET (W-PTCA-DAY-INDX) ROUNDED = W-PTCA-DAY-TOT-OFFSET (W-PTCA-DAY-INDX) + W-CAPROC-WAGE-ADJ-OFFSET (W-CAPROC-INDX) * *-------------------------------------------------------* * * SET POINTER TO NEXT PROCEDURE RECORD * * *-------------------------------------------------------* SET W-CAPROC-INDX UP BY 1 ADD 1 TO W-CAPROC-UNIT-CNT END-PERFORM END-SEARCH. 11396-TOTAL-DAY-PTCA-OFFS-EXIT. EXIT. *************************************************************** * * * MAP EACH PT DEVICE HCPCS ON THE CLAIM TO AN OFFSET * * PROCEDURE WHEN POSSIBLE - FIRST PASS: ASSIGN EACH PROCEDURE * * ONLY ONE PT DEVICE * * * *************************************************************** 11397-PTDO-MAPPINGS-1. *-------------------------------------------------------------* * INITIALIZE VARIABLES SPECIFIC TO THIS PT HCPCS RECORD * *-------------------------------------------------------------* MOVE 'N' TO W-PTDO-EOF-SWITCH. SET W-PTDO-PROC-INDX TO 1. *-------------------------------------------------------------* * SEARCH PTDO PROCEDURE TABLE FOR A PROCEDURE THAT MAPS TO * * THE CURRENT PT DEVICE * *-------------------------------------------------------------* PERFORM UNTIL W-PTDO-EOF-SWITCH = 'Y' SEARCH W-PTDO-PROC-ENTRY AT END MOVE 'Y' TO W-PTDO-EOF-SWITCH GO TO 11397-PTDO-MAPPINGS-1-EXIT *-------------------------------------------------------------* * PROCEDURE NOT ASSIGNED TO A PT DEVICE, SEE IF IT MAPS * *-------------------------------------------------------------* WHEN W-PTDO-PROC-USED (W-PTDO-PROC-INDX) NOT = 'Y' SET W-PTDO-DARRAY-INDX TO 1 MOVE W-PTDO-DARRAY-SIZE (W-PTDO-PROC-INDX) TO W-PTDO-DARRAY-MAX SEARCH W-PTDO-PROC-DARRAY AT END CONTINUE *-------------------------------------------------------------* * PROCEDURE MAPS TO CURRENT PT DEVICE HCPCS * *-------------------------------------------------------------* WHEN W-PTDO-PROC-DHCPCS (W-PTDO-PROC-INDX, W-PTDO-DARRAY-INDX) = W-PTDO-HCPCS-HCPCS (W-PTDO-HCPCS-INDX) MOVE W-PTDO-PROC-APC (W-PTDO-PROC-INDX) TO W-PTDO-HCPCS-PROC-APC (W-PTDO-HCPCS-INDX) MOVE W-PTDO-PROC-LNSUB (W-PTDO-PROC-INDX) TO W-PTDO-HCPCS-PROC-LNSUB (W-PTDO-HCPCS-INDX) MOVE 'Y' TO W-PTDO-PROC-USED (W-PTDO-PROC-INDX) MOVE 1 TO W-PTDO-PROC-DEVICE-CNT (W-PTDO-PROC-INDX) MOVE W-PTDO-HCPCS-SUB-CHRG (W-PTDO-HCPCS-INDX) TO W-PTDO-PROC-TOT-DCHRGS (W-PTDO-PROC-INDX) MOVE W-PTDO-HCPCS-UNITS (W-PTDO-HCPCS-INDX) TO W-PTDO-PROC-TOT-DUNITS (W-PTDO-PROC-INDX) GO TO 11397-PTDO-MAPPINGS-1-EXIT END-SEARCH SET W-PTDO-PROC-INDX UP BY 1 END-SEARCH END-PERFORM. 11397-PTDO-MAPPINGS-1-EXIT. EXIT. *************************************************************** * * * MAP EACH PT DEVICE HCPCS ON THE CLAIM TO AN OFFSET * * PROCEDURE WHEN POSSIBLE - SECOND PASS: ASSIGN PROCEDURES * * ADDITIONAL PT DEVICES WHEN NECESSARY * * * *************************************************************** 11397-PTDO-MAPPINGS-2. *-------------------------------------------------------------* * DETERMINE WHETHER THE PT DEVICE HCPCS NEEDS A PROCEDURE * *-------------------------------------------------------------* IF W-PTDO-HCPCS-PROC-CNT (W-PTDO-HCPCS-INDX) > 0 AND W-PTDO-HCPCS-PROC-APC (W-PTDO-HCPCS-INDX) = SPACES CONTINUE ELSE GO TO 11397-PTDO-MAPPINGS-2-EXIT END-IF. SET W-PTDO-PROC-INDX TO 1. *-------------------------------------------------------------* * INITIALIZE VARIABLES SPECIFIC TO THIS PT HCPCS RECORD * *-------------------------------------------------------------* MOVE 'N' TO W-PTDO-EOF-SWITCH. *-------------------------------------------------------------* * SEARCH PTDO PROCEDURE TABLE FOR A PROCEDURE THAT MAPS TO * * THE CURRENT PT DEVICE * *-------------------------------------------------------------* PERFORM UNTIL W-PTDO-EOF-SWITCH = 'Y' SEARCH W-PTDO-PROC-ENTRY AT END MOVE 'Y' TO W-PTDO-EOF-SWITCH GO TO 11397-PTDO-MAPPINGS-2-EXIT *-------------------------------------------------------------* * PROCEDURE ALREADY ASSIGNED TO PT DEVICE(S) * *-------------------------------------------------------------* WHEN W-PTDO-PROC-USED (W-PTDO-PROC-INDX) = 'Y' OR W-PTDO-PROC-USED (W-PTDO-PROC-INDX) = 'S' SET W-PTDO-DARRAY-INDX TO 1 MOVE W-PTDO-DARRAY-SIZE (W-PTDO-PROC-INDX) TO W-PTDO-DARRAY-MAX SEARCH W-PTDO-PROC-DARRAY AT END CONTINUE *-------------------------------------------------------------* * PROCEDURE MAPS TO CURRENT PT DEVICE HCPCS, SEE IF IT MAPS * *-------------------------------------------------------------* WHEN W-PTDO-PROC-DHCPCS (W-PTDO-PROC-INDX, W-PTDO-DARRAY-INDX) = W-PTDO-HCPCS-HCPCS (W-PTDO-HCPCS-INDX) MOVE W-PTDO-PROC-APC (W-PTDO-PROC-INDX) TO W-PTDO-HCPCS-PROC-APC (W-PTDO-HCPCS-INDX) MOVE W-PTDO-PROC-LNSUB (W-PTDO-PROC-INDX) TO W-PTDO-HCPCS-PROC-LNSUB (W-PTDO-HCPCS-INDX) MOVE 'S' TO W-PTDO-PROC-USED (W-PTDO-PROC-INDX) ADD 1 TO W-PTDO-PROC-DEVICE-CNT (W-PTDO-PROC-INDX) COMPUTE W-PTDO-PROC-TOT-DCHRGS (W-PTDO-PROC-INDX) = W-PTDO-PROC-TOT-DCHRGS (W-PTDO-PROC-INDX) + W-PTDO-HCPCS-SUB-CHRG (W-PTDO-HCPCS-INDX) COMPUTE W-PTDO-PROC-TOT-DUNITS (W-PTDO-PROC-INDX) = W-PTDO-PROC-TOT-DUNITS (W-PTDO-PROC-INDX) + W-PTDO-HCPCS-UNITS (W-PTDO-HCPCS-INDX) GO TO 11397-PTDO-MAPPINGS-2-EXIT END-SEARCH SET W-PTDO-PROC-INDX UP BY 1 END-SEARCH END-PERFORM. 11397-PTDO-MAPPINGS-2-EXIT. EXIT. *************************************************************** * * * CALCULATE LINE PYMNTS, DEDUCTIBLES, REIM., & COINSURANCE, * * ACCUMULATE CLAIM TOTALS, POPULATE DRUG DEDUCTIBLE TABLE, * * UPDATE PASS-THROUGH DEVICE TABLE WITH PROCEDURE & DEVICE * * LINE DATA, MOVE LINE VALUES TO VARIABLES TO BE PASSED BACK * * * *************************************************************** * * * LOOP THROUGH THE COINSURANCE DEDUCTIBLE TABLE TO DO THE * * FOLLOWING FOR EACH SERVICE LINE: * * * * - CHECK ALL APPROPRIATE FLAGS AND INDICATORS FROM OCE * * - SET RETURN CODES TO INDICATE ERRORS OR STATUS * * '20' - LINE PROCESSED BUT PAYMENT = 0, * * BENE DEDUCTIBLE => ADJUSTED PAYMENT * * - CALCULATE & ACCUMULATE LINE AND CLAIM LEVEL ITEMS * * - POPULATE DRUG COINSURANCE TABLE * * - MOVE LINE VARIABLE VALUES TO VARIABLES TO BE PASSED BACK * * * *************************************************************** 11400-CALCULATE. *-------------------------------------------------------------* * SET THE SERVICE LINE SUBSCRIPT TO THE CLAIM SERVICE LINE # * * ASSOCIATED WITH THE COINSURANCE DEDUCTIBLE TABLE RECORD * *-------------------------------------------------------------* MOVE W-LP-SUB (W-LP-INDX) TO LN-SUB. *-------------------------------------------------------------* * STOP PROCESSING LINE IF ERROR CODE * *-------------------------------------------------------------* IF A-RETURN-CODE (LN-SUB) > 25 GO TO 11400-CALCULATE-EXIT. *-------------------------------------------------------------* * CALCULATE THE FOLLOWING FOR VALID LINES IN THE COINSURANCE * * DEDUCTIBLE TABLE WITH A PAYABLE STATUS: * * - LINE ITEM PAYMENT (BASED ON LINE SERVICE INDICATOR) * * - BENEFICIARY DEDUCTIBLE (IN ORDER OF APC RANK) * * - MINIMUM, MAXIMUM, AND REDUCED COINSURANCE AMOUNTS * * - LINE ITEM REIMBURSEMENT IF MAX COIN LIMIT EXCEEDED * *-------------------------------------------------------------* IF OPPS-PYMT-IND (LN-SUB) = ' 1' OR ' 5' OR ' 6' OR ' 7' OR ' 8' PERFORM 11550-CALC-STANDARD THRU 11550-CALC-STANDARD-EXIT ELSE GO TO 11400-CALCULATE-EXIT. *-------------------------------------------------------------* * POPULATE DRUG COINSURANCE TABLE FOR LATER PROCESSING * * - ENFORCE INPATIENT COINSURANCE LIMIT * * - SET GJK-FLAG WHEN SERVICE = G OR K * *-------------------------------------------------------------* IF (A-RETURN-CODE (LN-SUB) < 30) PERFORM 11450-ADJ-PROC-COIN THRU 11450-ADJ-PROC-COIN-EXIT ELSE NEXT SENTENCE. *-------------------------------------------------------------* * FLAG CLAIMS WITH ARTIFICIAL CHARGES AND TOTAL PAYMENTS & * * CHARGES FOR ARTIFICIAL CHARGE AND PACKAGING PROCESSING * *-------------------------------------------------------------* PERFORM 11500-ADJ-CHRGS THRU 11500-ADJ-CHRGS-EXIT. *-------------------------------------------------------------* * UPDATE PASS-THROUGH DEVICE TABLE W/ ELIGIBLE PROCEDURE * * LINE DATA (FOR ASSOCIATED PROCEDURE OUTLIER CALC) * * EFFECTIVE CY 2008 QTR 2, LOGIC ADDED 02/12/2008 * *-------------------------------------------------------------* IF A-RETURN-CODE (LN-SUB) < 30 AND PTD-FLAG = 'Y' AND OPPS-SRVC-IND (LN-SUB) = ' S' OR ' T' OR ' V' OR ' X' PERFORM 11670-SET-PTD-PROC-FLAG THRU 11670-SET-PTD-PROC-FLAG-EXIT IF PTD-PROC-FLAG = 'Y' PERFORM 11392-PASS-THRU-DEV-PROCS THRU 11392-PASS-THRU-DEV-PROCS-EXIT END-IF END-IF. *-------------------------------------------------------------* * ACCUMULATE CLAIM TOTALS USING DATA FROM THE CURRENT VALID * * SERVICE LINE (IN THE COINSURANCE DEDUCTIBLE TABLE) * *-------------------------------------------------------------* IF A-RETURN-CODE (LN-SUB) < 30 COMPUTE A-TOTAL-CLM-DEDUCT = H-TOTAL-LN-DEDUCT + A-TOTAL-CLM-DEDUCT COMPUTE H-TOT-PYMT = H-TOT-PYMT + H-LITEM-PYMT COMPUTE A-BLOOD-DEDUCT-DUE = A-BLOOD-DEDUCT-DUE + H-LN-BLOOD-DEDUCT *-------------------------------------------------------------* * MOVE LINE VALUES TO VARIABLES TO BE PASSED BACK * * - THE LINE REIM. & ADJ-COIN IS ADJUSTED LATER (IF NEEDED) * * FOR THE INPATIENT DAILY LIMIT IN 11840-PROCESS-TYPE2 * *-------------------------------------------------------------* MOVE H-LITEM-PYMT TO A-LITEM-PYMT (LN-SUB) MOVE H-LITEM-REIM TO A-LITEM-REIM (LN-SUB) MOVE H-TOTAL-LN-DEDUCT TO A-TOTAL-LN-DEDUCT (LN-SUB) MOVE H-LN-BLOOD-DEDUCT TO A-BLOOD-LN-DEDUCT (LN-SUB) MOVE H-NAT-COIN TO A-ADJ-COIN (LN-SUB) MOVE H-RED-COIN TO A-RED-COIN (LN-SUB) IF H-RED-COIN > H-NAT-COIN MOVE H-NAT-COIN TO A-RED-COIN (LN-SUB) END-IF IF OPPS-LITEM-ACT-FLAG (LN-SUB) = '4' MOVE 0 TO A-LITEM-PYMT (LN-SUB) MOVE 0 TO A-LITEM-REIM (LN-SUB) COMPUTE H-TOT-PYMT = H-TOT-PYMT - H-LITEM-PYMT END-IF END-IF. *-------------------------------------------------------------* * INITIALIZE LINE VARIABLES FOR THE NEXT SERVICE LINE IN THE * * COINSURANCE DEDUCTIBLE TABLE * *-------------------------------------------------------------* MOVE ZERO TO LINE-HOLD-ITEMS. 11400-CALCULATE-EXIT. EXIT. *************************************************************** * * * POPULATE DRUG COINSURANCE ROLL-UP TABLE WITH THE * * COINSURANCE AMOUNTS OF SERVICE LINES IN THE COINSURANCE * * DEDUCTIBLE TABLE * * * *************************************************************** * * * ORDER LINES BY: * * 1. DATE OF SERVICE (EARLIEST TO LATEST) * * 2. DCP-CODE - TYPE OF ENTRY BASED ON SERVICE INDICATOR * * DCP-CODE OF 1: DAY SUMMARY * * DCP-CODE OF 2: DRUG / BLOOD LINE * * THERE IS ONE TYPE 1 RECORD PER DAY; THERE MAY BE MULTIPLE * * TYPE 2 RECORDS PER DAY - ONE FOR EVERY DRUG LINE * * ("DRUG" REFERS TO ANY SI = G OR K LINE FOR SIMPLICITY) * * * * DRUG COINSURANCE RECORD COMBINATIONS: * * - TYPE 1, COIN1 = 0, COIN2 > 0, & SI = X => * * DRUG(S) ADMINISTERED INDEPENDENT OF A PROCEDURE VISIT * * ON THE DATE OF SERVICE * * - TYPE 1, COIN1 > 0, COIN2 = 0, & SI = S, V, OR T => * * PROCEDURE / VISIT WITH NO DRUG(S) ADMINISTERED ON THE * * DATE OF SERVICE * * - TYPE 1, COIN1 > 0, COIN2 > 0, & SI = S, V, OR T => * * PROCEDURE / VISIT WITH DRUG(S) ADMINISTERED ON THE * * DATE OF SERVICE * * - TYPE 2, COIN1 = 0, COIN2 > 0, & SI = G OR K => * * DRUG ADMINSTERED ON THE DATE OF SERVICE * * * *************************************************************** 11450-ADJ-PROC-COIN. *************************************************************** * MOVE LINE DATE OF SERVICE TO DATE OF SERVICE HOLD AREA * *************************************************************** MOVE OPPS-LITEM-DOS (LN-SUB) TO H-DCP-DOS. *************************************************************** * * * PROCESS SI = S, T, OR V LINES (PROCEDURE OR VISIT) * * * *************************************************************** IF OPPS-SRVC-IND (LN-SUB) = ' S' OR ' T' OR ' V' *-------------------------------------------------------------* * CALCULATE WAGE ADJUSTED LINE NATIONAL COINSURANCE AMOUNT * *-------------------------------------------------------------* COMPUTE H-NEW-WGNAT ROUNDED = W-NAT-COIN (W-LP-INDX) * (.6 * W-WINX1 (W-LP-INDX) + .4) *-------------------------------------------------------------* * ENFORCE INPATIENT LIMIT ON NATIONAL COINSURANCE AMOUNT * *-------------------------------------------------------------* IF H-NEW-WGNAT > H-IP-LIMIT MOVE H-IP-LIMIT TO H-NEW-WGNAT END-IF *-------------------------------------------------------------* * CALCULATE LINE NEW COINSURANCE AMOUNT (ACTUAL COIN DUE) * *-------------------------------------------------------------* COMPUTE H-NEW-COIN = H-LITEM-PYMT - H-TOTAL-LN-DEDUCT - H-LITEM-REIM - H-LN-BLOOD-DEDUCT *-------------------------------------------------------------* * INDICATE TYPE 1 RECORD (ONE TYPE 1 RECORD PER DAY) * *-------------------------------------------------------------* MOVE 1 TO H-DCP-CODE *-------------------------------------------------------------* * ADD OR UPDATE DRUG COINSURANCE TABLE ENTRY FOR THE DOS * *-------------------------------------------------------------* PERFORM 11455-SEARCH-KEY THRU 11455-SEARCH-KEY-EXIT *************************************************************** * * * PROCESS SI = G, K, & R LINES ("DRUG" & BLOOD) * * * *************************************************************** ELSE IF OPPS-SRVC-IND (LN-SUB) = ' G' OR ' K' OR ' R' *-------------------------------------------------------------* * CALCULATE LINE NEW COINSURANCE AMOUNT (ACTUAL COIN DUE) * *-------------------------------------------------------------* COMPUTE H-NEW-COIN = H-LITEM-PYMT - H-TOTAL-LN-DEDUCT - H-LITEM-REIM - H-LN-BLOOD-DEDUCT *-------------------------------------------------------------* * SET GJK-FLAG TO INDICATE "DRUG" LINE * *-------------------------------------------------------------* MOVE 'Y' TO GJK-FLAG *-------------------------------------------------------------* * INDICATE TYPE 1 RECORD (ONE TYPE 1 RECORD PER DAY) * *-------------------------------------------------------------* MOVE 1 TO H-DCP-CODE *-------------------------------------------------------------* * ADD OR UPDATE DRUG COINSURANCE TABLE ENTRY FOR THE DOS * *-------------------------------------------------------------* PERFORM 11455-SEARCH-KEY THRU 11455-SEARCH-KEY-EXIT *-------------------------------------------------------------* * INDICATE TYPE 2 RECORD (ONE TYPE 2 REC FOR EVERY DRUG LINE) * *-------------------------------------------------------------* MOVE 2 TO H-DCP-CODE *-------------------------------------------------------------* * INCREASE THE TOTAL NUMBER OF TABLE RECORDS FOR NEW ENTRY * *-------------------------------------------------------------* ADD 1 TO W-DCP-MAX *-------------------------------------------------------------* * MOVE TO THE NEW ENTRY POSITION (EMPTY RECORD) * * A NEW TYPE 2 RECORD ENTRY IS CREATED FOR EVERY SI = G OR K * * SERVICE LINE REGARDLESS OF THE DATE OF SERVICE * *-------------------------------------------------------------* SET W-DCP-INDX TO W-DCP-MAX *-------------------------------------------------------------* * DETERMINE WHERE THE NEW DRUG / DEVICE COINSURANCE ENTRY * * FOR THE CURRENT SERVICE LINE SHOULD BE ENTERED INTO THE * * TABLE ACCORDING TO ITS DATE OF SERVICE AND RECORD TYPE * * COMBO KEY - LOWEST TO HIGHEST KEY. (RECORD TYPE 2 ONLY) * *-------------------------------------------------------------* PERFORM 11475-STAGE-DCP-ENTRY THRU 11475-STAGE-DCP-ENTRY-EXIT UNTIL W-DCP-INDX = 1 OR H-DCP-STAGE NOT < W-DCP-STAGE (W-DCP-INDX - 1) *-------------------------------------------------------------* * POPULATE THE EMPTY RECORD WITH THE NEW SERVICE LINE'S DATA * * RECORD TYPE 2, "DRUG" * *-------------------------------------------------------------* MOVE LN-SUB TO W-DCP-SUB (W-DCP-INDX) MOVE H-DCP-STAGE TO W-DCP-STAGE (W-DCP-INDX) MOVE ZERO TO W-DCP-COIN1 (W-DCP-INDX) MOVE ZERO TO W-DCP-WGNAT (W-DCP-INDX) MOVE H-NEW-COIN TO W-DCP-COIN2 (W-DCP-INDX) MOVE OPPS-SRVC-IND (LN-SUB) TO W-DCP-SRVC-IND (W-DCP-INDX). 11450-ADJ-PROC-COIN-EXIT. EXIT. *************************************************************** * * * DETERMINE WHETHER A NEW DRUG/DEVICE COINSURANCE TABLE * * RECORD SHOULD BE ADDED OR IF AN EXISITING RECORD NEEDS TO * * BE UPDATED * * * * (RECORD KEY IS DATE OF SERVICE & RECORD TYPE) * * * *************************************************************** 11455-SEARCH-KEY. *-------------------------------------------------------------* * SEARCH DRUG/DEVICE COINSURANCE TABLE STARTING AT ENTRY #1 * *-------------------------------------------------------------* SET W-DCP-INDX TO 1. SEARCH W-DCP-ENTRY VARYING W-DCP-INDX *-------------------------------------------------------------* * IF THE SERVICE LINE'S DATE OF SERVICE AND RECORD TYPE COMBO * * IS NOT ALREADY IN THE TABLE, ADD IT * *-------------------------------------------------------------* AT END PERFORM 11460-ADD-ENTRY THRU 11460-ADD-ENTRY-EXIT *-------------------------------------------------------------* * IF THE SERVICE LINE'S DATE OF SERVICE AND RECORD TYPE COMBO * * IS ALREADY IN THE TABLE, UPDATE THE ENTRY * *-------------------------------------------------------------* WHEN W-DCP-STAGE (W-DCP-INDX) = H-DCP-STAGE PERFORM 11465-UPDATE-ENTRY THRU 11465-UPDATE-ENTRY-EXIT. 11455-SEARCH-KEY-EXIT. EXIT. *************************************************************** * * * INSERT THE NEW COINSURANCE RECORD INTO THE CORRECT POSITION * * (LOWEST TO HIGHEST DATE OF SERVICE - RECORD TYPR COMBO) OF * * THE DRUG / DEVICE COINSURANCE TABLE * * (ONLY PROCESSES TYPE 1 RECORDS) * * * *************************************************************** 11460-ADD-ENTRY. *-------------------------------------------------------------* * INCREASE THE TOTAL NUMBER OF TABLE RECORDS FOR NEW ENTRY * *-------------------------------------------------------------* ADD 1 TO W-DCP-MAX. *-------------------------------------------------------------* * MOVE TO THE NEW ENTRY POSITION (EMPTY RECORD) * *-------------------------------------------------------------* SET W-DCP-INDX TO W-DCP-MAX. *-------------------------------------------------------------* * DETERMINE WHERE THE NEW DRUG / DEVICE COINSURANCE ENTRY * * FOR THE CURRENT SERVICE LINE SHOULD BE ENTERED INTO THE * * TABLE ACCORDING TO ITS DATE OF SERVICE AND RECORD TYPE * * COMBO KEY - LOWEST TO HIGHEST KEY. (TYPE 1 RECORDS ONLY) * *-------------------------------------------------------------* PERFORM 11475-STAGE-DCP-ENTRY THRU 11475-STAGE-DCP-ENTRY-EXIT UNTIL W-DCP-INDX = 1 OR H-DCP-STAGE NOT < W-DCP-STAGE (W-DCP-INDX - 1). *-------------------------------------------------------------* * POPULATE THE EMPTY RECORD WITH THE NEW SERVICE LINE'S DATA * * RECORD TYPE 1, "DRUG" * *-------------------------------------------------------------* IF OPPS-SRVC-IND (LN-SUB) = ' G' OR ' K' OR ' R' MOVE ZERO TO W-DCP-SUB (W-DCP-INDX) MOVE H-DCP-STAGE TO W-DCP-STAGE (W-DCP-INDX) MOVE ZERO TO W-DCP-COIN1 (W-DCP-INDX) MOVE ZERO TO W-DCP-WGNAT (W-DCP-INDX) MOVE H-NEW-COIN TO W-DCP-COIN2 (W-DCP-INDX) MOVE ' X' TO W-DCP-SRVC-IND (W-DCP-INDX) *-------------------------------------------------------------* * POPULATE THE EMPTY RECORD WITH THE NEW SERVICE LINE'S DATA * * RECORD TYPE 1, PROCEDURE OR VISIT * *-------------------------------------------------------------* ELSE MOVE LN-SUB TO W-DCP-SUB (W-DCP-INDX) MOVE H-DCP-STAGE TO W-DCP-STAGE (W-DCP-INDX) MOVE H-NEW-COIN TO W-DCP-COIN1 (W-DCP-INDX) MOVE H-NEW-WGNAT TO W-DCP-WGNAT (W-DCP-INDX) MOVE ZERO TO W-DCP-COIN2 (W-DCP-INDX) MOVE OPPS-SRVC-IND (LN-SUB) TO W-DCP-SRVC-IND (W-DCP-INDX). 11460-ADD-ENTRY-EXIT. EXIT. *************************************************************** * * * UPDATE THE EXISTING DRUG COINSURANCE RECORD WITH THE SAME * * DATE OF SERVICE AND RECORD TYPE OF THE CURRENT SERVICE LINE * * (ONLY PROCESSES TYPE 1 RECORDS) * * * *************************************************************** 11465-UPDATE-ENTRY. *-------------------------------------------------------------* * FOR "DRUG" LINES - ACCUMULATE DAY'S TOTAL "DRUG" COIN DUE * *-------------------------------------------------------------* IF OPPS-SRVC-IND (LN-SUB) = ' G' OR ' K' OR ' R' ADD H-NEW-COIN TO W-DCP-COIN2 (W-DCP-INDX) *-------------------------------------------------------------* * FOR PROCEDURE & VISIT LINES - WHEN THE EXISITING RECORD WAS * * WAS INITIALLY CREATED FOR A "DRUG" LINE, UPDATE THE RECORD * *-------------------------------------------------------------* ELSE IF W-DCP-SRVC-IND (W-DCP-INDX) = ' X' PERFORM 11485-REPLACE-TYPE1 THRU 11485-REPLACE-TYPE1-EXIT *-------------------------------------------------------------* * FOR PROCEDURE & VISIT LINES - WHEN THE EXISTING RECORD HAS * * DATA FROM ANOTHER PROCEDURE / VISIT, ENSURE THE PROC/VISIT * * WITH THE HIGHEST WAGE ADJUSTED NATIONAL COIN IS IN THE TBL * *-------------------------------------------------------------* ELSE PERFORM 11480-RANK-COIN THRU 11480-RANK-COIN-EXIT. 11465-UPDATE-ENTRY-EXIT. EXIT. *************************************************************** * * * MOVE THE EXISTING DRUG COINSURANCE RECORD WITH A HIGHER * * RANK UP ONE RECORD POSITION AND SET THE INDEX OF THE EMPTY * * RECORD FOR THE NEW ENTRY TO THE NEXT LOWER RECORD POSITION. * * * *************************************************************** 11475-STAGE-DCP-ENTRY. MOVE W-DCP-ENTRY (W-DCP-INDX - 1) TO W-DCP-ENTRY (W-DCP-INDX). SET W-DCP-INDX DOWN BY 1. 11475-STAGE-DCP-ENTRY-EXIT. EXIT. *************************************************************** * * * ENSURE THAT THE PROCEDURE/VISIT WITH THE HIGHEST WAGE ADJ. * * NATIONAL COINSURANCE AMOUNT IS IN THE TABLE WHEN THERE ARE * * MULTIPLE PROCEDURES/VISITS ON THE SAME DATE OF SERVICE. * * ONLY ONE PROCEDURE/VISIT'S DATA PER DAY APPEARS IN THE TBL. * * (ONLY PROCESSES TYPE 1 RECORDS) * * * *************************************************************** 11480-RANK-COIN. IF H-NEW-WGNAT > W-DCP-WGNAT (W-DCP-INDX) MOVE LN-SUB TO W-DCP-SUB (W-DCP-INDX) MOVE H-NEW-COIN TO W-DCP-COIN1 (W-DCP-INDX) MOVE H-NEW-WGNAT TO W-DCP-WGNAT (W-DCP-INDX) MOVE OPPS-SRVC-IND (LN-SUB) TO W-DCP-SRVC-IND (W-DCP-INDX). 11480-RANK-COIN-EXIT. EXIT. *************************************************************** * * * ENTER VALUES FROM THE CURRENT SI = S, V, OR T SERVICE LINE * * INTO AN EXISITING RECORD THAT WAS FORMERLY AN SI = G OR K * * ONLY ENTRY. * * - SERVICE LINE REFERENCES CURRENT PROCEDURE / VISIT LINE * * - COIN1 = PROCEDURE / VISIT LINE NEW COINSURANCE AMOUNT * * - COIN2 = DRUG / BLOOD LINE NEW COINSURANCE AMOUNT(S) * * - WAGE ADJUSTED NATIONAL COIN OF CURRENT LINE ENTERED * * - SERVICE INDICATOR = SI OF CURRENT LINE (S, V, OR T) * * * *************************************************************** 11485-REPLACE-TYPE1. MOVE LN-SUB TO W-DCP-SUB (W-DCP-INDX) MOVE H-NEW-COIN TO W-DCP-COIN1 (W-DCP-INDX) MOVE H-NEW-WGNAT TO W-DCP-WGNAT (W-DCP-INDX) MOVE OPPS-SRVC-IND (LN-SUB) TO W-DCP-SRVC-IND (W-DCP-INDX). 11485-REPLACE-TYPE1-EXIT. EXIT. *************************************************************** * * * IDENTIFY CLAIMS THAT HAVE SIGNIFICANT PROCEDURE (SURGERY) * * LINE(S) WITH ARTIFICIAL CHARGES FOR FURTHER PROCESSING, * * ACCUMULATE TOTAL CLAIM PAYMENTS AND CHARGES FOR SIGNIFICANT * * PROCEDURE LINES, AND ACCUMULATE TOTAL CLAIM CHARGES OF ALL * * SEPARATELY PAYABLE LINES. (THE FLAG AND CLAIM TOTALS ARE * * USED IN PARAGRAPH 11600-ADJ-CHRG-OUTL.) * * * *************************************************************** 11500-ADJ-CHRGS. *************************************************************** ** NEW LOGIC INSERTED FOR WEB USE ONLY * *************************************************************** *-------------------------------------------------------------* * FLAG CLAIM WHEN A SIGNIFICANT PROCEDURE LINE HAS ARTIFICIAL * * CHARGES ($1 OR LESS) - FLAGS ENTIRE CLAIM * *-------------------------------------------------------------* * NOTE: LINES WITH CHARGES < $1.01 ARE FIXED BY FISS BEFORE * * ENTERING THE PRICER. THEREFORE, THIS LOGIC IS NO * * LONGER NECESSARY. THIS LOGIC WAS NECESSARY BEFORE * * FISS IMPLEMENTED THE FIX. * *-------------------------------------------------------------* IF ((OPPS-SRVC-IND (LN-SUB) = ' T') OR ((OPPS-SRVC-IND (LN-SUB) = ' S') AND (OPPS-HCPCS (LN-SUB) > '09999' AND OPPS-HCPCS (LN-SUB) < '70000'))) AND (W-SUB-CHRG (W-LP-INDX) < 1.01) MOVE 'Y' TO ST0-FLAG. *-------------------------------------------------------------* * ACCUMULATE TOTAL CLAIM CHARGES AND PAYMENTS FROM UNPACKAGED * * SIGNIFICANT PROCEDURE (SURGERY) LINES * *-------------------------------------------------------------* IF ((OPPS-SRVC-IND (LN-SUB) = ' T') OR ((OPPS-SRVC-IND (LN-SUB) = ' S') AND (OPPS-HCPCS (LN-SUB) > '09999' AND OPPS-HCPCS (LN-SUB) < '70000'))) AND (OPPS-PKG-FLAG (LN-SUB) = '0' OR '3') COMPUTE H-TOT-ST-CHRG = W-SUB-CHRG (W-LP-INDX) + H-TOT-ST-CHRG COMPUTE H-TOT-ST-PYMT = H-LITEM-PYMT + H-TOT-ST-PYMT. *-------------------------------------------------------------* * ACCUMULATE TOTAL CLAIM PAYMENTS FROM UNPACKAGED SEPARATELY * * PAYABLE LINES (FOR PACKAGING LATER) * *-------------------------------------------------------------* * 12/18/2009 - ADD SIS R & U, WHICH ARE ELIGIBLE FOR OUTLIER * *-------------------------------------------------------------* IF (OPPS-SRVC-IND (LN-SUB) = ' S' OR ' T' OR ' V' OR ' X' OR ' P' OR ' R' OR ' U') AND (OPPS-PKG-FLAG (LN-SUB) = '0' OR '3') COMPUTE H-TOT-STVX-PYMT = H-LITEM-PYMT + H-TOT-STVX-PYMT. 11500-ADJ-CHRGS-EXIT. EXIT. *************************************************************** * * * CALCULATE THE FOLLOWING FOR VALID LINES IN THE COINSURANCE * * DEDUCTIBLE TABLE WITH A PAYABLE STATUS: * * - LINE ITEM PAYMENT (BASED ON LINE SERVICE INDICATOR) * * - BENEFICIARY DEDUCTIBLE (IN ORDER OF APC RANK) * * - MINIMUM, MAXIMUM, AND REDUCED COINSURANCE AMOUNTS * * * *************************************************************** * * * 1. CALCULATE STANDARD LINE ITEM PAYMENT (LINE PRICE) * * (APC PAYMENT * WAGE INDEX * SERVICE UNITS * * * DISCOUNT FACTOR) * * WAGE ADJUST 60% OF THE APC PAYMENT FOR SI = S, V, T, P, * * OR X LINES, THESE ARE ELIGIBLE FOR THE SCH ADJUSTMENT * * 2. APPLY DEDUCTIBLE TO HIGHEST NATIONAL COINSURANCE AMOUNT * * DESCENDING UNTIL DEDUCTIBLE = 0. * * 3. ADD LINE PRICE TO OUTLIER HOLD AREA * * 4. CALCULATE THE LINE PRICE FOR DESIGNATED DEVICES * * AND DRUGS & TAKE PT DEVICE OFFSET WHEN APPLICABLE * * 5. CALCULATE DEVICE REDUCTIONS * * * *************************************************************** 11550-CALC-STANDARD. *************************************************************** * INITIALIZE & SET LINE VARIABLES AND FLAGS * *************************************************************** *-------------------------------------------------------------* * INITIALIZE VARIABLE FOR LINES ELIGIBLE FOR BLOOD DEDUCTIBLE * *-------------------------------------------------------------* MOVE 0 TO H-BLOOD-FRACTION. *-------------------------------------------------------------* * FLAG LINE IF THE LINE APC IS A BRACHYTHERAPY APC * * ** NEW LIST EVERY JANUARY ** * *-------------------------------------------------------------* * 11/13/2007 - BRACHY APC CHECK ADDED * * 12/28/2007 - LOGIC MOVED HERE * * 11/12/2008 - LOGIC DISABLED, BRACHYTHERAPY LINES IDENTIFIED * * WITH A STATUS INDICATOR OF ' U' FOR CY 2009 * *-------------------------------------------------------------* * PERFORM 11650-SET-BRACHY-APC-FLAG * THRU 11650-SET-BRACHY-APC-FLAG-EXIT. *-------------------------------------------------------------* * FLAG LINE IF THE LINE HCPCS IS A BLOOD DEDUCTIBLE HCPCS * * ** NEW LIST EVERY JANUARY ** * *-------------------------------------------------------------* * 11/13/2007 - HCPCS LIST MOVED FROM 7550-CALC-GJK TO HERE * * 12/04/2007 - LIST MOVED TO 7655-SET-BD-HCPCS-FLAG * * 12/28/2007 - LOGIC MOVED HERE * *-------------------------------------------------------------* PERFORM 11655-SET-BD-HCPCS-FLAG THRU 11655-SET-BD-HCPCS-FLAG-EXIT. *-------------------------------------------------------------* * FLAG LINE IF THE LINE APC IS A RADIOPHARM APC * * ** NEW LIST EVERY JANUARY ** * *-------------------------------------------------------------* * 12/27/2007 - RADIOPHARM APC CHECK ADDED * * 12/28/2007 - LOGIC MOVED HERE * * 11/16/2009 - LOGIC REMOVED BECAUSE THERAP. RADIO NO LONGER * * HAVE AN SI=H (NOT PAID AT COST) - CY 2010 * *-------------------------------------------------------------* * PERFORM 11660-SET-RADIOPH-APC-FLAG * THRU 11660-SET-RADIOPH-APC-FLAG-EXIT. *-------------------------------------------------------------* * FLAG LINE IF LINE HCPCS IS A PASS-THROUGH RADIOPHARM HCPCS * * ** QUARTERLY UPDATES TO TABLE ** * *-------------------------------------------------------------* * 02/10/2009 - PT RADIOPHARM HCPCS CHECK ADDED * *-------------------------------------------------------------* PERFORM 11680-SET-PTRADIO-LINE-FLAG THRU 11680-SET-PTRADIO-LINE-FL-EXIT. *-------------------------------------------------------------* * FLAG LINE IF LINE HCPCS IS A PASS-THROUGH CONTRAST AGENT * * HCPCS ** QUARTERLY UPDATES TO TABLE ** * *-------------------------------------------------------------* * 11/16/2009 - PT CONTRAST AGENT HCPCS CHECK ADDED * *-------------------------------------------------------------* PERFORM 11681-SET-PTCA-LINE-FLAG THRU 11681-SET-PTCA-LINE-FL-EXIT. *************************************************************** * CALCULATE MAXIMUM COINSURANCE AMOUNT (INPATIENT LIMIT) * *************************************************************** COMPUTE H-MAX-COIN ROUNDED = (H-IP-LIMIT * W-SRVC-UNITS (W-LP-INDX) * W-DISC-RATE (W-LP-INDX)). *************************************************************** * CALCULATE FULL AND PARTIAL CREDIT DEVICE REDUCTIONS AND * * REDUCE THE APC PAYMENT BY THE REDUCTION AMOUNT * * PAYMENT ADJUSTMENT FLAGS: 7 = FULL, 8 = PARTIAL CREDIT * *-------------------------------------------------------------* * 11/1/2007 - PYMT ADJ FLAG 8 ADDED FOR PARTIAL CREDIT * * DEDUCTIONS - NEW FOR CY 2008 * *************************************************************** IF OPPS-PYMT-ADJ-FLAG (LN-SUB) = ' 7' OR ' 8' PERFORM 11550-DEVICE-REDUC THRU 11550-DEVICE-REDUC-EXIT. *************************************************************** * CALCULATE PAYMENT FOR SI = S, V, T, P, OR X LINES * * THE APC PAYMENT IS 60% WAGE ADJUSTED * *-------------------------------------------------------------* * 11/13/2007 - ADDED PERFORM 7560-CALC-BENE-DEDUCT * * (REMOVED FROM PARAGRAPH 7550-SCH-ADJ) * *************************************************************** IF (OPPS-SRVC-IND (LN-SUB) = ' S' OR ' V' OR ' T' OR ' P' OR ' X') THEN PERFORM 11550-SCH-ADJ THRU 11550-SCH-ADJ-EXIT PERFORM 11560-CALC-BENE-DEDUCT THRU 11560-CALC-BENE-DEDUCT-EXIT IF OPPS-SRVC-IND (LN-SUB) = ' P' THEN PERFORM 11550-PHP-PMT-FOR-OUTL THRU 11550-PHP-PMT-FOR-OUTL-EXIT END-IF *************************************************************** * CALCULATE PAYMENT FOR SI = H (DEVICE) LINES, PAYMENT IND. * * SHOULD BE 6 FOR THESE LINES (BASED ON CHARGE ADJ. TO COST) * * RETURN ERROR CODE 44 IF THIS IS NOT THE CASE * *-------------------------------------------------------------* * 01/01/2009 - BRACHYTHERAPY SERVICES ADDED FOR CY 2009 * * 11/15/2009 - BRACHYTHERAPY SERVICES (SI=U) REMOVED CY 2010 * * - THERAPEUTIC RADIOPHARMS' SI NOT 'H' FOR CY2010 * * 08/11/2010 - NEW PASS-THROUGH DEVICE OFFSET LOGIC ADDED IN * * PARAGRAPH 10555-CALC-H-STANDARD * *************************************************************** ELSE IF (OPPS-SRVC-IND (LN-SUB) = ' H') THEN IF (OPPS-SRVC-IND (LN-SUB) = ' H' AND OPPS-PYMT-IND (LN-SUB) = ' 6') PERFORM 11555-CALC-H-STANDARD THRU 11555-CALC-H-STANDARD-EXIT PERFORM 11560-CALC-BENE-DEDUCT THRU 11560-CALC-BENE-DEDUCT-EXIT ELSE MOVE 44 TO A-RETURN-CODE (LN-SUB) GO TO 11550-CALC-STANDARD-EXIT END-IF *************************************************************** * CALCULATE PAYMENT FOR SI = G, K, R & U LINES; THE PMT. IND. * * SHOULD BE 1, 5, OR 7 FOR THESE LINES (PAY STANDARD AMOUNT) * * RETURN ERROR CODE 41 IF INVALID SI - PYMT IND. COMBO * *-------------------------------------------------------------* * 12/31/2007 - REMOVED REDUNDANT H-BLOOD-FRAC. INITIALIZATION * * 11/15/2009 - ADDED BRACHYTHERAPY SERVICES (SI=U) FOR CY2010 * * THERAPEUTIC RADIOPHARMS' SI=K FOR CY 2010 * * 11/16/2009 - ADD LOGIC TO ADJUST PT CONTRAST AGENT HCPCS * * LINE PAYMENT BY OFFSET * *************************************************************** ELSE IF OPPS-SRVC-IND (LN-SUB) = ' G' OR ' K' OR ' R' OR ' U' THEN IF OPPS-PYMT-IND (LN-SUB) = ' 1' OR ' 5' OR ' 7' THEN PERFORM 11550-CALC-GJK THRU 11550-CALC-GJK-EXIT IF PTRADIO-LINE-FLAG = 'Y' AND H-NUCMED-TOT-OFFSET > 0 THEN PERFORM 11550-PTRADIO-OFFSET THRU 11550-PTRADIO-OFFSET-EXIT END-IF IF PTCA-LINE-FLAG = 'Y' AND W-PTCA-DAY-MAX > 0 AND W-CAPROC-MAX > 0 THEN PERFORM 11550-PTCA-OFFSET THRU 11550-PTCA-OFFSET-EXIT END-IF PERFORM 11560-CALC-BENE-DEDUCT THRU 11560-CALC-BENE-DEDUCT-EXIT ELSE MOVE 41 TO A-RETURN-CODE (LN-SUB) GO TO 11550-CALC-STANDARD-EXIT END-IF END-IF END-IF END-IF. *************************************************************** * CALCULATE LINE REIMBURSEMENT * *-------------------------------------------------------------* * 11/01/2007 - PERFORMS FOR PARAGRAPHS 7550-PD-AT-CST-JAN07 * * AND 7550-PD-AT-CST-JUL07 WERE DELETED (THE PARAGRAPHS * * WERE ALSO DELETED). THERE IS NO PAID AT COST TABLE FOR * * 2008. UNDER THE ORIGINAL 2008 LEGISLATION, DIAGNOSIS * * RADIOPHARM LINES WERE PACKAGED (SI=' N') AND THERAPEUTIC * * RADIOPHARM AND BRACHYTHERAPY LINES WERE SEPARATELY * * PAYABLE (SI=' K'). THEREFORE, PAID AT COST LOGIC WAS NOT * * NEEDED. * * * * 12/06/2007 - LINE REIMBURSEMENT AND NATIONAL COINSURANCE * * CALCULATIONS, AND MINIMUM COINSURANCE MOVE INSERTED * * (TAKEN FROM 6550-PD-AT-CST-JAN07). * * * * 12/27/2007 - PAID AT COST LOGIC REINSTATED FOR RADIOPHARM * * AND BRACHYTHERAPY LINES WITH A STATUS INDICATOR = ' H'. * * PAID AT COST LOGIC REVISED: NO TABLE OR TABLE SEARCH; * * FLAGS ARE USED INSTEAD. (REINSTATEMENT IS DUE TO A * * CHANGE IN LEGISLATION; ALL RADIO. & BRACHY SI = ' H'.) * * * * 05/14/2008 - PAID AT COST LOGIC NO LONGER APPLIED TO * * RADIOPHARM AND BRACHYTHERAPY LINES AS OF JULY 1, 2008. * * THESE LINES ARE ASSIGNED A SI OF ' K' EFFECTIVE JULY 1, * * 2008, SO THEY WILL AUTOMATICALLY BY-PASS THE LOGIC AND * * RECEIVE THE STANDARD REIM. PAID AT COST LOGIC RETAINED * * FOR PREVIOUS QUARTERS (JANUARY 1 - JUNE 30, 2008). * * * * 08/07/2008 - DUE TO LEGISLATION, THERAPEUTIC RADIOPHARMS & * * BRACHYTHERAPY SOURCE'S SI CHANGED FROM 'K' BACK TO 'H'; * * THEY CONTINUE TO BE PAID AT COST (EFFECTIVE 7/1/2008) * * * * 11/12/2008 - BRACHYTHERAPY SOURCE'S STATUS INDICATOR = ' U' * * EFFECTIVE 1/1/2009 * * * * 11/16/2009 - REMOVED LOGIC FOR THERAPEUTIC RADIOPHARMS & * * BRACHYTHERAPY SOURCES B/C THESE ARE NOT PAID * * AT COST FOR CY 2010 * * * * 04/11/2011 - ADDED LOGIC TO PREVENT LINES WITH PAFS 9 OR 10 * * FROM RECEIVING COINSURANCE & MODIFIED * * REIMBURSEMENT CALCULATION FOR THESE LINES * * * *************************************************************** *-------------------------------------------------------------* * CALCULATE REIMBURSEMENT AND SET COINSURANCE AMOUNTS TO $0 * * FOR LINES WITH A PAF= 9 OR 10 * *-------------------------------------------------------------* IF OPPS-PYMT-ADJ-FLAG (LN-SUB) = (' 9' OR '10') COMPUTE H-LITEM-REIM ROUNDED = H-LITEM-PYMT - H-TOTAL-LN-DEDUCT MOVE 0 TO H-NAT-COIN H-MIN-COIN H-MAX-COIN H-RED-COIN GO TO 11550-CALC-STANDARD-EXIT END-IF. *-------------------------------------------------------------* * STANDARD LINE REIMBURSEMENT CALCULATION * *-------------------------------------------------------------* COMPUTE H-LITEM-REIM ROUNDED = ((H-LITEM-PYMT - H-TOTAL-LN-DEDUCT) - H-LN-BLOOD-DEDUCT) * W-PPCT (W-LP-INDX). *************************************************************** * CALCULATE NATIONAL COINSURANCE * *-------------------------------------------------------------* * 12/6/2007 - LOGIC ADDED (TAKEN FROM 6550-PD-AT-CST-JAN07) * *************************************************************** COMPUTE H-NAT-COIN = H-LITEM-PYMT - H-TOTAL-LN-DEDUCT - H-LITEM-REIM - H-LN-BLOOD-DEDUCT. *************************************************************** * ADJUST MINIMUM COINSURANCE AMOUNT * * (REPLACES WHAT WAS IN THE APC TABLE IF > 0) * *************************************************************** MOVE W-MIN-COIN (W-LP-INDX) TO H-MIN-COIN. IF H-MIN-COIN > 0 *-------------------------------------------------------------* * DRUGS, DEVICES, BRACHYTHERAPY, THERAP. RADIO, & BLOOD * * (SI = G AND H LINES HAVE A MIN-COIN = 0, WON'T ENTER LOGIC) * *-------------------------------------------------------------* IF OPPS-SRVC-IND (LN-SUB) = ' G' OR ' H' OR ' K' OR ' R' OR ' U' COMPUTE H-MIN-COIN ROUNDED = H-MIN-COIN * (W-SRVC-UNITS (W-LP-INDX) - (W-SRVC-UNITS (W-LP-INDX) * H-BLOOD-FRACTION)) * W-DISC-RATE (W-LP-INDX) *-------------------------------------------------------------* * APCS 0158 & 0159'S MIN COINSURANCE = 25% OF LINE PMT * *-------------------------------------------------------------* ELSE IF OPPS-APC (LN-SUB) = '0158' OR '0159' COMPUTE H-MIN-COIN ROUNDED = H-LITEM-PYMT * .25 *-------------------------------------------------------------* * OTHER SERVICE TYPES AND APCS' MIN COIN = 20% OF LINE PMT * *-------------------------------------------------------------* ELSE COMPUTE H-MIN-COIN ROUNDED = H-LITEM-PYMT * .2 END-IF END-IF END-IF. *************************************************************** * ADJUST REDUCED COINSURANCE WHEN NECESSARY & ADJUST CLAIM * * TOTAL LINE ITEM REIMBURSEMENT WHEN THE REDUCED AND/OR * * NATIONAL COINSURANCE AMOUNTS EXCEED THE MAXIMUM COINSURANCE * * (PROVIDER MAY ELECT TO REDUCE COINSURANCE) * *************************************************************** MOVE W-RED-COIN (W-LP-INDX) TO H-RED-COIN. IF (H-RED-COIN > 0 AND < H-MIN-COIN) MOVE H-MIN-COIN TO H-RED-COIN ELSE IF H-RED-COIN < H-NAT-COIN AND > H-MIN-COIN AND > H-MAX-COIN COMPUTE H-LITEM-REIM = H-LITEM-REIM + (H-RED-COIN - H-MAX-COIN) END-IF END-IF. IF H-NAT-COIN > H-MAX-COIN AND H-RED-COIN = 0 THEN COMPUTE H-LITEM-REIM = H-LITEM-REIM + (H-NAT-COIN - H-MAX-COIN) MOVE H-MAX-COIN TO H-NAT-COIN. 11550-CALC-STANDARD-EXIT. EXIT. *************************************************************** * * * DELETED CODE: * * PAID AT COST WITH COINSURANCE TABLE SEARCH REMOVED * * 11/1/2007 FOR CY 2008. THERE IS NO NEW PAID AT COST * * TABLE FOR 2008. PARAGRAPHS REMOVED: * * - 7550-PD-AT-CST-JAN07, * * - 7550-PD-AT-CST-JAN07-EXIT, * * - 7550-PD-AT-CST-JUL07, * * - 7550-PD-AT-CST-JUL07-EXIT. * * * *************************************************************** *************************************************************** * * * DEVICE REDUCTION PROCESSING * * * *************************************************************** * * * SEARCH THE DEVICE REDUCTION TABLE TO SEE IF THERE IS AN APC * * MATCH; IF SO, REDUCE THE PYMT BY THE REDUCTION AMOUNT * * BECAUSE THIS IS A FREE OR REPLACEMENT DEVICE -OR- A PARTIAL * * CREDIT DEVICE. * * * * * BE SURE TO UPDATE THE TABLE REFERENCES EACH YEAR * * * * *-------------------------------------------------------------* * * * 11/1/2007 - PARTIAL CREDIT DEVICE PROCESSING ADDED * * NEW FOR CY 2008 * * * *************************************************************** 11550-DEVICE-REDUC. SEARCH ALL DEV-RED12 AT END GO TO 11550-DEVICE-REDUC-EXIT WHEN DEV-APC12 (DEV-INDX12) = OPPS-APC (LN-SUB) PERFORM 11550-DEVICE-COMPUTE THRU 11550-DEVICE-COMPUTE-EXIT. 11550-DEVICE-REDUC-EXIT. EXIT. *************************************************************** * * * IF THE DEVICE IS FOUND, AND REDUCTION AMOUNT IS LESS THAN * * PAYMENT AMOUNT, SUBTRACT REDUCTION AMOUNT FROM THE PAYMENT * * * * * BE SURE TO UPDATE THE TABLE REFERENCES EACH YEAR * * * * *-------------------------------------------------------------* * * * 11/1/2007 - PARTIAL CREDIT DEVICE PROCESSING ADDED * * NEW FOR CY 2008 * * * *************************************************************** 11550-DEVICE-COMPUTE. *-------------------------------------------------------------* * PROCESS FULL DEVICE REDUCTION (PAF = 7, FB MODIFER) * *-------------------------------------------------------------* IF OPPS-PYMT-ADJ-FLAG (LN-SUB) = ' 7' IF W-APC-PYMT (W-LP-INDX) NUMERIC IF W-APC-PYMT (W-LP-INDX) > DEV-REDUC12 (DEV-INDX12) COMPUTE W-APC-PYMT (W-LP-INDX) = (W-APC-PYMT (W-LP-INDX) - DEV-REDUC12 (DEV-INDX12)). *-------------------------------------------------------------* * PROCESS PARTIAL CREDIT DEVICE REDUCTION (PAF = 8, FC MOD) * *-------------------------------------------------------------* IF OPPS-PYMT-ADJ-FLAG (LN-SUB) = ' 8' IF W-APC-PYMT (W-LP-INDX) NUMERIC IF W-APC-PYMT (W-LP-INDX) > (DEV-REDUC12 (DEV-INDX12) / 2) COMPUTE W-APC-PYMT (W-LP-INDX) = (W-APC-PYMT (W-LP-INDX) - (DEV-REDUC12 (DEV-INDX12) / 2)). 11550-DEVICE-COMPUTE-EXIT. EXIT. *************************************************************** * * * CALCULATE WAGE ADJUSTED LINE ITEM PAYMENT WITH RURAL * * SOLE COMMUNITY HOSPITAL (SCH) ADJUSTMENT WHEN APPLICABLE * * * * FOR LINES WITH A SI OF S, V, T, P, X, R, OR U * * * *************************************************************** * * * THE SCH ADJUSTMENT IS MADE WHEN THE FOLLOWING IS TRUE: * * EITHER THE L-PSF-GEO-CBSA OR THE L-PSF-WI-CBSA MUST BE A * * VALUE OF ' 01' THRU ' 99' AND THE L-PSF-PROV-TYPE * * MUST BE A '16' OR '17' OR '21' OR '22'. * * * * EACH YEAR, CHECK WHETHER THE SCH ADJUSTMENT HARDCODED BELOW * * HAS CHANGED. * * CYS 2006 - 2009: SCH ADJ = 7.1% (1.071) * * * * * * 11/08/2007 - PROCESSING FOR BRACHY & BLOOD CODES WITH AN SI * * = K ADDED FOR CY 2008 * * 11/13/2007 - PROCESSING FOR BRACHY & BLOOD CODES REVISED. * * BLD-DEDUC-HCPCS-FLAG ADDED TO LOGIC. * * 11/13/2007 - PARAGRAPH 7560-CALC-BENE-DEDUCT PERFORM * * DELETED & MOVED TO PAR. 7550-CALC-STANDARD * * 05/14/2008 - BRACHYTHERAPY LINES PROCESSED IN THIS * * PARAGRAPH STARTING 7/1/2008 BECAUSE SI CHANGED * * TO ' K' ON THIS DATE. * * 08/07/2008 - DUE TO LEGISLATION, THERAPEUTIC RADIOPHARMS & * * BRACHYTHERAPY SOURCE'S SI CHANGED FROM 'K' * * BACK TO 'H' EFFECTIVE 7/1/2008; THESE LINES * * ARE NOT YET PROCESSED IN THIS PARAGRAPH * * 11/13/2008 - FOR CY 2009, BLOOD DEDUCTIBLE LINES (SI=R) * * ADDED TO LOGIC. BRACHY LINES NOT PROCESSED IN * * PARAGRAPH & NOW HAVE A SI = U, SI = K LOGIC * * REMOVED FROM THIS PARAGRAPH. * * 05/11/2009 - ADDED THE REQUIREMENT PAF = 5 OR 6 TO BLOOD * * DEDUCTIBLE LOGIC TO CORRECT PRICING ERROR. * * FIX EFFECTIVE RETROACTIVE TO 01/01/2009. * * 11/17/2009 - BRACHYTHERAPY LINES NOW PROCESSED IN THIS * * PARAGRAPH FOR CY 2010 (SI=U), DO NOT RECEIVE * * WAGE ADJUSTMENT * * 05/09/2011 - REVISED LOGIC TO EXCLUDE BILL TYPE 14X FROM * * RECEIVING THE SCH ADD-ON * * * *************************************************************** 11550-SCH-ADJ. MOVE L-PSF-GEO-CBSA TO GEO-CBSA-FLAG. MOVE L-PSF-WI-CBSA TO WI-CBSA-FLAG. *************************************************************** * CALCULATE THE SCH PAYMENT * * - FOR SCHS = APC OR BLOOD APC PAYMENT ADJUSTED BY 7.1% * * - FOR NON-SCHS = UNADJUSTED APC OR BLOOD APC PAYMENT * *************************************************************** IF ((RURAL-GEO OR RURAL-WI) AND (L-PSF-PROV-TYPE = '16' OR '17' OR '21' OR '22') AND (BILL14X-FLAG = 'N')) *-------------------------------------------------------------* * SCH, BLOOD DEDUCTIBLE HCPCS LINE * *-------------------------------------------------------------* IF OPPS-SRVC-IND (LN-SUB) = ' R' AND BLD-DEDUC-HCPCS-FLAG = 'Y' AND OPPS-PYMT-ADJ-FLAG (LN-SUB) = (' 5' OR ' 6') COMPUTE H-SCH-PYMT ROUNDED = (W-BD-APC-PYMT (W-BD-INDX) * 1.071) *-------------------------------------------------------------* * SCH, NOT A LINE WITH A BLOOD DEDUCTIBLE HCPCS * *-------------------------------------------------------------* ELSE COMPUTE H-SCH-PYMT ROUNDED = (W-APC-PYMT (W-LP-INDX) * 1.071) END-IF *-------------------------------------------------------------* * NON-SCH, BLOOD DEDUCTIBLE HCPCS LINE * *-------------------------------------------------------------* ELSE IF OPPS-SRVC-IND (LN-SUB) = ' R' AND BLD-DEDUC-HCPCS-FLAG = 'Y' AND OPPS-PYMT-ADJ-FLAG (LN-SUB) = (' 5' OR ' 6') MOVE W-BD-APC-PYMT (W-BD-INDX) TO H-SCH-PYMT *-------------------------------------------------------------* * NON-SCH, NOT A LINE WITH A BLOOD DEDUCTIBLE HCPCS * *-------------------------------------------------------------* ELSE MOVE W-APC-PYMT (W-LP-INDX) TO H-SCH-PYMT END-IF END-IF. *************************************************************** * CALCULATE THE LINE ITEM PAYMENT * *************************************************************** *-------------------------------------------------------------* * SI = R (BLOOD) OR U (BRACHY) LINES ARE NOT WAGE-ADJUSTED * *-------------------------------------------------------------* IF OPPS-SRVC-IND (LN-SUB) = ' R' OR ' U' IF OPPS-SRVC-IND (LN-SUB) = ' R' AND BLD-DEDUC-HCPCS-FLAG = 'Y' AND OPPS-PYMT-ADJ-FLAG (LN-SUB) = (' 5' OR ' 6') COMPUTE H-LITEM-PYMT ROUNDED = H-SCH-PYMT * W-BD-SRVC-UNITS (W-BD-INDX) * W-BD-DISC-RATE (W-BD-INDX) ELSE COMPUTE H-LITEM-PYMT ROUNDED = H-SCH-PYMT * W-SRVC-UNITS (W-LP-INDX) * W-DISC-RATE (W-LP-INDX) END-IF *-------------------------------------------------------------* * SI = S, V, T, P, OR X LINES ARE WAGE-ADJUSTED (60%) * *-------------------------------------------------------------* ELSE COMPUTE H-LITEM-PYMT ROUNDED = (((H-SCH-PYMT * .60) * W-WINX1 (W-LP-INDX)) + (H-SCH-PYMT * .40)) * W-SRVC-UNITS (W-LP-INDX) * W-DISC-RATE (W-LP-INDX) END-IF. 11550-SCH-ADJ-EXIT. EXIT. *************************************************************** * * * SET PARTIAL HOSPITALIZATION (PHP) "CAP" APC * * FOR USE IN THE OUTLIER CALCULATION * * (FOR SI = P LINES ONLY) * * * * ** ASK POLICY FOR THE PHP "CAP" APC ANUALLY ** * * * *-------------------------------------------------------------* * * * 11/13/2008 - THIS PARAGRAPH IS NEW FOR CY 2009, * * CY 2009 PHP "CAP" APC = 0173 * * 11/15/2010 - MODIFIED LOGIC TO ASSIGN CMHCS APC 00173 & * * HOSPITALS APC 00176 * * 11/04/2011 - MODIFIED LOGIC TO STOP APPLYING APC 00176 * * CAP TO PHP HOSPITAL LINES * * * *************************************************************** 11550-PHP-PMT-FOR-OUTL. *-------------------------------------------------------------* * ** FOR CMHC CLAIMS ONLY - USE APC 00173 * * LOOK-UP PHP "CAP" APC IN THE APC TABLE, STARTING AT * * THE APC'S MOST CURRENT RECORD - RETRIEVE PAYMENT RATE * *-------------------------------------------------------------* IF (L-PSF-PROV-3456 >= '1400' AND L-PSF-PROV-3456 <= '1499') OR (L-PSF-PROV-3456 >= '4600' AND L-PSF-PROV-3456 <= '4799') OR (L-PSF-PROV-3456 >= '4900' AND L-PSF-PROV-3456 <= '4999') SEARCH ALL WAA-ENTRY AT END GO TO 11550-PHP-PMT-FOR-OUTL-EXIT WHEN WAA-APC (WAA-INDX) = '00173' MOVE WAA-PTR (WAA-INDX) TO W-SUB2 PERFORM 11550-PHP-APC-LOOKUP. *-------------------------------------------------------------* * 11/04/2011 - DISABLED THIS LOGIC PER POLICY'S INSTRUCTIONS * * NOT TO CAP PHP HOSPITAL LINE PAYMENTS FOR THE * * OUTLIER CALCULATION USING APC 0176 * *-------------------------------------------------------------* * ** FOR HOSPITAL CLAIMS ONLY - USE APC 00176 * * LOOK-UP PHP "CAP" APC IN THE APC TABLE, STARTING AT * * THE APC'S MOST CURRENT RECORD - RETRIEVE PAYMENT RATE * *-------------------------------------------------------------* * ELSE * SEARCH ALL WAA-ENTRY * AT END * GO TO 11550-PHP-PMT-FOR-OUTL-EXIT * * WHEN WAA-APC (WAA-INDX) = '00176' * MOVE WAA-PTR (WAA-INDX) TO W-SUB2 * PERFORM 11550-PHP-APC-LOOKUP. *-------------------------------------------------------------* *-------------------------------------------------------------* * REDUCE APC PMT RATE BY REDUCED UPDATE RATIO WHEN APPROPRIATE* * 11/13/2009 - NEW FOR CY 2009 * *-------------------------------------------------------------* PERFORM 11180-REDUCE-APC-PYMT THRU 11180-REDUCE-APC-PYMT-EXIT. *-------------------------------------------------------------* * APPLY THE SCH ADJUSTMENT TO APC RATE WHEN APPLICABLE * * CY 2009 ADJ = 7.1% * *-------------------------------------------------------------* IF ((RURAL-GEO OR RURAL-WI) AND (L-PSF-PROV-TYPE = '16' OR '17' OR '21' OR '22')) COMPUTE H-APC-PYMT ROUNDED = (H-APC-PYMT * 1.071) END-IF. *-------------------------------------------------------------* * CALCULATE THE PHP "CAP" APC'S LINE PAYMENT (INCLUDES * * WAGE ADJUSTMENT AND SCH ADJUSTMENT IF APPLICABLE) * *-------------------------------------------------------------* COMPUTE H-PHP-LITEM-PYMT-OUTL ROUNDED = (((H-APC-PYMT * .60) * W-WINX1 (W-LP-INDX)) + (H-APC-PYMT * .40)) * W-SRVC-UNITS (W-LP-INDX) * W-DISC-RATE (W-LP-INDX). 11550-PHP-PMT-FOR-OUTL-EXIT. EXIT. *************************************************************** * * * LOOK-UP PHP "CAP" APC IN THE APC TABLE * * * *-------------------------------------------------------------* * * * 11/13/2008 - THIS PARAGRAPH IS NEW FOR CY 2009 * * * *************************************************************** 11550-PHP-APC-LOOKUP. *************************************************************** * APC RECORD EFFECTIVE DATE IS BEFORE OR ON THE LATEST * * EFFECTIVE DATE THE CLAIM CAN USE (SEARCH STARTS AT THE * * MOST CURRENT RECORD FOR THE APC) * *************************************************************** IF WAR-DTCD (W-SUB2) NOT > WAD-DTCD (WAD-SUB) *-------------------------------------------------------------* * APC RECORD EFFECTIVE DATE CORRECT, APC DELETED - ERROR * *-------------------------------------------------------------* IF WAR-RATEX (W-SUB2) = 'DELETED' MOVE ZEROS TO H-APC-PYMT *-------------------------------------------------------------* * APC RECORD EFFECTIVE DATE CORRECT, APC ACTIVE - ACCEPT REC * *-------------------------------------------------------------* ELSE MOVE WAR-RATE (W-SUB2) TO H-APC-PYMT *************************************************************** * APC RECORD EFFECTIVE DATE IS AFTER THE LATEST EFFECTIVE * * DATE THE CLAIM CAN USE. GO TO THE PREVIOUS RECORD IN THE * * APC TABLE. * *************************************************************** ELSE SUBTRACT 1 FROM W-SUB2 *-------------------------------------------------------------* * PREVIOUS REC BELONGS TO THE LINE APC, TEST EFFECTIVE DATE * *-------------------------------------------------------------* IF W-SUB2 > WAA-PTR (WAA-INDX - 1) GO TO 11550-PHP-APC-LOOKUP *-------------------------------------------------------------* * THERE IS NO RECORD FOR THE LINE APC WITH AN ACCEPTABLE * * EFFECTIVE DATE FOR THE LINE. RETURN ZEROS. * *-------------------------------------------------------------* ELSE MOVE 0 TO H-APC-PYMT. 11550-PHP-APC-LOOKUP-EXIT. EXIT. *************************************************************** * * * CALCULATE THE FOLLOWING FOR VALID SI = G, K, R, & U LINES: * * - APC PAYMENT FOR BLOOD LINES (SI = R) * * - BLOOD SPECIFIC ITEMS FOR BLOOD LINES * * - LINE ITEM PMT FOR ALL SI = G, K, OR U LINES (DRUGS, * * BIOLOGICALS, RADIOPHARMS, & BRACHYTHERAPIES) * * - SCH ADJUSTMENT APPLIED TO BLOOD & BRACHY LINES * * - BLOOD DEDUCTIBLE FOR BLOOD DEDUCTIBLE HCPCS LINES * * * *-------------------------------------------------------------* * * * - EFFECTIVE 01/01/2003, REMOVE PRO RATA REDUCTION FOR * * ALL SERVICE INDICATOR 'G' PAYMENTS. * * - 11/13/2007 - LINE ITEM PAYMENTS FOR BLOOD AND BRACHY * * LINES ARE CALCULATED IN PARAGRAPH 7550-SCH-ADJ TO APPLY * * THE SOLE COMMUNITY HOSPITAL (SCH) ADJUSTMENT WHEN * * APPLICABLE * * - 12/31/2007 - BRACHYTHERAPY & RADIOPHARM LINES' STATUS * * INDICATOR CHANGED BACK TO 'H' TEMPORARILY; THESE LINES * * WILL NOT ENTER THIS PARAGRAPH NOR PARAGRAPH 7550-SCH-ADJ * * UNTIL THEIR STATUS INDICATOR IS CHANGED BACK TO 'K' * * - 05/14/2008 - BRACHYTHERAPY & RADIOPHARM LINES' SI CHANGED * * TO ' K' EFFECTIVE 7/1/2008. THESE LINES ARE PROCESSED * * IN THIS PARAGRAPH STARTING 7/1/2008. * * - 08/07/2008 - DUE TO LEGISLATION, THERAPEUTIC RADIOPHARMS * * & BRACHYTHERAPY SOURCE'S SI CHANGED FROM 'K' BACK TO 'H' * * EFFECTIVE 7/1/2008; THESE LINES ARE NOT YET PROCESSED IN * * THIS PARAGRAPH. * * - 11/12/2008 - FOR CY 2009, BRACHYS NOT PROCESSED IN THIS * * PARAGRAPH; BRACHY LINES ASSIGNED A NEW SI OF ' U' * * - 11/13/2008 - FOR CY 2009, BLOOD DEDUCTIBLE LINES HAVE A * * SI = R * * - 12/05/2008 - MODIFIED LOGIC TO SEND BLOOD LINES WITHOUT * * A PMT ADJ FLAG = 5 OR 6 TO THE SCH ADJUSTMENT PARAGRAPH, * * INCLUDED SI = R IN THE BLOOD IDENTIFICATION LOGIC * * - 11/15/2009 - BRACHYTHERPY SERVICES (SI = U) & THERAPEUTIC * * RADIOPHARMS (SI = K) SENT TO THIS PARAGRAPH FOR CY 2010, * * LOGIC ALTERED TO PROCESS SI = U (RECEIVE REGULAR APC PMT) * * - 11/17/2009 - SEND BRACHYTHERAPY LINES TO 10550-SCH-ADJ TO * * MAKE ELIGIBLE FOR SCH ADJUSTMENT, NOT WAGE ADJUSTED * * * *************************************************************** 11550-CALC-GJK. *************************************************************** * * * CALCULATE LINE ITEM PAYMENT & BLOOD DEDUCTIBLE FOR BLOOD * * LINE WITH A HCPCS SUBJECT TO THE BLOOD DEDUCTIBLE (BD) * * * * (BLOOD DEDUCTIBLE LINES ARE PROCESSED IN THE ORDER THEY * * APPEAR IN THE BLOOD DEDUCTIBLE TABLE - EARLIEST TO LATEST * * DATE, LEAST TO MOST EXPENSIVE PAYMENT RATE. THE CURRENT * * COINSURANCE DEDUCTIBLE TABLE LINE BEING PROCESSED DOES NOT * * NECESSARILY CORRESPOND TO THE BLOOD DEDUCTIBLE LINE * * PROCESSED IN THE LOGIC BELOW.) * * * *************************************************************** IF OPPS-SRVC-IND (LN-SUB) = ' R' AND BLD-DEDUC-HCPCS-FLAG = 'Y' AND OPPS-PYMT-ADJ-FLAG (LN-SUB) = (' 5' OR ' 6') *-------------------------------------------------------------* * CALCULATE BLOOD FRACTION & BLOOD PINTS USED * *-------------------------------------------------------------* PERFORM 11550-SET-BLOOD-FRACTION THRU 11550-SET-BLOOD-FRACTION-EXIT *-------------------------------------------------------------* * ADJUST BLOOD APC PAYMENT BY BLOOD PRODUCT OR LABOR RATE * *-------------------------------------------------------------* PERFORM 11550-ADJ-BLOOD-COST THRU 11550-ADJ-BLOOD-COST-EXIT *-------------------------------------------------------------* * CALCULATE LINE ITEM PAYMENT W/ SCH ADJUSTMENT IF APPLICABLE * *-------------------------------------------------------------* * 11/14/2007 - 7550-SCH-ADJ PERFORM ADDED; LINE ITEM PAYMENT * * CALCULATION REMOVED FROM THIS SECTION * *-------------------------------------------------------------* PERFORM 11550-SCH-ADJ THRU 11550-SCH-ADJ-EXIT *-------------------------------------------------------------* * CALCULATE BLOOD DEDUCTIBLE (BD) - H-BLOOD-FRACTION IS THE * * FRACTION OF THE CURRENT LINE'S PINTS COVERED BY THE BD * *-------------------------------------------------------------* COMPUTE H-LN-BLOOD-DEDUCT ROUNDED = H-LITEM-PYMT * H-BLOOD-FRACTION *-------------------------------------------------------------* * POINT TO NEXT BLOOD DEDUCTIBLE RECORD FOR NEXT BD LINE * *-------------------------------------------------------------* SET W-BD-INDX UP BY 1 *************************************************************** * * * CALCULATE LINE ITEM PAYMENT FOR BLOOD LINE WITH A HCPCS NOT * * SUBJECT TO THE BLOOD DEDUCTIBLE, BUT PAF = 5 OR 6 * * (BLOOD PROCESSING AND PRODUCT BILLED TOGETHER) * * * *************************************************************** ELSE IF OPPS-SRVC-IND (LN-SUB) = ' R' AND OPPS-PYMT-ADJ-FLAG (LN-SUB) = (' 5' OR ' 6') *-------------------------------------------------------------* * ADJUST APC PAYMENT BY BLOOD PRODUCT OR LABOR RATE * *-------------------------------------------------------------* * 11/13/2007 - LINE ITEM PMT NO LONGER CALCULATED IN * * 7550-ADJ-PLATE-COST, BUT IN 7550-SCH-ADJ * *-------------------------------------------------------------* PERFORM 11550-ADJ-PLATE-COST THRU 11550-ADJ-PLATE-COST-EXIT *-------------------------------------------------------------* * CALCULATE LINE ITEM PAYMENT W/ SCH ADJUSTMENT IF APPLICABLE * *-------------------------------------------------------------* * 11/14/2007 - 7550-SCH-ADJ PERFORM ADDED; LINE ITEM PAYMENT * * CALCULATION REMOVED FROM THIS SECTION * *-------------------------------------------------------------* PERFORM 11550-SCH-ADJ THRU 11550-SCH-ADJ-EXIT *************************************************************** * * * CALCULATE LINE ITEM PAYMENT FOR BLOOD LINE WITH A HCPCS NOT * * SUBJECT TO THE BLOOD DEDUCTIBLE AND PAF NOT EQUAL TO 5 OR 6 * * (ONLY BLOOD PRODUCT BILLED) * * * *************************************************************** ELSE IF OPPS-SRVC-IND (LN-SUB) = ' R' *-------------------------------------------------------------* * CALCULATE LINE ITEM PAYMENT W/ SCH ADJUSTMENT IF APPLICABLE * *-------------------------------------------------------------* * 12/05/2008 - 7550-SCH-ADJ PERFORM ADDED FOR BLOOD LINES * * CALCULATION REMOVED FROM THIS SECTION * *-------------------------------------------------------------* PERFORM 11550-SCH-ADJ THRU 11550-SCH-ADJ-EXIT *************************************************************** * * * CALCULATE LINE ITEM PAYMENT FOR DRUGS, BIOLOGICALS, * * BRACHYTHERAPY SERVICES, & THERAPEUTIC RADIOPHARMS * * * *************************************************************** ELSE IF OPPS-SRVC-IND (LN-SUB) = ' G' OR ' K' COMPUTE H-LITEM-PYMT ROUNDED = W-APC-PYMT (W-LP-INDX) * W-SRVC-UNITS (W-LP-INDX) * W-DISC-RATE (W-LP-INDX) ELSE IF OPPS-SRVC-IND (LN-SUB) = ' U' PERFORM 11550-SCH-ADJ THRU 11550-SCH-ADJ-EXIT END-IF END-IF END-IF END-IF END-IF. 11550-CALC-GJK-EXIT. EXIT. *************************************************************** * * * DETERMINE THE FRACTION OF THE BLOOD LINE'S PAYMENT THAT * * WILL BE COVERED BY THE THE BENEFICIARY'S BLOOD DEDUCTIBLE * * FOR LINES WITH A HCPCS IN THE BLOOD DEDUCTIBLE LIST * * * * THE BENEFICIARY PAYS A BLOOD DEDUCTIBLE FOR THE FIRST * * 3 CHEAPEST BLOOD PINTS. MEDICARE COVERS ANY ADDITIONAL * * PINTS USED BY THE BENEFICIARY. * * * *************************************************************** 11550-SET-BLOOD-FRACTION. *-------------------------------------------------------------* * NAVIGATE TO SERVICE LINE ASSOCIATED WITH THE BLOOD ENTRY * *-------------------------------------------------------------* MOVE W-BD-SUB (W-BD-INDX) TO LN-SUB. *-------------------------------------------------------------* * BLOOD/BLOOD PRODUCT LINE * *-------------------------------------------------------------* IF OPPS-PYMT-ADJ-FLAG (LN-SUB) = ' 5' IF H-BENE-PINTS-USED > 0 *-------------------------------------------------------------* * BENEFICIARY HAS ENOUGH PINTS TO COVER ALL BLOOD LINE UNITS * * - BLOOD DEDUCTIBLE WILL COVER THE ENTIRE PYMNT (FRAC. = 1) * * - CALCULATE THE NUMBER OF DEDUCTIBLE PINTS BENE HAS LEFT * *-------------------------------------------------------------* IF W-BD-SRVC-UNITS (W-BD-INDX) <= H-BENE-PINTS-USED MOVE 1 TO H-BLOOD-FRACTION COMPUTE H-BENE-PINTS-USED = H-BENE-PINTS-USED - W-BD-SRVC-UNITS (W-BD-INDX) *-------------------------------------------------------------* * BENE. DOESN'T HAVE ENOUGH PINTS TO COVER ENTIRE BLOOD LINE * * - BLOOD DEDUCTIBLE WILL COVER A FRACTION OF THE PAYMENT * * (ACCORDING TO THE % OF PINTS COVERED) * * - BENEFICIARY HAS NO DEDUCTIBLE PINTS LEFT (PINTS = 0) * *-------------------------------------------------------------* ELSE IF W-BD-SRVC-UNITS (W-BD-INDX) > H-BENE-PINTS-USED COMPUTE H-BLOOD-FRACTION = H-BENE-PINTS-USED / W-BD-SRVC-UNITS (W-BD-INDX) MOVE 0 TO H-BENE-PINTS-USED ELSE MOVE 0 TO H-BLOOD-FRACTION *-------------------------------------------------------------* * BENEFICIARY HAS NO BLOOD DEDUCTIBLE PINTS LEFT * * THERE IS NO BLOOD DEDUCTIBLE * *-------------------------------------------------------------* ELSE MOVE 0 TO H-BLOOD-FRACTION *-------------------------------------------------------------* * BLOOD PROCESS/STORAGE LINE (PAF = 6) * * THERE IS NO BLOOD DEDUCTIBLE * *-------------------------------------------------------------* ELSE MOVE 0 TO H-BLOOD-FRACTION. 11550-SET-BLOOD-FRACTION-EXIT. EXIT. *************************************************************** * * * ADJUST APC PAYMENT BY BLOOD PRODUCT OR LABOR RATE TO * * CALCULATE THE BLOOD APC PAYMENT FOR LINES WITH A HCPCS * * IN THE BLOOD DEDUCTIBLE LIST * * * * THE RATE OF BLOOD TO BLOOD LABOR IS THE CLAIM AVERAGE. * * THE BLOOD LINE IS PAID ONLY THE PORTION OF THE APC * * PAYMENT THAT IS INDICATED BY THE PYMNT ADJUSTMENT FLAG. * * * *************************************************************** 11550-ADJ-BLOOD-COST. MOVE W-BD-SUB (W-BD-INDX) TO LN-SUB. *-------------------------------------------------------------* * CALCULATE BLOOD APC PAYMENT FOR BLOOD/BLOOD PRODUCT LINE * *-------------------------------------------------------------* IF OPPS-PYMT-ADJ-FLAG (LN-SUB) = ' 5' COMPUTE W-BD-APC-PYMT (W-BD-INDX) = W-BD-APC-PYMT (W-BD-INDX) * H-38X-39X-RATE. *-------------------------------------------------------------* * CALCULATE BLOOD APC PAYMENT FOR BLOOD PROCESS/STORAGE LINE * *-------------------------------------------------------------* IF OPPS-PYMT-ADJ-FLAG (LN-SUB) = ' 6' COMPUTE W-BD-APC-PYMT (W-BD-INDX) = W-BD-APC-PYMT (W-BD-INDX) * (1 - H-38X-39X-RATE). 11550-ADJ-BLOOD-COST-EXIT. EXIT. *************************************************************** * * * ADJUST APC PAYMENT BY BLOOD PRODUCT OR LABOR RATE TO * * CALCULATE THE BLOOD APC PAYMENT FOR BLOOD LINES WITH A * * HCPCS NOT IN THE BLOOD DEDUCTIBLE LIST * * * * THE RATE OF BLOOD TO BLOOD LABOR IS THE CLAIM AVERAGE. * * THE BLOOD LINE IS PAID ONLY THE PORTION OF THE APC * * PAYMENT THAT IS INDICATED BY THE PYMNT ADJUSTMENT FLAG. * * * *************************************************************** * * * 11/13/2007 - REMOVED LINE ITEM PAYMENT CALCULATION FROM * * THIS PARAGRAPH, NOW PERFORMED IN * * 7550-SCH-ADJ (CALLED FROM 7550-CALC-GJK) * * * *************************************************************** 11550-ADJ-PLATE-COST. *-------------------------------------------------------------* * CALCULATE BLOOD APC PAYMENT FOR BLOOD/BLOOD PRODUCT LINE * *-------------------------------------------------------------* IF OPPS-PYMT-ADJ-FLAG (LN-SUB) = ' 5' COMPUTE W-APC-PYMT (W-LP-INDX) = W-APC-PYMT (W-LP-INDX) * H-38X-39X-RATE. *-------------------------------------------------------------* * CALCULATE BLOOD APC PAYMENT FOR BLOOD PROCESS/STORAGE LINE * *-------------------------------------------------------------* IF OPPS-PYMT-ADJ-FLAG (LN-SUB) = ' 6' COMPUTE W-APC-PYMT (W-LP-INDX) = W-APC-PYMT (W-LP-INDX) * (1 - H-38X-39X-RATE). 11550-ADJ-PLATE-COST-EXIT. EXIT. *************************************************************** * * * ADJUST THE PASS-THROUGH RADIOPHARM PAYMENT BY * * ITS PROPORTION OF THE NUCLEAR MEDICINE OFFSET * * * * EFFECTIVE 04/01/2009, LOGIC ADDED 02/11/2009 * * * *************************************************************** 11550-PTRADIO-OFFSET. *-------------------------------------------------------------* * CALCULATE PROPORTION OF TOTAL OFFSET TO BE APPLIED TO LINE * *-------------------------------------------------------------* * 12/20/2009 - ADDED LOGIC TO PREVENT DIVISION BY ZERO ERROR * *-------------------------------------------------------------* MOVE OPPS-SUB-CHRG (LN-SUB) TO H-SUB-CHRG. IF H-PTRADIO-TOT-CHRGS > 0 THEN COMPUTE W-PTRADIO-CHRG-RATE ROUNDED = H-SUB-CHRG / H-PTRADIO-TOT-CHRGS ELSE MOVE 0 TO W-PTRADIO-CHRG-RATE END-IF. *-------------------------------------------------------------* * CALCULATE THE OFFSET AMOUNT TO BE APPLIED TO LINE * *-------------------------------------------------------------* COMPUTE W-PTRADIO-LINE-OFFSET ROUNDED = H-NUCMED-TOT-OFFSET * W-PTRADIO-CHRG-RATE. *-------------------------------------------------------------* * SUBTRACT THE APPLICABLE OFFSET FROM THE LINE PAYMENT * *-------------------------------------------------------------* COMPUTE H-LITEM-PYMT ROUNDED = H-LITEM-PYMT - W-PTRADIO-LINE-OFFSET. 11550-PTRADIO-OFFSET-EXIT. EXIT. *************************************************************** * * * ADJUST THE PASS-THROUGH CONTRAST AGENT PAYMENT BY * * ITS PROPORTION OF THE PT CONTRAST AGENT PROCEDURE OFFSET * * * * EFFECTIVE 01/01/2010, LOGIC ADDED 11/16/2009 * * * *************************************************************** 11550-PTCA-OFFSET. *-------------------------------------------------------------* * CAPTURE LINE DATE OF SERVICE * *-------------------------------------------------------------* MOVE OPPS-LITEM-DOS (LN-SUB) TO W-CAPROC-SRVC-DATE. *-------------------------------------------------------------* * SEARCH PT CONTRAST AGENT DAY TABLE FOR DATE OF SERVICE * *-------------------------------------------------------------* SET W-PTCA-DAY-INDX TO 1. SEARCH W-PTCA-DAY-ENTRY *-------------------------------------------------------------* * DATE OF SERVICE NOT FOUND IN TABLE, STOP PROCESS * *-------------------------------------------------------------* AT END GO TO 11550-PTCA-OFFSET-EXIT *-------------------------------------------------------------* * DATE OF SERVICE FOUND IN TABLE, TAKE OFFSET * *-------------------------------------------------------------* WHEN W-PTCA-DAY-LIDOS (W-PTCA-DAY-INDX) = W-CAPROC-SRVC-DATE *-------------------------------------------------------------* * CALCULATE PROPORTION OF TOTAL OFFSET TO BE APPLIED TO LINE * *-------------------------------------------------------------* * 12/20/2009 - ADDED LOGIC TO PREVENT DIVISION BY ZERO ERROR * *-------------------------------------------------------------* MOVE OPPS-SUB-CHRG (LN-SUB) TO H-SUB-CHRG IF W-PTCA-DAY-TOT-CHRGS (W-PTCA-DAY-INDX) > 0 COMPUTE W-PTCA-CHRG-RATE ROUNDED = H-SUB-CHRG / W-PTCA-DAY-TOT-CHRGS (W-PTCA-DAY-INDX) ELSE MOVE 0 TO W-PTCA-CHRG-RATE END-IF *-------------------------------------------------------------* * CALCULATE THE OFFSET AMOUNT TO BE APPLIED TO LINE * *-------------------------------------------------------------* COMPUTE W-PTCA-LINE-OFFSET ROUNDED = W-PTCA-DAY-TOT-OFFSET (W-PTCA-DAY-INDX) * W-PTCA-CHRG-RATE *-------------------------------------------------------------* * SUBTRACT THE APPLICABLE OFFSET FROM THE LINE PAYMENT * *-------------------------------------------------------------* IF H-LITEM-PYMT >= W-PTCA-LINE-OFFSET COMPUTE H-LITEM-PYMT ROUNDED = H-LITEM-PYMT - W-PTCA-LINE-OFFSET ELSE MOVE 0 TO H-LITEM-PYMT END-IF END-SEARCH. 11550-PTCA-OFFSET-EXIT. EXIT. *************************************************************** * * * ACCUMULATE TOTAL CLAIM CHARGES FROM DEVICE LINES * * * * *** DISABLED 08/11/2011 & REPLACED WITH NEW LOGIC *** * * * * EFFECTIVE 04/01/2002 A PRO RATA REDUCTION APPLIES TO ALL * * ALL SERVICE INDICATOR 'H' PAYMENTS (CURRENTLY .689) * * * * SERVICE INDICATOR OF 'H' = PASS-THROUGH DEVICES, * * THERAPEUTIC RADIOPHARMS * * * *************************************************************** *9555-CALC-H-TOT. * *-------------------------------------------------------------* * SET THE SERVICE LINE SUBSCRIPT TO THE CLAIM SERVICE LINE * * ASSOCIATED WITH THE COINSURANCE DEDUCTIBLE TABLE RECORD * *-------------------------------------------------------------* * MOVE W-LP-SUB (W-LP-INDX) TO LN-SUB. * *-------------------------------------------------------------* * ACCUMULATE TOTAL CLAIM DEVICE CHARGES FOR DEVICE LINES * *-------------------------------------------------------------* * 11/13/2008 - MODIFIED LOGIC TO PROCESS DEVICE LINES ONLY * * (EXCLUDE THERAPEUTIC RADIOPHARMS) * * 11/16/2009 REMOVED LOGIC THAT EXCLUDES THERAP. RADIOS * * (THERAP. RADIOS DO NOT HAVE AN SI=H CY 2010) * *-------------------------------------------------------------* * MOVE OPPS-SUB-CHRG (LN-SUB) TO H-SUB-CHRG. * * IF OPPS-SRVC-IND (LN-SUB) = ' H' AND * OPPS-PYMT-IND (LN-SUB) = ' 6' * COMPUTE H-TOT-H-CHRG = * (H-TOT-H-CHRG + H-SUB-CHRG) * END-IF. * *9555-CALC-H-TOT-EXIT. * EXIT. *************************************************************** * * * CALCULATE PAYMENT FOR PAID AT COST LINES * * (PAYMENT BASED ON CHARGE ADJUSTED TO COST) * * UPDATE PASS-THROUGH DEVICE TABLE * * * *-------------------------------------------------------------* * * * 08-11-2010 - PASS-THROUGH DEVICE OFFSET LOGIC REVISED * * * *************************************************************** 11555-CALC-H-STANDARD. *-------------------------------------------------------------* * SET LINE ITEM PAYMENT TO LINE COST - "PAID AT COST" * *-------------------------------------------------------------* MOVE OPPS-SUB-CHRG (LN-SUB) TO H-SUB-CHRG. COMPUTE T-LITEM-PYMT ROUNDED = (H-SUB-CHRG * L-PSF-OPCOST-RATIO). *-------------------------------------------------------------* * SEARCH THE PTDO HCPCS TABLE FOR THE CURRENT LINE HCPCS, * * IF FOUND APPLY THE OFFSET * *-------------------------------------------------------------* SET W-PTDO-HCPCS-INDX TO 1. SEARCH W-PTDO-HCPCS-ENTRY AT END CONTINUE WHEN W-PTDO-HCPCS-HCPCS (W-PTDO-HCPCS-INDX) = OPPS-HCPCS (LN-SUB) AND W-PTDO-HCPCS-LNSUB (W-PTDO-HCPCS-INDX) = LN-SUB PERFORM 11556-CALC-PTDO-OFFSET THRU 11556-CALC-PTDO-OFFSET-EXIT. *-------------------------------------------------------------* * CAPTURE PAYMENT AMOUNT * *-------------------------------------------------------------* IF T-LITEM-PYMT < 0 THEN MOVE 0 TO H-LITEM-PYMT ELSE MOVE T-LITEM-PYMT TO H-LITEM-PYMT. *-------------------------------------------------------------* * UPDATE PASS-THROUGH DEVICE TABLE WITH LINE ITEM PAYMENT OF * * DEVICE LINE (CHARGES CONVERTED TO COST LESS APPLICABLE * * OFFSET AMOUNT) * * WHEN PTD-FLAG = 'Y', A PASS-THROUGH DEVICE IS ON THE CLAIM * *-------------------------------------------------------------* * 11/16/2009 REMOVED LOGIC THAT EXCLUDES THERAP. RADIOS * * (THERAP. RADIOS DO NOT HAVE AN SI=H CY 2010) * *-------------------------------------------------------------* IF PTD-FLAG = 'Y' AND OPPS-SRVC-IND (LN-SUB) = ' H' PERFORM 11557-LOAD-PTD-LINE-PYMT THRU 11557-LOAD-PTD-LINE-PYMT-EXIT END-IF. *************************************************************** * OLD PASS-THROUGH DEVICE OFFSET LOGIC * * LOGIC DISABLED & REPLACED * *************************************************************** * WAGE ADJUST 60% OF THE CLAIM TOTAL DEVICE OFFSET AMOUNT * * (OFFSET AMOUNTS ARE COSTS, NOT CHARGES) * * (C-FLAG = Y MEANS THERE IS A DEVICE ON THE CLAIM) * *-------------------------------------------------------------* * 11/13/2008 - MODIFIED LOGIC TO PROCESS DEVICES ONLY * * (EXCLUDE BRACHYS & THERAPEUTIC RADIOPHARMS) * * 11/16/2009 REMOVED LOGIC THAT EXCLUDES THERAP. RADIOS * * (THERAP. RADIOS DO NOT HAVE AN SI=H CY 2010) * *-------------------------------------------------------------* * IF C-FLAG = 'Y' AND * OPPS-SRVC-IND (LN-SUB) = ' H' * *-------------------------------------------------------------* * OTHER LINES ON THE CLAIM BESIDES DEVICE LINES ARE OFFSET; * * CALCULATE DEVICE PORTION OF THE TOTAL WAGE ADJUSTED OFFSET * *-------------------------------------------------------------* * IF (H-TOT-OFF-UNITS > H-TOT-HTD-UNITS) * COMPUTE H-TOTAL-WAOFF ROUNDED = * (((H-TOTAL-OFFSET * .60) * A-WINX) + * (H-TOTAL-OFFSET * .40)) * * (H-TOT-HTD-UNITS / H-TOT-OFF-UNITS) * PERFORM 10700-CALC-H-OFFSET * THRU 10700-CALC-H-OFFSET-EXIT * ELSE * *-------------------------------------------------------------* * ONLY DEVICE LINES ON THE CLAIM ARE OFFSET; * * WAGE ADJUST THE TOTAL CLAIM OFFSET AMOUNT * *-------------------------------------------------------------* * COMPUTE H-TOTAL-WAOFF ROUNDED = * ((H-TOTAL-OFFSET * .60) * A-WINX) + * (H-TOTAL-OFFSET * .40) * PERFORM 10700-CALC-H-OFFSET * THRU 10700-CALC-H-OFFSET-EXIT * *-------------------------------------------------------------* * THERE IS NO DEVICE ON THE CLAIM * *-------------------------------------------------------------* * ELSE * NEXT SENTENCE. * * IF T-LITEM-PYMT < 0 THEN * MOVE 0 TO H-LITEM-PYMT * ELSE * MOVE T-LITEM-PYMT TO H-LITEM-PYMT. 11555-CALC-H-STANDARD-EXIT. EXIT. *************************************************************** * * * REDUCE LINE ITEM PAYMENTS OF PASS-THROUGH DEVICES THAT * * HAVE AN ASSOCIATED PROCEDURE ON THE CLAIM BY THE PROCEDURE * * WAGE-ADJUSTED OFFSET AMOUNT * * * *************************************************************** * * * ** EFFECTIVE 10/01/2010 - REVISED PT DEVICE OFFSET LOGIC * * * *************************************************************** 11556-CALC-PTDO-OFFSET. *-------------------------------------------------------------* * SEARCH PTDO PROCEDURE TABLE FOR THE PT DEVICE HCPCS LINE * *-------------------------------------------------------------* SET W-PTDO-PROC-INDX TO 1. SEARCH W-PTDO-PROC-ENTRY AT END GO TO 11556-CALC-PTDO-OFFSET-EXIT *-------------------------------------------------------------* * CURRENT PT DEVICE LINE'S ASSOCIATED PROCEDURE FOUND * *-------------------------------------------------------------* WHEN W-PTDO-PROC-APC (W-PTDO-PROC-INDX) = W-PTDO-HCPCS-PROC-APC (W-PTDO-HCPCS-INDX) AND W-PTDO-PROC-LNSUB (W-PTDO-PROC-INDX) = W-PTDO-HCPCS-PROC-LNSUB (W-PTDO-HCPCS-INDX) *-------------------------------------------------------------* * DETERMINE HOW MANY PROCEDURE UNITS WILL BE ALLOCATED * *-------------------------------------------------------------* IF W-PTDO-PROC-UNITS (W-PTDO-PROC-INDX) <= W-PTDO-PROC-TOT-DUNITS (W-PTDO-PROC-INDX) MOVE W-PTDO-PROC-UNITS (W-PTDO-PROC-INDX) TO W-DOPROC-UNITS ELSE MOVE W-PTDO-PROC-TOT-DUNITS (W-PTDO-PROC-INDX) TO W-DOPROC-UNITS END-IF *-------------------------------------------------------------* * DETERMINE WHAT % OF THE OFFSET WILL BE APPLIED * *-------------------------------------------------------------* IF W-PTDO-PROC-TOT-DCHRGS (W-PTDO-PROC-INDX) > 0 COMPUTE W-PTDO-CHRG-RATE ROUNDED = W-PTDO-HCPCS-SUB-CHRG (W-PTDO-HCPCS-INDX) / W-PTDO-PROC-TOT-DCHRGS (W-PTDO-PROC-INDX) ELSE GO TO 11556-CALC-PTDO-OFFSET-EXIT END-IF *-------------------------------------------------------------* * CALCULATE THE OFFSET AMOUNT TO BE TAKEN * *-------------------------------------------------------------* COMPUTE W-PTDO-LINE-OFFSET ROUNDED = W-PTDO-CHRG-RATE * W-DOPROC-UNITS * W-PTDO-PROC-WA-OFFSET (W-PTDO-PROC-INDX) *-------------------------------------------------------------* * SUBTRACT THE OFFSET AMOUNT FROM THE LINE PAYMENT * *-------------------------------------------------------------* IF W-PTDO-LINE-OFFSET <= T-LITEM-PYMT COMPUTE T-LITEM-PYMT ROUNDED = T-LITEM-PYMT - W-PTDO-LINE-OFFSET END-IF. 11556-CALC-PTDO-OFFSET-EXIT. EXIT. *************************************************************** * * * UPDATE PASS-THROUGH DEVICE TABLE WITH CHARGES FOR THE * * DEVICE LINE (LINE ITEM PAYMENT LESS OFFSET CONVERTED TO * * CHARGES) * * (FOR ASSOCIATED PROCEDURE OUTLIER CALCULATION) * * * *************************************************************** 11557-LOAD-PTD-LINE-PYMT. *-------------------------------------------------------------* * SEARCH PTD TABLE STARTING AT ENTRY #1 FOR THE RECORD THAT * * CORRESPONDS TO THE CURRENT SERVICE LINE * *-------------------------------------------------------------* SET W-PTD-INDX TO 1. SEARCH W-PTD-ENTRY VARYING W-PTD-INDX *-------------------------------------------------------------* * IF THE SERVICE LINE'S PAYMENT ADJUSTMENT FLAG IS NOT * * ALREADY IN THE TABLE, ADD IT * *-------------------------------------------------------------* AT END GO TO 11557-LOAD-PTD-LINE-PYMT-EXIT *-------------------------------------------------------------* * IF THE LINE'S HCPCS IS IN THE TABLE, CALCULATE THE LINE'S * * CHARGES AND PLACE INTO TABLE (FOR H LINES, THE PAYMENT IS * * CONVERTED TO COST AND OFFSET. HERE, THE PAYMENT IS * * CONVERTED BACK INTO CHARGES BY DIVIDING IT BY THE COST TO * * CHARGE RATIO.) * *-------------------------------------------------------------* WHEN W-PTD-SUB (W-PTD-INDX) = LN-SUB MOVE H-LITEM-PYMT TO W-PTD-LITEM-PYMT (W-PTD-INDX) END-SEARCH. 11557-LOAD-PTD-LINE-PYMT-EXIT. EXIT. *************************************************************** * * * CALCULATE THE BENEFICIARY DEDUCTIBLE AMOUNT THAT WILL BE * * APPLIED TO THE SERVICE LINES IN THE DEDUCTIBLE TABLE * * * * (THE DEDUCTIBLE IS APPLIED TO THE LOWEST TO HIGHEST RANKED * * APCS. THE LOWER THE RANK, THE HIGHER THE COINSURANCE %. * * THE TOTAL CLAIM BENEFICIARY COINSURANCE AMOUNT IS CHEAPER * * WHEN THE DEDUCTIBLE IS APPLIED IN THIS ORDER.) * * * *************************************************************** 11560-CALC-BENE-DEDUCT. *-------------------------------------------------------------* * LINES INELIGIBLE FOR DEDUCTIBLE SKIP DEDUCTIBLE CALCULATION * * EFF. 7/1/2009 - CLINICAL TRIAL LINES FOR MANAGED CARE BENES * * ASSIGNED A PAF = ' 4' * * - 04/11/2011 - ADDED PAF 9 FOR SERVICES WHERE THE * * DEDUCTIBLE AND CO-INSURANCE ARE NOT APPLICABLE * * (ADDED FOR PREVENTIVE SERVICES WAIVER IN CY 2011) * *-------------------------------------------------------------* IF OPPS-PYMT-ADJ-FLAG (LN-SUB) = (' 4' OR ' 9') GO TO 11560-CALC-BENE-DEDUCT-EXIT. *-------------------------------------------------------------* * BENEFICIARY HAS NOT MET HIS/HER DEDUCTIBLE LIMIT. * * CALCULATE THE "LINE BLOOD PAYMENT" * *-------------------------------------------------------------* IF H-BENE-DEDUCT > 0 THEN COMPUTE H-LN-BLD-PYMT = H-LITEM-PYMT - H-LN-BLOOD-DEDUCT *-------------------------------------------------------------* * BENEFICIARY'S DEDUCTIBLE DOES NOT COVER OR JUST COVERS THE * * ENTIRE LINE BLOOD PAYMENT: * * - BENEFICIARY'S REMAINING DEDUCTIBLE AMT APPLIED TO LINE * * - BENEFICIARY HAS REACHED HIS/HER DEDUCTIBLE LIMIT * *-------------------------------------------------------------* IF H-BENE-DEDUCT <= H-LN-BLD-PYMT THEN MOVE H-BENE-DEDUCT TO H-TOTAL-LN-DEDUCT MOVE 0 TO H-BENE-DEDUCT *-------------------------------------------------------------* * BENEFICIARY'S DEDUCTIBLE MORE THAN COVERS THE LINE BLOOD * * PAYMENT, DO THE FOLLOWING: * * - CALCULATE THE BENEFICIARY'S REMAINING DEDUCTIBLE AMOUNT * * AFTER PAYING FOR CURRENT SERVICE LINE * * - MEDICARE LINE PAYMENT = 0 * *-------------------------------------------------------------* ELSE COMPUTE H-BENE-DEDUCT = H-BENE-DEDUCT - H-LN-BLD-PYMT MOVE H-LN-BLD-PYMT TO H-TOTAL-LN-DEDUCT MOVE 20 TO A-RETURN-CODE (LN-SUB) END-IF END-IF. 11560-CALC-BENE-DEDUCT-EXIT. EXIT. *************************************************************** * * * CALCULATE OUTLIER PAYMENT * * ** CHANGE OUTLIER THRESHOLD EVERY JANUARY (HARD-CODED) ** * * * *************************************************************** * * * LOOP THROUGH THE COINSURANCE DEDUCTIBLE TABLE TO DO THE * * FOLLOWING FOR EACH SERVICE LINE: * * * * - DETERMINE IF THE LINE IS ELIGIBLE FOR AN OUTLIER PAYMENT * * - ADJUST CHARGES FOR LINES WITH ARTIFICIAL CHARGES ON CLAIM * * - DISTRIBUTE TOTAL CLAIM PACKAGED LINE CHARGES TO NON- * * PACKAGED PAYABLE LINES * * - ADJUST CHARGES OF PRIME CODE COMPOSITE APC LINES * * - ADJUST CHARGES OF MENTAL HEALTH LINES (APC = 34) * * - CALCULATE THE LINE OUTLIER PAYMENT FOR ELIGIBLE LINES * * * * * * NOTES: * * ------ * * - NEW FOR JANUARY 2004: * * - CHECK >= 20040101 AND SRVC-IND = 'K' * * - DISCONTINUE OUTLIER PROCESS * * * * - NEW FOR JANUARY 2008: * * - REVISED LOGIC FOR DETERMINING WHICH LINES WITH SRVC-IND * * = 'K' ARE ELIGIBLE FOR AN OUTLIER PAYMENT. THIS WAS * * NECESSARY B/C SOME RADIOPHARMS & ALL BRACHYTHERAPIES * * SRVC-IND = 'K' STARTING CY 2008. * * - PER LEGISLATION, BRACHYTHERAPY & RADIOPARM LINES' * * STATUS INDICATOR CHANGED BACK TO ' H' FOR CY 2008 QTR 1 * * ' K' LOGIC RETAINED B/C IT WILL NOT AFFECT PAYMENTS TO * * BRACHYTHERAPY OR RADIOPHARM LINES * * - COMPOSITE APC AND MENTAL HEALTH LINE CHARGE CALCS * * * * - NEW FOR APRIL 2008: ADD CHARGES AND PAYMENTS OF * * - PASS-THROUGH DEVICES TO THE CHARGES AND PAYMENTS OF * * PROCEDURES ELIGIBLE FOR THE DEVICES * * - A-LITEM-PYMT MOVED TO H-LITEM-PYMT-OUTL B/C PAYMENTS * * ARE ADJUSTED FOR PASS-THROUGH DEVICES FOR OUTLIER * * DETERMINATION ONLY * * * * - NEW FOR JULY 2008: BRACHYTHERAPY AND THERAPEUTIC * * RADIOPHARM LINES' SI CHANGED TO ' K'. BRACHYTHERAPY * * LINES ARE NOW ELIGIBLE FOR AN OUTLIER PAYMENT. * * * * - JULY 2008: DUE TO LEGISLATION, THERAPEUTIC RADIOPHARMS * * & BRACHYTHERAPY SOURCE'S SI CHANGED FROM 'K' BACK TO 'H' * * EFFECTIVE 7/1/2008; THESE LINES ARE NOT YET ELIGIBLE FOR * * AN OUTLIER PAYMENT. * * * * - 11/12/2008: FOR CY 2009, BRACHYS SI = U AND BLOOD SI = R * * BRACHY INELIGIBLE FOR OUTLIER, BLOOD ELIGIBLE FOR OUTLIER * * * * - 12/05/2008: ADDED SI = K TO LIST OF SIS INELIGIBLE FOR * * OUTLIER (BRACHYS & BLOOD NO LONGER HAVE SI = K) * * * * - 11/17/2009: REMOVED U FROM LIST OF SIS INELIGIBLE FOR * * OUTLIER; BRACHYS NOW ELIGIBLE B/C NOT PAID AT COST CY 2010* * * * - 12/16/2009: ADDED SIS R AND U TO LOGIC THAT DISTRIBUTES * * PACKAGED CHARGES TO PAYABLE LINES. V2010.1.2 * * * * - 11/04/2011: MODIFIED LOGIC TO APPLY THE PHP CAP ONLY TO * * PHP CMHC LINES, NOT PHP HOSPITAL LINES PER POLICY'S * * INSTRUCTIONS * * * *************************************************************** 11600-ADJ-CHRG-OUTL. *-------------------------------------------------------------* * GO TO SERVICE LINE ASSOCIATED WITH THE CURRENT COINSURANCE * * DEDUCTIBLE TABLE RECORD * *-------------------------------------------------------------* MOVE W-LP-SUB (W-LP-INDX) TO LN-SUB. *-------------------------------------------------------------* * LINES WITH SERVICE INDICATORS NOT ELIGIBLE FOR AN OUTLIER * * PAYMENT AND LINES PACKAGED AS PART OF DRUG ADMINISTRATION * * APC PAYMENT BYPASS OUTLIER CALCULATION * * (DRUGS, DEVICES, PACKAGED SERVICES, BIOLOGICALS) * *-------------------------------------------------------------* * *** ENSURE ALL SIS ELIGIBLE FOR AN OUTLIER PAYMENT ARE *** * * *** LISTED IN THE LOGIC BELOW THAT DISTRIBUTES PACKAGED *** * * *** CHARGES TO PAYABLE LINES AND IN THE SUMMING LOGIC *** * * *** IN PARAGRAPH _500-ADJ-CHRGS. *** * *-------------------------------------------------------------* * 11/12/2008 - BRACHY (SI=U) ADDED TO LIST * * 12/05/2008 - SI K ADDED TO THE LIST * * 11/16/2009 - REMOVED PAF=2 FROM BRACHY (SI=U) CRITERIA * * 11/17/2009 - REMOVE SI=U, BRACHYS ARE ELIGIBLE FOR OUTLIER * *-------------------------------------------------------------* IF (OPPS-SRVC-IND (LN-SUB) = ' G' OR ' H' OR ' N' OR ' K') OR (OPPS-PKG-FLAG (LN-SUB) = '4') GO TO 11600-ADJ-CHRG-OUTL-EXIT. *-------------------------------------------------------------* * DISTRIBUTE TOTAL CLAIM PROCEDURE CHARGES TO PROCEDURE LINES * * IN PROPORTION TO THE PROCEDURE LINES' PAYMENTS WHEN THERE * * ARE ARTIFICIAL PROCEDURE CHARGES (< $1.01) ON THE CLAIM. * * (DISTRIBUTED CHARGES REPLACE BILLED CHARGES) * *-------------------------------------------------------------* * NOTE: LINES WITH CHARGES < $1.01 ARE FIXED BY FISS BEFORE * * ENTERING THE PRICER. THEREFORE, THIS LOGIC IS NO * * LONGER NECESSARY. THIS LOGIC WAS NECESSARY BEFORE * * FISS IMPLEMENTED THE FIX. * *-------------------------------------------------------------* IF (ST0-FLAG = 'Y') AND ((OPPS-SRVC-IND (LN-SUB) = ' T') OR ((OPPS-SRVC-IND (LN-SUB) = ' S') AND (OPPS-HCPCS (LN-SUB) > '09999' AND OPPS-HCPCS (LN-SUB) < '70000'))) AND (H-TOT-ST-PYMT > 0) COMPUTE H-CHRG-RATE ROUNDED = (A-LITEM-PYMT (LN-SUB) / H-TOT-ST-PYMT) COMPUTE W-SUB-CHRG (W-LP-INDX) ROUNDED = (H-CHRG-RATE * H-TOT-ST-CHRG) *-------------------------------------------------------------* * DISTRIBUTE TOTAL CLAIM PACKAGED LINE CHARGES TO SEPARATELY * * PAYABLE LINES IN PROPORTION TO THEIR PAYMENTS WHEN THERE * * ARE NO ARTIFICIAL PROCEDURE CHARGES (< $1.01) ON THE CLAIM. * * (DISTRIBUTED CHARGES ARE ADDED TO THE BILLED CHARGES) * *-------------------------------------------------------------* * 12/16/2009 - ADDED SIS R AND U TO LOGIC * *-------------------------------------------------------------* ELSE IF (N-FLAG = 'Y' AND ST0-FLAG = 'N') AND ((OPPS-SRVC-IND (LN-SUB) = ' S' OR ' T' OR ' V' OR ' X' OR ' P' OR ' R' OR ' U') AND (OPPS-PKG-FLAG (LN-SUB) = '0' OR '3')) AND (H-TOT-STVX-PYMT > 0) COMPUTE H-CHRG-RATE ROUNDED = (A-LITEM-PYMT (LN-SUB) / H-TOT-STVX-PYMT) COMPUTE H-SUB-CHRG ROUNDED = (H-CHRG-RATE * H-TOT-N-CHRG) COMPUTE W-SUB-CHRG (W-LP-INDX) ROUNDED = W-SUB-CHRG (W-LP-INDX) + H-SUB-CHRG. *-------------------------------------------------------------* * DISTRIBUTE TOTAL CLAIM PACKAGED LINE CHARGES TO SEPARATELY * * PAYABLE LINES IN PROPORTION TO THEIR PAYMENTS WHEN THERE * * ARE ARTIFICIAL PROCEDURE CHARGES (< $1.01) ON THE CLAIM. * * (DISTRIBUTED CHARGES ARE ADDED TO THE BILLED CHARGES) * *-------------------------------------------------------------* * NOTE: LINES WITH CHARGES < $1.01 ARE FIXED BY FISS BEFORE * * ENTERING THE PRICER. THEREFORE, THIS LOGIC IS NO * * LONGER NECESSARY. THIS LOGIC WAS NECESSARY BEFORE * * FISS IMPLEMENTED THE FIX. * *-------------------------------------------------------------* * 12/16/2009 - ADDED SIS R AND U TO LOGIC * *-------------------------------------------------------------* IF (N-FLAG = 'Y' AND ST0-FLAG = 'Y') AND ((OPPS-SRVC-IND (LN-SUB) = ' S' OR ' T' OR ' V' OR ' X' OR ' P' OR ' R' OR ' U') AND (OPPS-PKG-FLAG (LN-SUB) = '0' OR '3')) AND (H-TOT-STVX-PYMT > 0) COMPUTE H-CHRG-RATE ROUNDED = (A-LITEM-PYMT (LN-SUB) / H-TOT-STVX-PYMT) COMPUTE H-SUB-CHRG ROUNDED = (H-CHRG-RATE * H-TOT-N-CHRG) COMPUTE W-SUB-CHRG (W-LP-INDX) ROUNDED = W-SUB-CHRG (W-LP-INDX) + H-SUB-CHRG. *************************************************************** * CALCULATE COMPOSITE APC CHARGES FOR PRIME CODE LINES * * * * THE CHARGES OF ALL PACKAGED LINES WITH A COMPOSITE ADJ. * * FLAG THAT INDICATES THE LINE IS A PART OF A COMPOSITE APC * * (VALUES 01 - NN...) ARE ACCUMULATED BY COMPOSITE * * ADJUSTMENT FLAG AND ADDED TO THE CORRESPONDING PRIME * * (PAYABLE) LINE'S CHARGES. * *-------------------------------------------------------------* * 11/29/2007 - LOGIC ADDED FOR CY 2008 * * 12/14/2007 - ROUNDED W-SUB-CHRG WHEN ADDING COMPOSITES * * 11/12/2008 - CHANGED LOGIC TO USE THE COMPOSITE ADJUSTMENT * * FLAG INSTEAD OF THE PAYMENT ADJUSTMENT FLAG * * VALUES 91 - 99 TO ID PRIME COMPOSITE LINES * *************************************************************** *-------------------------------------------------------------* * COMPOSITE ADJUSTMENT FLAG > 0 INDICATES COMPOSITE APC * *-------------------------------------------------------------* IF OPPS-COMP-ADJ-FLAG (LN-SUB) NOT = '00' *-------------------------------------------------------------* * SEARCH COMPOSITE APC TABLE STARTING AT ENTRY #1 * *-------------------------------------------------------------* MOVE OPPS-COMP-ADJ-FLAG (LN-SUB) TO H-CMP-CAF SET W-CMP-INDX TO 1 SEARCH W-CMP-ENTRY VARYING W-CMP-INDX *-------------------------------------------------------------* * SERVICE LINE'S PAYMENT ADJUSTMENT FLAG NOT IN TABLE * *-------------------------------------------------------------* AT END ADD 0 TO W-SUB-CHRG (W-LP-INDX) *-------------------------------------------------------------* * SERVICE LINE'S PAYMENT ADJUSTMENT FLAG IS IN TABLE, * * ADD THE PACKAGED SUBMITTED CHARGES TO THE LINE'S CHARGES * *-------------------------------------------------------------* WHEN W-CMP-PAF (W-CMP-INDX) = H-CMP-CAF COMPUTE W-SUB-CHRG (W-LP-INDX) ROUNDED = W-SUB-CHRG (W-LP-INDX) + W-CMP-TOT-SUB-CHRG (W-CMP-INDX) END-IF. *************************************************************** * CALCULATE TOTAL MENTAL HEALTH CHARGES FOR APC 34 LINES * * * * THE CHARGES OF PACKAGED LINES WITH A PACKAGING FLAG OF '2' * * ON A CLAIM WITH APC 34 (MENTAL HEALTH APC) ARE ACCUMULATED * * AND ADDED TO THE SEPARATELY PAYABLE APC 34 LINE'S CHARGES. * *-------------------------------------------------------------* * 11/29/2007 - LOGIC ADDED FOR CY 2008 * * 11/12/2008 - LOGIC DISABLED FOR CY 2009 BECAUSE MENTAL * * HEALTH COMPOSITES ARE NOW PROCESSED THE SAME * * AS ALL OTHER COMPOSITES USING THE COMPOSITE * * ADJUSTMENT FLAG * *************************************************************** * IF APC34-FLAG = 'Y' AND OPPS-APC (LN-SUB) = '0034' * COMPUTE W-SUB-CHRG (W-LP-INDX) = * W-SUB-CHRG (W-LP-INDX) + * H-TOT-MH-CHRG * END-IF. *************************************************************** * MOVE LINE PAYMENTS TO HOLD FIELD BECAUSE PAYMENTS MAY BE * * ADJUSTED FOR PASS-THROUGH DEVICES - ADDED 02/14/2008 * * NEW FOR CY 2009 - ALWAYS USE THE PHP "CAP" APC'S WAGE ADJ * * PMT FOR PHP LINES (SI=P) * *-------------------------------------------------------------* * 11/04/2011 - ONLY APPLY PHP "CAP" TO CMHC LINES; PER * * POLICY'S INSTRUCTIONS PHP HOSPITAL LINES ARE * * NOT CAPPED. * *************************************************************** MOVE ZEROS TO H-LITEM-PYMT-OUTL. IF OPPS-SRVC-IND (LN-SUB) = ' P' AND ( (L-PSF-PROV-3456 >= '1400' AND L-PSF-PROV-3456 <= '1499') OR (L-PSF-PROV-3456 >= '4600' AND L-PSF-PROV-3456 <= '4799') OR (L-PSF-PROV-3456 >= '4900' AND L-PSF-PROV-3456 <= '4999') ) MOVE H-PHP-LITEM-PYMT-OUTL TO H-LITEM-PYMT-OUTL ELSE MOVE A-LITEM-PYMT (LN-SUB) TO H-LITEM-PYMT-OUTL END-IF. *************************************************************** * CALCULATE TOTAL CHARGES AND PAYMENTS FOR PROCEDURE LINES * * ELIGIBLE FOR PASS-THROUGH DEVICE(S) * * * * THE CHARGES AND LINE PAYMENTS OF PASS-THROUGH DEVICE LINES * * ARE ADDED TO THE CHARGES AND PAYMENTS OF ALL PROCEDURES * * ELIGIBLE TO BE BILLED WITH THE PASS-THROUGH DEVICE. * * (PTD-FLAG = 'Y' INDICATES THERE IS AT LEAST ONE * * PASS-THROUGH DEVICE ON THE CLAIM) * *-------------------------------------------------------------* * 02/12/2008 - LOGIC ADDED FOR CY 2008 QTR 2 * *************************************************************** IF (PTD-FLAG = 'Y') AND (OPPS-SRVC-IND (LN-SUB) = ' S' OR ' T' OR ' V' OR ' X') *-------------------------------------------------------------* * DETERMINE WHETHER THE LINE IS ELIGIBLE FOR A PT DEVICE * *-------------------------------------------------------------* PERFORM 11670-SET-PTD-PROC-FLAG THRU 11670-SET-PTD-PROC-FLAG-EXIT *-------------------------------------------------------------* * PROCEDURE IS ELIGIBLE FOR A PASS-THROUGH DEVICE * *-------------------------------------------------------------* * 11/12/2008 - EDITED TO LOOK AT PTD-PROC-FLAG, NOT PTD-FLAG * * NO HARM DONE USING THE PTD-FLAG PREVIOUSLY * *-------------------------------------------------------------* IF PTD-PROC-FLAG = 'Y' *-------------------------------------------------------------* * LOOP THROUGH ELIGIBLE PROCEDURE'S PASS-THROUGH DEVICE TABLE * * GET THE PASS-THROUGH DEVICE HCPCS(S) FOR WHICH THE * * PROCEDURE IS ELIGIBLE & UPDATE PROCEDURE CHARGES & PAYMENTS * *-------------------------------------------------------------* PERFORM 11610-PERFORM-SEARCH THRU 11610-PERFORM-SEARCH-EXIT VARYING W-PTD-PROC-SUB FROM 1 BY 1 UNTIL W-PTD-PROC-SUB > W-PTD-CNT END-IF END-IF. *************************************************************** * * * CALCULATE THE OUTLIER PAYMENT FOR ELIGIBLE LINES * * * * -NEW FOR JANUARY 2005 * * - PROVIDER RANGE FOR CMHC * * - COMPUTE H-LITEM-OUTL-PYMT USING NEW FORMULA * * - CHANGE OUTLIER THRESHOLD AMOUNT EVERY JANUARY * * * * -NEW FOR APRIL 2008 * * - A-LITEM-PYMT (LN-SUB) CHANGED TO H-LITEM-PYMT-OUTL B/C * * PAYMENTS ARE NOW ADJUSTED FOR OUTLIER DETERMINATION * * * * -NEW FOR JANUARY 2009 * * - ALL PARTIAL HOSPITALIZATION (PHP) LINES (SI=P) USE * * THE PHP "CAP" APC'S LINE PAYMENT * * * *************************************************************** MOVE 1.75 TO H-OUTLIER-FACTOR. MOVE .50 TO H-OUTLIER-PCT. COMPUTE H-COST ROUNDED = W-SUB-CHRG (W-LP-INDX) * L-PSF-OPCOST-RATIO. COMPUTE H-APC-ADJ-PYMT ROUNDED = H-OUTLIER-FACTOR * H-LITEM-PYMT-OUTL. *-------------------------------------------------------------* * IDENTIFY COMMUNITY MENTAL HEALTH CENTER (CMHC) PROVIDERS * * FOR CMHCS, INCREASE OUTLIER FACTOR & CALC LINE OUTLIER PMT * * (CMHC PROVIDERS ONLY PROCESS PARTIAL HOSPITALIZATION LINES) * *-------------------------------------------------------------* IF (L-PSF-PROV-3456 >= '1400' AND L-PSF-PROV-3456 <= '1499') OR (L-PSF-PROV-3456 >= '4600' AND L-PSF-PROV-3456 <= '4799') OR (L-PSF-PROV-3456 >= '4900' AND L-PSF-PROV-3456 <= '4999') MOVE 3.4 TO H-OUTLIER-FACTOR COMPUTE H-LITEM-OUTL-PYMT ROUNDED = (H-COST - (H-OUTLIER-FACTOR * H-LITEM-PYMT-OUTL)) * H-OUTLIER-PCT *-------------------------------------------------------------* * FOR NON-CMHC PROVIDERS, LINE'S OUTLIER ELIGIBILITY & * * CALCULATE OUTLIER PAYMENT IF ELIGIBLE * * ** UPDATE THE LITERAL NUMBER BELOW EACH JANUARY ** * *-------------------------------------------------------------* ELSE IF (H-COST > H-APC-ADJ-PYMT) AND (H-COST > H-LITEM-PYMT-OUTL + 2025) COMPUTE H-LITEM-OUTL-PYMT ROUNDED = (H-COST - H-APC-ADJ-PYMT) * H-OUTLIER-PCT ELSE MOVE ZERO TO H-LITEM-OUTL-PYMT END-IF END-IF. *-------------------------------------------------------------* * ACCUMULATE TOTAL CLAIM OUTLIER PAYMENTS * *-------------------------------------------------------------* IF H-LITEM-OUTL-PYMT > 0 COMPUTE H-OUTLIER-PYMT = H-OUTLIER-PYMT + H-LITEM-OUTL-PYMT. *-------------------------------------------------------------* * LINES THAT RECEIVE AN EXTERNAL ADJUSTMENT ARE NOT ELIGIBLE * * FOR AN OUTLIER PAYMENT - ZERO OUT PAYMENT & REMOVE FROM * * CLAIM TOTAL * *-------------------------------------------------------------* IF OPPS-LITEM-ACT-FLAG (LN-SUB) = '4' COMPUTE H-OUTLIER-PYMT = H-OUTLIER-PYMT - H-LITEM-OUTL-PYMT MOVE 0 TO H-LITEM-OUTL-PYMT. 11600-ADJ-CHRG-OUTL-EXIT. EXIT. *************************************************************** * * * SEARCH THE PASS-THROUGH DEVICE TABLE FOR THE PASS-THROUGH * * DEVICE(S) THE PROCEDURE IS ELIGIBLE FOR * * * *************************************************************** 11610-PERFORM-SEARCH. *-------------------------------------------------------------* * SEARCH PTD TABLE STARTING AT ENTRY #1 FOR ALL OCCURANCES * * OF THE PASS-THRU DEVICE HCPCS IN THE PASS-THRU DEVICE TABLE.* * THIS IS DONE FOR ALL PASS-THROUGH DEVICES THE PROCEDURE IS * * ELIGIBLE FOR. * *-------------------------------------------------------------* MOVE 'N' TO W-END-OF-PTD-TBL. IF W-PTD-PROC-HCPCS (W-PTD-PROC-SUB) NOT = ' ' SET W-PTD-INDX TO 1 PERFORM 11611-SEARCH-PTD-HCPCS THRU 11611-SEARCH-PTD-HCPCS-EXIT UNTIL W-END-OF-PTD-TBL = 'Y' END-IF. 11610-PERFORM-SEARCH-EXIT. EXIT. *************************************************************** * * * SEARCH FOR THE PASS-THROUGH DEVICE FOR WHICH THE PROCEDURE * * IS ELIGIBLE IN THE TABLE & UPDATE PROCEDURE LINE PAYMENTS * * AND CHARGES * * * *************************************************************** 11611-SEARCH-PTD-HCPCS. MOVE 'N' TO W-END-OF-PTD-TBL. *-------------------------------------------------------------* * SEARCH PASS-THROUGH DEVICE TABLE * *-------------------------------------------------------------* SEARCH W-PTD-ENTRY VARYING W-PTD-INDX *-------------------------------------------------------------* * IF THERE ARE NO MORE OCCURANCES OF THE PASS-THROUGH DEVICE, * * STOP THE SEARCH AND INDICATE END OF FILE * *-------------------------------------------------------------* AT END MOVE 'Y' TO W-END-OF-PTD-TBL GO TO 11611-SEARCH-PTD-HCPCS-EXIT *-------------------------------------------------------------* * IF THE PASS-THROUGH DEVICE IS FOUND, INDICATE NOT END OF * * FILE AND UPDATE THE PROCEDURE'S CHARGES AND PAYMENTS * *-------------------------------------------------------------* WHEN W-PTD-HCPCS (W-PTD-INDX) = W-PTD-PROC-HCPCS (W-PTD-PROC-SUB) MOVE 'N' TO W-END-OF-PTD-TBL PERFORM 11612-UPDATE-PTD-PROC THRU 11612-UPDATE-PTD-PROC-EXIT SET W-PTD-INDX UP BY 1 END-SEARCH. *-------------------------------------------------------------* * SET UP FOR NEXT PASS-THROUGH DEVICE RECORD * *-------------------------------------------------------------* MOVE ZEROS TO H-PTD-UNIT-RATE H-PTD-SUB-CHRG H-PTD-LITEM-PYMT. 11611-SEARCH-PTD-HCPCS-EXIT. EXIT. *************************************************************** * * * UPDATE THE PROCEDURE LINE'S PAYMENTS AND CHARGES WITH THE * * PASS-THROUGH DEVICE'S PAYMENTS AND CHARGES (IN PROPORTION * * TO THE PROCEDURE'S UNITS IF OTHER PROCEDURES ARE ELIGIBLE * * FOR THE PASS-THROUGH DEVICE AS WELL) * * * *************************************************************** 11612-UPDATE-PTD-PROC. *-------------------------------------------------------------* * DETERMINE PROPORTION OF CHARGES & PAYMENTS PROCEDURE LINE * * WILL RECEIVE BASED ON ITS NUMBER OF UNITS * *-------------------------------------------------------------* IF W-PTD-TOTAL-PROC-UNITS (W-PTD-INDX) NOT = 0 COMPUTE H-PTD-UNIT-RATE ROUNDED = OPPS-SRVC-UNITS (LN-SUB) / W-PTD-TOTAL-PROC-UNITS (W-PTD-INDX) ELSE MOVE 0 TO H-PTD-UNIT-RATE END-IF. *-------------------------------------------------------------* * CALCULATE THE AMOUNT OF PASS-THROUGH DEVICE CHARGES TO BE * * ADDED TO THE PROCEDURE'S CHARGES IN PROPORTION TO UNITS * *-------------------------------------------------------------* COMPUTE H-PTD-SUB-CHRG ROUNDED = W-PTD-SUB-CHRG (W-PTD-INDX) * H-PTD-UNIT-RATE. *-------------------------------------------------------------* * ADD PASS-THROUGH DEVICE CHARGES TO PROCEDURE LINE CHARGES * *-------------------------------------------------------------* COMPUTE W-SUB-CHRG (W-LP-INDX) ROUNDED = W-SUB-CHRG (W-LP-INDX) + H-PTD-SUB-CHRG. *-------------------------------------------------------------* * CALCULATE THE AMOUNT OF PASS-THROUGH DEVICE PAYMENTS TO BE * * ADDED TO THE PROCEDURE'S PAYMENTS IN PROPORTION TO UNITS * *-------------------------------------------------------------* COMPUTE H-PTD-LITEM-PYMT ROUNDED = W-PTD-LITEM-PYMT (W-PTD-INDX) * H-PTD-UNIT-RATE. *-------------------------------------------------------------* * ADD PASS-THROUGH DEVICE PAYMENT TO PROCEDURE LINE PAYMENT * *-------------------------------------------------------------* COMPUTE H-LITEM-PYMT-OUTL ROUNDED = H-LITEM-PYMT-OUTL + H-PTD-LITEM-PYMT. 11612-UPDATE-PTD-PROC-EXIT. EXIT. *************************************************************** * * * DETERMINE WHETHER THE CURRENT APC IS A BRACHYTHERAPY APC * * - IF SO, SET BRACHY-APC-FLAG = 'Y' * * - THIS FLAG IS USED IN PARAGRAPHS 9600-ADJ-CHRG-OUTL & * * 9550-CALC-GJK TO PROCESS BRACHYS * * ** UPDATE THIS LIST EVERY JANUARY * * (CODE NEW FOR CY2008; ADDED 11/6/2007) * * * * 11/12/2008 - BRACHYTHERAPY APC LIST REMOVED FOR CY 2009; * * BRACHYTHERAPY LINES NOW IDENTIFIED BY A * * STATUS INDICATOR OF ' U' * * * *************************************************************** *9650-SET-BRACHY-APC-FLAG. * * MOVE 'N' TO BRACHY-APC-FLAG. * * IF OPPS-APC (LN-SUB) = ('2632' OR * '1716' OR * '1717' OR * '1719' OR * '2616' OR * '2634' OR * '2635' OR * '2636' OR * '2638' OR * '2639' OR * '2640' OR * '2641' OR * '2642' OR * '2643' OR * '2698' OR * '2699') * * MOVE 'Y' TO BRACHY-APC-FLAG * END-IF. * *9650-SET-BRACHY-APC-FLAG-EXIT. * EXIT. *************************************************************** * * * DETERMINE WHETHER THE CURRENT HCPCS IS A BLOOD DEDUCTIBLE * * HCPCS * * - IF SO, SET BLD-DEDUC-HCPCS-FLAG = 'Y' * * - THIS FLAG IS USED IN PARAGRAPHS 11550-CALC-GJK & * * 11550-SCH-ADJ TO PROCESS BLOOD DEDUCTIBLE LINES * * ** UPDATE THIS LIST EVERY JANUARY * * (CODE NEW FOR CY2008; ADDED 12/4/2007) * * * *************************************************************** 11655-SET-BD-HCPCS-FLAG. MOVE 'N' TO BLD-DEDUC-HCPCS-FLAG. IF OPPS-HCPCS(LN-SUB) = ('P9054' OR 'P9021' OR 'P9056' OR 'P9051' OR 'P9010' OR 'P9016' OR 'P9038' OR 'P9039' OR 'P9040' OR 'P9058' OR 'P9022' OR 'P9057' ) MOVE 'Y' TO BLD-DEDUC-HCPCS-FLAG END-IF. 11655-SET-BD-HCPCS-FLAG-EXIT. EXIT. *************************************************************** * * * DETERMINE WHETHER THE CURRENT APC IS A RADIOPHARM APC * * - IF SO, SET RADIOPH-APC-FLAG = 'Y' * * - THIS FLAG IS USED IN PARAGRAPH 9550-CALC-STANDARD * * TO PROCESS RADIOPHARM LINES * * ** UPDATE THIS LIST EVERY JANUARY * * (CODE NEW FOR CY2008; ADDED 12/27/2007) * * * * 11/16/2009 - LOGIC REMOVED BECAUSE THERAP. RADIO NO LONGER * * HAVE AN SI=H (NOT PAID AT COST) CY 2010 * * * *************************************************************** *9660-SET-RADIOPH-APC-FLAG. * * MOVE 'N' TO RADIOPH-APC-FLAG. * * IF OPPS-APC (LN-SUB) = ('1064' OR * '1150' OR * '1643' OR * '1645' OR * '1675' OR * '1676' OR * '0701' OR * '0702') * * MOVE 'Y' TO RADIOPH-APC-FLAG * END-IF. * *9660-SET-RADIOPH-APC-FLAG-EXIT. * EXIT. *************************************************************** * * * DETERMINE WHETHER THE CURRENT HCPCS IS A PASS-THROUGH * * DEVICE HCPCS (FOR OUTLIER PAYMENT ADJ) * * - IF SO, SET PTD-LINE-FLAG = 'Y' * * - THIS FLAG IS USED IN THE PASS-THROUGH DEVICE LOGIC * * TO POPULATE THE PASS-THROUGH-DEVICE TABLE * * ** UPDATE THIS LIST EVERY QUARTER * * (CODE NEW FOR CY2008 QTR 2; ADDED 02/11/2008) * * * *************************************************************** 11665-SET-PTD-LINE-FLAG. MOVE 'N' TO PTD-LINE-FLAG. *********************************************************** * 11/12/2008 - ALL LOGIC DISABLED B/C THERE ARE NO * * NO PASS-THROUGH DEVICES FOR CY 2009 * * 11/18/2009 - NO PASS-THROUGH DEVICES FOR CY 2010 * * 08/12/2010 - NEW PT DEVICE EFFECTIVE OCTOBER 1, 2010 * * 08/15/2011 - NEW PT DEVICES EFFECTIVE OCTOBER 1, 2011 * * 11/04/2011 - NEW PT DEVICES EFFECTIVE JANUARY 1, 2012 * *********************************************************** *---------------------------------------------------------* * ONLY CLAIMS WITH A DATE OF SERVICE ON OR AFTER * * 10/01/2010 ARE ELIGIBLE * *---------------------------------------------------------* IF OPPS-LITEM-DOS (LN-SUB) >= 20101001 *---------------------------------------------------------* * PT DEVICE HCPCS EFFECTIVE ON AND AFTER 10/01/2010 * *---------------------------------------------------------* IF (OPPS-LITEM-DOS (LN-SUB) >= 20101001 AND OPPS-LITEM-DOS (LN-SUB) <= 20121231 AND OPPS-HCPCS (LN-SUB) = 'C1749') OR *---------------------------------------------------------* * PT DEVICE HCPCS EFFECTIVE ON AND AFTER 10/01/2011 * *---------------------------------------------------------* (OPPS-LITEM-DOS (LN-SUB) >= 20111001 AND OPPS-HCPCS (LN-SUB) = ('C1830' OR 'C1840') ) OR *---------------------------------------------------------* * PT DEVICE HCPCS EFFECTIVE ON AND AFTER 01/01/2012 * *---------------------------------------------------------* (OPPS-LITEM-DOS (LN-SUB) >= 20120101 AND OPPS-HCPCS (LN-SUB) = ('C1840' OR 'C1886') ) MOVE 'Y' TO PTD-LINE-FLAG END-IF END-IF. 11665-SET-PTD-LINE-FLAG-EXIT. EXIT. *************************************************************** * * * DETERMINE WHETHER THE CURRENT HCPCS IS A PROCEDURE * * ELIGIBLE FOR A PASS-THROUGH DEVICE (FOR OUTLIER PMT ADJ) * * - IF SO, SET PTD-PROC-FLAG = 'Y' * * - THIS FLAG IS USED IN THE PASS-THROUGH DEVICE LOGIC * * ** UPDATE THIS LIST EVERY QUARTER * * (CODE NEW FOR CY2008 QTR 2; ADDED 02/11/2008) * * * *************************************************************** 11670-SET-PTD-PROC-FLAG. MOVE 'N' TO PTD-PROC-FLAG. *********************************************************** * 11/12/2008 - ALL LOGIC DISABLED B/C THERE ARE NO * * NO PASS-THROUGH DEVICES FOR CY 2009 * * 11/18/2009 - NO PASS-THROUGH DEVICES FOR CY 2010 * * 08/12/2010 - NEW PT DEVICE EFFECTIVE OCTOBER 1, 2010 * * 08/15/2011 - NEW PT DEVICES EFFECTIVE OCTOBER 1, 2011 * * 11/04/2011 - NEW PT DEVICES EFFECTIVE JANUARY 1, 2012, * * AND ONE PAIRING TERMINATED 12/31/2011 * *********************************************************** *---------------------------------------------------------* * ONLY CLAIMS WITH A DATE OF SERVICE ON OR AFTER * * 10/01/2010 ARE ELIGIBLE * *---------------------------------------------------------* IF OPPS-LITEM-DOS (LN-SUB) >= 20101001 *---------------------------------------------------------* * SPECIFY NUMBER OF ENTRIES (# OF PT DEVICES FROM POLICY)* *---------------------------------------------------------* MOVE 4 TO W-PTD-CNT *---------------------------------------------------------* * INITIALIZE PROCEDURE'S PTD HCPCS TABLE TO SPACES * *---------------------------------------------------------* PERFORM VARYING W-PTD-PROC-SUB FROM 1 BY 1 UNTIL W-PTD-PROC-SUB > W-PTD-CNT MOVE SPACES TO W-PTD-PROC-HCPCS (W-PTD-PROC-SUB) END-PERFORM *********************************************************** * * * ** PT DEVICE MAPPINGS VALID DURING CY 2012 ** * * * *********************************************************** *********************************************************** * PT DEVICE MAPPINGS EFFECTIVE ON AND AFTER 10/01/2010 * *********************************************************** *---------------------------------------------------------* * PROCEDURES ELIGIBLE FOR PASS-THROUGH DEVICE 1 (C1749) * *---------------------------------------------------------* IF OPPS-LITEM-DOS (LN-SUB) >= 20101001 AND OPPS-LITEM-DOS (LN-SUB) <= 20121231 AND OPPS-HCPCS (LN-SUB) = ('44388' OR '45355' OR '44389' OR '44394' OR '44390' OR '44392' OR '44391' OR '45379' OR '45391' OR '44393' OR '45392' OR '45386' OR '45378' OR '45380' OR '45381' OR '45382' OR '45383' OR '45384' OR '45385' OR 'G0105' OR 'G0121') MOVE 'Y' TO PTD-PROC-FLAG MOVE 1 TO W-PTD-PROC-SUB MOVE 'C1749' TO W-PTD-PROC-HCPCS (W-PTD-PROC-SUB) END-IF *********************************************************** * PT DEVICE MAPPINGS EFFECTIVE ON AND AFTER 10/01/2011 * *********************************************************** *---------------------------------------------------------* * PROCEDURES ELIGIBLE FOR PASS-THROUGH DEVICE 2 (C1830) * *---------------------------------------------------------* IF OPPS-LITEM-DOS (LN-SUB) >= 20111001 AND OPPS-HCPCS (LN-SUB) = ('38220' OR '38221') MOVE 'Y' TO PTD-PROC-FLAG MOVE 2 TO W-PTD-PROC-SUB MOVE 'C1830' TO W-PTD-PROC-HCPCS (W-PTD-PROC-SUB) END-IF *********************************************************** * PT DEVICE MAPPINGS EFFECTIVE ON AND AFTER 01/01/2012 * *********************************************************** *---------------------------------------------------------* * PROCEDURES ELIGIBLE FOR PASS-THROUGH DEVICE 3 (C1840) * *---------------------------------------------------------* IF OPPS-LITEM-DOS (LN-SUB) >= 20120101 AND OPPS-HCPCS (LN-SUB) = ('C9732') MOVE 'Y' TO PTD-PROC-FLAG MOVE 3 TO W-PTD-PROC-SUB MOVE 'C1840' TO W-PTD-PROC-HCPCS (W-PTD-PROC-SUB) END-IF *---------------------------------------------------------* * PROCEDURES ELIGIBLE FOR PASS-THROUGH DEVICE 4 (C1886) * *---------------------------------------------------------* IF OPPS-LITEM-DOS (LN-SUB) >= 20120101 AND OPPS-HCPCS (LN-SUB) = ('0276T' OR '0277T') MOVE 'Y' TO PTD-PROC-FLAG MOVE 4 TO W-PTD-PROC-SUB MOVE 'C1886' TO W-PTD-PROC-HCPCS (W-PTD-PROC-SUB) END-IF *---------------------------------------------------------* * END OF PT DEVICE MAPPINGS VALID DURING CY 2012 FOR * * LINES SERVICED ON OR AFTER 10/01/2010 * *---------------------------------------------------------* END-IF. *********************************************************** * * * ** EXPIRED PT DEVICE MAPPINGS ** * * * *********************************************************** *********************************************************** * PT DEVICE MAPPINGS EXPIRED 12/31/2008 * *********************************************************** * *---------------------------------------------------------* * PROCEDURES ELIGIBLE FOR PASS-THROUGH DEVICE 2 * * ** ENABLE IF THERE ARE MULTIPLE PT DEVICES * *---------------------------------------------------------* * IF OPPS-HCPCS (LN-SUB) = ('69714' OR * '69715' OR * '69717' OR * '69718') * * MOVE 'Y' TO PTD-PROC-FLAG * MOVE 2 TO W-PTD-PROC-SUB * MOVE 'L8690' TO W-PTD-PROC-HCPCS (W-PTD-PROC-SUB) * END-IF *********************************************************** * PT DEVICE MAPPINGS EXPIRED 12/31/2011 * *********************************************************** * *---------------------------------------------------------* * PROCEDURES ELIGIBLE FOR PASS-THROUGH DEVICE 3 (C1840) * *---------------------------------------------------------* * IF OPPS-LITEM-DOS (LN-SUB) >= 20111001 AND * OPPS-LITEM-DOS (LN-SUB) <= 20111231 AND * OPPS-HCPCS (LN-SUB) = ('66982' OR * '66984' OR * '66999') * * MOVE 'Y' TO PTD-PROC-FLAG * MOVE 3 TO W-PTD-PROC-SUB * MOVE 'C1840' TO W-PTD-PROC-HCPCS (W-PTD-PROC-SUB) * END-IF 11670-SET-PTD-PROC-FLAG-EXIT. EXIT. *************************************************************** * * * DETERMINE WHETHER THE LINE HCPCS IS A CURRENT PASS-THROUGH * * RADIOPHARMACEUTICAL HCPCS * * * * - IF SO: SET PTRADIO-LINE-FLAG = 'Y', * * ADD 1 TO COUNT OF TOTAL PT RADIOPHARMS, * * ADD CHARGES TO CLAIM TOTAL PT RADIOPHARM CHRGES * * - THIS FLAG IS USED IN PARAGRAPHS 11125-INIT & * * 11550-CALC-STANDARD TO PROCESS PT RADIOPHARM LINES * * * * ** PASS-THROUGH RADOIOPHARM TABLE IS UPDATED QUARTERLY * * (CODE NEW FOR CY2009; ADDED 02/10/2009) * * * *-------------------------------------------------------------* * * * 12/20/2011 - LOGIC REVISED TO INCLUDE TERMINATION DATE * * AS A VALID DATE OF SERVICE * * * *************************************************************** 11680-SET-PTRADIO-LINE-FLAG. MOVE 'N' TO PTRADIO-LINE-FLAG. SEARCH ALL PTRH-ENTRY AT END MOVE 'N' TO PTRADIO-LINE-FLAG WHEN PTRH-PTRADIO-HCPCS (PTRH-INDX) = OPPS-HCPCS (LN-SUB) IF OPPS-LITEM-DOS (LN-SUB) >= PTRH-EFF-DATE (PTRH-INDX) AND (OPPS-LITEM-DOS (LN-SUB) <= PTRH-TERM-DATE (PTRH-INDX) OR PTRH-TERM-DATE (PTRH-INDX) = 0) THEN MOVE 'Y' TO PTRADIO-LINE-FLAG END-IF. 11680-SET-PTRADIO-LINE-FL-EXIT. EXIT. *************************************************************** * * * DETERMINE WHETHER THE LINE HCPCS IS A CURRENT PASS-THROUGH * * CONTRAST AGENT HCPCS * * * * - IF SO: SET PTCA-LINE-FLAG = 'Y', * * - THIS FLAG IS USED IN PARAGRAPHS 11125-INIT & * * 11550-CALC-STANDARD TO PROCESS PT CONTRAST AGENT LINES * * * * ** PASS-THROUGH CONTRAST AGENT TABLE IS UPDATED QUARTERLY * * (CODE NEW FOR CY2010; ADDED 11/16/2009) * * * *-------------------------------------------------------------* * * * 12/20/2011 - LOGIC REVISED TO INCLUDE TERMINATION DATE * * AS A VALID DATE OF SERVICE * * * *************************************************************** 11681-SET-PTCA-LINE-FLAG. MOVE 'N' TO PTCA-LINE-FLAG. SEARCH ALL PTCH-ENTRY AT END MOVE 'N' TO PTCA-LINE-FLAG WHEN PTCH-PTCONTR-HCPCS (PTCH-INDX) = OPPS-HCPCS (LN-SUB) IF OPPS-LITEM-DOS (LN-SUB) >= PTCH-EFF-DATE (PTCH-INDX) AND (OPPS-LITEM-DOS (LN-SUB) <= PTCH-TERM-DATE (PTCH-INDX) OR PTCH-TERM-DATE (PTCH-INDX) = 0) THEN MOVE 'Y' TO PTCA-LINE-FLAG END-IF. 11681-SET-PTCA-LINE-FL-EXIT. EXIT. *************************************************************** * * * DETERMINE WHETHER THE LINE HCPCS IS A CURRENT PASS-THROUGH * * DEVICE HCPCS (FOR OFFSET) * * * * - IF SO: SET PTDO-LINE-FLAG = 'Y', * * - THIS FLAG IS USED IN PARAGRAPHS 11125-INIT & * * 11550-CALC-STANDARD TO PROCESS PT DEVICE LINES * * * * ** PASS-THROUGH DEVICE OFFSET TABLE IS UPDATED QUARTERLY * * (CODE NEW FOR OCT 2010; ADDED 08/02/2010) * * * *-------------------------------------------------------------* * * * 12/20/2011 - LOGIC REVISED TO ACCOMMODATE DEVICES THAT HAVE * * MULTIPLE PROCEDURE PAIRINGS WITH DIFFERENT * * EFFECTIVE AND TERMINATION DATES. ALSO ENSURED * * THE TERMINATION DATE IS AFTER OR ON THE * * DATE OF SERVICE. * * * *************************************************************** 11682-SET-PTDO-LINE-FLAG. MOVE 'N' TO PTDO-LINE-FLAG. SET PTDO-INDX TO 1. SEARCH PTDO-ENTRY AT END MOVE 'N' TO PTDO-LINE-FLAG *----------------------------------------------------------------* * LINE HCPCS IS FOUND IN THE PT DEVICE OFFSET HISTORY TABLE AND * * THE DATE OF SERVICE IS WITHIN THE EFFECTIVE & TERMINATION DATE * * PARAMETERS. * *----------------------------------------------------------------* WHEN PTDO-DEV-HCPCS (PTDO-INDX) = OPPS-HCPCS (LN-SUB) AND PTDO-EFF-DATE (PTDO-INDX) <= OPPS-LITEM-DOS (LN-SUB) AND (PTDO-TERM-DATE (PTDO-INDX) >= OPPS-LITEM-DOS (LN-SUB) OR PTDO-TERM-DATE (PTDO-INDX) = 0) MOVE 'Y' TO PTDO-LINE-FLAG. *-------------------------------------------------------------* * OLD LOGIC DISABLED & REPLACED BY LOGIC ABOVE ON 12/20/2011 * *-------------------------------------------------------------* * MOVE 'N' TO PTDO-LINE-FLAG. * * SEARCH ALL PTDO-ENTRY * AT END * MOVE 'N' TO PTDO-LINE-FLAG * * WHEN PTDO-DEV-HCPCS (PTDO-INDX) = OPPS-HCPCS (LN-SUB) * IF OPPS-LITEM-DOS (LN-SUB) >= PTDO-EFF-DATE (PTDO-INDX) AND * (OPPS-LITEM-DOS (LN-SUB) < PTDO-TERM-DATE (PTDO-INDX) OR * PTDO-TERM-DATE (PTDO-INDX) = 0) THEN * MOVE 'Y' TO PTDO-LINE-FLAG * END-IF. *-------------------------------------------------------------* 11682-SET-PTDO-LINE-FL-EXIT. EXIT. *************************************************************** * * * *** PARAGRAPH COMMENTED OUT 8/11/2010, * * REPLACED WITH REVISED PT DEVICE OFFSET LOGIC ** * * * * REDUCE LINE ITEM PAYMENTS OF DEVICE LINES (SI = H) BY THE * * WAGE ADJUSTED DEVICE OFFSET AMOUNT WHEN THERE ARE DEVICE * * OFFSETS ON THE CLAIM (PASS-THROUGH DEVICES) * * * *************************************************************** * * * 1. RE-CALCULATE LINE ITEM PAYMENT FOR SERVICE INDICATOR * * TYPE H * * 2. SUBTRACT WAGE ADJUSTED OFFSET AMOUNT FROM SI TYPE 'H' * * WITH HCPCS CODE BEGINNING WITH 'C' * * ** EFFECTIVE 04/01/2002 * * * *************************************************************** *9700-CALC-H-OFFSET. * *-------------------------------------------------------------* * REDUCE EACH DEVICE LINE'S PAYMENT BY THE WAGE ADJUSTED * * OFFSET AMOUNT IN PROPORTION TO THE DEVICE LINE'S CHARGES * *-------------------------------------------------------------* * IF H-TOT-H-CHRG > 0 * COMPUTE H-OFF-RATE ROUNDED = * H-SUB-CHRG / H-TOT-H-CHRG * COMPUTE T-LITEM-PYMT ROUNDED = * T-LITEM-PYMT - (H-TOTAL-WAOFF * H-OFF-RATE) * ELSE * NEXT SENTENCE. * * IF T-LITEM-PYMT < 0 * MOVE 0 TO T-LITEM-PYMT. * *9700-CALC-H-OFFSET-EXIT. * EXIT. *************************************************************** * * * PROCESS DRUG COINSURANCE TABLE RECORDS * * * *************************************************************** * * * ADJUST THE "DRUG" LINE COINSURANCE WHEN THE PROCEDURE * * COINSURANCE AMOUNTS PLUS THE "DRUG" COINSURANCE AMOUNT(S) * * BILLED ON THE SAME DAY EXCEED THE DAILY INPATIENT * * COINSURANCE LIMIT. * * * *************************************************************** 11800-ADJ-STV-REIM. IF W-DCP-CODE (W-DCP-INDX) = 1 PERFORM 11810-PROCESS-TYPE1 THRU 11810-PROCESS-TYPE1-EXIT ELSE PERFORM 11840-PROCESS-TYPE2 THRU 11840-PROCESS-TYPE2-EXIT. 11800-ADJ-STV-REIM-EXIT. EXIT. *************************************************************** * * * FOR DAYS OF SERVICE WITH "DRUG" COINSURANCE, DETERMINE THE * * % OF TOTAL "DRUG" COINSURANCE THAT CAN BE PAID IN ADDITION * * TO THE DAY'S MOST EXPENSIVE PROCEDURE/VISIT WAGE ADJUSTED * * COINSURANCE WHILE KEEPING WITHIN THE INPATIENT DAILY * * COINSURANCE LIMIT. * * * * WHEN H-RATIO = 0, NONE OF THE DRUG COINSURANCE CAN BE PAID * * WHEN H-RATIO = 1, ALL OF THE DRUG COINSURANCE CAN BE PAID * * * * BY USING THE DAY'S MOST EXPENSIVE PROCEDURE/VIST WAGE * * ADJUSTED COINSURANCE, THE BENEFICIARY RECEIVES THE * * GREATEST BENEFIT FROM THE INPATIENT LIMITATION PROVISION. * * * *************************************************************** 11810-PROCESS-TYPE1. *-------------------------------------------------------------* * DRUGS WERE ADMINISTERED ON THE DAY * *-------------------------------------------------------------* IF W-DCP-COIN2 (W-DCP-INDX) > 0 *-------------------------------------------------------------* * GET DATE OF SERVICE & WAGE ADJUSTED COINSURANCE OF THE * * DAY'S MOST EXPENSIVE PROCEDURE/VISIT * *-------------------------------------------------------------* MOVE W-DCP-DOS (W-DCP-INDX) TO H-DCP-DOS MOVE W-DCP-WGNAT (W-DCP-INDX) TO H-TOTAL *-------------------------------------------------------------* * CALCULATE THE % OF THE DAY'S TOTAL DRUG COIN THAT CAN BE * * PAID IN ADDITION TO THE PROCEDURE/VISIT COIN WITHIN THE * * INPATIENT LIMIT * *-------------------------------------------------------------* COMPUTE H-RATIO = (H-IP-LIMIT - W-DCP-WGNAT (W-DCP-INDX)) / W-DCP-COIN2 (W-DCP-INDX) *-------------------------------------------------------------* * NONE OF THE DAY'S DRUG COIN CAN BE PAID B/C THE PROCEDURE/ * * VISIT COIN > INPATIENT COIN LIMIT * *-------------------------------------------------------------* IF H-RATIO < 0 MOVE 0 TO H-RATIO. *-------------------------------------------------------------* * THE DAY'S TOTAL DRUG COINSURANCE CAN BE PAID WITHIN THE * * INPATIENT COIN LIMIT * *-------------------------------------------------------------* IF H-RATIO > 1 MOVE 1 TO H-RATIO. 11810-PROCESS-TYPE1-EXIT. EXIT. *************************************************************** * * * REDUCE THE "DRUG" LINE'S NATIONAL COINSURANCE AMOUNT AND * * ADD THE REDUCTION AMOUNT TO THE LINE'S REIMBURSEMENT * * AMOUNT WHEN THE INPATIENT LIMIT IS EXCEEDED * * * *************************************************************** 11840-PROCESS-TYPE2. *-------------------------------------------------------------* * CURRENT TYPE 2 DRUG COIN REC HAS SAME DATE OF SERVICE AS * * THE LAST TYPE 1 RECORD PROCESSED * *-------------------------------------------------------------* IF W-DCP-DOS (W-DCP-INDX) = H-DCP-DOS *-------------------------------------------------------------* * GO TO SERVICE LINE THAT CORRESPONDS TO THE DRUG COIN RECORD * *-------------------------------------------------------------* MOVE W-DCP-SUB (W-DCP-INDX) TO LN-SUB *-------------------------------------------------------------* * CALCULATE ACTUAL COIN AMT TO BE REIMBURSED DUE TO IP LIMIT * *-------------------------------------------------------------* COMPUTE H-SHIFT = W-DCP-COIN2 (W-DCP-INDX) * (1 - H-RATIO) *-------------------------------------------------------------* * ACCUMULATE THE TOTAL NATIONAL COIN DUE FOR THE DAY * * (LESS ACTUAL COIN AMT TO BE REIMBURSED DUE TO IP LIMIT) * *-------------------------------------------------------------* COMPUTE H-TOTAL = A-ADJ-COIN (LN-SUB) + H-TOTAL - H-SHIFT *-------------------------------------------------------------* * DETERMINE HOW MUCH THE DAY'S TOTAL NATIONAL COIN DUE * * EXCEEDS THE DAILY INPATIENT LIMIT (IF IT EXCEEDS THE LIMIT) * *-------------------------------------------------------------* * OCCURS WHEN THE NATIONAL COIN OF THIS LINE AND/OR PREVIOUS * * LINES FROM THE SAME DAY IS GREATER THAN THE ACTUAL COIN DUE * * & PUSHES THE DAILY TOTAL OVER THE INPATIENT LIMIT * *-------------------------------------------------------------* IF H-TOTAL > H-IP-LIMIT COMPUTE H-SHIFT = H-SHIFT + H-TOTAL - H-IP-LIMIT END-IF *-------------------------------------------------------------* * CALCULATE THE ADJUSTED NATIONAL COIN FOR THE DRUG LINE BY * * DEDUCTING THE AMT THAT EXCEEDS THE INPATIENT LIMIT * *-------------------------------------------------------------* COMPUTE A-ADJ-COIN (LN-SUB) = A-ADJ-COIN (LN-SUB) - H-SHIFT *-------------------------------------------------------------* * ADD DRUG COIN AMT THAT EXCEEDS IP LIMIT TO LINE REIM AMT * * SET RETURN CODE TO INDICATE DAILY COINSURANCE LIMITATION * *-------------------------------------------------------------* COMPUTE A-LITEM-REIM (LN-SUB) = A-LITEM-REIM (LN-SUB) + H-SHIFT MOVE 22 TO A-RETURN-CODE (LN-SUB) END-IF. 11840-PROCESS-TYPE2-EXIT. EXIT. *************************************************************** * * * END OF CLAIM PROCESSING * * * * 1. MOVE TOTAL CLAIM CHARGE AMOUNT. * * 2. MOVE TOTAL CLAIM PAYMENT AMOUNT. * * 3. MOVE TOTAL CLAIM BLOOD PINTS USED. * * 4. CALCULATE CLAIM LEVEL OUTLIER AMOUNT. * * * *************************************************************** 11900-END-PRICE-RTN. MOVE H-TOT-CHRG TO A-TOT-CLM-CHRG. MOVE H-TOT-PYMT TO A-TOT-CLM-PYMT. *-------------------------------------------------------------* * NUMBER OF BLOOD PINTS USED FOR BLOOD DEDUCTIBLES ON CLAIM = * * INITIAL NUMBER OF BLOOD PINTS ALLOWED FOR DEDUCTIBLES - * * BLOOD PINTS STILL LEFT AFTER PROCESSING BLOOD DEDUCTIBLES * *-------------------------------------------------------------* COMPUTE A-BLOOD-PINTS-USED = H-BENE-BLOOD-PINTS - H-BENE-PINTS-USED. IF H-OUTLIER-PYMT > 0 MOVE H-OUTLIER-PYMT TO A-OUTLIER-PYMT. 11900-END-PRICE-RTN-EXIT. EXIT.