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
