ABMDF51Y ;IHS/DSD/DMJ/LSL - PRINT UB92 ;
;;2.6;IHS 3P BILLING SYSTEM;**14,21**;NOV 12, 2009;Build 379
;Original;DMJ; IHS/CAO/JLB 2/6/2000 added to CAO changes
;
;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/SD/SDR - v2.5 p9 - IM15936 - Correct print format issues
;IHS/SD/SDR - v2.5 p10 - IM20395 - Split out lines being bundled by rev code
;IHS/SD/SDR - v2.5 p11 - IM24315 - Line items weren't printing box 50 s/b O/P MEDI-CAL if AO CONTROL NUMBER is 61044
;
;IHS/SD/SDR - 2.6*21 - HEAT123457 - Updated 61044 check from 'equals' to 'contains'
13 ;
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 ABMR(41,160) D
.S ABMDE=ABMR(41,160)_"^43^2" ; Value code 1
.D WRT^ABMDF11W ; form locator #39a
I ABMR(41,170) D
.S ABMDE=+ABMR(41,170)_"^46^9R" ; Value Amount 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 ABMR(41,190) D
.S ABMDE=+ABMR(41,190)_"^59^9R" ; Value amount 2
.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 ABMR(41,210) D
.S ABMDE=+ABMR(41,210)_"^72^9R" ; Value amount 3
.D WRT^ABMDF11W ; form locator #41a
;
14 ;
W !
S ABMDE=$G(ABM(9000003.1,+$G(ABME("PH")),.11,"E")) ; Policy holders Address - City
I $G(ABM(9000003.1,+$G(ABME("PH")),.12,"I")) D
.S ABMPHST=$P(^DIC(5,ABM(9000003.1,ABME("PH"),.12,"I"),0),"^",2) ; Policy holders Address - State
.S ABMDE=ABMDE_", "_ABMPHST
.Q
S ABMDE=ABMDE_" "_$G(ABM(9000003.1,+$G(ABME("PH")),.13,"E")) ; add Policy holders zip
I ABMDE'="" D
.S ABMDE=ABMDE_"^^40" ; Policy holders address
.D WRT^ABMDF11W ; form locator #38
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
.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
.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
.S ABMDE=+ABMR(41,270)_"^72^9R" ; Value amount 6
.D WRT^ABMDF11W ; form locator #41b
;
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
.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
.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
.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
.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
.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
.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)),U,12)
N 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
...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),U,2)=ABMP("CPT")
....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="ZZTOT" 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 ^ABMDF51Z
....W $$EN^ABMVDF("IOF")
....N I,J
....D 1^ABMDF51X
....K ABMORE
....N I
....F I=1:1:12 W !
....S ABMCTR=1
....Q
...; 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):$J($P(ABMRV(I,J,L),U,8),1,2)_"^30^9R",1:"")
...D WRT^ABMDF11W
...S ABMDE=$$MDY^ABMDUTL(ABMP("VDT"))_"^40^6"
...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
F W ! Q:$Y>39
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
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
.Q:'$D(ABMREC(30,I))
.W ! S ABMFLAG=I
.; Insurer name_" "_Payor Sub Identification
.;I $E(ABMREC(30,I),26,30)=61044 S ABMDE="O/P MEDI-CAL^^25" ;abm*2.6*21 IHS/SD/SDR HEAT123457
.I $E(ABMREC(30,I),26,30)["61044" S ABMDE="O/P MEDI-CAL^^25" ;abm*2.6*21 IHS/SD/SDR HEAT123457
.E S ABMDE=$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
W:'$G(ABMFLAG) !
W !!
K ABMR,ABMQUIT
Q
ABMDF51Y ;IHS/DSD/DMJ/LSL - PRINT UB92 ;
+1 ;;2.6;IHS 3P BILLING SYSTEM;**14,21**;NOV 12, 2009;Build 379
+2 ;Original;DMJ; IHS/CAO/JLB 2/6/2000 added to CAO changes
+3 ;
+4 ;IHS/DSD/LSL -3/23/98 - Add to line tag 18 to quit print if itemized for flat rate billing on a UB-92.
+5 ;IHS/SD/SDR - v2.5 p9 - IM15936 - Correct print format issues
+6 ;IHS/SD/SDR - v2.5 p10 - IM20395 - Split out lines being bundled by rev code
+7 ;IHS/SD/SDR - v2.5 p11 - IM24315 - Line items weren't printing box 50 s/b O/P MEDI-CAL if AO CONTROL NUMBER is 61044
+8 ;
+9 ;IHS/SD/SDR - 2.6*21 - HEAT123457 - Updated 61044 check from 'equals' to 'contains'
13 ;
+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 ABMR(41,160)
Begin DoDot:1
+14 ; Value code 1
SET ABMDE=ABMR(41,160)_"^43^2"
+15 ; form locator #39a
DO WRT^ABMDF11W
End DoDot:1
+16 IF ABMR(41,170)
Begin DoDot:1
+17 ; Value Amount 1
SET ABMDE=+ABMR(41,170)_"^46^9R"
+18 ; form locator #39a
DO WRT^ABMDF11W
End DoDot:1
+19 IF ABMR(41,180)
Begin DoDot:1
+20 ; Value code 2
SET ABMDE=ABMR(41,180)_"^56^2"
+21 ; form locator #40a
DO WRT^ABMDF11W
End DoDot:1
+22 IF ABMR(41,190)
Begin DoDot:1
+23 ; Value amount 2
SET ABMDE=+ABMR(41,190)_"^59^9R"
+24 ; form locator #40a
DO WRT^ABMDF11W
End DoDot:1
+25 IF ABMR(41,200)
Begin DoDot:1
+26 ; Value code 3
SET ABMDE=ABMR(41,200)_"^69^2"
+27 ; form locator #41a
DO WRT^ABMDF11W
End DoDot:1
+28 IF ABMR(41,210)
Begin DoDot:1
+29 ; Value amount 3
SET ABMDE=+ABMR(41,210)_"^72^9R"
+30 ; form locator #41a
DO WRT^ABMDF11W
End DoDot:1
+31 ;
14 ;
+1 WRITE !
+2 ; Policy holders Address - City
SET ABMDE=$GET(ABM(9000003.1,+$GET(ABME("PH")),.11,"E"))
+3 IF $GET(ABM(9000003.1,+$GET(ABME("PH")),.12,"I"))
Begin DoDot:1
+4 ; Policy holders Address - State
SET ABMPHST=$PIECE(^DIC(5,ABM(9000003.1,ABME("PH"),.12,"I"),0),"^",2)
+5 SET ABMDE=ABMDE_", "_ABMPHST
+6 QUIT
End DoDot:1
+7 ; add Policy holders zip
SET ABMDE=ABMDE_" "_$GET(ABM(9000003.1,+$GET(ABME("PH")),.13,"E"))
+8 IF ABMDE'=""
Begin DoDot:1
+9 ; Policy holders address
SET ABMDE=ABMDE_"^^40"
+10 ; form locator #38
DO WRT^ABMDF11W
End DoDot:1
+11 IF ABMR(41,220)
Begin DoDot:1
+12 ; Value code 4
SET ABMDE=ABMR(41,220)_"^43^2"
+13 ; form locator #39b
DO WRT^ABMDF11W
End DoDot:1
+14 IF ABMR(41,230)
Begin DoDot:1
+15 ; Value amount 4
SET ABMDE=+ABMR(41,230)_"^46^9R"
+16 ; form locator #39b
DO WRT^ABMDF11W
End DoDot:1
+17 IF ABMR(41,240)
Begin DoDot:1
+18 ; Value code 5
SET ABMDE=ABMR(41,240)_"^56^2"
+19 ; form locator #40b
DO WRT^ABMDF11W
End DoDot:1
+20 IF ABMR(41,250)
Begin DoDot:1
+21 ; Value amount 5
SET ABMDE=+ABMR(41,250)_"^59^9R"
+22 ; form locator #40b
DO WRT^ABMDF11W
End DoDot:1
+23 IF ABMR(41,260)
Begin DoDot:1
+24 ; Value code 6
SET ABMDE=ABMR(41,260)_"^69^2"
+25 ; form locator #41b
DO WRT^ABMDF11W
End DoDot:1
+26 IF ABMR(41,270)
Begin DoDot:1
+27 ; Value amount 6
SET ABMDE=+ABMR(41,270)_"^72^9R"
+28 ; form locator #41b
DO WRT^ABMDF11W
End DoDot:1
+29 ;
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 ; Value amount 7
SET ABMDE=+ABMR(41,290)_"^46^9R"
+8 ; form locator #39c
DO WRT^ABMDF11W
End DoDot:1
+9 IF ABMR(41,300)
Begin DoDot:1
+10 ; Value code 8
SET ABMDE=ABMR(41,300)_"^56^2"
+11 ; form locator #40c
DO WRT^ABMDF11W
End DoDot:1
+12 IF ABMR(41,310)
Begin DoDot:1
+13 ; Value amount 8
SET ABMDE=+ABMR(41,310)_"^59^9R"
+14 ; form locator #40c
DO WRT^ABMDF11W
End DoDot:1
+15 IF ABMR(41,320)
Begin DoDot:1
+16 ; Value code 9
SET ABMDE=ABMR(41,320)_"^69^2"
+17 ; form locator #41c
DO WRT^ABMDF11W
End DoDot:1
+18 IF ABMR(41,330)
Begin DoDot:1
+19 ; Value amount 9
SET ABMDE=+ABMR(41,330)_"^72^9R"
+20 ; form locator #41c
DO WRT^ABMDF11W
End DoDot:1
+21 ;
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 ; Value amount 10
SET ABMDE=+ABMR(41,350)_"^46^9R"
+7 ; form locator #39d
DO WRT^ABMDF11W
End DoDot:1
+8 IF ABMR(41,360)
Begin DoDot:1
+9 ; Value code 11
SET ABMDE=ABMR(41,360)_"^56^2"
+10 ; form locator #40d
DO WRT^ABMDF11W
End DoDot:1
+11 IF ABMR(41,370)
Begin DoDot:1
+12 ; Value amount 11
SET ABMDE=+ABMR(41,370)_"^59^9R"
+13 ; form locator #40d
DO WRT^ABMDF11W
End DoDot:1
+14 IF ABMR(41,380)
Begin DoDot:1
+15 ; Value code 12
SET ABMDE=ABMR(41,380)_"^69^2"
+16 ; form locator #41d
DO WRT^ABMDF11W
End DoDot:1
+17 IF ABMR(41,390)
Begin DoDot:1
+18 ; Value amount 12
SET ABMDE=+ABMR(41,390)_"^72^9R"
+19 ; form locator #41d
DO WRT^ABMDF11W
End DoDot:1
+20 ;
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)),U,12)
+11 NEW 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 J'="ZZTOT"
SET ABMRV("ZZTOT")=ABMRV("ZZTOT")+$PIECE(ABMRV(I,J,L),U,6)
+21 ; Grand total noncovered charges
+22 IF J'="ZZTOT"
SET ABMRV("NCTOT")=ABMRV("NCTOT")+$PIECE(ABMRV(I,J,L),U,7)
+23 ; if not itemized bill and not done, accumulate totals
+24 IF 'ABMITMZ
IF J'="ZZTOT"
Begin DoDot:4
+25 ; IEN to REVENUE CODE
SET $PIECE(ABMRV(I,"ZZTOT",1),U)=I
+26 IF $DATA(ABMP("CPT"))
SET $PIECE(ABMRV(I,"ZZTOT",1),U,2)=ABMP("CPT")
+27 NEW K
+28 ; Accumulate totals per revenue code
+29 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)
+30 ; unit charge
SET $PIECE(ABMRV(I,"ZZTOT",1),U,8)=$PIECE(ABMRV(I,J,L),U,8)
+31 QUIT
End DoDot:4
+32 IF 'ABMITMZ
IF J'="ZZTOT"
QUIT
+33 ; If itemized and done, Q
IF ABMITMZ
IF J="ZZTOT"
QUIT
+34 WRITE !
+35 ; Count items
SET ABMCTR=ABMCTR+1
+36 ; If more than 22 items, complete bottom of form,
+37 ; then start a new page
+38 IF ABMCTR>22
Begin DoDot:4
+39 SET ABMORE=1
+40 NEW I,J
+41 DO 42
+42 DO ^ABMDF51Z
+43 WRITE $$EN^ABMVDF("IOF")
+44 NEW I,J
+45 DO 1^ABMDF51X
+46 KILL ABMORE
+47 NEW I
+48 FOR I=1:1:12
WRITE !
+49 SET ABMCTR=1
+50 QUIT
End DoDot:4
+51 ; If description is blank, get it from visit type in INSURER file
+52 IF $PIECE(ABMRV(I,J,L),U,9)=""
Begin DoDot:4
+53 SET ABMDE=$PIECE($GET(^ABMNINS(DUZ(2),ABMP("INS"),1,ABMP("VTYP"),0)),U,9)
+54 ; standard abbreviation
IF ABMDE=""
SET ABMDE=$PIECE($GET(^AUTTREVN(I,0)),U,2)
+55 ; Description
SET ABMDE=ABMDE_"^5^24"
+56 ; form locator #43
DO WRT^ABMDF11W
+57 QUIT
End DoDot:4
+58 ; If description, use it
+59 IF $PIECE(ABMRV(I,J,L),U,9)'=""
Begin DoDot:4
+60 ; Description
SET ABMDE=$PIECE(ABMRV(I,J,L),U,9)_"^5^24"
+61 ; form locator #43
DO WRT^ABMDF11W
+62 QUIT
End DoDot:4
+63 ; HCPCS/rates -- form locator #44
+64 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):$JUSTIFY($PIECE(ABMRV(I,J,L),U,8),1,2
)_"^30^9R",1:"")
+65 DO WRT^ABMDF11W
+66 SET ABMDE=$$MDY^ABMDUTL(ABMP("VDT"))_"^40^6"
+67 ;form locator #45
DO WRT^ABMDF11W
+68 ; Total units per item
SET ABMDE=$PIECE(ABMRV(I,J,L),U,5)_"^47^7R"
+69 ; form locator #46
DO WRT^ABMDF11W
+70 SET ABMDE=$FNUMBER($PIECE(ABMRV(I,J,L),U,6),"T",2)
+71 ; Total charges per item
SET ABMDE=$TRANSLATE(ABMDE,".")_"^55^10R"
+72 ; form locator #47
DO WRT^ABMDF11W
+73 SET ABMDE=$FNUMBER($PIECE(ABMRV(I,J,L),U,7),"T",2)
+74 IF +ABMDE
Begin DoDot:4
+75 ; Total noncover charges per item
SET ABMDE=$TRANSLATE(ABMDE,".")_"^66^10R"
+76 ; form locator #48
DO WRT^ABMDF11W
+77 QUIT
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+78 FOR
WRITE !
IF $Y>39
QUIT
+79 SET ABMDE="0001 TOTAL^^10"
+80 DO WRT^ABMDF11W
+81 ; Grand total
SET ABMDE=$TRANSLATE($FNUMBER(ABMRV("ZZTOT"),"T",2),".")_"^55^10R"
+82 ; last item in description section
DO WRT^ABMDF11W
+83 IF +ABMRV("NCTOT")
Begin DoDot:1
+84 SET ABMDE=$TRANSLATE($FNUMBER(ABMRV("NCTOT"),"T",2),".")_"^66^10R"
+85 ; Grand total - noncovered items
DO WRT^ABMDF11W
+86 QUIT
End DoDot:1
+87 NEW I
+88 KILL ABMRV
+89 ;
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 IF '$DATA(ABMREC(30,I))
QUIT
+8 WRITE !
SET ABMFLAG=I
+9 ; Insurer name_" "_Payor Sub Identification
+10 ;I $E(ABMREC(30,I),26,30)=61044 S ABMDE="O/P MEDI-CAL^^25" ;abm*2.6*21 IHS/SD/SDR HEAT123457
+11 ;abm*2.6*21 IHS/SD/SDR HEAT123457
IF $EXTRACT(ABMREC(30,I),26,30)["61044"
SET ABMDE="O/P MEDI-CAL^^25"
+12 IF '$TEST
SET ABMDE=$EXTRACT(ABMREC(30,I),54,78)_" "_$EXTRACT(ABMREC(30,I),31,34)_"^^25"
+13 ; form locator #50
DO WRT^ABMDF11W
+14 ; Provider ID (blank)
SET ABMDE=$EXTRACT(ABMREC(30,I),160,172)_"^26^13"
+15 ; form locator #51
DO WRT^ABMDF11W
+16 ; Release code
SET ABMDE=$EXTRACT(ABMREC(30,I),142)_"^40^1"
+17 ; form locator #52
DO WRT^ABMDF11W
+18 ; Ben Assgn Indicator
SET ABMDE=$EXTRACT(ABMREC(30,I),143)_"^43^1"
+19 ; form locator #53
DO WRT^ABMDF11W
+20 ; 3PB pymnt recieve
SET ABMDE=+$EXTRACT(ABMREC(30,I),173,182)_" ^45^10R"
+21 ; form locator #54
IF +ABMDE
DO WRT^ABMDF11W
+22 ; Est 3PB amt due
SET ABMDE=+$EXTRACT(ABMREC(30,I),183,192)_" ^56^10R"
+23 ; form locator #55
IF +ABMDE
DO WRT^ABMDF11W
End DoDot:1
+24 IF '$GET(ABMFLAG)
WRITE !
+25 WRITE !!
+26 KILL ABMR,ABMQUIT
+27 QUIT
