ABME630 ; IHS/ASDST/DMJ - UB92 EMC RECORD 30 (Third Party Payor) ;
;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
;Original;DMJ;01/22/96 10:43 AM
;
; IHS/ASDS/DMJ - 01/23/01 - V2.4 Patch 3 - NOIS HQW-0101-100032
; Created routine to correct rejections for Medicare
;
START ;START HERE
K ABMREC(30),ABMREC(31),ABME,ABM,ABMP("PAYED")
K ABMP("SET")
D SET^ABMERUTL,LOOP ; get insurer data
K ABME,ABM
Q
;
LOOP ;FIRST LOOP
; Loop thru INS priorities
S ABME("S#")=0
F S ABME("S#")=$O(ABMP("INS",ABME("S#"))) Q:'ABME("S#") D
.S ABME("INS")=+ABMP("INS",ABME("S#")) ; Insurer IEN
.S ABME("INSIEN")=$P(ABMP("INS",ABME("S#")),"^",3) ; IEN to insurer multiple
.S ABME("RTYPE")=30 ; record type
.K ABMR(30),ABMR(31)
.D ISET^ABMERINS ; set INS priority
.D LOOP2 ; Get data
.D S90^ABMERUTL ; Add 1 to record type counts (electronic)
.D ^ABMER31 ; Get insured's data
Q
;
LOOP2 ;LOOP HERE
D ^ABME630A ; Get insurance data
F I=160:10:260 D
.D @I
.I $D(^ABMEXLM("AA",+$G(ABMP("INS")),+$G(ABMP("EXP")),30,I)) D @(^(I))
.I '$G(ABMP("NOFMT")) S ABMREC(30,ABME("S#"))=$G(ABMREC(30,ABME("S#")))_ABMR(30,I)
Q
;
160 ;EP - Release Code (SOURCE: FILE=9002274.4 FIELD=.74)
; form locator #52
S ABME("FLD")=.74
D DIQ1
S ABMR(30,160)=ABM(9002274.4,ABMP("BDFN"),.74,"I")
S ABMR(30,160)=$$FMT^ABMERUTL(ABMR(30,160),1)
Q
;
170 ;EP - Benefits Assigned Indicator (SOURCE: FILE=9002274.4, FIELD=.75)
; form locator #53
S ABME("FLD")=.75
D DIQ1
S ABMR(30,170)=ABM(9002274.4,ABMP("BDFN"),.75,"I")
S ABMR(30,170)=$$FMT^ABMERUTL(ABMR(30,170),1)
Q
;
180 ;EP - Patient's Relationship to Insured (SOURCE: FILE=, FIELD=)
; form locator #59
I '$G(ABME("PH")) S ABMR(30,180)="01"
I $G(ABME("PH")) S ABMR(30,180)=ABME("REL")
S ABMR(30,180)=$$FMT^ABMERUTL(ABMR(30,180),"2NR")
Q
;
190 ;EP - Employment Status Code (SOURCE: FILE=9000003.1, FIELD=.15)
S ABMR(30,190)=""
I $G(ABME("PPP")) D ; of patient
.S ABME("FLD")=.21
.D DIQ3
.S ABMR(30,190)=$G(ABM(9000001,ABME("PPP"),.21,"I"))
.Q
I ABMR(30,190)="",$G(ABME("PH")) D ; of policy holder
.S ABME("FLD")=.15
.D DIQ2
.S ABMR(30,190)=$G(ABM(9000003.1,+ABME("PH"),.15,"I"))
.Q
S ABMR(30,190)=$$FMT^ABMERUTL(ABMR(30,190),1)
Q
;
200 ;EP - Covered Days (SOURCE: FILE=9002274.4, FIELD=.73)
; form locator #7
S ABME("FLD")=.73
D DIQ1
S ABMR(30,200)=ABM(9002274.4,ABMP("BDFN"),.73,"I")
S ABMR(30,200)=$$FMT^ABMERUTL(ABMR(30,200),"3NR")
Q
;
210 ;EP - Non-Covered Days (SOURCE: FILE=9002274.4 FIELD=.66)
; form locator #8
S ABME("FLD")=.66
D DIQ1
S ABMR(30,210)=ABM(9002274.4,ABMP("BDFN"),.66,"I")
S ABMR(30,210)=$$FMT^ABMERUTL(ABMR(30,210),"4NR")
Q
;
220 ;EP - Coinsurance Days (SOURCE: FILE=9002274.4, FIELD=.67)
; form locator #9
S ABME("FLD")=.67
D DIQ1
S ABMR(30,220)=ABM(9002274.4,ABMP("BDFN"),.67,"I")
S ABMR(30,220)=$$FMT^ABMERUTL(ABMR(30,220),"3NR")
Q
;
230 ;EP - Lifetime Reserve Days (SOURCE: FILE=9002274.4, FIELD=.68)
; form locator #10
S ABME("FLD")=.68
D DIQ1
S ABMR(30,230)=ABM(9002274.4,ABMP("BDFN"),.68,"I")
S ABMR(30,230)=$$FMT^ABMERUTL(ABMR(30,230),"3NR")
Q
;
240 ;EP - Provider I.D. Number
; form locator #51
S ABMR(30,240)=$P($G(^ABMNINS(ABMP("LDFN"),ABME("INS"),1,ABMP("VTYP"),0)),"^",8)
S:ABMR(30,240)="" ABMR(30,240)=$P($G(^ABMNINS(DUZ(2),ABME("INS"),1,ABMP("VTYP"),0)),"^",8)
S:ABMR(30,240)="" ABMR(30,240)=$P($G(^AUTNINS(ABME("INS"),39,ABMP("VTYP"),0)),"^",8)
S:ABMR(30,240)="" ABMR(30,240)=$P($G(^AUTNINS(ABME("INS"),15,ABMP("LDFN"),0)),"^",2)
I ABME("ITYPE")="R" D
.S:ABMR(30,240)="" ABMR(30,240)=$P($G(^AUTTLOC(+ABMP("LDFN"),0)),"^",19)
.S ABMR(30,240)=$TR(ABMR(30,240),"-")
S ABMR(30,240)=$$FMT^ABMERUTL(ABMR(30,240),13)
Q
;
250 ;EP - Third Party Payments Received (SOURCE: FILE= FIELD=)
; form locator #54
I '$D(ABMP("PAYED")) D PAYED^ABMERUTL
S ABMR(30,250)=+$G(ABMP("PAYED",ABME("INS")))
; If non-ben patient and Prepay amt
I ABME("ITYPE")="N" S ABMR(30,250)=ABMR(30,250)+$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),9)),"^",9)
S ABMR(30,250)=$$FMT^ABMERUTL(ABMR(30,250),"10NRJ2")
Q
;
260 ;EP - Estimated Third Party Amount Due (SOURCE: FILE= FIELD=)
; form locator #55
I '$D(ABMP("PAYED")) D PAYED^ABMERUTL
S ABMR(30,260)=""
; If INS and initiated status
I ABME("INS")=ABMP("INS"),$P(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,ABME("INSIEN"),0),"^",3)="I" D
.S ABMR(30,260)=(+$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),2)),U))
S ABMR(30,260)=$$FMT^ABMERUTL(ABMR(30,260),"10NRJ2")
Q
;
DIQ1 ;PULL BILL DATA VIA DIQ1
Q:$D(ABM(9002274.4,ABMP("BDFN"),ABME("FLD")))
N I
S DIQ="ABM("
S DIQ(0)="EI"
S DIC="^ABMDBILL(DUZ(2),"
S DA=ABMP("BDFN")
S DR=".66;.67;.68;.73;.74;.75;.99"
D EN^DIQ1
K DIQ
Q
;
DIQ2 ;POLICY HOLDER INFORMATION
Q:'$G(ABME("PH"))
Q:$D(ABM(9000003.1,ABME("PH"),ABME("FLD")))
N I
S DIQ="ABM("
S DIQ(0)="EI"
S DIC="^AUPN3PPH("
S DA=ABME("PH")
S DR=".02;.15"
D EN^DIQ1
K DIQ
Q
;
DIQ3 ;PATIENT IS INSURED
Q:$D(ABM(9000001,ABMP("PDFN"),ABME("FLD")))
N I
S DIQ="ABM("
S DIQ(0)="EI"
S DIC="^AUPNPAT("
S DA=ABMP("PDFN")
S DR=".21"
D EN^DIQ1
K DIQ
Q
;
EX(ABMX,ABMY,ABMZ) ;EXTRINSIC FUNCTION HERE
;
; INPUT: ABMX = data element
; Y = bill internal entry number
; ABMZ = insurer
;
; 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
S ABME("S#")=0
D ISET^ABMERINS
I '$G(ABMP("NOFMT")) S ABMP("FMT")=0
D @ABMX
S Y=ABMR(30,ABMX)
I $D(ABMP("FMT")) S ABMP("FMT")=1
K ABMR(30,ABMX),ABMX,ABMY,ABMZ,ABME,ABM
Q Y
ABME630 ; IHS/ASDST/DMJ - UB92 EMC RECORD 30 (Third Party Payor) ;
+1 ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
+2 ;Original;DMJ;01/22/96 10:43 AM
+3 ;
+4 ; IHS/ASDS/DMJ - 01/23/01 - V2.4 Patch 3 - NOIS HQW-0101-100032
+5 ; Created routine to correct rejections for Medicare
+6 ;
START ;START HERE
+1 KILL ABMREC(30),ABMREC(31),ABME,ABM,ABMP("PAYED")
+2 KILL ABMP("SET")
+3 ; get insurer data
DO SET^ABMERUTL
DO LOOP
+4 KILL ABME,ABM
+5 QUIT
+6 ;
LOOP ;FIRST LOOP
+1 ; Loop thru INS priorities
+2 SET ABME("S#")=0
+3 FOR
SET ABME("S#")=$ORDER(ABMP("INS",ABME("S#")))
IF 'ABME("S#")
QUIT
Begin DoDot:1
+4 ; Insurer IEN
SET ABME("INS")=+ABMP("INS",ABME("S#"))
+5 ; IEN to insurer multiple
SET ABME("INSIEN")=$PIECE(ABMP("INS",ABME("S#")),"^",3)
+6 ; record type
SET ABME("RTYPE")=30
+7 KILL ABMR(30),ABMR(31)
+8 ; set INS priority
DO ISET^ABMERINS
+9 ; Get data
DO LOOP2
+10 ; Add 1 to record type counts (electronic)
DO S90^ABMERUTL
+11 ; Get insured's data
DO ^ABMER31
End DoDot:1
+12 QUIT
+13 ;
LOOP2 ;LOOP HERE
+1 ; Get insurance data
DO ^ABME630A
+2 FOR I=160:10:260
Begin DoDot:1
+3 DO @I
+4 IF $DATA(^ABMEXLM("AA",+$GET(ABMP("INS")),+$GET(ABMP("EXP")),30,I))
DO @(^(I))
+5 IF '$GET(ABMP("NOFMT"))
SET ABMREC(30,ABME("S#"))=$GET(ABMREC(30,ABME("S#")))_ABMR(30,I)
End DoDot:1
+6 QUIT
+7 ;
160 ;EP - Release Code (SOURCE: FILE=9002274.4 FIELD=.74)
+1 ; form locator #52
+2 SET ABME("FLD")=.74
+3 DO DIQ1
+4 SET ABMR(30,160)=ABM(9002274.4,ABMP("BDFN"),.74,"I")
+5 SET ABMR(30,160)=$$FMT^ABMERUTL(ABMR(30,160),1)
+6 QUIT
+7 ;
170 ;EP - Benefits Assigned Indicator (SOURCE: FILE=9002274.4, FIELD=.75)
+1 ; form locator #53
+2 SET ABME("FLD")=.75
+3 DO DIQ1
+4 SET ABMR(30,170)=ABM(9002274.4,ABMP("BDFN"),.75,"I")
+5 SET ABMR(30,170)=$$FMT^ABMERUTL(ABMR(30,170),1)
+6 QUIT
+7 ;
180 ;EP - Patient's Relationship to Insured (SOURCE: FILE=, FIELD=)
+1 ; form locator #59
+2 IF '$GET(ABME("PH"))
SET ABMR(30,180)="01"
+3 IF $GET(ABME("PH"))
SET ABMR(30,180)=ABME("REL")
+4 SET ABMR(30,180)=$$FMT^ABMERUTL(ABMR(30,180),"2NR")
+5 QUIT
+6 ;
190 ;EP - Employment Status Code (SOURCE: FILE=9000003.1, FIELD=.15)
+1 SET ABMR(30,190)=""
+2 ; of patient
IF $GET(ABME("PPP"))
Begin DoDot:1
+3 SET ABME("FLD")=.21
+4 DO DIQ3
+5 SET ABMR(30,190)=$GET(ABM(9000001,ABME("PPP"),.21,"I"))
+6 QUIT
End DoDot:1
+7 ; of policy holder
IF ABMR(30,190)=""
IF $GET(ABME("PH"))
Begin DoDot:1
+8 SET ABME("FLD")=.15
+9 DO DIQ2
+10 SET ABMR(30,190)=$GET(ABM(9000003.1,+ABME("PH"),.15,"I"))
+11 QUIT
End DoDot:1
+12 SET ABMR(30,190)=$$FMT^ABMERUTL(ABMR(30,190),1)
+13 QUIT
+14 ;
200 ;EP - Covered Days (SOURCE: FILE=9002274.4, FIELD=.73)
+1 ; form locator #7
+2 SET ABME("FLD")=.73
+3 DO DIQ1
+4 SET ABMR(30,200)=ABM(9002274.4,ABMP("BDFN"),.73,"I")
+5 SET ABMR(30,200)=$$FMT^ABMERUTL(ABMR(30,200),"3NR")
+6 QUIT
+7 ;
210 ;EP - Non-Covered Days (SOURCE: FILE=9002274.4 FIELD=.66)
+1 ; form locator #8
+2 SET ABME("FLD")=.66
+3 DO DIQ1
+4 SET ABMR(30,210)=ABM(9002274.4,ABMP("BDFN"),.66,"I")
+5 SET ABMR(30,210)=$$FMT^ABMERUTL(ABMR(30,210),"4NR")
+6 QUIT
+7 ;
220 ;EP - Coinsurance Days (SOURCE: FILE=9002274.4, FIELD=.67)
+1 ; form locator #9
+2 SET ABME("FLD")=.67
+3 DO DIQ1
+4 SET ABMR(30,220)=ABM(9002274.4,ABMP("BDFN"),.67,"I")
+5 SET ABMR(30,220)=$$FMT^ABMERUTL(ABMR(30,220),"3NR")
+6 QUIT
+7 ;
230 ;EP - Lifetime Reserve Days (SOURCE: FILE=9002274.4, FIELD=.68)
+1 ; form locator #10
+2 SET ABME("FLD")=.68
+3 DO DIQ1
+4 SET ABMR(30,230)=ABM(9002274.4,ABMP("BDFN"),.68,"I")
+5 SET ABMR(30,230)=$$FMT^ABMERUTL(ABMR(30,230),"3NR")
+6 QUIT
+7 ;
240 ;EP - Provider I.D. Number
+1 ; form locator #51
+2 SET ABMR(30,240)=$PIECE($GET(^ABMNINS(ABMP("LDFN"),ABME("INS"),1,ABMP("VTYP"),0)),"^",8)
+3 IF ABMR(30,240)=""
SET ABMR(30,240)=$PIECE($GET(^ABMNINS(DUZ(2),ABME("INS"),1,ABMP("VTYP"),0)),"^",8)
+4 IF ABMR(30,240)=""
SET ABMR(30,240)=$PIECE($GET(^AUTNINS(ABME("INS"),39,ABMP("VTYP"),0)),"^",8)
+5 IF ABMR(30,240)=""
SET ABMR(30,240)=$PIECE($GET(^AUTNINS(ABME("INS"),15,ABMP("LDFN"),0)),"^",2)
+6 IF ABME("ITYPE")="R"
Begin DoDot:1
+7 IF ABMR(30,240)=""
SET ABMR(30,240)=$PIECE($GET(^AUTTLOC(+ABMP("LDFN"),0)),"^",19)
+8 SET ABMR(30,240)=$TRANSLATE(ABMR(30,240),"-")
End DoDot:1
+9 SET ABMR(30,240)=$$FMT^ABMERUTL(ABMR(30,240),13)
+10 QUIT
+11 ;
250 ;EP - Third Party Payments Received (SOURCE: FILE= FIELD=)
+1 ; form locator #54
+2 IF '$DATA(ABMP("PAYED"))
DO PAYED^ABMERUTL
+3 SET ABMR(30,250)=+$GET(ABMP("PAYED",ABME("INS")))
+4 ; If non-ben patient and Prepay amt
+5 IF ABME("ITYPE")="N"
SET ABMR(30,250)=ABMR(30,250)+$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),9)),"^",9)
+6 SET ABMR(30,250)=$$FMT^ABMERUTL(ABMR(30,250),"10NRJ2")
+7 QUIT
+8 ;
260 ;EP - Estimated Third Party Amount Due (SOURCE: FILE= FIELD=)
+1 ; form locator #55
+2 IF '$DATA(ABMP("PAYED"))
DO PAYED^ABMERUTL
+3 SET ABMR(30,260)=""
+4 ; If INS and initiated status
+5 IF ABME("INS")=ABMP("INS")
IF $PIECE(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,ABME("INSIEN"),0),"^",3)="I"
Begin DoDot:1
+6 SET ABMR(30,260)=(+$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),2)),U))
End DoDot:1
+7 SET ABMR(30,260)=$$FMT^ABMERUTL(ABMR(30,260),"10NRJ2")
+8 QUIT
+9 ;
DIQ1 ;PULL BILL DATA VIA DIQ1
+1 IF $DATA(ABM(9002274.4,ABMP("BDFN"),ABME("FLD")))
QUIT
+2 NEW I
+3 SET DIQ="ABM("
+4 SET DIQ(0)="EI"
+5 SET DIC="^ABMDBILL(DUZ(2),"
+6 SET DA=ABMP("BDFN")
+7 SET DR=".66;.67;.68;.73;.74;.75;.99"
+8 DO EN^DIQ1
+9 KILL DIQ
+10 QUIT
+11 ;
DIQ2 ;POLICY HOLDER INFORMATION
+1 IF '$GET(ABME("PH"))
QUIT
+2 IF $DATA(ABM(9000003.1,ABME("PH"),ABME("FLD")))
QUIT
+3 NEW I
+4 SET DIQ="ABM("
+5 SET DIQ(0)="EI"
+6 SET DIC="^AUPN3PPH("
+7 SET DA=ABME("PH")
+8 SET DR=".02;.15"
+9 DO EN^DIQ1
+10 KILL DIQ
+11 QUIT
+12 ;
DIQ3 ;PATIENT IS INSURED
+1 IF $DATA(ABM(9000001,ABMP("PDFN"),ABME("FLD")))
QUIT
+2 NEW I
+3 SET DIQ="ABM("
+4 SET DIQ(0)="EI"
+5 SET DIC="^AUPNPAT("
+6 SET DA=ABMP("PDFN")
+7 SET DR=".21"
+8 DO EN^DIQ1
+9 KILL DIQ
+10 QUIT
+11 ;
EX(ABMX,ABMY,ABMZ) ;EXTRINSIC FUNCTION HERE
+1 ;
+2 ; INPUT: ABMX = data element
+3 ; Y = bill internal entry number
+4 ; ABMZ = insurer
+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 SET ABME("S#")=0
+13 DO ISET^ABMERINS
+14 IF '$GET(ABMP("NOFMT"))
SET ABMP("FMT")=0
+15 DO @ABMX
+16 SET Y=ABMR(30,ABMX)
+17 IF $DATA(ABMP("FMT"))
SET ABMP("FMT")=1
+18 KILL ABMR(30,ABMX),ABMX,ABMY,ABMZ,ABME,ABM
+19 QUIT Y
