ABME3DA1 ; IHS/ASDST/DMJ - HCFA-1500 NSF 3.01 EMC RECORD DA1 (Insurance Information) ;
;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
;
; IHS/ASDS/DMJ - V2.4 P7 - 9/6/01 NOIS HQW-0701-100066
; This is a new routine related to Medicare Part B.
;
START ;START HERE
K ABMR(31),ABMREC(31,ABME("S#"))
S ABME("RTYPE")=31 ; Record type
D SET^ABMERUTL
D PAYED^ABMERUTL
D ADDR
D LOOP
D S90^ABMERUTL ; Increment record type counter
K ABMADR,ABMP("PAYED")
Q
;
LOOP ;LOOP HERE
F I=10:10:390 D
.D @I
.I $D(^ABMEXLM("AA",+$G(ABMP("INS")),+$G(ABMP("EXP")),31,I)) D @(^(I))
.I '$G(ABMP("NOFMT")) S ABMREC(31,ABME("S#"))=$G(ABMREC(31,ABME("S#")))_ABMR(31,I)
Q
;
10 ;1-3 Record ID
S ABMR(31,10)="DA1"
Q
;
20 ;4-5 Sequence #
S ABMR(31,20)="0"_ABME("S#")
S ABMR(31,20)=$$FMT^ABMERUTL(ABMR(31,20),2)
Q
;
30 ;6-22 Patient Control Number
S ABMR(31,30)=ABMP("PCN")
S ABMR(31,30)=$$FMT^ABMERUTL(ABMR(31,30),17)
Q
;
40 ;23-52 Payor Address Line 1
S ABMR(31,40)=ABMADR(2)
S ABMR(31,40)=$$FMT^ABMERUTL(ABMR(31,40),30)
Q
;
50 ;53-82 Payor Address Line 2
S ABMR(31,50)=""
S ABMR(31,50)=$$FMT^ABMERUTL(ABMR(31,50),30)
Q
;
60 ;83-102 Payor City
S ABMR(31,60)=ABMADR(3)
S ABMR(31,60)=$$FMT^ABMERUTL(ABMR(31,60),20)
Q
;
70 ;103-104 Payor State
S ABMR(31,70)=ABMADR(4)
S ABMR(31,70)=$$FMT^ABMERUTL(ABMR(31,70),2)
Q
;
80 ;105-113 Payor Zip
S ABMR(31,80)=ABMADR(5)
S ABMR(31,80)=$$FMT^ABMERUTL(ABMR(31,80),"9S")
Q
90 ;114-120 Dissallowed Cost Cont
S ABMR(31,90)=""
S ABMR(31,90)=$$FMT^ABMERUTL(ABMR(31,90),7)
Q
100 ;121-127 Disallowed Other
S ABMR(31,100)=""
S ABMR(31,100)=$$FMT^ABMERUTL(ABMR(31,100),7)
Q
110 ;128-134 Allowed Amount
S ABMR(31,110)=""
S ABMR(31,110)=$$FMT^ABMERUTL(ABMR(31,110),7)
Q
120 ;135-141 Deductible Amount
S ABMR(31,120)=""
S ABMR(31,120)=$$FMT^ABMERUTL(ABMR(31,120),7)
Q
130 ;142-148 Coinsurance Amount
S ABMR(31,130)=""
S ABMR(31,130)=$$FMT^ABMERUTL(ABMR(31,130),7)
Q
140 ;149-155 Payor Amount Payed
S ABMR(31,140)=$G(ABMP("PAYED",+ABME("INS")))
S ABMR(31,140)=$$FMT^ABMERUTL(ABMR(31,140),"7NRJ2")
Q
150 ;156-156 Zero Pay Indicator
S ABMR(31,150)=""
S ABMR(31,150)=$$FMT^ABMERUTL(ABMR(31,150),1)
Q
160 ;157-158 Adjucation Ind 1
S ABMR(31,160)=""
S ABMR(31,160)=$$FMT^ABMERUTL(ABMR(31,160),2)
Q
170 ;159-160 Adjudication Ind 2
S ABMR(31,170)=""
S ABMR(31,170)=$$FMT^ABMERUTL(ABMR(31,170),2)
Q
180 ;161-162 Adjudication Ind 3
S ABMR(31,180)=""
S ABMR(31,180)=$$FMT^ABMERUTL(ABMR(31,180),2)
Q
190 ;163-163 Champus Spnsr Branch
S ABMR(31,190)=""
S ABMR(31,190)=$$FMT^ABMERUTL(ABMR(31,190),1)
Q
200 ;164-165 Champus Spnsr Grade
S ABMR(31,200)=""
S ABMR(31,200)=$$FMT^ABMERUTL(ABMR(31,200),2)
Q
210 ;166-166 Champus Spnsr Status
S ABMR(31,210)=""
S ABMR(31,210)=$$FMT^ABMERUTL(ABMR(31,210),1)
Q
220 ;167-174 Ins Card Effect Date
S ABMR(31,220)=""
S ABMR(31,220)=$$FMT^ABMERUTL(ABMR(31,220),8)
Q
230 ;175-182 Ins Card Term Date
S ABMR(31,230)=""
S ABMR(31,230)=$$FMT^ABMERUTL(ABMR(31,230),8)
Q
240 ;183-189 Balance Due
S ABMR(31,240)=""
S ABMR(31,240)=$$FMT^ABMERUTL(ABMR(31,240),"7NRJ2")
Q
250 ;190-197 Eomb Date 1
S ABMR(31,250)=""
S ABMR(31,250)=$$FMT^ABMERUTL(ABMR(31,250),8)
Q
260 ;198-205 Eomb Date 2
S ABMR(31,260)=""
S ABMR(31,260)=$$FMT^ABMERUTL(ABMR(31,260),8)
Q
270 ;206-213 Eomb Date 3
S ABMR(31,270)=""
S ABMR(31,270)=$$FMT^ABMERUTL(ABMR(31,270),8)
Q
280 ;214-221 Eomb Date 4
S ABMR(31,280)=""
S ABMR(31,280)=$$FMT^ABMERUTL(ABMR(31,280),8)
Q
290 ;222-229 Claim Receipt Date
S ABMR(31,290)=""
S ABMR(31,290)=$$FMT^ABMERUTL(ABMR(31,290),8)
Q
300 ;230-238 Amt Paid to Bene
S ABMR(31,300)=""
S ABMR(31,300)=$$FMT^ABMERUTL(ABMR(31,300),"9NRJ2")
Q
310 ;239-253 Bene Check\EFT Trace No
S ABMR(31,310)=""
S ABMR(31,310)=$$FMT^ABMERUTL(ABMR(31,310),15)
Q
320 ;254-261 Bene Check Date
S ABMR(31,320)=""
S ABMR(31,320)=$$FMT^ABMERUTL(ABMR(31,320),8)
Q
330 ;262-270 Amt Paid to Prov
S ABMR(31,330)=""
S ABMR(31,330)=$$FMT^ABMERUTL(ABMR(31,330),"9NRJ2")
Q
340 ;271-285 Prov Check\EFT Trace No
S ABMR(31,340)=""
S ABMR(31,340)=$$FMT^ABMERUTL(ABMR(31,340),15)
Q
350 ;286-293 Prov Check Date
S ABMR(31,350)=""
S ABMR(31,350)=$$FMT^ABMERUTL(ABMR(31,350),8)
Q
360 ;294-302 Interest Paid
S ABMR(31,360)=""
S ABMR(31,360)=$$FMT^ABMERUTL(ABMR(31,360),"9NRJ2")
Q
370 ;303-311 Approved Amt
S ABMR(31,370)=""
S ABMR(31,370)=$$FMT^ABMERUTL(ABMR(31,370),"9NRJ2")
Q
380 ;312-312 Contract Agreement Indicator
S ABMR(31,380)=""
S ABMR(31,380)=$$FMT^ABMERUTL(ABMR(31,380),1)
Q
390 ;313-320 Filler National
S ABMR(31,390)=""
S ABMR(31,390)=$$FMT^ABMERUTL(ABMR(31,390),8)
Q
ADDR ;Payor Address Info
K ABMADR
N I F I=1:1:5 S ABMADR(I)=$P(^AUTNINS(ABME("INS"),0),"^",I)
S ABMADR(4)=$P($G(^DIC(5,+ABMADR(4),0)),"^",2)
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(31,ABMX)
I $D(ABMP("FMT")) S ABMP("FMT")=1
K ABMR(31,ABMX),ABME,ABMX,ABMY,ABMZ,ABM
Q Y
ABME3DA1 ; IHS/ASDST/DMJ - HCFA-1500 NSF 3.01 EMC RECORD DA1 (Insurance Information) ;
+1 ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
+2 ;
+3 ; IHS/ASDS/DMJ - V2.4 P7 - 9/6/01 NOIS HQW-0701-100066
+4 ; This is a new routine related to Medicare Part B.
+5 ;
START ;START HERE
+1 KILL ABMR(31),ABMREC(31,ABME("S#"))
+2 ; Record type
SET ABME("RTYPE")=31
+3 DO SET^ABMERUTL
+4 DO PAYED^ABMERUTL
+5 DO ADDR
+6 DO LOOP
+7 ; Increment record type counter
DO S90^ABMERUTL
+8 KILL ABMADR,ABMP("PAYED")
+9 QUIT
+10 ;
LOOP ;LOOP HERE
+1 FOR I=10:10:390
Begin DoDot:1
+2 DO @I
+3 IF $DATA(^ABMEXLM("AA",+$GET(ABMP("INS")),+$GET(ABMP("EXP")),31,I))
DO @(^(I))
+4 IF '$GET(ABMP("NOFMT"))
SET ABMREC(31,ABME("S#"))=$GET(ABMREC(31,ABME("S#")))_ABMR(31,I)
End DoDot:1
+5 QUIT
+6 ;
10 ;1-3 Record ID
+1 SET ABMR(31,10)="DA1"
+2 QUIT
+3 ;
20 ;4-5 Sequence #
+1 SET ABMR(31,20)="0"_ABME("S#")
+2 SET ABMR(31,20)=$$FMT^ABMERUTL(ABMR(31,20),2)
+3 QUIT
+4 ;
30 ;6-22 Patient Control Number
+1 SET ABMR(31,30)=ABMP("PCN")
+2 SET ABMR(31,30)=$$FMT^ABMERUTL(ABMR(31,30),17)
+3 QUIT
+4 ;
40 ;23-52 Payor Address Line 1
+1 SET ABMR(31,40)=ABMADR(2)
+2 SET ABMR(31,40)=$$FMT^ABMERUTL(ABMR(31,40),30)
+3 QUIT
+4 ;
50 ;53-82 Payor Address Line 2
+1 SET ABMR(31,50)=""
+2 SET ABMR(31,50)=$$FMT^ABMERUTL(ABMR(31,50),30)
+3 QUIT
+4 ;
60 ;83-102 Payor City
+1 SET ABMR(31,60)=ABMADR(3)
+2 SET ABMR(31,60)=$$FMT^ABMERUTL(ABMR(31,60),20)
+3 QUIT
+4 ;
70 ;103-104 Payor State
+1 SET ABMR(31,70)=ABMADR(4)
+2 SET ABMR(31,70)=$$FMT^ABMERUTL(ABMR(31,70),2)
+3 QUIT
+4 ;
80 ;105-113 Payor Zip
+1 SET ABMR(31,80)=ABMADR(5)
+2 SET ABMR(31,80)=$$FMT^ABMERUTL(ABMR(31,80),"9S")
+3 QUIT
90 ;114-120 Dissallowed Cost Cont
+1 SET ABMR(31,90)=""
+2 SET ABMR(31,90)=$$FMT^ABMERUTL(ABMR(31,90),7)
+3 QUIT
100 ;121-127 Disallowed Other
+1 SET ABMR(31,100)=""
+2 SET ABMR(31,100)=$$FMT^ABMERUTL(ABMR(31,100),7)
+3 QUIT
110 ;128-134 Allowed Amount
+1 SET ABMR(31,110)=""
+2 SET ABMR(31,110)=$$FMT^ABMERUTL(ABMR(31,110),7)
+3 QUIT
120 ;135-141 Deductible Amount
+1 SET ABMR(31,120)=""
+2 SET ABMR(31,120)=$$FMT^ABMERUTL(ABMR(31,120),7)
+3 QUIT
130 ;142-148 Coinsurance Amount
+1 SET ABMR(31,130)=""
+2 SET ABMR(31,130)=$$FMT^ABMERUTL(ABMR(31,130),7)
+3 QUIT
140 ;149-155 Payor Amount Payed
+1 SET ABMR(31,140)=$GET(ABMP("PAYED",+ABME("INS")))
+2 SET ABMR(31,140)=$$FMT^ABMERUTL(ABMR(31,140),"7NRJ2")
+3 QUIT
150 ;156-156 Zero Pay Indicator
+1 SET ABMR(31,150)=""
+2 SET ABMR(31,150)=$$FMT^ABMERUTL(ABMR(31,150),1)
+3 QUIT
160 ;157-158 Adjucation Ind 1
+1 SET ABMR(31,160)=""
+2 SET ABMR(31,160)=$$FMT^ABMERUTL(ABMR(31,160),2)
+3 QUIT
170 ;159-160 Adjudication Ind 2
+1 SET ABMR(31,170)=""
+2 SET ABMR(31,170)=$$FMT^ABMERUTL(ABMR(31,170),2)
+3 QUIT
180 ;161-162 Adjudication Ind 3
+1 SET ABMR(31,180)=""
+2 SET ABMR(31,180)=$$FMT^ABMERUTL(ABMR(31,180),2)
+3 QUIT
190 ;163-163 Champus Spnsr Branch
+1 SET ABMR(31,190)=""
+2 SET ABMR(31,190)=$$FMT^ABMERUTL(ABMR(31,190),1)
+3 QUIT
200 ;164-165 Champus Spnsr Grade
+1 SET ABMR(31,200)=""
+2 SET ABMR(31,200)=$$FMT^ABMERUTL(ABMR(31,200),2)
+3 QUIT
210 ;166-166 Champus Spnsr Status
+1 SET ABMR(31,210)=""
+2 SET ABMR(31,210)=$$FMT^ABMERUTL(ABMR(31,210),1)
+3 QUIT
220 ;167-174 Ins Card Effect Date
+1 SET ABMR(31,220)=""
+2 SET ABMR(31,220)=$$FMT^ABMERUTL(ABMR(31,220),8)
+3 QUIT
230 ;175-182 Ins Card Term Date
+1 SET ABMR(31,230)=""
+2 SET ABMR(31,230)=$$FMT^ABMERUTL(ABMR(31,230),8)
+3 QUIT
240 ;183-189 Balance Due
+1 SET ABMR(31,240)=""
+2 SET ABMR(31,240)=$$FMT^ABMERUTL(ABMR(31,240),"7NRJ2")
+3 QUIT
250 ;190-197 Eomb Date 1
+1 SET ABMR(31,250)=""
+2 SET ABMR(31,250)=$$FMT^ABMERUTL(ABMR(31,250),8)
+3 QUIT
260 ;198-205 Eomb Date 2
+1 SET ABMR(31,260)=""
+2 SET ABMR(31,260)=$$FMT^ABMERUTL(ABMR(31,260),8)
+3 QUIT
270 ;206-213 Eomb Date 3
+1 SET ABMR(31,270)=""
+2 SET ABMR(31,270)=$$FMT^ABMERUTL(ABMR(31,270),8)
+3 QUIT
280 ;214-221 Eomb Date 4
+1 SET ABMR(31,280)=""
+2 SET ABMR(31,280)=$$FMT^ABMERUTL(ABMR(31,280),8)
+3 QUIT
290 ;222-229 Claim Receipt Date
+1 SET ABMR(31,290)=""
+2 SET ABMR(31,290)=$$FMT^ABMERUTL(ABMR(31,290),8)
+3 QUIT
300 ;230-238 Amt Paid to Bene
+1 SET ABMR(31,300)=""
+2 SET ABMR(31,300)=$$FMT^ABMERUTL(ABMR(31,300),"9NRJ2")
+3 QUIT
310 ;239-253 Bene Check\EFT Trace No
+1 SET ABMR(31,310)=""
+2 SET ABMR(31,310)=$$FMT^ABMERUTL(ABMR(31,310),15)
+3 QUIT
320 ;254-261 Bene Check Date
+1 SET ABMR(31,320)=""
+2 SET ABMR(31,320)=$$FMT^ABMERUTL(ABMR(31,320),8)
+3 QUIT
330 ;262-270 Amt Paid to Prov
+1 SET ABMR(31,330)=""
+2 SET ABMR(31,330)=$$FMT^ABMERUTL(ABMR(31,330),"9NRJ2")
+3 QUIT
340 ;271-285 Prov Check\EFT Trace No
+1 SET ABMR(31,340)=""
+2 SET ABMR(31,340)=$$FMT^ABMERUTL(ABMR(31,340),15)
+3 QUIT
350 ;286-293 Prov Check Date
+1 SET ABMR(31,350)=""
+2 SET ABMR(31,350)=$$FMT^ABMERUTL(ABMR(31,350),8)
+3 QUIT
360 ;294-302 Interest Paid
+1 SET ABMR(31,360)=""
+2 SET ABMR(31,360)=$$FMT^ABMERUTL(ABMR(31,360),"9NRJ2")
+3 QUIT
370 ;303-311 Approved Amt
+1 SET ABMR(31,370)=""
+2 SET ABMR(31,370)=$$FMT^ABMERUTL(ABMR(31,370),"9NRJ2")
+3 QUIT
380 ;312-312 Contract Agreement Indicator
+1 SET ABMR(31,380)=""
+2 SET ABMR(31,380)=$$FMT^ABMERUTL(ABMR(31,380),1)
+3 QUIT
390 ;313-320 Filler National
+1 SET ABMR(31,390)=""
+2 SET ABMR(31,390)=$$FMT^ABMERUTL(ABMR(31,390),8)
+3 QUIT
ADDR ;Payor Address Info
+1 KILL ABMADR
+2 NEW I
FOR I=1:1:5
SET ABMADR(I)=$PIECE(^AUTNINS(ABME("INS"),0),"^",I)
+3 SET ABMADR(4)=$PIECE($GET(^DIC(5,+ABMADR(4),0)),"^",2)
+4 QUIT
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(31,ABMX)
+16 IF $DATA(ABMP("FMT"))
SET ABMP("FMT")=1
+17 KILL ABMR(31,ABMX),ABME,ABMX,ABMY,ABMZ,ABM
+18 QUIT Y
