ABMDF3A ; IHS/ASDST/DMJ - Set HCFA-1500 Print Array ;
;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
;Original;TMD;03/25/96 4:36 PM
;
; IHS/ASDS/DMJ - 05/16/00 - V2.4 Patch 1 - NOIS HQW-0500-100040
; Modified location code to check for satellite first. If no
; satellite, use parent
;
; IHS/SD/SDR - v2.5 p8 - task 6
; Print origin/destination for ambulance
;
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")=$P(ABMP("B0"),"^",10) ;Clinic
S ABMP("ITYPE")=$P($G(^AUTNINS(ABMP("INS"),2)),U) ; Type of 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,3)=$P(ABMV("X1"),U,4) ; Billing City,State Zip
;
VLOC ;
S $P(ABMF(51),U)=$P(^DIC(4,ABMP("LDFN"),0),U)
I $P($G(^DIC(40.7,$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),0)),U,10),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),"^",2)=$$CSZ^ABMDUTL($P(ABMVLOC,"^",3)_"^"_$P(^DIC(4,ABMP("LDFN"),0),"^",2)_"^"_$P(ABMVLOC,"^",4))
.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,2)=$$CSZ^ABMDUTL($P(^AUTTLOC(ABMP("LDFN"),0),U,13,15))
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 $P(ABMF(54),U,3)=ABM("INUM")
I $P($G(^AUTNINS(ABMP("INS"),2)),U)="R" S $P(ABMF(54),U,3)=$P(^AUTTLOC(ABMP("LDFN"),0),U,19)
S ABM("ITYP")=$P($G(^AUTNINS(ABMP("INS"),2)),U)
S ABM("ITYP")=$S(ABM("ITYP")="R":1,ABM("ITYP")="D":2,ABM("ITYP")="C":3,1:7)
S $P(ABMF(1),U,ABM("ITYP"))="X"
;
TAX ;
S $P(ABMF(49),U,1)=$P(ABMV("X1"),U,6)
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)
;
XIT ;
K ABM,ABMX,ABMV
Q
ABMDF3A ; IHS/ASDST/DMJ - Set HCFA-1500 Print Array ;
+1 ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
+2 ;Original;TMD;03/25/96 4:36 PM
+3 ;
+4 ; IHS/ASDS/DMJ - 05/16/00 - V2.4 Patch 1 - NOIS HQW-0500-100040
+5 ; Modified location code to check for satellite first. If no
+6 ; satellite, use parent
+7 ;
+8 ; IHS/SD/SDR - v2.5 p8 - task 6
+9 ; Print origin/destination for ambulance
+10 ;
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")=$PIECE(ABMP("B0"),"^",10)
+12 ; Type of ins.
SET ABMP("ITYPE")=$PIECE($GET(^AUTNINS(ABMP("INS"),2)),U)
+13 SET (ABMV("X1"),ABMV("X2"),ABMV("X3"))=""
+14 ; returns ABMV("X2") array
DO PAT^ABMDE1X
+15 ; returns ABMV("X3") array
DO REMPL^ABMDE1X1
+16 ; returns ABMV("X1") array
DO LOC^ABMDE1X1
+17 KILL ABME
+18 ;
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 ; Billing City,State Zip
SET $PIECE(ABMF(53),U,3)=$PIECE(ABMV("X1"),U,4)
+8 ;
VLOC ;
+1 SET $PIECE(ABMF(51),U)=$PIECE(^DIC(4,ABMP("LDFN"),0),U)
+2 IF $PIECE($GET(^DIC(40.7,$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),0)),U,10),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 SET $PIECE(ABMF(53),"^",2)=$$CSZ^ABMDUTL($PIECE(ABMVLOC,"^",3)_"^"_$PIECE(^DIC(4,ABMP("LDFN"),0),"^",2)_"^"_$PIECE(ABMVLOC,"^",4))
+7 KILL ABMVLOC
End DoDot:1
+8 IF '$DATA(^DIC(4,ABMP("LDFN"),1))
Begin DoDot:1
+9 SET $PIECE(ABMF(52),U,2)=$PIECE(^AUTTLOC(ABMP("LDFN"),0),U,12)
+10 SET $PIECE(ABMF(53),U,2)=$$CSZ^ABMDUTL($PIECE(^AUTTLOC(ABMP("LDFN"),0),U,13,15))
End DoDot:1
+11 IF $PIECE($GET(^DIC(40.7,$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),0)),U,10),0)),U)["AMBULANCE"
Begin DoDot:1
+12 SET ABMDREC=$$GETDEST^ABMDE31($PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),12)),U,7))
+13 SET $PIECE(ABMF(52),U,2)="DESTINATION: "_$PIECE(ABMDREC,U)
End DoDot:1
+14 ;
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 ;
+4 ;
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 SET $PIECE(ABMF(54),U,3)=ABM("INUM")
+8 IF $PIECE($GET(^AUTNINS(ABMP("INS"),2)),U)="R"
SET $PIECE(ABMF(54),U,3)=$PIECE(^AUTTLOC(ABMP("LDFN"),0),U,19)
+9 SET ABM("ITYP")=$PIECE($GET(^AUTNINS(ABMP("INS"),2)),U)
+10 SET ABM("ITYP")=$SELECT(ABM("ITYP")="R":1,ABM("ITYP")="D":2,ABM("ITYP")="C":3,1:7)
+11 SET $PIECE(ABMF(1),U,ABM("ITYP"))="X"
+12 ;
TAX ;
+1 SET $PIECE(ABMF(49),U,1)=$PIECE(ABMV("X1"),U,6)
+2 IF $PIECE(ABMV("X1"),U,6)]""
SET $PIECE(ABMF(49),U,3)="X"
+3 SET $PIECE(ABMF(49),U,5)="X"
+4 ;
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 IF $PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),4)),U,9)'=""
SET $PIECE(ABMF(31),U,3)=$PIECE(^(4),U,9)
+6 ;
XIT ;
+1 KILL ABM,ABMX,ABMV
+2 QUIT
