ABME3DA1.m

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