ABMDF27A ; IHS/SD/SDR - Set HCFA-1500 (08/05) Print Array ;
;;2.6;IHS Third Party Billing;**1,4,10,11**;NOV 12, 2009;Build 133
;
; IHS/SD/SDR - v2.5 p12 - IM25331
; Put taxonomy code if NPI ONLY
; IHS/SD/SDR - abm*2.6*1 - HEAT4158 - mammography cert#
; IHS/SD/SDR - abm*2.6*4 - HEAT12115 - Moved box 22 right by 2 for "extra" DX codes
;
ENT ;
K ABMF,ABM,ABMU,ABMR,ABMS
S ABMP("B0")=^ABMDBILL(DUZ(2),ABMP("BDFN"),0) ;0 node bill file
S ABMP("INS")=$P(ABMP("B0"),U,8) ;Active insurer IEN
Q:'ABMP("INS") ;q:no active ins
S ABMP("PDFN")=$P(ABMP("B0"),U,5) ;Patient IEN
S ABMP("LDFN")=$P(ABMP("B0"),U,3) ;Visit Location IEN
Q:'ABMP("PDFN")!('+ABMP("LDFN")) ;q:no pat or loc
S ABMP("VDT")=$P(^ABMDBILL(DUZ(2),ABMP("BDFN"),7),U) ;Srv date from
S ABMP("BTYP")=$P(ABMP("B0"),"^",2) ;Bill type
S ABMP("VTYP")=$P(ABMP("B0"),"^",7) ;Visit Type IEN
S (ABMP("CLN"),ABMP("CLIN"))=$P(ABMP("B0"),"^",10) ;clinic
;S ABMP("ITYPE")=$P($G(^AUTNINS(ABMP("INS"),2)),U) ; Type of ins. ;abm*2.6*10 HEAT73780
S ABMP("ITYPE")=$$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,ABMP("INS"),".211","I"),1,"I") ; Type of ins. ;abm*2.6*10 HEAT73780
S ABMP("NPIS")=$$NPIUSAGE^ABMUTLF(ABMP("LDFN"),ABMP("INS"))
S (ABMV("X1"),ABMV("X2"),ABMV("X3"))=""
D PAT^ABMDE1X ; returns ABMV("X2") array
D REMPL^ABMDE1X1 ; returns ABMV("X3") array
D LOC^ABMDE1X1 ; returns ABMV("X1") array
K ABME
;
BLOC ;
S ABMF(50)=$P($G(^AUTTLOC(ABMP("LDFN"),0)),U,11) ; Facility phone
; Billing Name
S $P(ABMF(51),"^",2)=$P($G(^ABMDPARM(ABMP("LDFN"),1,2)),"^",6)
I $P(ABMF(51),"^",2)="" D
.S $P(ABMF(51),U,2)=$S($P($G(^ABMDPARM(DUZ(2),1,2)),U,6)]"":$P(^(2),U,6),$P($P(ABMV("X1"),U,2),"C/O ",2)]"":$P($P(ABMV("X1"),U,2),"C/O ",2),1:$P($P(ABMV("X1"),U),";",2))
S $P(ABMF(52),U,3)=$P(ABMV("X1"),U,3) ; Billing Address
;S $P(ABMF(53),U,2)=$TR($P(ABMV("X1"),U,4),",") ; Billing City,State Zip ;abm*2.6*10 HEAT64983
S $P(ABMF(53),U,3)=$TR($P(ABMV("X1"),U,4),",") ; Billing City,State Zip ;abm*2.6*10 HEAT64983
S ABMLNPI=$S($P($G(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),1)),U,8)'="":$P(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),1),U,8),$P($G(^ABMDPARM(ABMP("LDFN"),1,2)),U,12)'="":$P(^ABMDPARM(ABMP("LDFN"),1,2),U,12),1:ABMP("LDFN"))
S $P(ABMF(54),U,2)=$P($$NPI^XUSNPI("Organization_ID",ABMLNPI),U)
I ($P($G(^DIC(40.7,ABMP("CLIN"),0)),U,2)=72)&($P($G(^ABMDPARM(ABMP("LDFN"),1,5)),U,4)'="") S $P(ABMF(54),U,2)=$P($G(^ABMDPARM(ABMP("LDFN"),1,5)),U,4) ;abm*2.6*1 HEAT4158
I ABMP("ITYPE")="R"&(ABMP("NPIS")'="")&(ABMP("NPIS")'="N") S $P(ABMF(54),U,3)=$S($$MCR^ABMUTLF(ABMP("LDFN"))'="":"1C"_$$MCR^ABMUTLF(ABMP("LDFN")),1:"")
I (ABMP("ITYPE")="D"!(ABMP("ITYPE")="K"))&(ABMP("NPIS")'="")&(ABMP("NPIS")'="N") S $P(ABMF(54),U,3)=$S($$MCD^ABMUTLF(ABMP("LDFN"))'="":"1D"_$$MCD^ABMUTLF(ABMP("LDFN")),1:"")
I (ABMP("ITYPE")'="R"&(ABMP("ITYPE")'="D")&(ABMP("ITYPE")'="K"))&(ABMP("NPIS")'="N") D
.S ABMIDCD=""
.D PIREFID^ABME8L2
.S $P(ABMF(54),U,3)=$S($$PI^ABMUTLF(ABMP("LDFN"))'="":ABMIDCD_$$PI^ABMUTLF(ABMP("LDFN")),1:"")
I $G(ABMP("NPIS"))="N"&(($P($G(^AUTNINS(ABMP("INS"),0)),U)="NEW MEXICO MEDICAID")!($P($G(^AUTNINS(ABMP("INS"),0)),U)="MEDICAID EXEMPT")) D
.S $P(ABMF(54),U,3)=""
E I (ABMP("NPIS")'="")&(ABMP("NPIS")'="N") S $P(ABMF(54),U,3)="ZZ"_$$PTAX^ABMUTLF(ABMP("LDFN"))
;
VLOC ;
S $P(ABMF(51),U)=$P(^DIC(4,ABMP("LDFN"),0),U)
I $G(ABMP("CLIN"))'="",($P($G(^DIC(40.7,ABMP("CLIN"),0)),U)["AMBULANCE") S $P(ABMF(51),U)="ORIGIN: "_$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),12)),U,2)
I $D(^DIC(4,ABMP("LDFN"),1)) D
.S ABMVLOC=^DIC(4,ABMP("LDFN"),1)
.S $P(ABMF(52),"^",2)=$P(ABMVLOC,U)
.;S $P(ABMF(53),U)=$TR($$CSZ^ABMDUTL($P(ABMVLOC,"^",3)_"^"_$P(^DIC(4,ABMP("LDFN"),0),"^",2)_"^"_$P(ABMVLOC,"^",4)),",") ;abm*2.6*10 HEAT64983
.S $P(ABMF(53),U,2)=$TR($$CSZ^ABMDUTL($P(ABMVLOC,"^",3)_"^"_$P(^DIC(4,ABMP("LDFN"),0),"^",2)_"^"_$P(ABMVLOC,"^",4)),",") ;abm*2.6*10 HEAT64983
.K ABMVLOC
I '$D(^DIC(4,ABMP("LDFN"),1)) D
.S $P(ABMF(52),U,2)=$P(^AUTTLOC(ABMP("LDFN"),0),U,12)
.;S $P(ABMF(53),U)=$TR($$CSZ^ABMDUTL($P(^AUTTLOC(ABMP("LDFN"),0),U,13,15)),",") ;abm*2.6*10 HEAT64983
.S $P(ABMF(53),U,2)=$TR($$CSZ^ABMDUTL($P(^AUTTLOC(ABMP("LDFN"),0),U,13,15)),",") ;abm*2.6*10 HEAT64983
I $P($G(^DIC(40.7,$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),0)),U,10),0)),U)["AMBULANCE" D
.S ABMDREC=$$GETDEST^ABMDE31($P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),12)),U,7))
.S $P(ABMF(52),U,2)="DESTINATION: "_$P(ABMDREC,U)
;
BNUM ;
S $P(ABMF(49),U,4)=$P(ABMP("B0"),U)_$S($P($G(^ABMDPARM(ABMP("LDFN"),1,2)),U,4)]"":"-"_$P(^ABMDPARM(ABMP("LDFN"),1,2),U,4),1:"")
I $P($G(^ABMDPARM(ABMP("LDFN"),1,3)),U,3),($P($G(^AUPNPAT(ABMP("PDFN"),41,ABMP("LDFN"),0)),U,2)) S $P(ABMF(49),U,4)=$P(ABMF(49),U,4)_"-"_$P(^AUPNPAT(ABMP("PDFN"),41,ABMP("LDFN"),0),U,2)
;
INSNUM ;
;GET PROVIDER NUMBER
S ABM("INUM")=$P($G(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),0)),"^",8)
I ABM("INUM")="" D
.S ABM("I")=$P($G(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,$P(ABMP("B0"),U,7),0)),U,6)
.S ABM("INUM")=$P($G(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,$S(ABM("I")="Y":999,1:$P(ABMP("B0"),U,7)),0)),U,8)
S:ABM("INUM")="" ABM("INUM")=$P($G(^AUTNINS(ABMP("INS"),15,ABMP("LDFN"),0)),U,2)
S:(ABMP("NPIS")'="N") $P(ABMF(54),U,5)=ABM("INUM")
;I $P($G(^AUTNINS(ABMP("INS"),2)),U)="R"&(ABMP("NPIS")'="N") S $P(ABMF(54),U,5)=$P(^AUTTLOC(ABMP("LDFN"),0),U,19) ;abm*2.6*10 HEAT73780
;S ABM("ITYP")=$P($G(^AUTNINS(ABMP("INS"),2)),U) ;abm*2.6*10 HEAT73780
S ABM("ITYP")=$$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,ABMP("INS"),".211","I"),1,"I") ;abm*2.6*10 HEAT73780
I ABM("ITYP")="R"&(ABMP("NPIS")'="N") S $P(ABMF(54),U,5)=$P(^AUTTLOC(ABMP("LDFN"),0),U,19) ;abm*2.6*10 HEAT73780
S ABM("ITYP")=$S(ABM("ITYP")="R":1,ABM("ITYP")="D":2,ABM("ITYP")="C":3,1:7)
I $P($G(^AUTNINS(ABMP("INS"),0)),U)="PHC MEDICAID" S ABM("ITYP")=5 ;abm*2.6*11 IHS/SD/AML 3/31/2011 HEAT30524 - PARTNERSHIP MEDICAID EDITS
S $P(ABMF(1),U,ABM("ITYP"))="X"
;
TAX ;
S $P(ABMF(49),U,1)=$P(ABMV("X1"),U,6)
;abm*2.6*11 IHS/SD/AML 7/1/13 - BEGIN NEW CODE - Uses new Tax ID for VA Billing only
I $P($G(^AUTNINS(ABMP("INS"),0)),U)["VMBP" D
.I DUZ(2)=2248 S $P(ABMF(49),U,1)="364587378" ;Crow Hospital
.I DUZ(2)=2299 S $P(ABMF(49),U,1)="371522894" ;Fort Belknap
.I DUZ(2)=2311 S $P(ABMF(49),U,1)="364587381" ;Fort Peck
.I DUZ(2)=2348 S $P(ABMF(49),U,1)="364587379" ;Lame Deer
.I DUZ(2)=2336 S $P(ABMF(49),U,1)="364587384" ;Fort Washakie
;abm*2.6*11 IHS/SD/AML 7/1/13 - END NEW CODE - Uses new Tax ID for VA Billing only
S:$P(ABMV("X1"),U,6)]"" $P(ABMF(49),U,3)="X"
S $P(ABMF(49),U,5)="X"
;
PNODES ;
;PATIENT INFO
D ISET^ABMERUTL ; Needed to get medicaid name from ABMER20A
D PNM^ABMER20A
S ABM("P0")=ABME("PNM")
S $P(ABM("P0"),"^",3)=ABME("DOB")
;
NAME ;
S ABMF(3)=$P(ABM("P0"),U)
;
ADDRESS ;
S $P(ABMF(5),U)=$P(ABMV("X2"),U,3)
S $P(ABMF(7),U)=$P($P(ABMV("X2"),U,4),", ")
S $P(ABMF(7),U,2)=$P($P($P(ABMV("X2"),U,4),", ",2)," ")
S $P(ABMF(9),U)=$P($P($P(ABMV("X2"),U,4),", ",2)," ",2)
S $P(ABMF(9),U,2)=$S($E($P(ABMV("X2"),U,5))="(":"",1:" ")_$P(ABMV("X2"),U,5)
;
DOB ;
S $P(ABMF(3),U,2)=$P(ABM("P0"),U,3)
;
SEX ;
I $P(ABMV("X2"),U,2)="M" S $P(ABMF(3),U,3)="X"
E S $P(ABMF(3),U,4)="X"
K ABM("P0")
I $P(^AUPNPAT(ABMP("PDFN"),0),U,21),"1246"[$P(^(0),U,21) S $P(ABMF(9),U,3)="X"
;I $P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),4)),U,9)'="" S $P(ABMF(31),U,3)=$P(^(4),U,9) ;abm*2.6*4 HEAT12115
I $P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),4)),U,9)'="" S $P(ABMF(31),U,5)=$P(^(4),U,9) ;abm*2.6*4 HEAT12115
;
XIT ;
K ABM,ABMX,ABMV
Q
ABMDF27A ; IHS/SD/SDR - Set HCFA-1500 (08/05) Print Array ;
+1 ;;2.6;IHS Third Party Billing;**1,4,10,11**;NOV 12, 2009;Build 133
+2 ;
+3 ; IHS/SD/SDR - v2.5 p12 - IM25331
+4 ; Put taxonomy code if NPI ONLY
+5 ; IHS/SD/SDR - abm*2.6*1 - HEAT4158 - mammography cert#
+6 ; IHS/SD/SDR - abm*2.6*4 - HEAT12115 - Moved box 22 right by 2 for "extra" DX codes
+7 ;
ENT ;
+1 KILL ABMF,ABM,ABMU,ABMR,ABMS
+2 ;0 node bill file
SET ABMP("B0")=^ABMDBILL(DUZ(2),ABMP("BDFN"),0)
+3 ;Active insurer IEN
SET ABMP("INS")=$PIECE(ABMP("B0"),U,8)
+4 ;q:no active ins
IF 'ABMP("INS")
QUIT
+5 ;Patient IEN
SET ABMP("PDFN")=$PIECE(ABMP("B0"),U,5)
+6 ;Visit Location IEN
SET ABMP("LDFN")=$PIECE(ABMP("B0"),U,3)
+7 ;q:no pat or loc
IF 'ABMP("PDFN")!('+ABMP("LDFN"))
QUIT
+8 ;Srv date from
SET ABMP("VDT")=$PIECE(^ABMDBILL(DUZ(2),ABMP("BDFN"),7),U)
+9 ;Bill type
SET ABMP("BTYP")=$PIECE(ABMP("B0"),"^",2)
+10 ;Visit Type IEN
SET ABMP("VTYP")=$PIECE(ABMP("B0"),"^",7)
+11 ;clinic
SET (ABMP("CLN"),ABMP("CLIN"))=$PIECE(ABMP("B0"),"^",10)
+12 ;S ABMP("ITYPE")=$P($G(^AUTNINS(ABMP("INS"),2)),U) ; Type of ins. ;abm*2.6*10 HEAT73780
+13 ; Type of ins. ;abm*2.6*10 HEAT73780
SET ABMP("ITYPE")=$$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,ABMP("INS"),".211","I"),1,"I")
+14 SET ABMP("NPIS")=$$NPIUSAGE^ABMUTLF(ABMP("LDFN"),ABMP("INS"))
+15 SET (ABMV("X1"),ABMV("X2"),ABMV("X3"))=""
+16 ; returns ABMV("X2") array
DO PAT^ABMDE1X
+17 ; returns ABMV("X3") array
DO REMPL^ABMDE1X1
+18 ; returns ABMV("X1") array
DO LOC^ABMDE1X1
+19 KILL ABME
+20 ;
BLOC ;
+1 ; Facility phone
SET ABMF(50)=$PIECE($GET(^AUTTLOC(ABMP("LDFN"),0)),U,11)
+2 ; Billing Name
+3 SET $PIECE(ABMF(51),"^",2)=$PIECE($GET(^ABMDPARM(ABMP("LDFN"),1,2)),"^",6)
+4 IF $PIECE(ABMF(51),"^",2)=""
Begin DoDot:1
+5 SET $PIECE(ABMF(51),U,2)=$SELECT($PIECE($GET(^ABMDPARM(DUZ(2),1,2)),U,6)]"":$PIECE(^(2),U,6),$PIECE($PIECE(ABMV("X1"),U,2),"C/O ",2)]"":$PIECE($PIECE(ABMV("X1"),U,2),"C/O ",2),1:$PIECE($PIECE(ABMV("X1"),U),";",2))
End DoDot:1
+6 ; Billing Address
SET $PIECE(ABMF(52),U,3)=$PIECE(ABMV("X1"),U,3)
+7 ;S $P(ABMF(53),U,2)=$TR($P(ABMV("X1"),U,4),",") ; Billing City,State Zip ;abm*2.6*10 HEAT64983
+8 ; Billing City,State Zip ;abm*2.6*10 HEAT64983
SET $PIECE(ABMF(53),U,3)=$TRANSLATE($PIECE(ABMV("X1"),U,4),",")
+9 SET ABMLNPI=$SELECT($PIECE($GET(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),1)),U,8)'="":...
... $PIECE(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),1),U,8),$PIECE($GET(^ABMDPARM(ABMP("LDFN"),1,2)),U,12)'="":$PIECE(^ABMDPARM(ABMP("LDFN"),1,2),U,12),1:ABMP("LDFN"))
+10 SET $PIECE(ABMF(54),U,2)=$PIECE($$NPI^XUSNPI("Organization_ID",ABMLNPI),U)
+11 ;abm*2.6*1 HEAT4158
IF ($PIECE($GET(^DIC(40.7,ABMP("CLIN"),0)),U,2)=72)&($PIECE($GET(^ABMDPARM(ABMP("LDFN"),1,5)),U,4)'="")
SET $PIECE(ABMF(54),U,2)=$PIECE($GET(^ABMDPARM(ABMP("LDFN"),1,5)),U,4)
+12 IF ABMP("ITYPE")="R"&(ABMP("NPIS")'="")&(ABMP("NPIS")'="N")
SET $PIECE(ABMF(54),U,3)=$SELECT($$MCR^ABMUTLF(ABMP("LDFN"))'="":"1C"_$$MCR^ABMUTLF(ABMP("LDFN")),1:"")
+13 IF (ABMP("ITYPE")="D"!(ABMP("ITYPE")="K"))&(ABMP("NPIS")'="")&(ABMP("NPIS")'="N")
SET $PIECE(ABMF(54),U,3)=$SELECT($$MCD^ABMUTLF(ABMP("LDFN"))'="":"1D"_$$MCD^ABMUTLF(ABMP("LDFN")),1:"")
+14 IF (ABMP("ITYPE")'="R"&(ABMP("ITYPE")'="D")&(ABMP("ITYPE")'="K"))&(ABMP("NPIS")'="N")
Begin DoDot:1
+15 SET ABMIDCD=""
+16 DO PIREFID^ABME8L2
+17 SET $PIECE(ABMF(54),U,3)=$SELECT($$PI^ABMUTLF(ABMP("LDFN"))'="":ABMIDCD_$$PI^ABMUTLF(ABMP("LDFN")),1:"")
End DoDot:1
+18 IF $GET(ABMP("NPIS"))="N"&(($PIECE($GET(^AUTNINS(ABMP("INS"),0)),U)="NEW MEXICO MEDICAID")!($PIECE($GET(^AUTNINS(ABMP("INS"),0)),U)="MEDICAID EXEMPT"))
Begin DoDot:1
+19 SET $PIECE(ABMF(54),U,3)=""
End DoDot:1
+20 IF '$TEST
IF (ABMP("NPIS")'="")&(ABMP("NPIS")'="N")
SET $PIECE(ABMF(54),U,3)="ZZ"_$$PTAX^ABMUTLF(ABMP("LDFN"))
+21 ;
VLOC ;
+1 SET $PIECE(ABMF(51),U)=$PIECE(^DIC(4,ABMP("LDFN"),0),U)
+2 IF $GET(ABMP("CLIN"))'=""
IF ($PIECE($GET(^DIC(40.7,ABMP("CLIN"),0)),U)["AMBULANCE")
SET $PIECE(ABMF(51),U)="ORIGIN: "_$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),12)),U,2)
+3 IF $DATA(^DIC(4,ABMP("LDFN"),1))
Begin DoDot:1
+4 SET ABMVLOC=^DIC(4,ABMP("LDFN"),1)
+5 SET $PIECE(ABMF(52),"^",2)=$PIECE(ABMVLOC,U)
+6 ;S $P(ABMF(53),U)=$TR($$CSZ^ABMDUTL($P(ABMVLOC,"^",3)_"^"_$P(^DIC(4,ABMP("LDFN"),0),"^",2)_"^"_$P(ABMVLOC,"^",4)),",") ;abm*2.6*10 HEAT64983
+7 ;abm*2.6*10 HEAT64983
SET $PIECE(ABMF(53),U,2)=$TRANSLATE($$CSZ^ABMDUTL($PIECE(ABMVLOC,"^",3)_"^"_$PIECE(^DIC(4,ABMP("LDFN"),0),"^",2)_"^"_$PIECE(ABMVLOC,"^",4)),",")
+8 KILL ABMVLOC
End DoDot:1
+9 IF '$DATA(^DIC(4,ABMP("LDFN"),1))
Begin DoDot:1
+10 SET $PIECE(ABMF(52),U,2)=$PIECE(^AUTTLOC(ABMP("LDFN"),0),U,12)
+11 ;S $P(ABMF(53),U)=$TR($$CSZ^ABMDUTL($P(^AUTTLOC(ABMP("LDFN"),0),U,13,15)),",") ;abm*2.6*10 HEAT64983
+12 ;abm*2.6*10 HEAT64983
SET $PIECE(ABMF(53),U,2)=$TRANSLATE($$CSZ^ABMDUTL($PIECE(^AUTTLOC(ABMP("LDFN"),0),U,13,15)),",")
End DoDot:1
+13 IF $PIECE($GET(^DIC(40.7,$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),0)),U,10),0)),U)["AMBULANCE"
Begin DoDot:1
+14 SET ABMDREC=$$GETDEST^ABMDE31($PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),12)),U,7))
+15 SET $PIECE(ABMF(52),U,2)="DESTINATION: "_$PIECE(ABMDREC,U)
End DoDot:1
+16 ;
BNUM ;
+1 SET $PIECE(ABMF(49),U,4)=$PIECE(ABMP("B0"),U)_$SELECT($PIECE($GET(^ABMDPARM(ABMP("LDFN"),1,2)),U,4)]"":"-"_$PIECE(^ABMDPARM(ABMP("LDFN"),1,2),U,4),1:"")
+2 IF $PIECE($GET(^ABMDPARM(ABMP("LDFN"),1,3)),U,3)
IF ($PIECE($GET(^AUPNPAT(ABMP("PDFN"),41,ABMP("LDFN"),0)),U,2))
SET $PIECE(ABMF(49),U,4)=$PIECE(ABMF(49),U,4)_"-"_$PIECE(^AUPNPAT(ABMP("PDFN"),41,ABMP("LDFN"),0),U,2)
+3 ;
INSNUM ;
+1 ;GET PROVIDER NUMBER
+2 SET ABM("INUM")=$PIECE($GET(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),0)),"^",8)
+3 IF ABM("INUM")=""
Begin DoDot:1
+4 SET ABM("I")=$PIECE($GET(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,$PIECE(ABMP("B0"),U,7),0)),U,6)
+5 SET ABM("INUM")=$PIECE($GET(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,$SELECT(ABM("I")="Y":999,1:$PIECE(ABMP("B0"),U,7)),0)),U,8)
End DoDot:1
+6 IF ABM("INUM")=""
SET ABM("INUM")=$PIECE($GET(^AUTNINS(ABMP("INS"),15,ABMP("LDFN"),0)),U,2)
+7 IF (ABMP("NPIS")'="N")
SET $PIECE(ABMF(54),U,5)=ABM("INUM")
+8 ;I $P($G(^AUTNINS(ABMP("INS"),2)),U)="R"&(ABMP("NPIS")'="N") S $P(ABMF(54),U,5)=$P(^AUTTLOC(ABMP("LDFN"),0),U,19) ;abm*2.6*10 HEAT73780
+9 ;S ABM("ITYP")=$P($G(^AUTNINS(ABMP("INS"),2)),U) ;abm*2.6*10 HEAT73780
+10 ;abm*2.6*10 HEAT73780
SET ABM("ITYP")=$$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,ABMP("INS"),".211","I"),1,"I")
+11 ;abm*2.6*10 HEAT73780
IF ABM("ITYP")="R"&(ABMP("NPIS")'="N")
SET $PIECE(ABMF(54),U,5)=$PIECE(^AUTTLOC(ABMP("LDFN"),0),U,19)
+12 SET ABM("ITYP")=$SELECT(ABM("ITYP")="R":1,ABM("ITYP")="D":2,ABM("ITYP")="C":3,1:7)
+13 ;abm*2.6*11 IHS/SD/AML 3/31/2011 HEAT30524 - PARTNERSHIP MEDICAID EDITS
IF $PIECE($GET(^AUTNINS(ABMP("INS"),0)),U)="PHC MEDICAID"
SET ABM("ITYP")=5
+14 SET $PIECE(ABMF(1),U,ABM("ITYP"))="X"
+15 ;
TAX ;
+1 SET $PIECE(ABMF(49),U,1)=$PIECE(ABMV("X1"),U,6)
+2 ;abm*2.6*11 IHS/SD/AML 7/1/13 - BEGIN NEW CODE - Uses new Tax ID for VA Billing only
+3 IF $PIECE($GET(^AUTNINS(ABMP("INS"),0)),U)["VMBP"
Begin DoDot:1
+4 ;Crow Hospital
IF DUZ(2)=2248
SET $PIECE(ABMF(49),U,1)="364587378"
+5 ;Fort Belknap
IF DUZ(2)=2299
SET $PIECE(ABMF(49),U,1)="371522894"
+6 ;Fort Peck
IF DUZ(2)=2311
SET $PIECE(ABMF(49),U,1)="364587381"
+7 ;Lame Deer
IF DUZ(2)=2348
SET $PIECE(ABMF(49),U,1)="364587379"
+8 ;Fort Washakie
IF DUZ(2)=2336
SET $PIECE(ABMF(49),U,1)="364587384"
End DoDot:1
+9 ;abm*2.6*11 IHS/SD/AML 7/1/13 - END NEW CODE - Uses new Tax ID for VA Billing only
+10 IF $PIECE(ABMV("X1"),U,6)]""
SET $PIECE(ABMF(49),U,3)="X"
+11 SET $PIECE(ABMF(49),U,5)="X"
+12 ;
PNODES ;
+1 ;PATIENT INFO
+2 ; Needed to get medicaid name from ABMER20A
DO ISET^ABMERUTL
+3 DO PNM^ABMER20A
+4 SET ABM("P0")=ABME("PNM")
+5 SET $PIECE(ABM("P0"),"^",3)=ABME("DOB")
+6 ;
NAME ;
+1 SET ABMF(3)=$PIECE(ABM("P0"),U)
+2 ;
ADDRESS ;
+1 SET $PIECE(ABMF(5),U)=$PIECE(ABMV("X2"),U,3)
+2 SET $PIECE(ABMF(7),U)=$PIECE($PIECE(ABMV("X2"),U,4),", ")
+3 SET $PIECE(ABMF(7),U,2)=$PIECE($PIECE($PIECE(ABMV("X2"),U,4),", ",2)," ")
+4 SET $PIECE(ABMF(9),U)=$PIECE($PIECE($PIECE(ABMV("X2"),U,4),", ",2)," ",2)
+5 SET $PIECE(ABMF(9),U,2)=$SELECT($EXTRACT($PIECE(ABMV("X2"),U,5))="(":"",1:" ")_$PIECE(ABMV("X2"),U,5)
+6 ;
DOB ;
+1 SET $PIECE(ABMF(3),U,2)=$PIECE(ABM("P0"),U,3)
+2 ;
SEX ;
+1 IF $PIECE(ABMV("X2"),U,2)="M"
SET $PIECE(ABMF(3),U,3)="X"
+2 IF '$TEST
SET $PIECE(ABMF(3),U,4)="X"
+3 KILL ABM("P0")
+4 IF $PIECE(^AUPNPAT(ABMP("PDFN"),0),U,21)
IF "1246"[$PIECE(^(0),U,21)
SET $PIECE(ABMF(9),U,3)="X"
+5 ;I $P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),4)),U,9)'="" S $P(ABMF(31),U,3)=$P(^(4),U,9) ;abm*2.6*4 HEAT12115
+6 ;abm*2.6*4 HEAT12115
IF $PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),4)),U,9)'=""
SET $PIECE(ABMF(31),U,5)=$PIECE(^(4),U,9)
+7 ;
XIT ;
+1 KILL ABM,ABMX,ABMV
+2 QUIT
