- ABME5L2 ; IHS/ASDST/DMJ - Header
- ;;2.6;IHS Third Party Billing System;**6,8,9,10,21,27**;NOV 12, 2009;Build 486
- ;Header Segments
- ;IHS/SD/SDR 2.6*21 HEAT172519 - Added MEDICAID FQHC and CD MEDICAID to WASHINGTON MEDICAID check
- ;IHS/SD/SDR 2.6*21 HEAT236026 - Added Dental Medicaid FQHC to check 2000A PRV segment
- ;IHS/SD/SDR 2.6*27 CR9867 For PRV segment removed hardcoding for specific insurers and added check for new parameter instead
- ;
- START ;START HERE
- K ABMHLCNT
- S ABMLOOP="2000A"
- D EP^ABME5HL(20,1)
- D WR^ABMUTL8("HL")
- ;I ABMP("EXP")=31!((ABMRCID="NMMAD")&(ABMP("EXP")=32))!((ABMP("EXP")=32)&(ABMP("VTYP")=831)) D ;abm*2.6*8 HEAT49305
- ;I ABMP("EXP")=31!((ABMRCID="NMMAD")&(ABMP("EXP")=32))!((ABMP("EXP")=32)&(ABMP("VTYP")=831))!($P($G(^AUTNINS(ABMP("INS"),0)),U)["WASHINGTON MEDICAID")!(ABMP("EXP")=33) D ;abm*2.6*8 HEAT49305 ;abm*2.6*9 HEAT57952
- ;I ABMP("EXP")=31!((ABMRCID="NMMAD")&(ABMP("EXP")=32))!((ABMP("EXP")=32)&(ABMP("VTYP")=831))!($P($G(^AUTNINS(ABMP("INS"),0)),U)["WASHINGTON MEDICAID") D ;abm*2.6*8 HEAT49305 ;abm*2.6*9 HEAT57952 ;abm*2.6*21 IHS/SD/SDR HEAT172519
- ;I ABMP("EXP")=31!((ABMRCID="NMMAD")&(ABMP("EXP")=32))!((ABMP("EXP")=32)&(ABMP("VTYP")=831))!("^WASHINGTON MEDICAID^MEDICAID FQHC^CD MEDICAID^"[("^"_($P($G(^AUTNINS(ABMP("INS"),0)),U)_"^"))) D ;abm*2.6*9 HEAT57952 ;abm*2.6*21 IHS/SD/SDR HEAT172519 ;abm*2.6*21 IHS/SD/SDR HEAT236026
- ;start old abm*2.6*27 IHS/SD/AML CR9867
- ;;start new abm*2.6*21 IHS/SD/SDR HEAT172519, HEAT236026, HEAT206174
- ;S ABMDFLG=0
- ;I ABMP("EXP")=31!((ABMRCID="NMMAD")&(ABMP("EXP")=32))!((ABMP("EXP")=32)&(ABMP("VTYP")=831)) S ABMDFLG=1
- ;I ("^WASHINGTON MEDICAID^MEDICAID FQHC^CD MEDICAID^WISCONSIN MEDICAID^"[("^"_($P($G(^AUTNINS(ABMP("INS"),0)),U)_"^"))) S ABMDFLG=1
- ;I (ABMP("EXP")=33&($P($G(^AUTNINS(ABMP("INS"),0)),U)="WA MEDICAID DENTAL")) S ABMDFLG=1
- ;I ABMDFLG=1 D
- ;.D EP^ABME5PRV("BI",DUZ(2))
- ;.D WR^ABMUTL8("PRV")
- ;.;end new abm*2.6*21 IHS/SD/SDR HEAT172519, HEAT236026, HEAT206174
- ;end old start new abm*2.6*27 IHS/SD/AML CR9867
- D EP^ABME5PRV("BI",ABMP("LDFN"))
- I $P($G(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),1)),U,23)'="" D
- .D WR^ABMUTL8("PRV")
- ;end new abm*2.6*27 IHS/SD/AML CR9867
- S ABMP("PAYDFN")=$P($G(^ABMDPARM(DUZ(2),1,2)),U,3)
- S ABMLOOP="2010AA"
- D EP^ABME5NM1(85)
- D WR^ABMUTL8("NM1")
- D EP^ABME5N3(4,DUZ(2))
- D WR^ABMUTL8("N3")
- D EP^ABME5N4(4,DUZ(2))
- D WR^ABMUTL8("N4")
- D EP^ABME5REF("EI",9999999.06,DUZ(2))
- D WR^ABMUTL8("REF")
- S ABMNPIU=$$NPIUSAGE^ABMUTLF(DUZ(2),ABMP("INS"))
- ;start new code abm*2.6*10 HEAT46645 IHS/SD/AML 6/1/12
- I ABMNPIU=""!(ABMNPIU="L")!(ABMNPIU="B") D
- .D EP^ABME5REF("0B",9999999.06,DUZ(2))
- .D WR^ABMUTL8("REF")
- ;end new code abm*2.6*10 HEAT46645 IHS/SD/AML 6/1/12
- 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") ;abm*2.6*10 HEAT73780
- .Q:$$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,ABMP("INS"),".211","I"),1,"I")="D"&($P($G(^AUTNINS(ABMP("INS"),0)),U)["OK") ;abm*2.6*10 HEAT73780
- .S ABMLOOP="2010AB"
- .D EP^ABME5NM1(87)
- .D WR^ABMUTL8("NM1")
- .D EP^ABME5N3(9999999.06,ABMP("PAYDFN"))
- .D WR^ABMUTL8("N3")
- .D EP^ABME5N4(9999999.06,ABMP("PAYDFN"))
- .D WR^ABMUTL8("N4")
- .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
- ABME5L2 ; IHS/ASDST/DMJ - Header
- +1 ;;2.6;IHS Third Party Billing System;**6,8,9,10,21,27**;NOV 12, 2009;Build 486
- +2 ;Header Segments
- +3 ;IHS/SD/SDR 2.6*21 HEAT172519 - Added MEDICAID FQHC and CD MEDICAID to WASHINGTON MEDICAID check
- +4 ;IHS/SD/SDR 2.6*21 HEAT236026 - Added Dental Medicaid FQHC to check 2000A PRV segment
- +5 ;IHS/SD/SDR 2.6*27 CR9867 For PRV segment removed hardcoding for specific insurers and added check for new parameter instead
- +6 ;
- START ;START HERE
- +1 KILL ABMHLCNT
- +2 SET ABMLOOP="2000A"
- +3 DO EP^ABME5HL(20,1)
- +4 DO WR^ABMUTL8("HL")
- +5 ;I ABMP("EXP")=31!((ABMRCID="NMMAD")&(ABMP("EXP")=32))!((ABMP("EXP")=32)&(ABMP("VTYP")=831)) D ;abm*2.6*8 HEAT49305
- +6 ;I ABMP("EXP")=31!((ABMRCID="NMMAD")&(ABMP("EXP")=32))!((ABMP("EXP")=32)&(ABMP("VTYP")=831))!($P($G(^AUTNINS(ABMP("INS"),0)),U)["WASHINGTON MEDICAID")!(ABMP("EXP")=33) D ;abm*2.6*8 HEAT49305 ;abm*2.6*9 HEAT57952
- +7 ;I ABMP("EXP")=31!((ABMRCID="NMMAD")&(ABMP("EXP")=32))!((ABMP("EXP")=32)&(ABMP("VTYP")=831))!($P($G(^AUTNINS(ABMP("INS"),0)),U)["WASHINGTON MEDICAID") D ;abm*2.6*8 HEAT49305 ;abm*2.6*9 HEAT57952 ;abm*2.6*21 IHS/SD/SDR HEAT172519
- +8 ;I ABMP("EXP")=31!((ABMRCID="NMMAD")&(ABMP("EXP")=32))!((ABMP("EXP")=32)&(ABMP("VTYP")=831))!("^WASHINGTON MEDICAID^MEDICAID FQHC^CD MEDICAID^"[("^"_($P($G(^AUTNINS(ABMP("INS"),0)),U)_"^"))) D ;abm*2.6*9 HEAT57952 ;abm*2.6*21 IHS/SD/SDR HEAT17
- 2519 ;abm*2.6*21 IHS/SD/SDR HEAT236026
- +9 ;start old abm*2.6*27 IHS/SD/AML CR9867
- +10 ;;start new abm*2.6*21 IHS/SD/SDR HEAT172519, HEAT236026, HEAT206174
- +11 ;S ABMDFLG=0
- +12 ;I ABMP("EXP")=31!((ABMRCID="NMMAD")&(ABMP("EXP")=32))!((ABMP("EXP")=32)&(ABMP("VTYP")=831)) S ABMDFLG=1
- +13 ;I ("^WASHINGTON MEDICAID^MEDICAID FQHC^CD MEDICAID^WISCONSIN MEDICAID^"[("^"_($P($G(^AUTNINS(ABMP("INS"),0)),U)_"^"))) S ABMDFLG=1
- +14 ;I (ABMP("EXP")=33&($P($G(^AUTNINS(ABMP("INS"),0)),U)="WA MEDICAID DENTAL")) S ABMDFLG=1
- +15 ;I ABMDFLG=1 D
- +16 ;.D EP^ABME5PRV("BI",DUZ(2))
- +17 ;.D WR^ABMUTL8("PRV")
- +18 ;.;end new abm*2.6*21 IHS/SD/SDR HEAT172519, HEAT236026, HEAT206174
- +19 ;end old start new abm*2.6*27 IHS/SD/AML CR9867
- +20 DO EP^ABME5PRV("BI",ABMP("LDFN"))
- +21 IF $PIECE($GET(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),1)),U,23)'=""
- Begin DoDot:1
- +22 DO WR^ABMUTL8("PRV")
- End DoDot:1
- +23 ;end new abm*2.6*27 IHS/SD/AML CR9867
- +24 SET ABMP("PAYDFN")=$PIECE($GET(^ABMDPARM(DUZ(2),1,2)),U,3)
- +25 SET ABMLOOP="2010AA"
- +26 DO EP^ABME5NM1(85)
- +27 DO WR^ABMUTL8("NM1")
- +28 DO EP^ABME5N3(4,DUZ(2))
- +29 DO WR^ABMUTL8("N3")
- +30 DO EP^ABME5N4(4,DUZ(2))
- +31 DO WR^ABMUTL8("N4")
- +32 DO EP^ABME5REF("EI",9999999.06,DUZ(2))
- +33 DO WR^ABMUTL8("REF")
- +34 SET ABMNPIU=$$NPIUSAGE^ABMUTLF(DUZ(2),ABMP("INS"))
- +35 ;start new code abm*2.6*10 HEAT46645 IHS/SD/AML 6/1/12
- +36 IF ABMNPIU=""!(ABMNPIU="L")!(ABMNPIU="B")
- Begin DoDot:1
- +37 DO EP^ABME5REF("0B",9999999.06,DUZ(2))
- +38 DO WR^ABMUTL8("REF")
- End DoDot:1
- +39 ;end new code abm*2.6*10 HEAT46645 IHS/SD/AML 6/1/12
- +40 KILL ABMIDCD
- +41 IF ABMP("PAYDFN")'=DUZ(2)
- Begin DoDot:1
- +42 ;Q:$P($G(^AUTNINS(ABMP("INS"),2)),U)="D"&($P($G(^AUTNINS(ABMP("INS"),0)),U)["OK") ;abm*2.6*10 HEAT73780
- +43 ;abm*2.6*10 HEAT73780
- IF $$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,ABMP("INS"),".211","I"),1,"I")="D"&($PIECE($GET(^AUTNINS(ABMP("INS"),0)),U)["OK")
- QUIT
- +44 SET ABMLOOP="2010AB"
- +45 DO EP^ABME5NM1(87)
- +46 DO WR^ABMUTL8("NM1")
- +47 DO EP^ABME5N3(9999999.06,ABMP("PAYDFN"))
- +48 DO WR^ABMUTL8("N3")
- +49 DO EP^ABME5N4(9999999.06,ABMP("PAYDFN"))
- +50 DO WR^ABMUTL8("N4")
- +51 KILL ABMIDCD
- +52 KILL ABMLOOP
- End DoDot:1
- +53 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
