ABMDF11Y ; IHS/ASDST/DMJ - PRINT UB92 ;
;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
;Original;DMJ;
;
;IHS/DSD/LSL -3/23/98 - Add to line tag 18 to quit print if
;itemized for flat rate billing on a UB-92.
;
;IHS/ASDS/DMJ - 04/20/00 - V2.4 Patch 1 - NOIS XAA-0500-200043
; Allow value codes etc to print leading zeroes and alpha
;
;IHS/ASDS/SDH - 11/27/01 - v2.4 p10 - NOIS UAA-0901-170076
; Modified so it would print the address of the insurer if that
; is what is selected in UB-92 FL38 in site parameters
;
;IHS/SD/SDR - 11/6/2003 - added code to print DOS in form locator 45
;
; IHS/SD/SDR - v2.5 p8 - IM13324/IM15558
; Added code to format 0 to 0.00
;
; IHS/SD/SDR - v2.5 p8 - IM15034
; Modified to print all fields on 2-page claims
;
; IHS/SD/SDR - v2.5 p8 - task 6
; format for dollar amount or zip code
;
; IHS/SD/SDR - v2.5 p9 - IM16660
; 4-digit revenue codes
;
; IHS/SD/SDR - v2.5 p9 - IM17247
; Print write MEDICARE when insurer is Railroad
;
; IHS/SD/SDR - v2.5 p9 - IM15413
; Print OUTPATIENT CLINIC line when EPSDT
;
; IHS/SD/SDR - v2.5 p9 - IM17888
; Add Rx number in FL44
;
; IHS/SD/SDR - v2.5 p10 - IM17247
; Changed RAILROAD to RAILROAD MEDICARE
;
; IHS/SD/SDR - v2.5 p10 - IM20227
; Changed hardset of 001 rev code to 0001
;
; IHS/SD/SDR - v2.5 p10 - IM20309
; Added code to check for RX in FL44 parameter
;
; IHS/SD/SDR - v2.5 p10 - IM20395
; Split line bundled by rev code
;
; IHS/SD/SDR - v2.5 p10 - IM22017
; Removed address check for Medicare/Medicaid
;
; IHS/SD/SDR - v2.5 p11 - IM22386
; Removed duplicate 0510 line from claim
;
;**********************************************************************
13 ; EP
W !
K ABMR
S ABM("9SP")=" "
N I
F I=160:10:200 D
.D @(I_"^ABMER41A")
N I
F I=210:10:390 D
.D @(I_"^ABMER41")
; Policy holder street address
S ABMDE=$G(ABM(9000003.1,+$G(ABME("PH")),.09,"E"))_"^^40"
D WRT^ABMDF11W ; form locator #38
I ABM38FLG["I" D
.S ABMDE=ABMISTR_"^^40"
.D WRT^ABMDF11W
I ABMR(41,160)'="" D
.S ABMDE=ABMR(41,160)_"^43^2" ; Value code 1
.D WRT^ABMDF11W ; form locator #39a
I ($TR(ABMR(41,170)," ",""))'="" D
.I ABMR(41,160)="A0" S ABMDE=+ABMR(41,170)_"^46^9"
.E S ABMDE=$FN(+ABMR(41,170),"",2)_"^46^9R" ;Value Amt 1
.D WRT^ABMDF11W ; form locator #39a
I ABMR(41,180)'="" D
.S ABMDE=ABMR(41,180)_"^56^2" ; Value code 2
.D WRT^ABMDF11W ; form locator #40a
I ($TR(ABMR(41,190)," ",""))'="" D
.I ABMR(41,180)="A0" S ABMDE=+ABMR(41,190)_"^59^9"
.E S ABMDE=$FN(+ABMR(41,190),"",2)_"^59^9R"
.D WRT^ABMDF11W ; form locator #40a
I ABMR(41,200)'="" D
.S ABMDE=ABMR(41,200)_"^69^2" ; Value code 3
.D WRT^ABMDF11W ; form locator #41a
I ($TR(ABMR(41,210)," ",""))'="" D
.I ABMR(41,200)="A0" S ABMDE=+ABMR(41,210)_"^72^9"
.E S ABMDE=+ABMR(41,210)_"^72^9R"
.D WRT^ABMDF11W ; form locator #41a
;
14 ;
W !
I ABM38FLG["I" D
.S ABMDE=ABMICTY_", "_$P($G(^DIC(5,ABMIST,0)),U,2)_" "_ABMIZIP_"^^40"
.D WRT^ABMDF11W
I ABMR(41,220)'="" D
.S ABMDE=ABMR(41,220)_"^43^2" ; Value code 4
.D WRT^ABMDF11W ; form locator #39b
I ABMR(41,230) D
.I ABMR(41,220)="A0" S ABMDE=+ABMR(41,230)_"^46^9"
.E S ABMDE=+ABMR(41,230)_"^46^9R" ; Value amount 4
.D WRT^ABMDF11W ; form locator #39b
I ABMR(41,240)'="" D
.S ABMDE=ABMR(41,240)_"^56^2" ; Value code 5
.D WRT^ABMDF11W ; form locator #40b
I ABMR(41,250) D
.I ABMR(41,240)="A0" S ABMDE=+ABMR(41,250)_"^59^9"
.E S ABMDE=+ABMR(41,250)_"^59^9R" ; Value amount 5
.D WRT^ABMDF11W ; form locator #40b
I ABMR(41,260)'="" D
.S ABMDE=ABMR(41,260)_"^69^2" ; Value code 6
.D WRT^ABMDF11W ; form locator #41b
I ABMR(41,270) D
.I ABMR(41,260)="A0" S ABMDE=+ABMR(41,270)_"^72^9"
.E S ABMDE=+ABMR(41,270)_"^72^9R" ; Value amount 6
.D WRT^ABMDF11W ; form locator #41b
Q:$G(ABMORE)
;
15 ;
W !
K ABM
I ABMR(41,280)'="" D
.S ABMDE=ABMR(41,280)_"^43^2" ; Value code 7
.D WRT^ABMDF11W ; form locator #39c
I ABMR(41,290) D
.I ABMR(41,280)="A0" S ABMDE=+ABMR(41,290)_"^46^9"
.E S ABMDE=+ABMR(41,290)_"^46^9R" ; Value amount 7
.D WRT^ABMDF11W ; form locator #39c
I ABMR(41,300)'="" D
.S ABMDE=ABMR(41,300)_"^56^2" ; Value code 8
.D WRT^ABMDF11W ; form locator #40c
I ABMR(41,310) D
.I ABMR(41,300)="A0" S ABMDE=+ABMR(41,310)_"^59^9"
.E S ABMDE=+ABMR(41,310)_"^59^9R" ; Value amount 8
.D WRT^ABMDF11W ; form locator #40c
I ABMR(41,320)'="" D
.S ABMDE=ABMR(41,320)_"^69^2" ; Value code 9
.D WRT^ABMDF11W ; form locator #41c
I ABMR(41,330) D
.I ABMR(41,320)="A0" S ABMDE=+ABMR(41,330)_"^72^9"
.E S ABMDE=+ABMR(41,330)_"^72^9R" ; Value amount 9
.D WRT^ABMDF11W ; form locator #41c
;
16 ;
W !
I ABMR(41,340)'="" D
.S ABMDE=ABMR(41,340)_"^43^2" ; Value code 10
.D WRT^ABMDF11W ; form locator #39d
I ABMR(41,350) D
.I ABMR(41,340)="A0" S ABMDE=+ABMR(41,350)_"^46^9"
.E S ABMDE=+ABMR(41,350)_"^46^9R" ; Value amount 10
.D WRT^ABMDF11W ; form locator #39d
I ABMR(41,360)'="" D
.S ABMDE=ABMR(41,360)_"^56^2" ; Value code 11
.D WRT^ABMDF11W ; form locator #40d
I ABMR(41,370) D
.I ABMR(41,360)="A0" S ABMDE=+ABMR(41,370)_"^59^9"
.E S ABMDE=+ABMR(41,370)_"^59^9R" ; Value amount 11
.D WRT^ABMDF11W ; form locator #40d
I ABMR(41,380)'="" D
.S ABMDE=ABMR(41,380)_"^69^2" ; Value code 12
.D WRT^ABMDF11W ; form locator #41d
I ABMR(41,390) D
.I ABMR(41,380)="A0" S ABMDE=+ABMR(41,390)_"^72^9"
.E S ABMDE=+ABMR(41,390)_"^72^9R" ; Value amount 12
.D WRT^ABMDF11W ; form locator #41d
;
18 ;
; Lines 18 - 40 on form (description area)
; ABMVR(IEN,code,counter) = IEN ^ Code ^ Modifier ^ 2nd Modifier ^
; Total units ^ Total charges ^ ^ Unit charge ^
; NDC name or description ^ date/time
W !
K ABMRV
D ORV^ABMERGRV ; get other revenue codes
D P1^ABMERGRV ; Build ABMVR of revenue codes
; Itemized UB-92 flag (1=yes, 0=no)
S ABMITMZ=$P($G(^ABMNINS(DUZ(2),ABMP("INS"),1,ABMP("VTYP"),0)),"^",12)
K I,J,L
S I=0
S (ABMCTR,ABMRV("ZZTOT"),ABMRV("NCTOT"))=0
F S I=$O(ABMRV(I)) Q:'I D
.S J=-1
.F S J=$O(ABMRV(I,J)) Q:J="" D
..S L=0
..F S L=$O(ABMRV(I,J,L)) Q:+L=0 D
...; Grand total charges
...I $P($G(^ABMDVTYP(ABMP("VTYP"),0)),U)["EPSDT",(+$P($G(ABMRV(I,J,L)),U,2)=0) D
....S $P(ABMRV(I,J,L),U,9)="OUTPATIENT CLINIC"
...S:J'="ZZTOT" ABMRV("ZZTOT")=ABMRV("ZZTOT")+$P(ABMRV(I,J,L),U,6)
...; Grand total noncovered charges
...S:J'="ZZTOT" ABMRV("NCTOT")=ABMRV("NCTOT")+$P(ABMRV(I,J,L),U,7)
...; if not itemized bill and not done, accumulate totals
...I 'ABMITMZ,J'="ZZTOT" D
....S $P(ABMRV(I,"ZZTOT",1),U)=I ; IEN to REVENUE CODE
....S:$D(ABMP("CPT")) $P(ABMRV(I,"ZZTOT",1),"^",2)=ABMP("CPT") ;CPT code
....N K
....; Accumulate totals per revenue code
....F K=5:1:7 S $P(ABMRV(I,"ZZTOT",1),U,K)=$P(ABMRV(I,"ZZTOT",1),U,K)+$P(ABMRV(I,J,L),U,K)
....S $P(ABMRV(I,"ZZTOT",1),U,8)=$P(ABMRV(I,J,L),U,8) ; unit charge
....Q
...I 'ABMITMZ,J'="ZZTOT" Q
...I ABMITMZ,(J["TOT") Q ; If itemized and done, Q
...W !
...S ABMCTR=ABMCTR+1 ; Count items
...; If more than 22 items, complete bottom of form,
...; then start a new page
...I ABMCTR>22 D
....S ABMORE=1
....N I,J
....D 42
....D ^ABMDF11Z
....W $$EN^ABMVDF("IOF")
....N I,J
....D 1^ABMDF11X
....K ABMORE
....N I
....F I=1:1:4 W !
....S ABMCTR=1
....Q
...S ABMDE=$$GETREV^ABMDUTL(I)_"^^4R" ; Revenue code
...D WRT^ABMDF11W ; form locator #42
...; If description is blank, get it from visit type in INSURER file
...I $P(ABMRV(I,J,L),U,9)="" D
....S ABMDE=$P($G(^ABMNINS(DUZ(2),ABMP("INS"),1,ABMP("VTYP"),0)),U,9)
....S:ABMDE="" ABMDE=$P($G(^AUTTREVN(I,0)),U,2) ; standard abbreviation
....S ABMDE=ABMDE_"^5^24" ; Description
....D WRT^ABMDF11W ; form locator #43
....Q
...; If description, use it
...I $P(ABMRV(I,J,L),U,9)'="" D
....S ABMDE=$P(ABMRV(I,J,L),U,9)_"^5^24" ; Description
....D WRT^ABMDF11W ; form locator #43
....Q
...; HCPCS/rates -- form locator #44
...S ABMDE=$S($L($P(ABMRV(I,J,L),U,2))>3:$P(ABMRV(I,J,L),U,2)_$S($P(ABMRV(I,J,L),U,3)]"":"-"_$P(ABMRV(I,J,L),U,3),1:"")_"^30^9",$P(ABMRV(I,J,L),U,8)&(+$P(ABMRV(I,J,L),U,2)'=0):$J($P(ABMRV(I,J,L),U,8),1,2)_"^30^9R",1:"")
...I $P($G(ABMRV(I,J,L)),U,14)'="",($P($G(^ABMNINS(DUZ(2),ABMP("INS"),1,ABMP("VTYP"),0)),U,24)="Y") S ABMDE="RX"_$P(ABMRV(I,J,L),U,14)_"^30^9"
...D WRT^ABMDF11W
...S ABMDE=$$MDY^ABMDUTL($P(ABMRV(I,J,L),U,10))_"^40^6" ;DOS
...D WRT^ABMDF11W ;form locator #45
...S ABMDE=$P(ABMRV(I,J,L),U,5)_"^47^7R" ; Total units per item
...D WRT^ABMDF11W ; form locator #46
...S ABMDE=$FN($P(ABMRV(I,J,L),U,6),"T",2)
...S ABMDE=$TR(ABMDE,".")_"^55^10R" ; Total charges per item
...D WRT^ABMDF11W ; form locator #47
...S ABMDE=$FN($P(ABMRV(I,J,L),U,7),"T",2)
...I +ABMDE D
....S ABMDE=$TR(ABMDE,".")_"^66^10R" ; Total noncover charges per item
....D WRT^ABMDF11W ; form locator #48
....Q
W !
S ABMDE="0001 TOTAL^^10"
D WRT^ABMDF11W
S ABMDE=$TR($FN(ABMRV("ZZTOT"),"T",2),".")_"^55^10R" ; Grand total
D WRT^ABMDF11W ; last item in description section
I +ABMRV("NCTOT") D
.S ABMDE=$TR($FN(ABMRV("NCTOT"),"T",2),".")_"^66^10R"
.D WRT^ABMDF11W ; Grand total - noncovered items
.Q
N I
F I=1:1:22-ABMCTR W !
K ABMRV
;
42 ;
; Lines 42 - 44
W !
K ABMP("SET")
D ^ABMER30 ; get insurer and payment data
N I
F I=1:1:3 D
.W !
.Q:'$D(ABMREC(30,I))
.; Insurer name_" "_Payor Sub Identification
.S ABMDE=$S($E(ABMREC(30,I),54,78)["RAILROAD":"RAILROAD MEDICARE",1:$E(ABMREC(30,I),54,78))_" "_$E(ABMREC(30,I),31,34)_"^^25"
.D WRT^ABMDF11W ; form locator #50
.S ABMDE=$E(ABMREC(30,I),160,172)_"^26^13" ; Provider ID (blank)
.D WRT^ABMDF11W ; form locator #51
.S ABMDE=$E(ABMREC(30,I),142)_"^40^1" ; Release code
.D WRT^ABMDF11W ; form locator #52
.S ABMDE=$E(ABMREC(30,I),143)_"^43^1" ; Ben Assgn Indicator
.D WRT^ABMDF11W ; form locator #53
.S ABMDE=+$E(ABMREC(30,I),173,182)_" ^45^10R" ; 3PB pymnt recieve
.I +ABMDE D WRT^ABMDF11W ; form locator #54
.S ABMDE=+$E(ABMREC(30,I),183,192)_" ^56^10R" ; Est 3PB amt due
.I +ABMDE D WRT^ABMDF11W ; form locator #55
K ABMR
Q
ABMDF11Y ; IHS/ASDST/DMJ - PRINT UB92 ;
+1 ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
+2 ;Original;DMJ;
+3 ;
+4 ;IHS/DSD/LSL -3/23/98 - Add to line tag 18 to quit print if
+5 ;itemized for flat rate billing on a UB-92.
+6 ;
+7 ;IHS/ASDS/DMJ - 04/20/00 - V2.4 Patch 1 - NOIS XAA-0500-200043
+8 ; Allow value codes etc to print leading zeroes and alpha
+9 ;
+10 ;IHS/ASDS/SDH - 11/27/01 - v2.4 p10 - NOIS UAA-0901-170076
+11 ; Modified so it would print the address of the insurer if that
+12 ; is what is selected in UB-92 FL38 in site parameters
+13 ;
+14 ;IHS/SD/SDR - 11/6/2003 - added code to print DOS in form locator 45
+15 ;
+16 ; IHS/SD/SDR - v2.5 p8 - IM13324/IM15558
+17 ; Added code to format 0 to 0.00
+18 ;
+19 ; IHS/SD/SDR - v2.5 p8 - IM15034
+20 ; Modified to print all fields on 2-page claims
+21 ;
+22 ; IHS/SD/SDR - v2.5 p8 - task 6
+23 ; format for dollar amount or zip code
+24 ;
+25 ; IHS/SD/SDR - v2.5 p9 - IM16660
+26 ; 4-digit revenue codes
+27 ;
+28 ; IHS/SD/SDR - v2.5 p9 - IM17247
+29 ; Print write MEDICARE when insurer is Railroad
+30 ;
+31 ; IHS/SD/SDR - v2.5 p9 - IM15413
+32 ; Print OUTPATIENT CLINIC line when EPSDT
+33 ;
+34 ; IHS/SD/SDR - v2.5 p9 - IM17888
+35 ; Add Rx number in FL44
+36 ;
+37 ; IHS/SD/SDR - v2.5 p10 - IM17247
+38 ; Changed RAILROAD to RAILROAD MEDICARE
+39 ;
+40 ; IHS/SD/SDR - v2.5 p10 - IM20227
+41 ; Changed hardset of 001 rev code to 0001
+42 ;
+43 ; IHS/SD/SDR - v2.5 p10 - IM20309
+44 ; Added code to check for RX in FL44 parameter
+45 ;
+46 ; IHS/SD/SDR - v2.5 p10 - IM20395
+47 ; Split line bundled by rev code
+48 ;
+49 ; IHS/SD/SDR - v2.5 p10 - IM22017
+50 ; Removed address check for Medicare/Medicaid
+51 ;
+52 ; IHS/SD/SDR - v2.5 p11 - IM22386
+53 ; Removed duplicate 0510 line from claim
+54 ;
+55 ;**********************************************************************
13 ; EP
+1 WRITE !
+2 KILL ABMR
+3 SET ABM("9SP")=" "
+4 NEW I
+5 FOR I=160:10:200
Begin DoDot:1
+6 DO @(I_"^ABMER41A")
End DoDot:1
+7 NEW I
+8 FOR I=210:10:390
Begin DoDot:1
+9 DO @(I_"^ABMER41")
End DoDot:1
+10 ; Policy holder street address
+11 SET ABMDE=$GET(ABM(9000003.1,+$GET(ABME("PH")),.09,"E"))_"^^40"
+12 ; form locator #38
DO WRT^ABMDF11W
+13 IF ABM38FLG["I"
Begin DoDot:1
+14 SET ABMDE=ABMISTR_"^^40"
+15 DO WRT^ABMDF11W
End DoDot:1
+16 IF ABMR(41,160)'=""
Begin DoDot:1
+17 ; Value code 1
SET ABMDE=ABMR(41,160)_"^43^2"
+18 ; form locator #39a
DO WRT^ABMDF11W
End DoDot:1
+19 IF ($TRANSLATE(ABMR(41,170)," ",""))'=""
Begin DoDot:1
+20 IF ABMR(41,160)="A0"
SET ABMDE=+ABMR(41,170)_"^46^9"
+21 ;Value Amt 1
IF '$TEST
SET ABMDE=$FNUMBER(+ABMR(41,170),"",2)_"^46^9R"
+22 ; form locator #39a
DO WRT^ABMDF11W
End DoDot:1
+23 IF ABMR(41,180)'=""
Begin DoDot:1
+24 ; Value code 2
SET ABMDE=ABMR(41,180)_"^56^2"
+25 ; form locator #40a
DO WRT^ABMDF11W
End DoDot:1
+26 IF ($TRANSLATE(ABMR(41,190)," ",""))'=""
Begin DoDot:1
+27 IF ABMR(41,180)="A0"
SET ABMDE=+ABMR(41,190)_"^59^9"
+28 IF '$TEST
SET ABMDE=$FNUMBER(+ABMR(41,190),"",2)_"^59^9R"
+29 ; form locator #40a
DO WRT^ABMDF11W
End DoDot:1
+30 IF ABMR(41,200)'=""
Begin DoDot:1
+31 ; Value code 3
SET ABMDE=ABMR(41,200)_"^69^2"
+32 ; form locator #41a
DO WRT^ABMDF11W
End DoDot:1
+33 IF ($TRANSLATE(ABMR(41,210)," ",""))'=""
Begin DoDot:1
+34 IF ABMR(41,200)="A0"
SET ABMDE=+ABMR(41,210)_"^72^9"
+35 IF '$TEST
SET ABMDE=+ABMR(41,210)_"^72^9R"
+36 ; form locator #41a
DO WRT^ABMDF11W
End DoDot:1
+37 ;
14 ;
+1 WRITE !
+2 IF ABM38FLG["I"
Begin DoDot:1
+3 SET ABMDE=ABMICTY_", "_$PIECE($GET(^DIC(5,ABMIST,0)),U,2)_" "_ABMIZIP_"^^40"
+4 DO WRT^ABMDF11W
End DoDot:1
+5 IF ABMR(41,220)'=""
Begin DoDot:1
+6 ; Value code 4
SET ABMDE=ABMR(41,220)_"^43^2"
+7 ; form locator #39b
DO WRT^ABMDF11W
End DoDot:1
+8 IF ABMR(41,230)
Begin DoDot:1
+9 IF ABMR(41,220)="A0"
SET ABMDE=+ABMR(41,230)_"^46^9"
+10 ; Value amount 4
IF '$TEST
SET ABMDE=+ABMR(41,230)_"^46^9R"
+11 ; form locator #39b
DO WRT^ABMDF11W
End DoDot:1
+12 IF ABMR(41,240)'=""
Begin DoDot:1
+13 ; Value code 5
SET ABMDE=ABMR(41,240)_"^56^2"
+14 ; form locator #40b
DO WRT^ABMDF11W
End DoDot:1
+15 IF ABMR(41,250)
Begin DoDot:1
+16 IF ABMR(41,240)="A0"
SET ABMDE=+ABMR(41,250)_"^59^9"
+17 ; Value amount 5
IF '$TEST
SET ABMDE=+ABMR(41,250)_"^59^9R"
+18 ; form locator #40b
DO WRT^ABMDF11W
End DoDot:1
+19 IF ABMR(41,260)'=""
Begin DoDot:1
+20 ; Value code 6
SET ABMDE=ABMR(41,260)_"^69^2"
+21 ; form locator #41b
DO WRT^ABMDF11W
End DoDot:1
+22 IF ABMR(41,270)
Begin DoDot:1
+23 IF ABMR(41,260)="A0"
SET ABMDE=+ABMR(41,270)_"^72^9"
+24 ; Value amount 6
IF '$TEST
SET ABMDE=+ABMR(41,270)_"^72^9R"
+25 ; form locator #41b
DO WRT^ABMDF11W
End DoDot:1
+26 IF $GET(ABMORE)
QUIT
+27 ;
15 ;
+1 WRITE !
+2 KILL ABM
+3 IF ABMR(41,280)'=""
Begin DoDot:1
+4 ; Value code 7
SET ABMDE=ABMR(41,280)_"^43^2"
+5 ; form locator #39c
DO WRT^ABMDF11W
End DoDot:1
+6 IF ABMR(41,290)
Begin DoDot:1
+7 IF ABMR(41,280)="A0"
SET ABMDE=+ABMR(41,290)_"^46^9"
+8 ; Value amount 7
IF '$TEST
SET ABMDE=+ABMR(41,290)_"^46^9R"
+9 ; form locator #39c
DO WRT^ABMDF11W
End DoDot:1
+10 IF ABMR(41,300)'=""
Begin DoDot:1
+11 ; Value code 8
SET ABMDE=ABMR(41,300)_"^56^2"
+12 ; form locator #40c
DO WRT^ABMDF11W
End DoDot:1
+13 IF ABMR(41,310)
Begin DoDot:1
+14 IF ABMR(41,300)="A0"
SET ABMDE=+ABMR(41,310)_"^59^9"
+15 ; Value amount 8
IF '$TEST
SET ABMDE=+ABMR(41,310)_"^59^9R"
+16 ; form locator #40c
DO WRT^ABMDF11W
End DoDot:1
+17 IF ABMR(41,320)'=""
Begin DoDot:1
+18 ; Value code 9
SET ABMDE=ABMR(41,320)_"^69^2"
+19 ; form locator #41c
DO WRT^ABMDF11W
End DoDot:1
+20 IF ABMR(41,330)
Begin DoDot:1
+21 IF ABMR(41,320)="A0"
SET ABMDE=+ABMR(41,330)_"^72^9"
+22 ; Value amount 9
IF '$TEST
SET ABMDE=+ABMR(41,330)_"^72^9R"
+23 ; form locator #41c
DO WRT^ABMDF11W
End DoDot:1
+24 ;
16 ;
+1 WRITE !
+2 IF ABMR(41,340)'=""
Begin DoDot:1
+3 ; Value code 10
SET ABMDE=ABMR(41,340)_"^43^2"
+4 ; form locator #39d
DO WRT^ABMDF11W
End DoDot:1
+5 IF ABMR(41,350)
Begin DoDot:1
+6 IF ABMR(41,340)="A0"
SET ABMDE=+ABMR(41,350)_"^46^9"
+7 ; Value amount 10
IF '$TEST
SET ABMDE=+ABMR(41,350)_"^46^9R"
+8 ; form locator #39d
DO WRT^ABMDF11W
End DoDot:1
+9 IF ABMR(41,360)'=""
Begin DoDot:1
+10 ; Value code 11
SET ABMDE=ABMR(41,360)_"^56^2"
+11 ; form locator #40d
DO WRT^ABMDF11W
End DoDot:1
+12 IF ABMR(41,370)
Begin DoDot:1
+13 IF ABMR(41,360)="A0"
SET ABMDE=+ABMR(41,370)_"^59^9"
+14 ; Value amount 11
IF '$TEST
SET ABMDE=+ABMR(41,370)_"^59^9R"
+15 ; form locator #40d
DO WRT^ABMDF11W
End DoDot:1
+16 IF ABMR(41,380)'=""
Begin DoDot:1
+17 ; Value code 12
SET ABMDE=ABMR(41,380)_"^69^2"
+18 ; form locator #41d
DO WRT^ABMDF11W
End DoDot:1
+19 IF ABMR(41,390)
Begin DoDot:1
+20 IF ABMR(41,380)="A0"
SET ABMDE=+ABMR(41,390)_"^72^9"
+21 ; Value amount 12
IF '$TEST
SET ABMDE=+ABMR(41,390)_"^72^9R"
+22 ; form locator #41d
DO WRT^ABMDF11W
End DoDot:1
+23 ;
18 ;
+1 ; Lines 18 - 40 on form (description area)
+2 ; ABMVR(IEN,code,counter) = IEN ^ Code ^ Modifier ^ 2nd Modifier ^
+3 ; Total units ^ Total charges ^ ^ Unit charge ^
+4 ; NDC name or description ^ date/time
+5 WRITE !
+6 KILL ABMRV
+7 ; get other revenue codes
DO ORV^ABMERGRV
+8 ; Build ABMVR of revenue codes
DO P1^ABMERGRV
+9 ; Itemized UB-92 flag (1=yes, 0=no)
+10 SET ABMITMZ=$PIECE($GET(^ABMNINS(DUZ(2),ABMP("INS"),1,ABMP("VTYP"),0)),"^",12)
+11 KILL I,J,L
+12 SET I=0
+13 SET (ABMCTR,ABMRV("ZZTOT"),ABMRV("NCTOT"))=0
+14 FOR
SET I=$ORDER(ABMRV(I))
IF 'I
QUIT
Begin DoDot:1
+15 SET J=-1
+16 FOR
SET J=$ORDER(ABMRV(I,J))
IF J=""
QUIT
Begin DoDot:2
+17 SET L=0
+18 FOR
SET L=$ORDER(ABMRV(I,J,L))
IF +L=0
QUIT
Begin DoDot:3
+19 ; Grand total charges
+20 IF $PIECE($GET(^ABMDVTYP(ABMP("VTYP"),0)),U)["EPSDT"
IF (+$PIECE($GET(ABMRV(I,J,L)),U,2)=0)
Begin DoDot:4
+21 SET $PIECE(ABMRV(I,J,L),U,9)="OUTPATIENT CLINIC"
End DoDot:4
+22 IF J'="ZZTOT"
SET ABMRV("ZZTOT")=ABMRV("ZZTOT")+$PIECE(ABMRV(I,J,L),U,6)
+23 ; Grand total noncovered charges
+24 IF J'="ZZTOT"
SET ABMRV("NCTOT")=ABMRV("NCTOT")+$PIECE(ABMRV(I,J,L),U,7)
+25 ; if not itemized bill and not done, accumulate totals
+26 IF 'ABMITMZ
IF J'="ZZTOT"
Begin DoDot:4
+27 ; IEN to REVENUE CODE
SET $PIECE(ABMRV(I,"ZZTOT",1),U)=I
+28 ;CPT code
IF $DATA(ABMP("CPT"))
SET $PIECE(ABMRV(I,"ZZTOT",1),"^",2)=ABMP("CPT")
+29 NEW K
+30 ; Accumulate totals per revenue code
+31 FOR K=5:1:7
SET $PIECE(ABMRV(I,"ZZTOT",1),U,K)=$PIECE(ABMRV(I,"ZZTOT",1),U,K)+$PIECE(ABMRV(I,J,L),U,K)
+32 ; unit charge
SET $PIECE(ABMRV(I,"ZZTOT",1),U,8)=$PIECE(ABMRV(I,J,L),U,8)
+33 QUIT
End DoDot:4
+34 IF 'ABMITMZ
IF J'="ZZTOT"
QUIT
+35 ; If itemized and done, Q
IF ABMITMZ
IF (J["TOT")
QUIT
+36 WRITE !
+37 ; Count items
SET ABMCTR=ABMCTR+1
+38 ; If more than 22 items, complete bottom of form,
+39 ; then start a new page
+40 IF ABMCTR>22
Begin DoDot:4
+41 SET ABMORE=1
+42 NEW I,J
+43 DO 42
+44 DO ^ABMDF11Z
+45 WRITE $$EN^ABMVDF("IOF")
+46 NEW I,J
+47 DO 1^ABMDF11X
+48 KILL ABMORE
+49 NEW I
+50 FOR I=1:1:4
WRITE !
+51 SET ABMCTR=1
+52 QUIT
End DoDot:4
+53 ; Revenue code
SET ABMDE=$$GETREV^ABMDUTL(I)_"^^4R"
+54 ; form locator #42
DO WRT^ABMDF11W
+55 ; If description is blank, get it from visit type in INSURER file
+56 IF $PIECE(ABMRV(I,J,L),U,9)=""
Begin DoDot:4
+57 SET ABMDE=$PIECE($GET(^ABMNINS(DUZ(2),ABMP("INS"),1,ABMP("VTYP"),0)),U,9)
+58 ; standard abbreviation
IF ABMDE=""
SET ABMDE=$PIECE($GET(^AUTTREVN(I,0)),U,2)
+59 ; Description
SET ABMDE=ABMDE_"^5^24"
+60 ; form locator #43
DO WRT^ABMDF11W
+61 QUIT
End DoDot:4
+62 ; If description, use it
+63 IF $PIECE(ABMRV(I,J,L),U,9)'=""
Begin DoDot:4
+64 ; Description
SET ABMDE=$PIECE(ABMRV(I,J,L),U,9)_"^5^24"
+65 ; form locator #43
DO WRT^ABMDF11W
+66 QUIT
End DoDot:4
+67 ; HCPCS/rates -- form locator #44
+68 SET ABMDE=$SELECT($LENGTH($PIECE(ABMRV(I,J,L),U,2))>3:$PIECE(ABMRV(I,J,L),U,2)_$SELECT($PIECE(ABMRV(I,J,L),U,3)]"":"-"_$PIECE(ABMRV(I,J,L),U,3),1:"")_"^30^9",$PIECE(ABMRV(I,J,L),U,8)&(+...
... $PIECE(ABMRV(I,J,L),U,2)'=0):$JUSTIFY($PIECE(ABMRV(I,J,L),U,8),1,2)_"^30^9R",1:"")
+69 IF $PIECE($GET(ABMRV(I,J,L)),U,14)'=""
IF ($PIECE($GET(^ABMNINS(DUZ(2),ABMP("INS"),1,ABMP("VTYP"),0)),U,24)="Y")
SET ABMDE="RX"_$PIECE(ABMRV(I,J,L),U,14)_"^30^9"
+70 DO WRT^ABMDF11W
+71 ;DOS
SET ABMDE=$$MDY^ABMDUTL($PIECE(ABMRV(I,J,L),U,10))_"^40^6"
+72 ;form locator #45
DO WRT^ABMDF11W
+73 ; Total units per item
SET ABMDE=$PIECE(ABMRV(I,J,L),U,5)_"^47^7R"
+74 ; form locator #46
DO WRT^ABMDF11W
+75 SET ABMDE=$FNUMBER($PIECE(ABMRV(I,J,L),U,6),"T",2)
+76 ; Total charges per item
SET ABMDE=$TRANSLATE(ABMDE,".")_"^55^10R"
+77 ; form locator #47
DO WRT^ABMDF11W
+78 SET ABMDE=$FNUMBER($PIECE(ABMRV(I,J,L),U,7),"T",2)
+79 IF +ABMDE
Begin DoDot:4
+80 ; Total noncover charges per item
SET ABMDE=$TRANSLATE(ABMDE,".")_"^66^10R"
+81 ; form locator #48
DO WRT^ABMDF11W
+82 QUIT
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+83 WRITE !
+84 SET ABMDE="0001 TOTAL^^10"
+85 DO WRT^ABMDF11W
+86 ; Grand total
SET ABMDE=$TRANSLATE($FNUMBER(ABMRV("ZZTOT"),"T",2),".")_"^55^10R"
+87 ; last item in description section
DO WRT^ABMDF11W
+88 IF +ABMRV("NCTOT")
Begin DoDot:1
+89 SET ABMDE=$TRANSLATE($FNUMBER(ABMRV("NCTOT"),"T",2),".")_"^66^10R"
+90 ; Grand total - noncovered items
DO WRT^ABMDF11W
+91 QUIT
End DoDot:1
+92 NEW I
+93 FOR I=1:1:22-ABMCTR
WRITE !
+94 KILL ABMRV
+95 ;
42 ;
+1 ; Lines 42 - 44
+2 WRITE !
+3 KILL ABMP("SET")
+4 ; get insurer and payment data
DO ^ABMER30
+5 NEW I
+6 FOR I=1:1:3
Begin DoDot:1
+7 WRITE !
+8 IF '$DATA(ABMREC(30,I))
QUIT
+9 ; Insurer name_" "_Payor Sub Identification
+10 SET ABMDE=$SELECT($EXTRACT(ABMREC(30,I),54,78)["RAILROAD":"RAILROAD MEDICARE",1:$EXTRACT(ABMREC(30,I),54,78))_" "_$EXTRACT(ABMREC(30,I),31,34)_"^^25"
+11 ; form locator #50
DO WRT^ABMDF11W
+12 ; Provider ID (blank)
SET ABMDE=$EXTRACT(ABMREC(30,I),160,172)_"^26^13"
+13 ; form locator #51
DO WRT^ABMDF11W
+14 ; Release code
SET ABMDE=$EXTRACT(ABMREC(30,I),142)_"^40^1"
+15 ; form locator #52
DO WRT^ABMDF11W
+16 ; Ben Assgn Indicator
SET ABMDE=$EXTRACT(ABMREC(30,I),143)_"^43^1"
+17 ; form locator #53
DO WRT^ABMDF11W
+18 ; 3PB pymnt recieve
SET ABMDE=+$EXTRACT(ABMREC(30,I),173,182)_" ^45^10R"
+19 ; form locator #54
IF +ABMDE
DO WRT^ABMDF11W
+20 ; Est 3PB amt due
SET ABMDE=+$EXTRACT(ABMREC(30,I),183,192)_" ^56^10R"
+21 ; form locator #55
IF +ABMDE
DO WRT^ABMDF11W
End DoDot:1
+22 KILL ABMR
+23 QUIT
