ABME5L14.m

ABME5L14 ; IHS/SD/SDR - Header 

 ;;2.6;IHS 3P BILLING SYSTEM;**6,8,9,14,21**;NOV 12, 2009;Build 379

 ;Header Segments

 ;IHS/SD/SDR - 2.6*14 - HEAT70826 - Modified to remove 2310B loop based on SGTM entry

 ;IHS/SD/SDR - 2.6*21 - HEAT70826 - Change made in p14 was incomplete.  P21 fixes it up.

 ;

EP ;START HERE

 N ABM

 D GETPRV^ABMEEPRV   ;Build Claim Level Provider array

 ;

 ; Loop 2310A - Referring Physician Name

 S ABMLOOP="2310A"

 I $D(ABMP("PRV","F")) D

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

 .D EP^ABME5NM1("DN")

 .D WR^ABMUTL8("NM1")

 .D EP^ABME5PRV("RF",ABM("PRV"))

 .D WR^ABMUTL8("PRV")

 .;I ABMNPIU="N" D

 .;.Q:((ABMRCID="99999")!(ABMRCID="AHCCCS866004791"))  ;AZ Medicaid

 .;.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 2310B - Rendering Physician Name

 S ABMLOOP="2310B"

 I $D(ABMP("PRV","R"))!($D(ABMP("PRV","A"))) D

 .;I $D(^ABMNINS(ABMP("LDFN"),ABMP("INS"),2.5,"ASEND",ABMP("EXP"),"2310B","N"))=1 Q  ;abm*2.6*14 HEAT70826  ;abm*2.6*21 IHS/SD/SDR HEAT70826

 .;start new abm*2.6*21 IHS/SD/SDR HEAT70826

 .S ABMOFLG=0

 .I $D(^ABMNINS(ABMP("LDFN"),ABMP("INS"),2.5,"ASEND",ABMP("EXP"),"2310B","00","0","N"))>0 D

 ..S ABMO=0

 ..F  S ABMO=$O(^ABMNINS(ABMP("LDFN"),ABMP("INS"),2.5,"ASEND",ABMP("EXP"),"2310B","00","0","N",ABMO)) Q:'ABMO  D

 ...I $P($G(^ABMNINS(ABMP("LDFN"),ABMP("INS"),2.5,ABMO,0)),U,6)=""!($P($G(^ABMNINS(ABMP("LDFN"),ABMP("INS"),2.5,ABMO,0)),U,6)=ABMP("VTYP")) S ABMOFLG=1

 .Q:ABMOFLG=1

 .;end new abm*2.6*21 IHS/SD/SDR HEAT70826

 .S ABM("PRV")=$S($D(ABMP("PRV","R")):$O(ABMP("PRV","R",0)),1:$O(ABMP("PRV","A",0)))

 .D EP^ABME5NM1("82")

 .D WR^ABMUTL8("NM1")

 .D EP^ABME5PRV("PE",ABM("PRV"))

 .D WR^ABMUTL8("PRV")

 .;I ABMNPIU="N" D

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

 .;.Q:((ABMRCID="99999")!(ABMRCID="AHCCCS866004791"))  ;AZ Medicaid

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

 .I ABMNPIU'="N" D

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

 ..D WR^ABMUTL8("REF")

 ;

 ; Loop 2310C - Service Facility Name

 S ABMLOOP="2310C"

 ;I "21^22^31^35"[$$POS^ABMERUTL() D  ;abm*2.6*8

 ;I $P($G(^DIC(4,DUZ(2),0)),U)'=($P($G(^DIC(4,ABMP("LDFN"),0)),U)) D  ;abm*2.6*8  ;abm*2.6*9 HEAT57746

 S ABMSLOC=$P($G(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),1)),U,17)  ;abm*2.6*9 HEAT57746

 I ((ABMSLOC="S")!((ABMSLOC="D")!(ABMSLOC="")&($P($G(^DIC(4,DUZ(2),0)),U)'=$P($G(^DIC(4,ABMP("LDFN"),0)),U)))) D  ;abm*2.6*8  ;abm*2.6*9 HEAT57746

 .D EP^ABME5NM1("77")

 .D WR^ABMUTL8("NM1")

 .;abm*2.6*9 NOHEAT IHS/SD/AML 1/19/2012 - Add Service Line Address

 .D EP^ABME5N3(4,ABMP("LDFN"))

 .D WR^ABMUTL8("N3")

 .D EP^ABME5N4(4,ABMP("LDFN"))

 .D WR^ABMUTL8("N4")

 .;abm*2.6*9 NOHEAT IHS/SD/AML 1/19/2012 - End Add Service Line Address

 .;I ABMNPIU'="N" D

 .;.I ABMP("ITYPE")="R" D

 .;..D EP^ABME5REF("1C",9999999.06,ABMP("LDFN"))

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

 .;.I ABMP("ITYPE")="D"!(ABMP("ITYPE")="K") D

 .;..D EP^ABME5REF("1D",9999999.06,ABMP("LDFN"))

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

 ;

 ; Loop 2310E - Supervising Physician Name

 S ABMLOOP="2310E"

 I $D(ABMP("PRV","S")) D

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

 .D EP^ABME5NM1("DQ")

 .D WR^ABMUTL8("NM1")

 Q

ABME5L14  ; IHS/SD/SDR - Header 

 +1       ;;2.6;IHS 3P BILLING SYSTEM;**6,8,9,14,21**;NOV 12, 2009;Build 379

 +2       ;Header Segments

 +3       ;IHS/SD/SDR - 2.6*14 - HEAT70826 - Modified to remove 2310B loop based on SGTM entry

 +4       ;IHS/SD/SDR - 2.6*21 - HEAT70826 - Change made in p14 was incomplete.  P21 fixes it up.

 +5       ;

EP        ;START HERE

 +1        NEW ABM

 +2       ;Build Claim Level Provider array

           DO GETPRV^ABMEEPRV

 +3       ;

 +4       ; Loop 2310A - Referring Physician Name

 +5        SET ABMLOOP="2310A"

 +6        IF $DATA(ABMP("PRV","F"))

               Begin DoDot:1

 +7                SET ABM("PRV")=$ORDER(ABMP("PRV","F",0))

 +8                DO EP^ABME5NM1("DN")

 +9                DO WR^ABMUTL8("NM1")

 +10               DO EP^ABME5PRV("RF",ABM("PRV"))

 +11               DO WR^ABMUTL8("PRV")

 +12      ;I ABMNPIU="N" D

 +13      ;.Q:((ABMRCID="99999")!(ABMRCID="AHCCCS866004791"))  ;AZ Medicaid

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

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

 +16               IF ABMNPIU'="N"

                       Begin DoDot:2

 +17                       DO EP^ABME5REF(ABMP("RTYPE"),200,ABM("PRV"))

 +18                       DO WR^ABMUTL8("REF")

                       End DoDot:2

               End DoDot:1

 +19      ;

 +20      ; Loop 2310B - Rendering Physician Name

 +21       SET ABMLOOP="2310B"

 +22       IF $DATA(ABMP("PRV","R"))!($DATA(ABMP("PRV","A")))

               Begin DoDot:1

 +23      ;I $D(^ABMNINS(ABMP("LDFN"),ABMP("INS"),2.5,"ASEND",ABMP("EXP"),"2310B","N"))=1 Q  ;abm*2.6*14 HEAT70826  ;abm*2.6*21 IHS/SD/SDR HEAT70826

 +24      ;start new abm*2.6*21 IHS/SD/SDR HEAT70826

 +25               SET ABMOFLG=0

 +26               IF $DATA(^ABMNINS(ABMP("LDFN"),ABMP("INS"),2.5,"ASEND",ABMP("EXP"),"2310B","00","0","N"))>0

                       Begin DoDot:2

 +27                       SET ABMO=0

 +28                       FOR 

                               SET ABMO=$ORDER(^ABMNINS(ABMP("LDFN"),ABMP("INS"),2.5,"ASEND",ABMP("EXP"),"2310B","00","0","N",ABMO))

                               IF 'ABMO

                                   QUIT 

                               Begin DoDot:3

 +29                               IF $PIECE($GET(^ABMNINS(ABMP("LDFN"),ABMP("INS"),2.5,ABMO,0)),U,6)=""!($PIECE($GET(^ABMNINS(ABMP("LDFN"),ABMP("INS"),2.5,ABMO,0)),U,6)=ABMP("VTYP"))

                                       SET ABMOFLG=1

                               End DoDot:3

                       End DoDot:2

 +30               IF ABMOFLG=1

                       QUIT 

 +31      ;end new abm*2.6*21 IHS/SD/SDR HEAT70826

 +32               SET ABM("PRV")=$SELECT($DATA(ABMP("PRV","R")):$ORDER(ABMP("PRV","R",0)),1:$ORDER(ABMP("PRV","A",0)))

 +33               DO EP^ABME5NM1("82")

 +34               DO WR^ABMUTL8("NM1")

 +35               DO EP^ABME5PRV("PE",ABM("PRV"))

 +36               DO WR^ABMUTL8("PRV")

 +37      ;I ABMNPIU="N" D

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

 +39      ;.Q:((ABMRCID="99999")!(ABMRCID="AHCCCS866004791"))  ;AZ Medicaid

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

 +41               IF ABMNPIU'="N"

                       Begin DoDot:2

 +42                       DO EP^ABME5REF(ABMP("RTYPE"),200,ABM("PRV"))

 +43                       DO WR^ABMUTL8("REF")

                       End DoDot:2

               End DoDot:1

 +44      ;

 +45      ; Loop 2310C - Service Facility Name

 +46       SET ABMLOOP="2310C"

 +47      ;I "21^22^31^35"[$$POS^ABMERUTL() D  ;abm*2.6*8

 +48      ;I $P($G(^DIC(4,DUZ(2),0)),U)'=($P($G(^DIC(4,ABMP("LDFN"),0)),U)) D  ;abm*2.6*8  ;abm*2.6*9 HEAT57746

 +49      ;abm*2.6*9 HEAT57746

           SET ABMSLOC=$PIECE($GET(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),1)),U,17)

 +50      ;abm*2.6*8  ;abm*2.6*9 HEAT57746

           IF ((ABMSLOC="S")!((ABMSLOC="D")!(ABMSLOC="")&($PIECE($GET(^DIC(4,DUZ(2),0)),U)'=$PIECE($GET(^DIC(4,ABMP("LDFN"),0)),U))))

               Begin DoDot:1

 +51               DO EP^ABME5NM1("77")

 +52               DO WR^ABMUTL8("NM1")

 +53      ;abm*2.6*9 NOHEAT IHS/SD/AML 1/19/2012 - Add Service Line Address

 +54               DO EP^ABME5N3(4,ABMP("LDFN"))

 +55               DO WR^ABMUTL8("N3")

 +56               DO EP^ABME5N4(4,ABMP("LDFN"))

 +57               DO WR^ABMUTL8("N4")

 +58      ;abm*2.6*9 NOHEAT IHS/SD/AML 1/19/2012 - End Add Service Line Address

 +59      ;I ABMNPIU'="N" D

 +60      ;.I ABMP("ITYPE")="R" D

 +61      ;..D EP^ABME5REF("1C",9999999.06,ABMP("LDFN"))

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

 +63      ;.I ABMP("ITYPE")="D"!(ABMP("ITYPE")="K") D

 +64      ;..D EP^ABME5REF("1D",9999999.06,ABMP("LDFN"))

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

               End DoDot:1

 +66      ;

 +67      ; Loop 2310E - Supervising Physician Name

 +68       SET ABMLOOP="2310E"

 +69       IF $DATA(ABMP("PRV","S"))

               Begin DoDot:1

 +70               SET ABM("PRV")=$ORDER(ABMP("PRV","S",0))

 +71               DO EP^ABME5NM1("DQ")

 +72               DO WR^ABMUTL8("NM1")

               End DoDot:1

 +73       QUIT