ABMEH31 ; IHS/ASDST/DMJ - HCFA-1500 EMC RECORD DA1 (Insurance Information) ;
;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
;
; IHS/ASDS/LSL - 04/05/01 - V2.4 Patch 9 - NOIS NHA-0600-180066
; Need to 0 fill numeric fields in the DA1 record. The fields
; are Disallowed other (121-127), Allowed amount (128-134),
; Deductible amount (135-141), and Coinsurance amount (142-148).
;
; *********************************************************************
;
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:260 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 ;103-113 Payor Zip
S ABMR(31,80)=ABMADR(5)
S ABMR(31,80)=$$FMT^ABMERUTL(ABMR(31,80),"9")
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),"7NRJ2")
Q
110 ;128-134 Allowed Amount
S ABMR(31,110)=""
S ABMR(31,110)=$$FMT^ABMERUTL(ABMR(31,110),"7NRJ2")
Q
120 ;135-141 Deductible Amount
S ABMR(31,120)=""
S ABMR(31,120)=$$FMT^ABMERUTL(ABMR(31,120),"7NRJ2")
Q
130 ;142-148 Coinsurance Amount
S ABMR(31,130)=""
S ABMR(31,130)=$$FMT^ABMERUTL(ABMR(31,130),"7NRJ2")
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),7)
Q
250 ;190-252 Filler (National)
S ABMR(31,250)=""
S ABMR(31,250)=$$FMT^ABMERUTL(ABMR(31,250),63)
Q
260 ;301-320 Filler (Local)
S ABMR(31,260)=""
S ABMR(31,260)=$$FMT^ABMERUTL(ABMR(31,260),68)
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
ABMEH31 ; IHS/ASDST/DMJ - HCFA-1500 EMC RECORD DA1 (Insurance Information) ;
+1 ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
+2 ;
+3 ; IHS/ASDS/LSL - 04/05/01 - V2.4 Patch 9 - NOIS NHA-0600-180066
+4 ; Need to 0 fill numeric fields in the DA1 record. The fields
+5 ; are Disallowed other (121-127), Allowed amount (128-134),
+6 ; Deductible amount (135-141), and Coinsurance amount (142-148).
+7 ;
+8 ; *********************************************************************
+9 ;
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:260
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 ;103-113 Payor Zip
+1 SET ABMR(31,80)=ABMADR(5)
+2 SET ABMR(31,80)=$$FMT^ABMERUTL(ABMR(31,80),"9")
+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),"7NRJ2")
+3 QUIT
110 ;128-134 Allowed Amount
+1 SET ABMR(31,110)=""
+2 SET ABMR(31,110)=$$FMT^ABMERUTL(ABMR(31,110),"7NRJ2")
+3 QUIT
120 ;135-141 Deductible Amount
+1 SET ABMR(31,120)=""
+2 SET ABMR(31,120)=$$FMT^ABMERUTL(ABMR(31,120),"7NRJ2")
+3 QUIT
130 ;142-148 Coinsurance Amount
+1 SET ABMR(31,130)=""
+2 SET ABMR(31,130)=$$FMT^ABMERUTL(ABMR(31,130),"7NRJ2")
+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),7)
+3 QUIT
250 ;190-252 Filler (National)
+1 SET ABMR(31,250)=""
+2 SET ABMR(31,250)=$$FMT^ABMERUTL(ABMR(31,250),63)
+3 QUIT
260 ;301-320 Filler (Local)
+1 SET ABMR(31,260)=""
+2 SET ABMR(31,260)=$$FMT^ABMERUTL(ABMR(31,260),68)
+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
