ABME5L10.m

ABME5L10 ; IHS/ASDST/DMJ - Header 

 ;;2.6;IHS Third Party Billing System;**6,8,10,11,19,21,22,23**;NOV 12, 2009;Build 427

 ;Header Segments

 ;IHS/SD/SDR - 2.6*19 - HEAT116949 - Include LIN segment in 837I if line item has an NDC.

 ;IHS/SD/SDR - 2.6*21 - HEAT106899 - Updated to print operating.  Fixed so it would print both

 ;   oper. and rend. if both populated.  Also made correction to patch 19 code.  There was a QUIT that was

 ;   causing none of the line item provider lines to print if there wasn't an NDC on the line.

 ;IHS/SD/SDR - 2.6*21 - HEAT120880 - Made change for OK Medicaid to print date range in loop 2400.

 ;IHS/SD/SDR 2.6*22 HEAT335246 check new parameter for itemized but with the flat rate on first line, zeros for the rest

 ;IHS/SD/SDR 2.6*23 HEAT247169 Added checks for NDC in piece 19 of ABMRV array

 ;

EP ;START HERE

 S ABMLXCNT=0

 K ABM

 D FRATE^ABMDF11

 D ^ABMERGRV

 S ABMITMZ=$P($G(^ABMNINS(DUZ(2),ABMP("INS"),1,ABMP("VTYP"),0)),"^",12)  ;abm*2.6*22 IHS/SD/SDR HEAT335246

 I +ABMITMZ&($P($G(^ABMNINS(DUZ(2),ABMP("INS"),0)),U,14)="Y")&(+$G(ABMP("FLAT"))'=0) D START^ABMERGR4  ;abm*2.6*22 IHS/SD/SDR HEAT335246

 S ABMI=""

 F  S ABMI=$O(ABMRV(ABMI)) Q:ABMI=""  D

 .Q:ABMI=9999

 .S ABMJ=-1

 .F  S ABMJ=$O(ABMRV(ABMI,ABMJ)) Q:ABMJ=""  D

 ..S ABMK=0

 ..F  S ABMK=$O(ABMRV(ABMI,ABMJ,ABMK)) Q:ABMK=""  D

 ...D LOOP

 K ABMI,ABMJ,ABMK

 Q

 ;

LOOP ;

 ; Loop 2400 - Service Line Number

 S ABMLOOP=2400

 S ABMLXCNT=ABMLXCNT+1

 D EP^ABME5LX

 D WR^ABMUTL8("LX")

 D EP^ABME5SV2

 D WR^ABMUTL8("SV2")

 ;start old abm*2.6*21 IHS/SD/SDR HEAT120880

 ;I $P(ABMRV(ABMI,ABMJ,ABMK),U,10) D

 ;.D EP^ABME5DTP("472","D8",$P(ABMRV(ABMI,ABMJ,ABMK),U,10))

 ;I '$P(ABMRV(ABMI,ABMJ,ABMK),U,10) D

 ;.D EP^ABME5DTP(472,"D8",$P(ABMB7,U))

 ;end old start new abm*2.6*21 IHS/SD/SDR HEAT120880

 I $$GET1^DIQ(9999999.18,ABMP("INS"),".01","E")="OKLAHOMA MEDICAID" D

 .I $P(ABMRV(ABMI,ABMJ,ABMK),U,10) D

 ..D EP^ABME5DTP("472","RD8",$P(ABMRV(ABMI,ABMJ,ABMK),U,10),$S($P(ABMRV(ABMI,ABMJ,ABMK),U,27):$P(ABMRV(ABMI,ABMJ,ABMK),U,27),1:$P(ABMRV(ABMI,ABMJ,ABMK),U,10)))

 .I '$P(ABMRV(ABMI,ABMJ,ABMK),U,10) D

 ..D EP^ABME5DTP(472,"RD8",$P(ABMB7,U),$P(ABMB7,U,2))

 I $$GET1^DIQ(9999999.18,ABMP("INS"),".01","E")'="OKLAHOMA MEDICAID" D	

 .I $P(ABMRV(ABMI,ABMJ,ABMK),U,10) D

 ..D EP^ABME5DTP("472","D8",$P(ABMRV(ABMI,ABMJ,ABMK),U,10))

 .I '$P(ABMRV(ABMI,ABMJ,ABMK),U,10) D

 ..D EP^ABME5DTP(472,"D8",$P(ABMB7,U))

 ;end new abm*2.6*21 IHS/SD/SDR HEAT120880

 D WR^ABMUTL8("DTP")

 ;D EP^ABME5REF("6R","")   ;line item control number  ;abm*2.6*11 HEAT92070

 ;D WR^ABMUTL8("REF")  ;abm*2.6*11 HEAT92070

 ;start new code abm*2.6*11 HEAT92070

 I $P($G(ABMRV(ABMI,ABMJ,ABMK)),U,38)'="" D

 .D EP^ABME5REF("6R","")

 .D WR^ABMUTL8("REF")   ;line item control number

 ;end new code HEAT92070

 ;

 ; Loop 2410 - Drug Identification

 S ABMLOOP=2410

 ;I $P($G(ABMRV(ABMI,ABMJ,ABMK)),U,14)'="" D  ;abm*2.6*10 HEAT72307

 ;I $P($G(ABMRV(ABMI,ABMJ,ABMK)),U,13)'="" D  ;abm*2.6*10 HEAT72307  ;abm*2.6*10 HEAT78446

 ;I $P($G(ABMRV(ABMI,ABMJ,ABMK)),U,28)'="" D  ;abm*2.6*10 HEAT72307  ;abm*2.6*10 HEAT78446  ;abm*2.6*19 HEAT116949

 S NDC=$P($P(ABMRV(ABMI,ABMJ,ABMK),U,9)," ")  ;abm*2.6*19 HEAT116949

 ;start old abm*2.6*21 IHS/SD/SDR HEAT106899

 ;S NDC=$TR(NDC,"-") I ($L(NDC)'=10&($L(NDC)'=11)) Q  ;abm*2.6*19 HEAT116949

 ;I NDC D  ;abm*2.6*19 HEAT116949

 ;.I $P($P(ABMRV(ABMI,ABMJ,ABMK),U,9)," ")'="" D

 ;..D EP^ABME5LIN

 ;..D WR^ABMUTL8("LIN")

 ;.I +$P(ABMRV(ABMI,ABMJ,ABMK),U,5) D

 ;..D EP^ABME5CTP

 ;..D WR^ABMUTL8("CTP")

 ;.;start old abm*2.6*19 HEAT116949

 ;.;D EP^ABME5REF("XZ",$P(ABMRV(ABMI,ABMJ,ABMK),U,14))

 ;.;D WR^ABMUTL8("REF")

 ;.;end old start new abm*2.6*19 HEAT116949

 ;.I $P($G(ABMRV(ABMI,ABMJ,ABMK)),U,14)'="" D

 ;..D EP^ABME5REF("XZ",$P(ABMRV(ABMI,ABMJ,ABMK),U,14))

 ;..D WR^ABMUTL8("REF")

 ;end old start new abm*2.6*21 IHS/SD/SDR HEAT106899

 I +$G(NDC)=0 S NDC=$P(ABMRV(ABMI,ABMJ,ABMK),U,19)  ;abm*2.6*23 IHS/SD/SDR HEAT247169

 S NDC=$TR(NDC,"-")

 I NDC&(($L(NDC)=10)!($L(NDC)=11)) D

 .;I $P($P(ABMRV(ABMI,ABMJ,ABMK),U,9)," ")'="" D  ;abm*2.6*23 IHS/SD/SDR HEAT247169

 .I $P($P(ABMRV(ABMI,ABMJ,ABMK),U,9)," ")'=""!$P(ABMRV(ABMI,ABMJ,ABMK),U,19)'="" D  ;abm*2.6*23 IHS/SD/SDR HEAT247169

 ..D EP^ABME5LIN

 ..D WR^ABMUTL8("LIN")

 .;I +$P(ABMRV(ABMI,ABMJ,ABMK),U,5) D  ;abm*2.6*22 IHS/SD/SDR HEAT335246

 .I +$P(ABMRV(ABMI,ABMJ,ABMK),U,5)!($P($G(^ABMNINS(ABMP("LDFN"),ABMP("INS"),0)),U,14)="Y") D  ;abm*2.6*22 IHS/SD/SDR HEAT335246

 ..D EP^ABME5CTP

 ..D WR^ABMUTL8("CTP")

 .I $P($G(ABMRV(ABMI,ABMJ,ABMK)),U,14)'="" D

 ..D EP^ABME5REF("XZ",$P(ABMRV(ABMI,ABMJ,ABMK),U,14))

 ..D WR^ABMUTL8("REF")

 ;end new abm*2.6*21 IHS/SD/SDR HEAT106899

 ;

 ; Loop 2420A - Operating Physician Name

 S ABMLOOP="2420A"

 I $P($G(ABMRV(ABMI,ABMJ,ABMK)),U,16) D

 .S ABM("PRV")=$P(ABMRV(ABMI,ABMJ,ABMK),U,16)

 .Q:ABM("PRV")=$O(ABMP("PRV","O",0))

 .D EP^ABME5NM1("72")

 .D WR^ABMUTL8("NM1")

 .I ABMNPIU="N" D

 ..D EP^ABME5REF("EI",9999999.06,DUZ(2))

 ..D WR^ABMUTL8("REF")

 .I ABMNPIU'="N" D

 ..D EP^ABME5REF(ABMP("RTYPE"),200,ABM("PRV"))

 ..D WR^ABMUTL8("REF")

 ;

 ; Loop 2420C - Other Physician Name

 I $P($G(ABMRV(ABMI,ABMJ,ABMK)),U,18) D

 .S ABM("PRV")=$P(ABMRV(ABMI,ABMJ,ABMK),U,18)

 .;Q:ABM("PRV")=$O(ABMP("PRV","T",0))  ;abm*2.6*21 IHS/SD/SDR HEAT106899

 .Q:ABM("PRV")=$O(ABMP("PRV","R",0))  ;abm*2.6*21 IHS/SD/SDR HEAT106899

 .;D EP^ABME5NM1("73")  ;abm*2.6*21 IHS/SD/SDR HEAT106899

 .D EP^ABME5NM1("82")  ;abm*2.6*21 IHS/SD/SDR HEAT106899

 .D WR^ABMUTL8("NM1")

 .I ABMNPIU="N" D

 ..D EP^ABME5REF("EI",9999999.06,DUZ(2))

 ..D WR^ABMUTL8("REF")

 .I ABMNPIU'="N" D

 ..D EP^ABME5REF(ABMP("RTYPE"),200,ABM("PRV"))

 ..D WR^ABMUTL8("REF")

 ;

 ; Loop 2420D - Referring Physician Name

 I $P($G(ABMRV(ABMI,ABMJ,ABMK)),U,17) D

 .S ABM("PRV")=$P(ABMRV(ABMI,ABMJ,ABMK),U,17)

 .Q:ABM("PRV")=$O(ABMP("PRV","F",0))

 .D EP^ABME5NM1("DN")

 .D WR^ABMUTL8("NM1")

 .I ABMNPIU="N" D

 ..D EP^ABME5REF("EI",9999999.06,DUZ(2))

 ..D WR^ABMUTL8("REF")

 .I ABMNPIU'="N" D

 ..D EP^ABME5REF(ABMP("RTYPE"),200,ABM("PRV"))

 ..D WR^ABMUTL8("REF")

 ;

 ; Loop 2430 - Line Adjudication Information

 Q

ABME5L10  ; IHS/ASDST/DMJ - Header 

 +1       ;;2.6;IHS Third Party Billing System;**6,8,10,11,19,21,22,23**;NOV 12, 2009;Build 427

 +2       ;Header Segments

 +3       ;IHS/SD/SDR - 2.6*19 - HEAT116949 - Include LIN segment in 837I if line item has an NDC.

 +4       ;IHS/SD/SDR - 2.6*21 - HEAT106899 - Updated to print operating.  Fixed so it would print both

 +5       ;   oper. and rend. if both populated.  Also made correction to patch 19 code.  There was a QUIT that was

 +6       ;   causing none of the line item provider lines to print if there wasn't an NDC on the line.

 +7       ;IHS/SD/SDR - 2.6*21 - HEAT120880 - Made change for OK Medicaid to print date range in loop 2400.

 +8       ;IHS/SD/SDR 2.6*22 HEAT335246 check new parameter for itemized but with the flat rate on first line, zeros for the rest

 +9       ;IHS/SD/SDR 2.6*23 HEAT247169 Added checks for NDC in piece 19 of ABMRV array

 +10      ;

EP        ;START HERE

 +1        SET ABMLXCNT=0

 +2        KILL ABM

 +3        DO FRATE^ABMDF11

 +4        DO ^ABMERGRV

 +5       ;abm*2.6*22 IHS/SD/SDR HEAT335246

           SET ABMITMZ=$PIECE($GET(^ABMNINS(DUZ(2),ABMP("INS"),1,ABMP("VTYP"),0)),"^",12)

 +6       ;abm*2.6*22 IHS/SD/SDR HEAT335246

           IF +ABMITMZ&($PIECE($GET(^ABMNINS(DUZ(2),ABMP("INS"),0)),U,14)="Y")&(+$GET(ABMP("FLAT"))'=0)

               DO START^ABMERGR4

 +7        SET ABMI=""

 +8        FOR 

               SET ABMI=$ORDER(ABMRV(ABMI))

               IF ABMI=""

                   QUIT 

               Begin DoDot:1

 +9                IF ABMI=9999

                       QUIT 

 +10               SET ABMJ=-1

 +11               FOR 

                       SET ABMJ=$ORDER(ABMRV(ABMI,ABMJ))

                       IF ABMJ=""

                           QUIT 

                       Begin DoDot:2

 +12                       SET ABMK=0

 +13                       FOR 

                               SET ABMK=$ORDER(ABMRV(ABMI,ABMJ,ABMK))

                               IF ABMK=""

                                   QUIT 

                               Begin DoDot:3

 +14                               DO LOOP

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +15       KILL ABMI,ABMJ,ABMK

 +16       QUIT 

 +17      ;

LOOP      ;

 +1       ; Loop 2400 - Service Line Number

 +2        SET ABMLOOP=2400

 +3        SET ABMLXCNT=ABMLXCNT+1

 +4        DO EP^ABME5LX

 +5        DO WR^ABMUTL8("LX")

 +6        DO EP^ABME5SV2

 +7        DO WR^ABMUTL8("SV2")

 +8       ;start old abm*2.6*21 IHS/SD/SDR HEAT120880

 +9       ;I $P(ABMRV(ABMI,ABMJ,ABMK),U,10) D

 +10      ;.D EP^ABME5DTP("472","D8",$P(ABMRV(ABMI,ABMJ,ABMK),U,10))

 +11      ;I '$P(ABMRV(ABMI,ABMJ,ABMK),U,10) D

 +12      ;.D EP^ABME5DTP(472,"D8",$P(ABMB7,U))

 +13      ;end old start new abm*2.6*21 IHS/SD/SDR HEAT120880

 +14       IF $$GET1^DIQ(9999999.18,ABMP("INS"),".01","E")="OKLAHOMA MEDICAID"

               Begin DoDot:1

 +15               IF $PIECE(ABMRV(ABMI,ABMJ,ABMK),U,10)

                       Begin DoDot:2

 +16                       DO EP^ABME5DTP("472","RD8",$PIECE(ABMRV(ABMI,ABMJ,ABMK),U,10),$SELECT($PIECE(ABMRV(ABMI,ABMJ,ABMK),U,27):$PIECE(ABMRV(ABMI,ABMJ,ABMK),U,27),1:$PIECE(ABMRV(ABMI,ABMJ,ABMK),U,10)))

                       End DoDot:2

 +17               IF '$PIECE(ABMRV(ABMI,ABMJ,ABMK),U,10)

                       Begin DoDot:2

 +18                       DO EP^ABME5DTP(472,"RD8",$PIECE(ABMB7,U),$PIECE(ABMB7,U,2))

                       End DoDot:2

               End DoDot:1

 +19       IF $$GET1^DIQ(9999999.18,ABMP("INS"),".01","E")'="OKLAHOMA MEDICAID"