ABME8L2 ; IHS/ASDST/DMJ - Header
;;2.6;IHS 3P BILLING SYSTEM;**3,6**;NOV 12, 2009
;Header Segments
;
; IHS/SD/SDR - v2.5 p8 - IM14124/IM15667/IM16383
; Added code to put REF segment for Medicaid and Kidscare
;
; IHS/SD/SDR - v2.5 p8 - IM14026/IM14883/IM16505
; Modified to use Location DFN instead of DUZ(2)
;
; IHS/SD/SDR - v2.5 p8 - IM13693/IM17856/IM21870
; Added code for REF segment for ID codes for 2010AA loop
;
; IHS/SD/SDR - v2.5 p10 - IM20454 - Added flag for what loop
; IHS/SD/SDR - v2.5 p11 - NPI
; IHS/SD/SDR - v2.5 p12 - IM24975 - Made changes for Value Options
; IHS/SD/SDR - abm*2.6*6 - HEAT7254 - add PRV segment to 837D claims
;
START ;START HERE
K ABMHLCNT
D EP^ABME8HL(20,1)
D WR^ABMUTL8("HL")
;I ABMP("EXP")=21!((ABMRCID="NMMAD")&(ABMP("EXP")=22))!((ABMP("EXP")=22)&(ABMP("VTYP")=831)) D ;abm*2.6*3 HEAT12845
;I ABMP("EXP")=21!((ABMRCID="NMMAD")&(ABMP("EXP")=22))!((ABMP("EXP")=22)&(ABMP("VTYP")=831))!($P($G(^AUTNINS(ABMP("INS"),0)),U)["WASHINGTON MEDICAID") D ;abm*2.6*3 HEAT12845 ;abm*2.6*6 HEAT7254
I ABMP("EXP")=21!((ABMRCID="NMMAD")&(ABMP("EXP")=22))!((ABMP("EXP")=22)&(ABMP("VTYP")=831))!($P($G(^AUTNINS(ABMP("INS"),0)),U)["WASHINGTON MEDICAID")!(ABMP("EXP")=23) D ;abm*2.6*3 HEAT12845 ;abm*2.6*6 HEAT7254
.D EP^ABME8PRV("BI",DUZ(2))
.D WR^ABMUTL8("PRV")
S ABMP("PAYDFN")=$P($G(^ABMDPARM(DUZ(2),1,2)),U,3)
D EP^ABME8NM1(85)
D WR^ABMUTL8("NM1")
D EP^ABME8N3(4,DUZ(2))
D WR^ABMUTL8("N3")
D EP^ABME8N4(4,DUZ(2))
D WR^ABMUTL8("N4")
S ABMLOOP="2010AA"
S ABMNPIU=$$NPIUSAGE^ABMUTLF(DUZ(2),ABMP("INS"))
;
I ABMNPIU=""!(ABMNPIU="L")!(ABMNPIU="B") D
.I ABMP("ITYPE")="R" D
..D EP^ABME8REF("1C",9999999.06,ABMP("LDFN"))
..D WR^ABMUTL8("REF")
.I ABMP("ITYPE")="D"!(ABMP("ITYPE")="K") D
..I ABMRCID="FHC&AFFILIATES" D
...D EP^ABME8REF("G2",9999999.06,ABMP("LDFN"))
..E D EP^ABME8REF("1D",9999999.06,ABMP("LDFN"))
..D WR^ABMUTL8("REF")
..I ABMRCID="FHC&AFFILIATES" D
...D EP^ABME8REF("LU",9999999.06,ABMP("LDFN"))
...D WR^ABMUTL8("REF")
.S ABMIDCD=""
.D PIREFID
.I ABMIDCD]"" D
..D EP^ABME8REF(ABMIDCD,9999999.06,DUZ(2))
..D WR^ABMUTL8("REF")
;
I ABMNPIU="B"!(ABMNPIU="N") D
.D EP^ABME8REF("EI",9999999.06,DUZ(2))
.D WR^ABMUTL8("REF")
K ABMIDCD
I ABMP("PAYDFN")'=DUZ(2) D
.Q:$P($G(^AUTNINS(ABMP("INS"),2)),U)="D"&($P($G(^AUTNINS(ABMP("INS"),0)),U)["OK")
.S ABMLOOP="2010AB"
.D EP^ABME8NM1(87)
.D WR^ABMUTL8("NM1")
.D EP^ABME8N3(9999999.06,ABMP("PAYDFN"))
.D WR^ABMUTL8("N3")
.D EP^ABME8N4(9999999.06,ABMP("PAYDFN"))
.D WR^ABMUTL8("N4")
.I ABMNPIU=""!(ABMNPIU="L")!(ABMNPIU="B") D
..I ABMP("ITYPE")="R" D
...D EP^ABME8REF("1C",9999999.06,ABMP("LDFN"))
...D WR^ABMUTL8("REF")
..I ABMP("ITYPE")="D"!(ABMP("ITYPE")="K") D
...I ABMRCID="FHC&AFFILIATES" D
....D EP^ABME8REF("G2",9999999.06,ABMP("LDFN"))
....D WR^ABMUTL8("REF")
...E D
....D EP^ABME8REF("1D",9999999.06,ABMP("LDFN"))
....D WR^ABMUTL8("REF")
...I ABMRCID="FHC&AFFILIATES" D
....D EP^ABME8REF("LU",9999999.06,ABMP("LDFN"))
....D WR^ABMUTL8("REF")
.I ABMNPIU'="N" D
..S ABMIDCD=""
..D PIREFID
..I ABMIDCD]"" D
...D EP^ABME8REF(ABMIDCD,9999999.06,DUZ(2))
...D WR^ABMUTL8("REF")
.I ABMNPIU="B"!(ABMNPIU="N") D
..D EP^ABME8REF("EI",9999999.06,DUZ(2))
..D WR^ABMUTL8("REF")
.K ABMIDCD
.K ABMLOOP
Q
PIREFID ;EP - Find EMC Ref ID for Private Ins.
S:ABMP("ITYPE")="H" ABMIDCD="BQ"
S:ABMP("ITYPE")="C" ABMIDCD="1H"
I "M^P^W^F"[ABMP("ITYPE") S ABMIDCD="G2"
I ABMIDCD="G2",ABMP("ITYPE")'="M" D
.I $P($G(^ABMNINS(DUZ(2),ABMP("INS"),1,ABMP("VTYP"),1)),U)]"" D
..S ABMIDCD=$P($G(^ABMNINS(DUZ(2),ABMP("INS"),1,ABMP("VTYP"),1)),U)
..S ABMIDCD=$P($G(^ABMREFID(ABMIDCD,0)),U)
..S:ABMIDCD="" ABMIDCD="G2"
Q
ABME8L2 ; IHS/ASDST/DMJ - Header
+1 ;;2.6;IHS 3P BILLING SYSTEM;**3,6**;NOV 12, 2009
+2 ;Header Segments
+3 ;
+4 ; IHS/SD/SDR - v2.5 p8 - IM14124/IM15667/IM16383
+5 ; Added code to put REF segment for Medicaid and Kidscare
+6 ;
+7 ; IHS/SD/SDR - v2.5 p8 - IM14026/IM14883/IM16505
+8 ; Modified to use Location DFN instead of DUZ(2)
+9 ;
+10 ; IHS/SD/SDR - v2.5 p8 - IM13693/IM17856/IM21870
+11 ; Added code for REF segment for ID codes for 2010AA loop
+12 ;
+13 ; IHS/SD/SDR - v2.5 p10 - IM20454 - Added flag for what loop
+14 ; IHS/SD/SDR - v2.5 p11 - NPI
+15 ; IHS/SD/SDR - v2.5 p12 - IM24975 - Made changes for Value Options
+16 ; IHS/SD/SDR - abm*2.6*6 - HEAT7254 - add PRV segment to 837D claims
+17 ;
START ;START HERE
+1 KILL ABMHLCNT
+2 DO EP^ABME8HL(20,1)
+3 DO WR^ABMUTL8("HL")
+4 ;I ABMP("EXP")=21!((ABMRCID="NMMAD")&(ABMP("EXP")=22))!((ABMP("EXP")=22)&(ABMP("VTYP")=831)) D ;abm*2.6*3 HEAT12845
+5 ;I ABMP("EXP")=21!((ABMRCID="NMMAD")&(ABMP("EXP")=22))!((ABMP("EXP")=22)&(ABMP("VTYP")=831))!($P($G(^AUTNINS(ABMP("INS"),0)),U)["WASHINGTON MEDICAID") D ;abm*2.6*3 HEAT12845 ;abm*2.6*6 HEAT7254
+6 ;abm*2.6*3 HEAT12845 ;abm*2.6*6 HEAT7254
IF ABMP("EXP")=21!((ABMRCID="NMMAD")&(ABMP("EXP")=22))!((ABMP("EXP")=22)&(ABMP("VTYP")=831))!($PIECE($GET(^AUTNINS(ABMP("INS"),0)),U)["WASHINGTON MEDICAID")!(ABMP("EXP")=23)
Begin DoDot:1
+7 DO EP^ABME8PRV("BI",DUZ(2))
+8 DO WR^ABMUTL8("PRV")
End DoDot:1
+9 SET ABMP("PAYDFN")=$PIECE($GET(^ABMDPARM(DUZ(2),1,2)),U,3)
+10 DO EP^ABME8NM1(85)
+11 DO WR^ABMUTL8("NM1")
+12 DO EP^ABME8N3(4,DUZ(2))
+13 DO WR^ABMUTL8("N3")
+14 DO EP^ABME8N4(4,DUZ(2))
+15 DO WR^ABMUTL8("N4")
+16 SET ABMLOOP="2010AA"
+17 SET ABMNPIU=$$NPIUSAGE^ABMUTLF(DUZ(2),ABMP("INS"))
+18 ;
+19 IF ABMNPIU=""!(ABMNPIU="L")!(ABMNPIU="B")
Begin DoDot:1
+20 IF ABMP("ITYPE")="R"
Begin DoDot:2
+21 DO EP^ABME8REF("1C",9999999.06,ABMP("LDFN"))
+22 DO WR^ABMUTL8("REF")
End DoDot:2
+23 IF ABMP("ITYPE")="D"!(ABMP("ITYPE")="K")
Begin DoDot:2
+24 IF ABMRCID="FHC&AFFILIATES"
Begin DoDot:3
+25 DO EP^ABME8REF("G2",9999999.06,ABMP("LDFN"))
End DoDot:3
+26 IF '$TEST
DO EP^ABME8REF("1D",9999999.06,ABMP("LDFN"))
+27 DO WR^ABMUTL8("REF")
+28 IF ABMRCID="FHC&AFFILIATES"
Begin DoDot:3
+29 DO EP^ABME8REF("LU",9999999.06,ABMP("LDFN"))
+30 DO WR^ABMUTL8("REF")
End DoDot:3
End DoDot:2
+31 SET ABMIDCD=""
+32 DO PIREFID
+33 IF ABMIDCD]""
Begin DoDot:2
+34 DO EP^ABME8REF(ABMIDCD,9999999.06,DUZ(2))
+35 DO WR^ABMUTL8("REF")
End DoDot:2
End DoDot:1
+36 ;
+37 IF ABMNPIU="B"!(ABMNPIU="N")
Begin DoDot:1
+38 DO EP^ABME8REF("EI",9999999.06,DUZ(2))
+39 DO WR^ABMUTL8("REF")
End DoDot:1
+40 KILL ABMIDCD
+41 IF ABMP("PAYDFN")'=DUZ(2)
Begin DoDot:1
+42 IF $PIECE($GET(^AUTNINS(ABMP("INS"),2)),U)="D"&($PIECE($GET(^AUTNINS(ABMP("INS"),0)),U)["OK")
QUIT
+43 SET ABMLOOP="2010AB"
+44 DO EP^ABME8NM1(87)
+45 DO WR^ABMUTL8("NM1")
+46 DO EP^ABME8N3(9999999.06,ABMP("PAYDFN"))
+47 DO WR^ABMUTL8("N3")
+48 DO EP^ABME8N4(9999999.06,ABMP("PAYDFN"))
+49 DO WR^ABMUTL8("N4")
+50 IF ABMNPIU=""!(ABMNPIU="L")!(ABMNPIU="B")
Begin DoDot:2
+51 IF ABMP("ITYPE")="R"
Begin DoDot:3
+52 DO EP^ABME8REF("1C",9999999.06,ABMP("LDFN"))
+53 DO WR^ABMUTL8("REF")
End DoDot:3
+54 IF ABMP("ITYPE")="D"!(ABMP("ITYPE")="K")
Begin DoDot:3
+55 IF ABMRCID="FHC&AFFILIATES"
Begin DoDot:4
+56 DO EP^ABME8REF("G2",9999999.06,ABMP("LDFN"))
+57 DO WR^ABMUTL8("REF")
End DoDot:4
+58 IF '$TEST
Begin DoDot:4
+59 DO EP^ABME8REF("1D",9999999.06,ABMP("LDFN"))
+60 DO WR^ABMUTL8("REF")
End DoDot:4
+61 IF ABMRCID="FHC&AFFILIATES"
Begin DoDot:4
+62 DO EP^ABME8REF("LU",9999999.06,ABMP("LDFN"))
+63 DO WR^ABMUTL8("REF")
End DoDot:4
End DoDot:3
End DoDot:2
+64 IF ABMNPIU'="N"
Begin DoDot:2
+65 SET ABMIDCD=""
+66 DO PIREFID
+67 IF ABMIDCD]""
Begin DoDot:3
+68 DO EP^ABME8REF(ABMIDCD,9999999.06,DUZ(2))
+69 DO WR^ABMUTL8("REF")
End DoDot:3
End DoDot:2
+70 IF ABMNPIU="B"!(ABMNPIU="N")
Begin DoDot:2
+71 DO EP^ABME8REF("EI",9999999.06,DUZ(2))
+72 DO WR^ABMUTL8("REF")
End DoDot:2
+73 KILL ABMIDCD
+74 KILL ABMLOOP
End DoDot:1
+75 QUIT
PIREFID ;EP - Find EMC Ref ID for Private Ins.
+1 IF ABMP("ITYPE")="H"
SET ABMIDCD="BQ"
+2 IF ABMP("ITYPE")="C"
SET ABMIDCD="1H"
+3 IF "M^P^W^F"[ABMP("ITYPE")
SET ABMIDCD="G2"
+4 IF ABMIDCD="G2"
IF ABMP("ITYPE")'="M"
Begin DoDot:1
+5 IF $PIECE($GET(^ABMNINS(DUZ(2),ABMP("INS"),1,ABMP("VTYP"),1)),U)]""
Begin DoDot:2
+6 SET ABMIDCD=$PIECE($GET(^ABMNINS(DUZ(2),ABMP("INS"),1,ABMP("VTYP"),1)),U)
+7 SET ABMIDCD=$PIECE($GET(^ABMREFID(ABMIDCD,0)),U)
+8 IF ABMIDCD=""
SET ABMIDCD="G2"
End DoDot:2
End DoDot:1
+9 QUIT
