ABMEH32 ; IHS/ASDST/DMJ - HCFA-1500 EMC RECORD DA2 (Insurance Information) ;
;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
;
; IHS/ASDS/DMJ - 03/26/01 - V2.4 P5 - HQW-0301-100073
; Modified to put state abbrev. in DA2
;
START ;START HERE
K ABMR(32),ABMREC(32,ABME("S#"))
S ABME("RTYPE")=32 ; Record type
D SET^ABMERUTL,LOOP
D S90^ABMERUTL ; Increment record type counter
Q
;
LOOP ;LOOP HERE
F I=10:10:200 D
.D @I
.I $D(^ABMEXLM("AA",+$G(ABMP("INS")),+$G(ABMP("EXP")),32,I)) D @(^(I))
.I '$G(ABMP("NOFMT")) S ABMREC(32,ABME("S#"))=$G(ABMREC(32,ABME("S#")))_ABMR(32,I)
Q
;
10 ;1-3 Record ID
S ABMR(32,10)="DA2"
Q
;
20 ;4-5 Sequence #
S ABMR(32,20)="0"_ABME("S#")
S ABMR(32,20)=$$FMT^ABMERUTL(ABMR(32,20),2)
Q
;
30 ;6-22 Patient Control Number
S ABMR(32,30)=ABMP("PCN")
S ABMR(32,30)=$$FMT^ABMERUTL(ABMR(32,30),17)
Q
;
40 ;23-52 Insured's Address Line 1
S ABMR(32,40)=""
I $G(ABME("PPP")) D ; from patient file
.S ABME("FLD")=.111
.D DIQ4^ABMER31A
.S ABMR(32,40)=$G(ABM(2,ABME("PPP"),.111,"E"))
I ABMR(32,40)="",$G(ABME("PH")) D ; else policy holder file
.S ABME("FLD")=.09
.D DIQ1^ABMER31A
.S ABMR(32,40)=$G(ABM(9000003.1,+ABME("PH"),.09,"E"))
S ABMR(32,40)=$$FMT^ABMERUTL(ABMR(32,40),30)
Q
;
50 ;53-82 Insured's Address Line 2
S ABMR(32,50)=""
I $G(ABME("PPP")) D
.S ABME("FLD")=.112
.D DIQ4^ABMER31A
.S ABMR(32,50)=$G(ABM(2,ABME("PPP"),.112,"E"))
S ABMR(32,50)=$$FMT^ABMERUTL(ABMR(32,50),30)
Q
;
60 ;83-102 Insured's City
S ABMR(32,60)=""
I $G(ABME("PPP")) D
.S ABME("FLD")=.114
.D DIQ4^ABMER31A
.S ABMR(32,60)=$G(ABM(2,ABME("PPP"),.114,"E"))
I ABMR(32,60)="",$G(ABME("PH")) D
.S ABME("FLD")=.11
.D DIQ1^ABMER31A
.S ABMR(32,60)=$G(ABM(9000003.1,+ABME("PH"),.11,"E"))
S ABMR(32,60)=$$FMT^ABMERUTL(ABMR(32,60),20)
Q
;
70 ;103-104 Insured's State
S ABMR(32,70)=""
S ABME("ISTATE")=""
I $G(ABME("PPP")) D
.S ABME("FLD")=.115
.D DIQ4^ABMER31A
.S ABME("ISTATE")=$G(ABM(2,ABME("PPP"),.115,"I"))
I 'ABME("ISTATE"),$G(ABME("PH")) D
.S ABME("FLD")=.12
.D DIQ1^ABMER31A
.S ABME("ISTATE")=$G(ABM(9000003.1,ABME("PH"),.12,"I"))
S ABMR(32,70)=$P($G(^DIC(5,+ABME("ISTATE"),0)),"^",2)
S ABMR(32,70)=$$FMT^ABMERUTL(ABMR(32,70),2)
Q
;
80 ;103-113 Insured's Zip
S ABMR(32,80)=""
I $G(ABME("PPP")) D
.S ABME("FLD")=.116
.D DIQ4^ABMER31A
.S ABMR(32,80)=$G(ABM(2,ABME("PPP"),.116,"E"))
I ABMR(32,80)="",$G(ABME("PH")) D
.S ABME("FLD")=.13
.D DIQ1^ABMER31A
.S ABMR(32,80)=$G(ABM(9000003.1,ABME("PH"),.13,"E"))
S $E(ABMR(32,80),6,9)="0000"
S ABMR(32,80)=$$FMT^ABMERUTL(ABMR(32,80),9)
Q
90 ;114-123 Insured Phone
S ABMR(32,90)=""
S ABMR(32,90)=$$FMT^ABMERUTL(ABMR(32,90),10)
Q
100 ;124-131 Insured Retire Date
S ABMR(32,100)=""
S ABMR(32,100)=$$FMT^ABMERUTL(ABMR(32,100),8)
Q
110 ;132-139 Insured Retire Date
S ABMR(32,110)=""
S ABMR(32,110)=$$FMT^ABMERUTL(ABMR(32,110),8)
Q
120 ;140-172 Employer Name
S ABMR(32,120)=""
I $G(ABME("PPP")) D
.S ABME("FLD")=.01
.D DIQ3^ABMER31A
.S ABMR(32,120)=$G(ABM(9999999.75,+DA,.01,"E"))
I ABMR(32,120)="",$G(ABME("PH")) D
.S ABME("FLD")=.16
.D DIQ1^ABMER31A
.S ABMR(32,120)=$G(ABM(9000003.1,ABME("PH"),.16,"E"))
S ABMR(32,120)=$$FMT^ABMERUTL(ABMR(32,120),33)
Q
;
130 ;173-202 Employer Address 1
S ABMR(32,130)=""
I $G(ABME("PPP")) D
.S ABME("FLD")=.02
.D DIQ3^ABMER31A
.S ABMR(32,130)=$G(ABM(9999999.75,+DA,.02,"E"))
I ABMR(32,130)="",$G(ABME("PH")) D
.S ABME("FLD")=.02
.D DIQ2^ABMER31A
.S ABMR(32,130)=$G(ABM(9999999.75,+ABME("EMP"),.02,"E"))
S ABMR(32,130)=$$FMT^ABMERUTL(ABMR(32,130),30)
Q
140 ;203-232 Employer Address 2
S ABMR(32,140)=""
S ABMR(32,140)=$$FMT^ABMERUTL(ABMR(32,140),30)
Q
150 ;233-252 Employer City
S ABMR(32,150)=""
I $G(ABME("PPP")) D
.S ABME("FLD")=.03
.D DIQ3^ABMER31A
.S ABMR(32,150)=$G(ABM(9999999.75,+DA,.03,"E"))
I ABMR(32,150)="",$G(ABME("PH")) D
.S ABME("FLD")=.03
.D DIQ2^ABMER31A
.S ABMR(32,150)=$G(ABM(9999999.75,+ABME("EMP"),.03,"E"))
S ABMR(32,150)=$$FMT^ABMERUTL(ABMR(32,150),20)
Q
;
160 ;253-254 Employer State
I $G(ABME("PPP")) D
.S ABME("FLD")=.04
.D DIQ3^ABMER31A
.S ABME("ESTATE")=$G(ABM(9999999.75,+DA,.04,"I"))
I '$G(ABME("ESTATE")),$G(ABME("PH")) D
.S ABME("FLD")=.04
.D DIQ2^ABMER31A
.S ABME("ESTATE")=$G(ABM(9999999.75,+ABME("EMP"),.04,"I"))
S ABMR(32,160)=$S($G(ABME("ESTATE")):$P($G(^DIC(5,ABME("ESTATE"),0)),"^",2),1:"")
S ABMR(32,160)=$$FMT^ABMERUTL(ABMR(32,160),2)
Q
;
170 ;255-263 Employer Zip
S ABMR(32,170)=""
I $G(ABME("PPP")) D
.S ABME("FLD")=.05
.D DIQ3^ABMER31A
.S ABMR(32,170)=$G(ABM(9999999.75,+DA,.05,"E"))
I ABMR(32,170)="",$G(ABME("PH")) D
.S ABME("FLD")=.05
.D DIQ2^ABMER31A
.S ABMR(32,170)=$G(ABM(9999999.75,+ABME("EMP"),.05,"E"))
S ABMR(32,170)=$$FMT^ABMERUTL(ABMR(32,170),9)
Q
;
180 ;264-275 Employee ID #
S ABMR(32,180)=""
S ABMR(32,180)=$$FMT^ABMERUTL(ABMR(32,180),12)
Q
;
190 ;276-300 Filler (National)
S ABMR(32,190)=""
S ABMR(32,190)=$$FMT^ABMERUTL(ABMR(32,190),25)
Q
200 ;301-320 Filler (Local)
S ABMR(32,200)=""
S ABMR(32,200)=$$FMT^ABMERUTL(ABMR(32,200),20)
Q
;
EX(ABMX,ABMY,ABMZ) ;EXTRINSIC FUNCTION HERE
;
; INPUT: ABMX = data element
; ABMY = bill internal entry number
; ABMZ = Insurer priority (1 thru 3)
;
; OUTPUT: Y = bill internal entry number
;
S ABMP("BDFN")=ABMY
D SET^ABMERUTL
S ABME("INS")=ABMZ
I '$D(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,"B",ABME("INS"))) S Y="" Q Y
D ISET^ABMERINS
I '$G(ABMP("NOFMT")) S ABMP("FMT")=0
D @ABMX
S Y=ABMR(32,ABMX)
I $D(ABMP("FMT")) S ABMP("FMT")=1
K ABMR(32,ABMX),ABME,ABMX,ABMY,ABMZ,ABM
Q Y
ABMEH32 ; IHS/ASDST/DMJ - HCFA-1500 EMC RECORD DA2 (Insurance Information) ;
+1 ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
+2 ;
+3 ; IHS/ASDS/DMJ - 03/26/01 - V2.4 P5 - HQW-0301-100073
+4 ; Modified to put state abbrev. in DA2
+5 ;
START ;START HERE
+1 KILL ABMR(32),ABMREC(32,ABME("S#"))
+2 ; Record type
SET ABME("RTYPE")=32
+3 DO SET^ABMERUTL
DO LOOP
+4 ; Increment record type counter
DO S90^ABMERUTL
+5 QUIT
+6 ;
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")),32,I))
DO @(^(I))
+4 IF '$GET(ABMP("NOFMT"))
SET ABMREC(32,ABME("S#"))=$GET(ABMREC(32,ABME("S#")))_ABMR(32,I)
End DoDot:1
+5 QUIT
+6 ;
10 ;1-3 Record ID
+1 SET ABMR(32,10)="DA2"
+2 QUIT
+3 ;
20 ;4-5 Sequence #
+1 SET ABMR(32,20)="0"_ABME("S#")
+2 SET ABMR(32,20)=$$FMT^ABMERUTL(ABMR(32,20),2)
+3 QUIT
+4 ;
30 ;6-22 Patient Control Number
+1 SET ABMR(32,30)=ABMP("PCN")
+2 SET ABMR(32,30)=$$FMT^ABMERUTL(ABMR(32,30),17)
+3 QUIT
+4 ;
40 ;23-52 Insured's Address Line 1
+1 SET ABMR(32,40)=""
+2 ; from patient file
IF $GET(ABME("PPP"))
Begin DoDot:1
+3 SET ABME("FLD")=.111
+4 DO DIQ4^ABMER31A
+5 SET ABMR(32,40)=$GET(ABM(2,ABME("PPP"),.111,"E"))
End DoDot:1
+6 ; else policy holder file
IF ABMR(32,40)=""
IF $GET(ABME("PH"))
Begin DoDot:1
+7 SET ABME("FLD")=.09
+8 DO DIQ1^ABMER31A
+9 SET ABMR(32,40)=$GET(ABM(9000003.1,+ABME("PH"),.09,"E"))
End DoDot:1
+10 SET ABMR(32,40)=$$FMT^ABMERUTL(ABMR(32,40),30)
+11 QUIT
+12 ;
50 ;53-82 Insured's Address Line 2
+1 SET ABMR(32,50)=""
+2 IF $GET(ABME("PPP"))
Begin DoDot:1
+3 SET ABME("FLD")=.112
+4 DO DIQ4^ABMER31A
+5 SET ABMR(32,50)=$GET(ABM(2,ABME("PPP"),.112,"E"))
End DoDot:1
+6 SET ABMR(32,50)=$$FMT^ABMERUTL(ABMR(32,50),30)
+7 QUIT
+8 ;
60 ;83-102 Insured's City
+1 SET ABMR(32,60)=""
+2 IF $GET(ABME("PPP"))
Begin DoDot:1
+3 SET ABME("FLD")=.114
+4 DO DIQ4^ABMER31A
+5 SET ABMR(32,60)=$GET(ABM(2,ABME("PPP"),.114,"E"))
End DoDot:1
+6 IF ABMR(32,60)=""
IF $GET(ABME("PH"))
Begin DoDot:1
+7 SET ABME("FLD")=.11
+8 DO DIQ1^ABMER31A
+9 SET ABMR(32,60)=$GET(ABM(9000003.1,+ABME("PH"),.11,"E"))
End DoDot:1
+10 SET ABMR(32,60)=$$FMT^ABMERUTL(ABMR(32,60),20)
+11 QUIT
+12 ;
70 ;103-104 Insured's State
+1 SET ABMR(32,70)=""
+2 SET ABME("ISTATE")=""
+3 IF $GET(ABME("PPP"))
Begin DoDot:1
+4 SET ABME("FLD")=.115
+5 DO DIQ4^ABMER31A
+6 SET ABME("ISTATE")=$GET(ABM(2,ABME("PPP"),.115,"I"))
End DoDot:1
+7 IF 'ABME("ISTATE")
IF $GET(ABME("PH"))
Begin DoDot:1
+8 SET ABME("FLD")=.12
+9 DO DIQ1^ABMER31A
+10 SET ABME("ISTATE")=$GET(ABM(9000003.1,ABME("PH"),.12,"I"))
End DoDot:1
+11 SET ABMR(32,70)=$PIECE($GET(^DIC(5,+ABME("ISTATE"),0)),"^",2)
+12 SET ABMR(32,70)=$$FMT^ABMERUTL(ABMR(32,70),2)
+13 QUIT
+14 ;
80 ;103-113 Insured's Zip
+1 SET ABMR(32,80)=""
+2 IF $GET(ABME("PPP"))
Begin DoDot:1
+3 SET ABME("FLD")=.116
+4 DO DIQ4^ABMER31A
+5 SET ABMR(32,80)=$GET(ABM(2,ABME("PPP"),.116,"E"))
End DoDot:1
+6 IF ABMR(32,80)=""
IF $GET(ABME("PH"))
Begin DoDot:1
+7 SET ABME("FLD")=.13
+8 DO DIQ1^ABMER31A
+9 SET ABMR(32,80)=$GET(ABM(9000003.1,ABME("PH"),.13,"E"))
End DoDot:1
+10 SET $EXTRACT(ABMR(32,80),6,9)="0000"
+11 SET ABMR(32,80)=$$FMT^ABMERUTL(ABMR(32,80),9)
+12 QUIT
90 ;114-123 Insured Phone
+1 SET ABMR(32,90)=""
+2 SET ABMR(32,90)=$$FMT^ABMERUTL(ABMR(32,90),10)
+3 QUIT
100 ;124-131 Insured Retire Date
+1 SET ABMR(32,100)=""
+2 SET ABMR(32,100)=$$FMT^ABMERUTL(ABMR(32,100),8)
+3 QUIT
110 ;132-139 Insured Retire Date
+1 SET ABMR(32,110)=""
+2 SET ABMR(32,110)=$$FMT^ABMERUTL(ABMR(32,110),8)
+3 QUIT
120 ;140-172 Employer Name
+1 SET ABMR(32,120)=""
+2 IF $GET(ABME("PPP"))
Begin DoDot:1
+3 SET ABME("FLD")=.01
+4 DO DIQ3^ABMER31A
+5 SET ABMR(32,120)=$GET(ABM(9999999.75,+DA,.01,"E"))
End DoDot:1
+6 IF ABMR(32,120)=""
IF $GET(ABME("PH"))
Begin DoDot:1
+7 SET ABME("FLD")=.16
+8 DO DIQ1^ABMER31A
+9 SET ABMR(32,120)=$GET(ABM(9000003.1,ABME("PH"),.16,"E"))
End DoDot:1
+10 SET ABMR(32,120)=$$FMT^ABMERUTL(ABMR(32,120),33)
+11 QUIT
+12 ;
130 ;173-202 Employer Address 1
+1 SET ABMR(32,130)=""
+2 IF $GET(ABME("PPP"))
Begin DoDot:1
+3 SET ABME("FLD")=.02
+4 DO DIQ3^ABMER31A
+5 SET ABMR(32,130)=$GET(ABM(9999999.75,+DA,.02,"E"))
End DoDot:1
+6 IF ABMR(32,130)=""
IF $GET(ABME("PH"))
Begin DoDot:1
+7 SET ABME("FLD")=.02
+8 DO DIQ2^ABMER31A
+9 SET ABMR(32,130)=$GET(ABM(9999999.75,+ABME("EMP"),.02,"E"))
End DoDot:1
+10 SET ABMR(32,130)=$$FMT^ABMERUTL(ABMR(32,130),30)
+11 QUIT
140 ;203-232 Employer Address 2
+1 SET ABMR(32,140)=""
+2 SET ABMR(32,140)=$$FMT^ABMERUTL(ABMR(32,140),30)
+3 QUIT
150 ;233-252 Employer City
+1 SET ABMR(32,150)=""
+2 IF $GET(ABME("PPP"))
Begin DoDot:1
+3 SET ABME("FLD")=.03
+4 DO DIQ3^ABMER31A
+5 SET ABMR(32,150)=$GET(ABM(9999999.75,+DA,.03,"E"))
End DoDot:1
+6 IF ABMR(32,150)=""
IF $GET(ABME("PH"))
Begin DoDot:1
+7 SET ABME("FLD")=.03
+8 DO DIQ2^ABMER31A
+9 SET ABMR(32,150)=$GET(ABM(9999999.75,+ABME("EMP"),.03,"E"))
End DoDot:1
+10 SET ABMR(32,150)=$$FMT^ABMERUTL(ABMR(32,150),20)
+11 QUIT
+12 ;
160 ;253-254 Employer State
+1 IF $GET(ABME("PPP"))
Begin DoDot:1
+2 SET ABME("FLD")=.04
+3 DO DIQ3^ABMER31A
+4 SET ABME("ESTATE")=$GET(ABM(9999999.75,+DA,.04,"I"))
End DoDot:1
+5 IF '$GET(ABME("ESTATE"))
IF $GET(ABME("PH"))
Begin DoDot:1
+6 SET ABME("FLD")=.04
+7 DO DIQ2^ABMER31A
+8 SET ABME("ESTATE")=$GET(ABM(9999999.75,+ABME("EMP"),.04,"I"))
End DoDot:1
+9 SET ABMR(32,160)=$SELECT($GET(ABME("ESTATE")):$PIECE($GET(^DIC(5,ABME("ESTATE"),0)),"^",2),1:"")
+10 SET ABMR(32,160)=$$FMT^ABMERUTL(ABMR(32,160),2)
+11 QUIT
+12 ;
170 ;255-263 Employer Zip
+1 SET ABMR(32,170)=""
+2 IF $GET(ABME("PPP"))
Begin DoDot:1
+3 SET ABME("FLD")=.05
+4 DO DIQ3^ABMER31A
+5 SET ABMR(32,170)=$GET(ABM(9999999.75,+DA,.05,"E"))
End DoDot:1
+6 IF ABMR(32,170)=""
IF $GET(ABME("PH"))
Begin DoDot:1
+7 SET ABME("FLD")=.05
+8 DO DIQ2^ABMER31A
+9 SET ABMR(32,170)=$GET(ABM(9999999.75,+ABME("EMP"),.05,"E"))
End DoDot:1
+10 SET ABMR(32,170)=$$FMT^ABMERUTL(ABMR(32,170),9)
+11 QUIT
+12 ;
180 ;264-275 Employee ID #
+1 SET ABMR(32,180)=""
+2 SET ABMR(32,180)=$$FMT^ABMERUTL(ABMR(32,180),12)
+3 QUIT
+4 ;
190 ;276-300 Filler (National)
+1 SET ABMR(32,190)=""
+2 SET ABMR(32,190)=$$FMT^ABMERUTL(ABMR(32,190),25)
+3 QUIT
200 ;301-320 Filler (Local)
+1 SET ABMR(32,200)=""
+2 SET ABMR(32,200)=$$FMT^ABMERUTL(ABMR(32,200),20)
+3 QUIT
+4 ;
EX(ABMX,ABMY,ABMZ) ;EXTRINSIC FUNCTION HERE
+1 ;
+2 ; INPUT: ABMX = data element
+3 ; ABMY = bill internal entry number
+4 ; ABMZ = Insurer priority (1 thru 3)
+5 ;
+6 ; OUTPUT: Y = bill internal entry number
+7 ;
+8 SET ABMP("BDFN")=ABMY
+9 DO SET^ABMERUTL
+10 SET ABME("INS")=ABMZ
+11 IF '$DATA(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,"B",ABME("INS")))
SET Y=""
QUIT Y
+12 DO ISET^ABMERINS
+13 IF '$GET(ABMP("NOFMT"))
SET ABMP("FMT")=0
+14 DO @ABMX
+15 SET Y=ABMR(32,ABMX)
+16 IF $DATA(ABMP("FMT"))
SET ABMP("FMT")=1
+17 KILL ABMR(32,ABMX),ABME,ABMX,ABMY,ABMZ,ABM
+18 QUIT Y
