- 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