ABMEH15 ; IHS/ASDST/DMJ - HCFA-1500 EMC RECORD BA1 (Provider) ;
;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
;
; IHS/ASDS/DMJ - 04/18/00 - V2.4 Patch 1 - NOIS HQW-0500-100040
; Modified location code to check for satellite first. If no
; satellite, use parent.
; IHS/ASDS/DMJ - 08/30/00 - V2.4 Patch 3 - NOIS HQW-0800-100133
; Modified to check provider number under DUZ(2) if missing
; ABMP("LDFN")
;
START ;START HERE
K ABMREC(15),ABMR(15)
S ABME("RTYPE")=15
D LOOP
S ABMRT(95,"RTOT")=ABMRT(95,"RTOT")+1
K ABME,ABM
Q
;
LOOP ;LOOP HERE
F I=10:10:200 D
.D @I
.I $D(^ABMEXLM("AA",+$G(ABMP("INS")),+$G(ABMP("EXP")),15,I)) D @(^(I))
.I '$G(ABMP("NOFMT")) S ABMREC(15)=$G(ABMREC(15))_ABMR(15,I)
Q
;
10 ;Record type
S ABMR(15,10)="BA1"
Q
20 ;4-18 EMC Provider ID
S ABMR(15,20)=$P($G(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),0)),"^",8)
S:ABMR(15,20)="" ABMR(15,20)=$P($G(^ABMNINS(DUZ(2),ABMP("INS"),1,ABMP("VTYP"),0)),"^",8)
S:ABMR(15,20)="" ABMR(15,20)=$P($G(^AUTNINS(ABMP("INS"),15,ABMP("LDFN"),0)),"^",2)
S:$$RCID^ABMERUTL(ABMP("INS"))=99999 ABMR(15,20)="00"_ABMR(15,20) ;TMJ changed and tested
S ABMR(15,20)=$$FMT^ABMERUTL(ABMR(15,20),15)
Q
30 ;19-21 Type of Batch
S ABMR(15,30)=100
I $$RCID^ABMERUTL(ABMP("INS"))'=99999 D
.S:ABMP("VTYP")=998 ABMR(15,30)=200
.S:ABMP("VTYP")=997 ABMR(15,30)=300
Q
;
40 ;22-25 Batch Number
S ABMR(15,40)=$G(ABMEF("BATCH#"))
S ABMR(15,40)=$$FMT^ABMERUTL(ABMR(15,40),"4NR")
Q
50 ;26-31 Batch ID
S ABMR(15,50)=$G(ABMR(1,50))
S ABMR(15,50)=$$FMT^ABMERUTL(ABMR(15,50),6)
Q
60 ;32-34 Provider Type Org
S ABMR(15,60)=""
S ABMR(15,60)=$$FMT^ABMERUTL(ABMR(15,60),3)
Q
70 ;35-64 Prov Svc Addr 1
D DIQ1
S ABMR(15,70)=$G(ABM(9999999.06,DUZ(2),.14,"E"))
S ABMR(15,70)=$$FMT^ABMERUTL(ABMR(15,70),30)
Q
80 ;65-94 Prov Svc Addr2
S ABMR(15,80)=""
S ABMR(15,80)=$$FMT^ABMERUTL(ABMR(15,80),30)
Q
90 ;95-114 Prov Svc City
S ABMR(15,90)=$G(ABM(9999999.06,DUZ(2),.15,"E"))
S ABMR(15,90)=$$FMT^ABMERUTL(ABMR(15,90),20)
Q
100 ;115-116 Prov Svc State
S ABMR(15,100)=$G(ABM(9999999.06,DUZ(2),.16,"I"))
S ABMR(15,100)=$P($G(^DIC(5,+ABMR(15,100),0)),"^",2)
S ABMR(15,100)=$$FMT^ABMERUTL(ABMR(15,100),2)
Q
110 ;117-125 Prov Svc Zip
S ABMR(15,110)=$G(ABM(9999999.06,DUZ(2),.17,"E"))
S ABMR(15,110)=$$FMT^ABMERUTL(ABMR(15,110),9)
Q
120 ;126-135 Prov Svc Phone
S ABMR(15,120)=$G(ABM(9999999.06,DUZ(2),.13,"E"))
S ABMR(15,120)=$TR(ABMR(15,120),"()- ")
S ABMR(15,120)=$$FMT^ABMERUTL(ABMR(15,120),10)
Q
130 ;136-165 Prov Pay To Addr1
D DIQ2
S ABMR(15,130)=$G(ABM(9999999.06,+ABMP("PAYDFN"),.14,"E"))
S ABMR(15,130)=$$FMT^ABMERUTL(ABMR(15,130),30)
Q
140 ;166-195 Prov Pay To Addr2
S ABMR(15,140)=""
S ABMR(15,140)=$$FMT^ABMERUTL(ABMR(15,140),30)
Q
150 ;196-215 Prov Pay To City
S ABMR(15,150)=$G(ABM(9999999.06,+ABMP("PAYDFN"),.15,"E"))
S ABMR(15,150)=$$FMT^ABMERUTL(ABMR(15,150),20)
Q
160 ;216-217 Prov Pay To State
S ABMR(15,160)=$G(ABM(9999999.06,+ABMP("PAYDFN"),.16,"I"))
S ABMR(15,160)=$P($G(^DIC(5,+ABMR(15,160),0)),"^",2)
S ABMR(15,160)=$$FMT^ABMERUTL(ABMR(15,160),2)
Q
170 ;218-226 Prov Pay To Zip
S ABMR(15,170)=$G(ABM(9999999.06,+ABMP("PAYDFN"),.17,"E"))
S ABMR(15,170)=$$FMT^ABMERUTL(ABMR(15,170),9)
Q
180 ;227-236 Prov Pay To Phone
S ABMR(15,180)=$G(ABM(9999999.06,+ABMP("PAYDFN"),.13,"E"))
S ABMR(15,180)=$TR(ABMR(15,180),"()- ")
S ABMR(15,180)=$$FMT^ABMERUTL(ABMR(15,180),10)
Q
190 ;237-278 Filler (National Use)
S ABMR(15,190)=""
S ABMR(15,190)=$$FMT^ABMERUTL(ABMR(15,190),42)
Q
200 ;279-320 Filler (Local Use)
S ABMR(15,200)=""
S ABMR(15,200)=$$FMT^ABMERUTL(ABMR(15,200),42)
Q
DIQ1 ;PULL LOCATION DATA VIA DIQ1
N I
S DIQ="ABM("
S DIQ(0)="IE"
S DIC="^AUTTLOC("
S DA=DUZ(2)
S DR=".01;.13;.14;.15;.16;.17;.21;.22"
D EN^DIQ1
Q
DIQ2 ;pay to info
N I
S ABMP("PAYDFN")=$P($G(^ABMDPARM(DUZ(2),1,2)),"^",3)
Q:ABMP("PAYDFN")=""
Q:ABMP("PAYDFN")=DUZ(2)
S DA=ABMP("PAYDFN")
S DR=".01;.13;.14;.15;.16;.17;.21"
D EN^DIQ1
K DIQ
Q
DIQ3 ;GET SITE PARAMETER INFO
N I
S DIQ="ABM("
S DIQ(0)="E"
S DIC="^ABMDPARM(DUZ(2),"
S DA=1
S DR=.26
D EN^DIQ1 K DIQ
Q
;
EX(ABMX,ABMY) ;EXTRINSIC FUNCTION HERE
;
; INPUT: ABMX = data element
; Y = bill internal entry number
;
; OUTPUT: Y = bill internal entry number
;
S ABMP("BDFN")=ABMY
D SET^ABMERUTL
I '$G(ABMP("NOFMT")) S ABMP("FMT")=0
D @ABMX
S Y=ABMR(20,ABMX)
K ABMR(20,ABMX),ABME,ABM,ABMX,ABMY
I $D(ABMP("FMT")) S ABMP("FMT")=1
Q Y
ABMEH15 ; IHS/ASDST/DMJ - HCFA-1500 EMC RECORD BA1 (Provider) ;
+1 ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
+2 ;
+3 ; IHS/ASDS/DMJ - 04/18/00 - V2.4 Patch 1 - NOIS HQW-0500-100040
+4 ; Modified location code to check for satellite first. If no
+5 ; satellite, use parent.
+6 ; IHS/ASDS/DMJ - 08/30/00 - V2.4 Patch 3 - NOIS HQW-0800-100133
+7 ; Modified to check provider number under DUZ(2) if missing
+8 ; ABMP("LDFN")
+9 ;
START ;START HERE
+1 KILL ABMREC(15),ABMR(15)
+2 SET ABME("RTYPE")=15
+3 DO LOOP
+4 SET ABMRT(95,"RTOT")=ABMRT(95,"RTOT")+1
+5 KILL ABME,ABM
+6 QUIT
+7 ;
LOOP ;LOOP HERE
+1 FOR I=10:10:200
Begin DoDot:1
+2 DO @I
+3 IF $DATA(^ABMEXLM("AA",+$GET(ABMP("INS")),+$GET(ABMP("EXP")),15,I))
DO @(^(I))
+4 IF '$GET(ABMP("NOFMT"))
SET ABMREC(15)=$GET(ABMREC(15))_ABMR(15,I)
End DoDot:1
+5 QUIT
+6 ;
10 ;Record type
+1 SET ABMR(15,10)="BA1"
+2 QUIT
20 ;4-18 EMC Provider ID
+1 SET ABMR(15,20)=$PIECE($GET(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),0)),"^",8)
+2 IF ABMR(15,20)=""
SET ABMR(15,20)=$PIECE($GET(^ABMNINS(DUZ(2),ABMP("INS"),1,ABMP("VTYP"),0)),"^",8)
+3 IF ABMR(15,20)=""
SET ABMR(15,20)=$PIECE($GET(^AUTNINS(ABMP("INS"),15,ABMP("LDFN"),0)),"^",2)
+4 ;TMJ changed and tested
IF $$RCID^ABMERUTL(ABMP("INS"))=99999
SET ABMR(15,20)="00"_ABMR(15,20)
+5 SET ABMR(15,20)=$$FMT^ABMERUTL(ABMR(15,20),15)
+6 QUIT
30 ;19-21 Type of Batch
+1 SET ABMR(15,30)=100
+2 IF $$RCID^ABMERUTL(ABMP("INS"))'=99999
Begin DoDot:1
+3 IF ABMP("VTYP")=998
SET ABMR(15,30)=200
+4 IF ABMP("VTYP")=997
SET ABMR(15,30)=300
End DoDot:1
+5 QUIT
+6 ;
40 ;22-25 Batch Number
+1 SET ABMR(15,40)=$GET(ABMEF("BATCH#"))
+2 SET ABMR(15,40)=$$FMT^ABMERUTL(ABMR(15,40),"4NR")
+3 QUIT
50 ;26-31 Batch ID
+1 SET ABMR(15,50)=$GET(ABMR(1,50))
+2 SET ABMR(15,50)=$$FMT^ABMERUTL(ABMR(15,50),6)
+3 QUIT
60 ;32-34 Provider Type Org
+1 SET ABMR(15,60)=""
+2 SET ABMR(15,60)=$$FMT^ABMERUTL(ABMR(15,60),3)
+3 QUIT
70 ;35-64 Prov Svc Addr 1
+1 DO DIQ1
+2 SET ABMR(15,70)=$GET(ABM(9999999.06,DUZ(2),.14,"E"))
+3 SET ABMR(15,70)=$$FMT^ABMERUTL(ABMR(15,70),30)
+4 QUIT
80 ;65-94 Prov Svc Addr2
+1 SET ABMR(15,80)=""
+2 SET ABMR(15,80)=$$FMT^ABMERUTL(ABMR(15,80),30)
+3 QUIT
90 ;95-114 Prov Svc City
+1 SET ABMR(15,90)=$GET(ABM(9999999.06,DUZ(2),.15,"E"))
+2 SET ABMR(15,90)=$$FMT^ABMERUTL(ABMR(15,90),20)
+3 QUIT
100 ;115-116 Prov Svc State
+1 SET ABMR(15,100)=$GET(ABM(9999999.06,DUZ(2),.16,"I"))
+2 SET ABMR(15,100)=$PIECE($GET(^DIC(5,+ABMR(15,100),0)),"^",2)
+3 SET ABMR(15,100)=$$FMT^ABMERUTL(ABMR(15,100),2)
+4 QUIT
110 ;117-125 Prov Svc Zip
+1 SET ABMR(15,110)=$GET(ABM(9999999.06,DUZ(2),.17,"E"))
+2 SET ABMR(15,110)=$$FMT^ABMERUTL(ABMR(15,110),9)
+3 QUIT
120 ;126-135 Prov Svc Phone
+1 SET ABMR(15,120)=$GET(ABM(9999999.06,DUZ(2),.13,"E"))
+2 SET ABMR(15,120)=$TRANSLATE(ABMR(15,120),"()- ")
+3 SET ABMR(15,120)=$$FMT^ABMERUTL(ABMR(15,120),10)
+4 QUIT
130 ;136-165 Prov Pay To Addr1
+1 DO DIQ2
+2 SET ABMR(15,130)=$GET(ABM(9999999.06,+ABMP("PAYDFN"),.14,"E"))
+3 SET ABMR(15,130)=$$FMT^ABMERUTL(ABMR(15,130),30)
+4 QUIT
140 ;166-195 Prov Pay To Addr2
+1 SET ABMR(15,140)=""
+2 SET ABMR(15,140)=$$FMT^ABMERUTL(ABMR(15,140),30)
+3 QUIT
150 ;196-215 Prov Pay To City
+1 SET ABMR(15,150)=$GET(ABM(9999999.06,+ABMP("PAYDFN"),.15,"E"))
+2 SET ABMR(15,150)=$$FMT^ABMERUTL(ABMR(15,150),20)
+3 QUIT
160 ;216-217 Prov Pay To State
+1 SET ABMR(15,160)=$GET(ABM(9999999.06,+ABMP("PAYDFN"),.16,"I"))
+2 SET ABMR(15,160)=$PIECE($GET(^DIC(5,+ABMR(15,160),0)),"^",2)
+3 SET ABMR(15,160)=$$FMT^ABMERUTL(ABMR(15,160),2)
+4 QUIT
170 ;218-226 Prov Pay To Zip
+1 SET ABMR(15,170)=$GET(ABM(9999999.06,+ABMP("PAYDFN"),.17,"E"))
+2 SET ABMR(15,170)=$$FMT^ABMERUTL(ABMR(15,170),9)
+3 QUIT
180 ;227-236 Prov Pay To Phone
+1 SET ABMR(15,180)=$GET(ABM(9999999.06,+ABMP("PAYDFN"),.13,"E"))
+2 SET ABMR(15,180)=$TRANSLATE(ABMR(15,180),"()- ")
+3 SET ABMR(15,180)=$$FMT^ABMERUTL(ABMR(15,180),10)
+4 QUIT
190 ;237-278 Filler (National Use)
+1 SET ABMR(15,190)=""
+2 SET ABMR(15,190)=$$FMT^ABMERUTL(ABMR(15,190),42)
+3 QUIT
200 ;279-320 Filler (Local Use)
+1 SET ABMR(15,200)=""
+2 SET ABMR(15,200)=$$FMT^ABMERUTL(ABMR(15,200),42)
+3 QUIT
DIQ1 ;PULL LOCATION DATA VIA DIQ1
+1 NEW I
+2 SET DIQ="ABM("
+3 SET DIQ(0)="IE"
+4 SET DIC="^AUTTLOC("
+5 SET DA=DUZ(2)
+6 SET DR=".01;.13;.14;.15;.16;.17;.21;.22"
+7 DO EN^DIQ1
+8 QUIT
DIQ2 ;pay to info
+1 NEW I
+2 SET ABMP("PAYDFN")=$PIECE($GET(^ABMDPARM(DUZ(2),1,2)),"^",3)
+3 IF ABMP("PAYDFN")=""
QUIT
+4 IF ABMP("PAYDFN")=DUZ(2)
QUIT
+5 SET DA=ABMP("PAYDFN")
+6 SET DR=".01;.13;.14;.15;.16;.17;.21"
+7 DO EN^DIQ1
+8 KILL DIQ
+9 QUIT
DIQ3 ;GET SITE PARAMETER INFO
+1 NEW I
+2 SET DIQ="ABM("
+3 SET DIQ(0)="E"
+4 SET DIC="^ABMDPARM(DUZ(2),"
+5 SET DA=1
+6 SET DR=.26
+7 DO EN^DIQ1
KILL DIQ
+8 QUIT
+9 ;
EX(ABMX,ABMY) ;EXTRINSIC FUNCTION HERE
+1 ;
+2 ; INPUT: ABMX = data element
+3 ; Y = bill internal entry number
+4 ;
+5 ; OUTPUT: Y = bill internal entry number
+6 ;
+7 SET ABMP("BDFN")=ABMY
+8 DO SET^ABMERUTL
+9 IF '$GET(ABMP("NOFMT"))
SET ABMP("FMT")=0
+10 DO @ABMX
+11 SET Y=ABMR(20,ABMX)
+12 KILL ABMR(20,ABMX),ABME,ABM,ABMX,ABMY
+13 IF $DATA(ABMP("FMT"))
SET ABMP("FMT")=1
+14 QUIT Y
