ABMEH61 ; IHS/ASDST/DMJ - HCFA-1500 EMC RECORD FA0 (Claim Root Segment) ;
;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
;
; IHS/ASDS/DMJ - 06/22/00 - Patch 3 - NOIS NHA-0600-180066
; AHCCCS denies Medicare zero pays.
;
; IHS/FCS/DRS - 09/17/01 - ABM*2.4*9
; Several fixes: Parts 1a,1b,5b,6,8,8f,13a,b,e,f,18
;
; IHS/SD/SDR - V2.5 P2 - 5/9/02 - NOIS HQW-0302-100190
; Modified to display 2nd and 3rd modifiers and units
;
; IHS/SD/SDR - v2.5 p10 - IM20395
; Split out lines bundled by rev code
;
START ;START HERE
K ABMR(61)
S ABME("S#")=0
D SET^ABMERUTL
K ABMP("FLAT") D FRATE^ABMDF11
D ^ABMEHGRV
D LOOP
K ABM,ABME,ABMRV
Q
LOOP ;LOOP HERE
S J=0 F S J=$O(ABMRV(J)) Q:'J D
.S K=0 F S K=$O(ABMRV(J,K)) Q:K="" D
..S L=0
..F S L=$O(ABMRV(J,K,L)) Q:L="" D
...K ABMREC(61)
...I $$ENVOY^ABMEF19 N ABMEH61 D
....N X S X=$P(ABMRV(J,K,L),U,7)
....S ABMEH61("RENDERING")=$S(X:X,1:ABMAPRV)
...S ABME("S#")=ABME("S#")+1
...F I=10:10:500 D
....D @I
....I $D(^ABMEXLM("AA",+$G(ABMP("INS")),+$G(ABMP("EXP")),61,I)) D @(^(I))
....D ADD
...Q:J=9999
...S ABM("ACTOT")=+$P(ABMRV(J,K,L),U,6)
...S ABM("NCTOT")=+$P(ABMRV(J,K,L),U,7)
...D ADTT^ABMER60
...S ABMEF("LINE")=ABMREC(61)
...D WRITE^ABMEF19
...S ABME("RTYPE")=61 D S90^ABMERUTL
...S ABMRT(95,"LTOT")=+$G(ABMRT(95,"LTOT"))+1
...I $$DOFB0 D
....D ^ABMEH62
...I $$DOFB1 D ^ABMEH63
Q
DOFB0() ; Should we do a FB0?
I J=23,'$G(ABMP("FLAT")) Q 1
I ABMP("VTYP")=50,$$RCID^ABMERUTL(ABMP("INS"))=99999 Q 1
Q 0
DOFB1() ; ABM*2.4*9 Part 1b - check for '$$ENVOY^ABMEF19
I '$$ENVOY^ABMEF19 Q 0
I $P(ABMRV(J,K,L),U,7) Q 1
I ABMAPRV Q 1
Q 0
ADD ;ADD TO RECORD
I '$G(ABMP("NOFMT")) S ABMREC(61)=$G(ABMREC(61))_ABMR(61,I)
Q
10 ;1-3 Record type
S ABMR(61,10)="FA0"
Q
20 ;4-5 Sequence
S ABMR(61,20)=ABME("S#")
S ABMR(61,20)=$$FMT^ABMERUTL(ABMR(61,20),"2NR")
Q
30 ;6-22 Patient Control Number
S ABMR(61,30)=ABMP("PCN")
S ABMR(61,30)=$$FMT^ABMERUTL(ABMR(61,30),17)
Q
40 ;23-39 Line Item Control #
S ABMR(61,40)=""
S ABMR(61,40)=$$FMT^ABMERUTL(ABMR(61,40),17)
Q
50 ;40-47 Service Date From
S ABMR(61,50)=$P(ABMRV(J,K,L),U,10)
S:ABMR(61,50)="" ABMR(61,50)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),7)),U)
S ABMR(61,50)=$$Y2KD2^ABMDUTL(ABMR(61,50))
S ABMR(61,50)=$$FMT^ABMERUTL(ABMR(61,50),8)
Q
60 ;48-55 Service Date To
S ABMR(61,60)=$P(ABMRV(J,K,L),U,10)
S:ABMR(61,60)="" ABMR(61,60)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),7)),"^",2)
S ABMR(61,60)=$$Y2KD2^ABMDUTL(ABMR(61,60))
S ABMR(61,60)=$$FMT^ABMERUTL(ABMR(61,60),8)
Q
70 ;56-57 Place of Service Code
S ABMR(61,70)=$$POS^ABMERUTL
S ABMR(61,70)=$$FMT^ABMERUTL(ABMR(61,70),2)
Q
80 ;58-59 Type of Service Code
I $$ENVOY^ABMEF19 D
.S ABMR(61,80)=$$TOS^ABMEH63 ;
E S ABMR(61,80)=$$TOS^ABMERUTL(J)
S ABMR(61,80)=$$FMT^ABMERUTL(ABMR(61,80),2)
Q
90 ;60-64 HCPCS Procedure Code
S ABMR(61,90)=$P(ABMRV(J,K,L),U,2)
S ABMR(61,90)=$$FMT^ABMERUTL(ABMR(61,90),5)
Q
100 ;65-66 Modifier 1
S ABMR(61,100)=$P(ABMRV(J,K,L),U,3)
S ABMR(61,100)=$$FMT^ABMERUTL(ABMR(61,100),2)
Q
110 ;67-68 Modifier 2
S ABMR(61,110)=$P(ABMRV(J,K,L),U,4)
S ABMR(61,110)=$$FMT^ABMERUTL(ABMR(61,110),2)
Q
120 ;69-70 Modifier 3
S ABMR(61,120)=$P(ABMRV(J,K,L),U,12)
S ABMR(61,120)=$$FMT^ABMERUTL(ABMR(61,120),2)
Q
130 ;71-77 Line Charges
S ABMR(61,130)=$P(ABMRV(J,K,L),U,6)
S ABMRT(90,"DTOT")=+$G(ABMRT(90,"DTOT"))+ABMR(61,130)
S ABMR(61,130)=$$FMT^ABMERUTL(ABMR(61,130),"7NRJ2")
Q
140 ;78-78 Diag Code Pointer 1
S ABMCDX=$P(ABMRV(J,K,L),U,11)
D
.; because there are only four diags stored in EA0 record (ABMEH40)
.N I F I=1:1:$L(ABMCDX,",") D
..N X S X=$P(ABMCDX,",",I) Q:'X
..I X>4 S $P(ABMCDX,",",I)="" Q
..; and also remove pointers to non-existent diags
..I '$D(^ABMDBILL(DUZ(2),ABMP("BDFN"),17,"C",X)) S $P(ABMCDX,",",I)=""
S:$P(ABMCDX,",")="" $P(ABMCDX,",")=1
S ABMR(61,140)=$P(ABMCDX,",",1)
S ABMR(61,140)=$$FMT^ABMERUTL(ABMR(61,140),1)
Q
150 ;79-79 Diag Code Pointer 2
S ABMR(61,150)=$P(ABMCDX,",",2)
S ABMR(61,150)=$$FMT^ABMERUTL(ABMR(61,150),1)
Q
160 ;80-80 Diag Code Pointer 3
S ABMR(61,160)=$P(ABMCDX,",",3)
S ABMR(61,160)=$$FMT^ABMERUTL(ABMR(61,160),1)
Q
170 ;81-81 Diag Code Pointer 4
S ABMR(61,170)=$P(ABMCDX,",",4)
S ABMR(61,170)=$$FMT^ABMERUTL(ABMR(61,170),1)
K ABMCDX
Q
180 ;82-85 Units of Service
S ABMR(61,180)=$P(ABMRV(J,K,L),U,5)
S ABMR(61,180)=$$FMT^ABMERUTL(ABMR(61,180),"4NRJ1")
Q
190 ;86-89 Anesthesia/Oxygen Min
S ABMR(61,190)=""
S ABMR(61,190)=$$FMT^ABMERUTL(ABMR(61,190),"4NR")
Q
200 ;90-90 Emergency Ind
S ABMR(61,200)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),8)),"^",5)
S:ABMR(61,200)="" ABMR(61,200)="N"
S ABMR(61,200)=$$FMT^ABMERUTL(ABMR(61,200),1)
Q
210 ;91-91 COB Ind
S ABMR(61,210)=""
S ABMR(61,210)=$$FMT^ABMERUTL(ABMR(61,210),1)
Q
220 ;92-92 HPSA Ind
S ABMR(61,220)=""
S ABMR(61,220)=$$FMT^ABMERUTL(ABMR(61,220),1)
Q
230 ;93-107 Rendering Prov ID
S ABMR(61,230)=""
; SSN/EIN it's supposed to be there,
; it's supposed to be SSN or EIN, even though spec has X(15) and
; mention of any such thing.
I $$ENVOY^ABMEF19 D
.I $G(ABMEH61("RENDERING")) D
..N X
..S X=$$SSN^ABMEEPRV(ABMEH61("RENDERING"))
..S X=$$FMT^ABMERUTL(X,"9S")
..S X=$J(+X,9)
..S X=$TR(X," ","0")
..S ABMR(61,230)=X
S ABMR(61,230)=$$FMT^ABMERUTL(ABMR(61,230),15)
Q
240 ;108-122 Referring Prov ID
S ABMR(61,240)=""
S ABMR(61,240)=$$FMT^ABMERUTL(ABMR(61,240),15)
Q
250 ;123-124 Referring Prov State
S ABMR(61,250)=""
S ABMR(61,250)=$$FMT^ABMERUTL(ABMR(61,250),2)
Q
260 ;125-125 Pur Svc Ind
S ABMR(61,260)=""
S ABMR(61,260)=$$FMT^ABMERUTL(ABMR(61,260),1)
Q
270 ;126-132 Disallowed Cost Cont
S ABMR(61,270)=""
S ABMR(61,270)=$$FMT^ABMERUTL(ABMR(61,270),"7NRJ2")
Q
280 ;133-139 Disallowed Other
S ABMR(61,280)=""
S ABMR(61,280)=$$FMT^ABMERUTL(ABMR(61,280),"7NRJ2")
Q
290 ;140-140 Review By Code Ind
S ABMR(61,290)=""
S ABMR(61,290)=$$FMT^ABMERUTL(ABMR(61,290),1)
Q
300 ;141-141 Multi Procedure Ind
S ABMR(61,300)=""
S ABMR(61,300)=$$FMT^ABMERUTL(ABMR(61,300),1)
Q
310 ;142-151 Mammography Cert No
S ABMR(61,310)=""
S ABMR(61,310)=$$FMT^ABMERUTL(ABMR(61,310),10)
Q
320 ;152-160 Class Findings
S ABMR(61,320)=""
S ABMR(61,320)=$$FMT^ABMERUTL(ABMR(61,320),9)
Q
330 ;161-163 Podiatry Svc Cond
S ABMR(61,330)=""
S ABMR(61,330)=$$FMT^ABMERUTL(ABMR(61,330),3)
Q
340 ;164-178 CLIA ID #
S ABMR(61,340)=""
S ABMR(61,340)=$$FMT^ABMERUTL(ABMR(61,340),15)
Q
350 ;179-185 Primary Paid Amount (Other Insurance)
S ABMR(61,350)=""
S ABMR(61,350)=$$FMT^ABMERUTL(ABMR(61,350),"7NRJ2")
Q
360 ;186-187 HCPCS Modifier 4
S ABMR(61,360)=""
S ABMR(61,360)=$$FMT^ABMERUTL(ABMR(61,360),2)
Q
370 ;188-190 Provider Specialty
S ABMR(61,370)=""
S ABMR(61,370)=$$FMT^ABMERUTL(ABMR(61,370),3)
Q
380 ;191-191 Podiatry Therapy Ind
S ABMR(61,380)=""
S ABMR(61,380)=$$FMT^ABMERUTL(ABMR(61,380),1)
Q
390 ;192-192 Podiatry Therapy Type
S ABMR(61,390)=""
S ABMR(61,390)=$$FMT^ABMERUTL(ABMR(61,390),1)
Q
400 ;193-193 Hospice Employed Prov Ind
S ABMR(61,400)=""
S ABMR(61,400)=$$FMT^ABMERUTL(ABMR(61,400),1)
Q
410 ;194-201 HGB/HCT Date
S ABMR(61,410)=""
S ABMR(61,410)=$$FMT^ABMERUTL(ABMR(61,410),8)
Q
420 ;202-204 HGB Result
S ABMR(61,420)=""
S ABMR(61,420)=$$FMT^ABMERUTL(ABMR(61,420),"3NR")
Q
430 ;205-206 HCT Result
S ABMR(61,430)=""
S ABMR(61,430)=$$FMT^ABMERUTL(ABMR(61,430),"2NR")
Q
440 ;207-209 Patient Weight
S ABMR(61,440)=""
S ABMR(61,440)=$$FMT^ABMERUTL(ABMR(61,440),"3NR")
Q
450 ;210-212 EPO Dosage
S ABMR(61,450)=""
S ABMR(61,450)=$$FMT^ABMERUTL(ABMR(61,450),"3NR")
Q
460 ;213-220 Serum Creatine Date
S ABMR(61,460)=""
S ABMR(61,460)=$$FMT^ABMERUTL(ABMR(61,460),8)
Q
470 ;221-223 Creatine Result
S ABMR(61,470)=""
S ABMR(61,470)=$$FMT^ABMERUTL(ABMR(61,470),"3NR")
Q
480 ;224-230 Obligated Accept Amt
S ABMR(61,480)=""
S ABMR(61,480)=$$FMT^ABMERUTL(ABMR(61,480),"7NRJ2")
Q
490 ;231-237 Drug Discount Amt
S ABMR(61,490)=""
S ABMR(61,490)=$$FMT^ABMERUTL(ABMR(61,490),"7NRJ2")
Q
500 ;238-320 Filler (National)
S ABMR(61,500)=""
S ABMR(61,500)=$$FMT^ABMERUTL(ABMR(61,500),83)
; TYPE OF SERVICE X(3) POSITIONS 238-240
; An Envoy-specific extension required by some payers.
; We use the two-character standard Type of Service code and fill the
; third space with a blank.
I $$ENVOY^ABMEF19 D
.S $E(ABMR(61,500),1,3)=ABMR(61,80)_" "
Q
EX(ABMX,ABMY,ABMZ) ;EXTRINSIC FUNCTION HERE
;X=data element, Y=bill internal entry number
S ABMP("BDFN")=ABMY D SET^ABMERUTL
I '$G(ABMP("NOFMT")) S ABMP("FMT")=0
D @ABMX
S Y=ABMR(61,ABMX)
I $D(ABMP("FMT")) S ABMP("FMT")=1
K ABMR(61,ABMX),ABME,ABMX,ABMY,ABMZ,ABM
Q Y
ABMEH61 ; IHS/ASDST/DMJ - HCFA-1500 EMC RECORD FA0 (Claim Root Segment) ;
+1 ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
+2 ;
+3 ; IHS/ASDS/DMJ - 06/22/00 - Patch 3 - NOIS NHA-0600-180066
+4 ; AHCCCS denies Medicare zero pays.
+5 ;
+6 ; IHS/FCS/DRS - 09/17/01 - ABM*2.4*9
+7 ; Several fixes: Parts 1a,1b,5b,6,8,8f,13a,b,e,f,18
+8 ;
+9 ; IHS/SD/SDR - V2.5 P2 - 5/9/02 - NOIS HQW-0302-100190
+10 ; Modified to display 2nd and 3rd modifiers and units
+11 ;
+12 ; IHS/SD/SDR - v2.5 p10 - IM20395
+13 ; Split out lines bundled by rev code
+14 ;
START ;START HERE
+1 KILL ABMR(61)
+2 SET ABME("S#")=0
+3 DO SET^ABMERUTL
+4 KILL ABMP("FLAT")
DO FRATE^ABMDF11
+5 DO ^ABMEHGRV
+6 DO LOOP
+7 KILL ABM,ABME,ABMRV
+8 QUIT
LOOP ;LOOP HERE
+1 SET J=0
FOR
SET J=$ORDER(ABMRV(J))
IF 'J
QUIT
Begin DoDot:1
+2 SET K=0
FOR
SET K=$ORDER(ABMRV(J,K))
IF K=""
QUIT
Begin DoDot:2
+3 SET L=0
+4 FOR
SET L=$ORDER(ABMRV(J,K,L))
IF L=""
QUIT
Begin DoDot:3
+5 KILL ABMREC(61)
+6 IF $$ENVOY^ABMEF19
NEW ABMEH61
Begin DoDot:4
+7 NEW X
SET X=$PIECE(ABMRV(J,K,L),U,7)
+8 SET ABMEH61("RENDERING")=$SELECT(X:X,1:ABMAPRV)
End DoDot:4
+9 SET ABME("S#")=ABME("S#")+1
+10 FOR I=10:10:500
Begin DoDot:4
+11 DO @I
+12 IF $DATA(^ABMEXLM("AA",+$GET(ABMP("INS")),+$GET(ABMP("EXP")),61,I))
DO @(^(I))
+13 DO ADD
End DoDot:4
+14 IF J=9999
QUIT
+15 SET ABM("ACTOT")=+$PIECE(ABMRV(J,K,L),U,6)
+16 SET ABM("NCTOT")=+$PIECE(ABMRV(J,K,L),U,7)
+17 DO ADTT^ABMER60
+18 SET ABMEF("LINE")=ABMREC(61)
+19 DO WRITE^ABMEF19
+20 SET ABME("RTYPE")=61
DO S90^ABMERUTL
+21 SET ABMRT(95,"LTOT")=+$GET(ABMRT(95,"LTOT"))+1
+22 IF $$DOFB0
Begin DoDot:4
+23 DO ^ABMEH62
End DoDot:4
+24 IF $$DOFB1
DO ^ABMEH63
End DoDot:3
End DoDot:2
End DoDot:1
+25 QUIT
DOFB0() ; Should we do a FB0?
+1 IF J=23
IF '$GET(ABMP("FLAT"))
QUIT 1
+2 IF ABMP("VTYP")=50
IF $$RCID^ABMERUTL(ABMP("INS"))=99999
QUIT 1
+3 QUIT 0
DOFB1() ; ABM*2.4*9 Part 1b - check for '$$ENVOY^ABMEF19
+1 IF '$$ENVOY^ABMEF19
QUIT 0
+2 IF $PIECE(ABMRV(J,K,L),U,7)
QUIT 1
+3 IF ABMAPRV
QUIT 1
+4 QUIT 0
ADD ;ADD TO RECORD
+1 IF '$GET(ABMP("NOFMT"))
SET ABMREC(61)=$GET(ABMREC(61))_ABMR(61,I)
+2 QUIT
10 ;1-3 Record type
+1 SET ABMR(61,10)="FA0"
+2 QUIT
20 ;4-5 Sequence
+1 SET ABMR(61,20)=ABME("S#")
+2 SET ABMR(61,20)=$$FMT^ABMERUTL(ABMR(61,20),"2NR")
+3 QUIT
30 ;6-22 Patient Control Number
+1 SET ABMR(61,30)=ABMP("PCN")
+2 SET ABMR(61,30)=$$FMT^ABMERUTL(ABMR(61,30),17)
+3 QUIT
40 ;23-39 Line Item Control #
+1 SET ABMR(61,40)=""
+2 SET ABMR(61,40)=$$FMT^ABMERUTL(ABMR(61,40),17)
+3 QUIT
50 ;40-47 Service Date From
+1 SET ABMR(61,50)=$PIECE(ABMRV(J,K,L),U,10)
+2 IF ABMR(61,50)=""
SET ABMR(61,50)=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),7)),U)
+3 SET ABMR(61,50)=$$Y2KD2^ABMDUTL(ABMR(61,50))
+4 SET ABMR(61,50)=$$FMT^ABMERUTL(ABMR(61,50),8)
+5 QUIT
60 ;48-55 Service Date To
+1 SET ABMR(61,60)=$PIECE(ABMRV(J,K,L),U,10)
+2 IF ABMR(61,60)=""
SET ABMR(61,60)=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),7)),"^",2)
+3 SET ABMR(61,60)=$$Y2KD2^ABMDUTL(ABMR(61,60))
+4 SET ABMR(61,60)=$$FMT^ABMERUTL(ABMR(61,60),8)
+5 QUIT
70 ;56-57 Place of Service Code
+1 SET ABMR(61,70)=$$POS^ABMERUTL
+2 SET ABMR(61,70)=$$FMT^ABMERUTL(ABMR(61,70),2)
+3 QUIT
80 ;58-59 Type of Service Code
+1 IF $$ENVOY^ABMEF19
Begin DoDot:1
+2 ;
SET ABMR(61,80)=$$TOS^ABMEH63
End DoDot:1
+3 IF '$TEST
SET ABMR(61,80)=$$TOS^ABMERUTL(J)
+4 SET ABMR(61,80)=$$FMT^ABMERUTL(ABMR(61,80),2)
+5 QUIT
90 ;60-64 HCPCS Procedure Code
+1 SET ABMR(61,90)=$PIECE(ABMRV(J,K,L),U,2)
+2 SET ABMR(61,90)=$$FMT^ABMERUTL(ABMR(61,90),5)
+3 QUIT
100 ;65-66 Modifier 1
+1 SET ABMR(61,100)=$PIECE(ABMRV(J,K,L),U,3)
+2 SET ABMR(61,100)=$$FMT^ABMERUTL(ABMR(61,100),2)
+3 QUIT
110 ;67-68 Modifier 2
+1 SET ABMR(61,110)=$PIECE(ABMRV(J,K,L),U,4)
+2 SET ABMR(61,110)=$$FMT^ABMERUTL(ABMR(61,110),2)
+3 QUIT
120 ;69-70 Modifier 3
+1 SET ABMR(61,120)=$PIECE(ABMRV(J,K,L),U,12)
+2 SET ABMR(61,120)=$$FMT^ABMERUTL(ABMR(61,120),2)
+3 QUIT
130 ;71-77 Line Charges
+1 SET ABMR(61,130)=$PIECE(ABMRV(J,K,L),U,6)
+2 SET ABMRT(90,"DTOT")=+$GET(ABMRT(90,"DTOT"))+ABMR(61,130)
+3 SET ABMR(61,130)=$$FMT^ABMERUTL(ABMR(61,130),"7NRJ2")
+4 QUIT
140 ;78-78 Diag Code Pointer 1
+1 SET ABMCDX=$PIECE(ABMRV(J,K,L),U,11)
+2 Begin DoDot:1
+3 ; because there are only four diags stored in EA0 record (ABMEH40)
+4 NEW I
FOR I=1:1:$LENGTH(ABMCDX,",")
Begin DoDot:2
+5 NEW X
SET X=$PIECE(ABMCDX,",",I)
IF 'X
QUIT
+6 IF X>4
SET $PIECE(ABMCDX,",",I)=""
QUIT
+7 ; and also remove pointers to non-existent diags
+8 IF '$DATA(^ABMDBILL(DUZ(2),ABMP("BDFN"),17,"C",X))
SET $PIECE(ABMCDX,",",I)=""
End DoDot:2
End DoDot:1
+9 IF $PIECE(ABMCDX,",")=""
SET $PIECE(ABMCDX,",")=1
+10 SET ABMR(61,140)=$PIECE(ABMCDX,",",1)
+11 SET ABMR(61,140)=$$FMT^ABMERUTL(ABMR(61,140),1)
+12 QUIT
150 ;79-79 Diag Code Pointer 2
+1 SET ABMR(61,150)=$PIECE(ABMCDX,",",2)
+2 SET ABMR(61,150)=$$FMT^ABMERUTL(ABMR(61,150),1)
+3 QUIT
160 ;80-80 Diag Code Pointer 3
+1 SET ABMR(61,160)=$PIECE(ABMCDX,",",3)
+2 SET ABMR(61,160)=$$FMT^ABMERUTL(ABMR(61,160),1)
+3 QUIT
170 ;81-81 Diag Code Pointer 4
+1 SET ABMR(61,170)=$PIECE(ABMCDX,",",4)
+2 SET ABMR(61,170)=$$FMT^ABMERUTL(ABMR(61,170),1)
+3 KILL ABMCDX
+4 QUIT
180 ;82-85 Units of Service
+1 SET ABMR(61,180)=$PIECE(ABMRV(J,K,L),U,5)
+2 SET ABMR(61,180)=$$FMT^ABMERUTL(ABMR(61,180),"4NRJ1")
+3 QUIT
190 ;86-89 Anesthesia/Oxygen Min
+1 SET ABMR(61,190)=""
+2 SET ABMR(61,190)=$$FMT^ABMERUTL(ABMR(61,190),"4NR")
+3 QUIT
200 ;90-90 Emergency Ind
+1 SET ABMR(61,200)=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),8)),"^",5)
+2 IF ABMR(61,200)=""
SET ABMR(61,200)="N"
+3 SET ABMR(61,200)=$$FMT^ABMERUTL(ABMR(61,200),1)
+4 QUIT
210 ;91-91 COB Ind
+1 SET ABMR(61,210)=""
+2 SET ABMR(61,210)=$$FMT^ABMERUTL(ABMR(61,210),1)
+3 QUIT
220 ;92-92 HPSA Ind
+1 SET ABMR(61,220)=""
+2 SET ABMR(61,220)=$$FMT^ABMERUTL(ABMR(61,220),1)
+3 QUIT
230 ;93-107 Rendering Prov ID
+1 SET ABMR(61,230)=""
+2 ; SSN/EIN it's supposed to be there,
+3 ; it's supposed to be SSN or EIN, even though spec has X(15) and
+4 ; mention of any such thing.
+5 IF $$ENVOY^ABMEF19
Begin DoDot:1
+6 IF $GET(ABMEH61("RENDERING"))
Begin DoDot:2
+7 NEW X
+8 SET X=$$SSN^ABMEEPRV(ABMEH61("RENDERING"))
+9 SET X=$$FMT^ABMERUTL(X,"9S")
+10 SET X=$JUSTIFY(+X,9)
+11 SET X=$TRANSLATE(X," ","0")
+12 SET ABMR(61,230)=X
End DoDot:2
End DoDot:1
+13 SET ABMR(61,230)=$$FMT^ABMERUTL(ABMR(61,230),15)
+14 QUIT
240 ;108-122 Referring Prov ID
+1 SET ABMR(61,240)=""
+2 SET ABMR(61,240)=$$FMT^ABMERUTL(ABMR(61,240),15)
+3 QUIT
250 ;123-124 Referring Prov State
+1 SET ABMR(61,250)=""
+2 SET ABMR(61,250)=$$FMT^ABMERUTL(ABMR(61,250),2)
+3 QUIT
260 ;125-125 Pur Svc Ind
+1 SET ABMR(61,260)=""
+2 SET ABMR(61,260)=$$FMT^ABMERUTL(ABMR(61,260),1)
+3 QUIT
270 ;126-132 Disallowed Cost Cont
+1 SET ABMR(61,270)=""
+2 SET ABMR(61,270)=$$FMT^ABMERUTL(ABMR(61,270),"7NRJ2")
+3 QUIT
280 ;133-139 Disallowed Other
+1 SET ABMR(61,280)=""
+2 SET ABMR(61,280)=$$FMT^ABMERUTL(ABMR(61,280),"7NRJ2")
+3 QUIT
290 ;140-140 Review By Code Ind
+1 SET ABMR(61,290)=""
+2 SET ABMR(61,290)=$$FMT^ABMERUTL(ABMR(61,290),1)
+3 QUIT
300 ;141-141 Multi Procedure Ind
+1 SET ABMR(61,300)=""
+2 SET ABMR(61,300)=$$FMT^ABMERUTL(ABMR(61,300),1)
+3 QUIT
310 ;142-151 Mammography Cert No
+1 SET ABMR(61,310)=""
+2 SET ABMR(61,310)=$$FMT^ABMERUTL(ABMR(61,310),10)
+3 QUIT
320 ;152-160 Class Findings
+1 SET ABMR(61,320)=""
+2 SET ABMR(61,320)=$$FMT^ABMERUTL(ABMR(61,320),9)
+3 QUIT
330 ;161-163 Podiatry Svc Cond
+1 SET ABMR(61,330)=""
+2 SET ABMR(61,330)=$$FMT^ABMERUTL(ABMR(61,330),3)
+3 QUIT
340 ;164-178 CLIA ID #
+1 SET ABMR(61,340)=""
+2 SET ABMR(61,340)=$$FMT^ABMERUTL(ABMR(61,340),15)
+3 QUIT
350 ;179-185 Primary Paid Amount (Other Insurance)
+1 SET ABMR(61,350)=""
+2 SET ABMR(61,350)=$$FMT^ABMERUTL(ABMR(61,350),"7NRJ2")
+3 QUIT
360 ;186-187 HCPCS Modifier 4
+1 SET ABMR(61,360)=""
+2 SET ABMR(61,360)=$$FMT^ABMERUTL(ABMR(61,360),2)
+3 QUIT
370 ;188-190 Provider Specialty
+1 SET ABMR(61,370)=""
+2 SET ABMR(61,370)=$$FMT^ABMERUTL(ABMR(61,370),3)
+3 QUIT
380 ;191-191 Podiatry Therapy Ind
+1 SET ABMR(61,380)=""
+2 SET ABMR(61,380)=$$FMT^ABMERUTL(ABMR(61,380),1)
+3 QUIT
390 ;192-192 Podiatry Therapy Type
+1 SET ABMR(61,390)=""
+2 SET ABMR(61,390)=$$FMT^ABMERUTL(ABMR(61,390),1)
+3 QUIT
400 ;193-193 Hospice Employed Prov Ind
+1 SET ABMR(61,400)=""
+2 SET ABMR(61,400)=$$FMT^ABMERUTL(ABMR(61,400),1)
+3 QUIT
410 ;194-201 HGB/HCT Date
+1 SET ABMR(61,410)=""
+2 SET ABMR(61,410)=$$FMT^ABMERUTL(ABMR(61,410),8)
+3 QUIT
420 ;202-204 HGB Result
+1 SET ABMR(61,420)=""
+2 SET ABMR(61,420)=$$FMT^ABMERUTL(ABMR(61,420),"3NR")
+3 QUIT
430 ;205-206 HCT Result
+1 SET ABMR(61,430)=""
+2 SET ABMR(61,430)=$$FMT^ABMERUTL(ABMR(61,430),"2NR")
+3 QUIT
440 ;207-209 Patient Weight
+1 SET ABMR(61,440)=""
+2 SET ABMR(61,440)=$$FMT^ABMERUTL(ABMR(61,440),"3NR")
+3 QUIT
450 ;210-212 EPO Dosage
+1 SET ABMR(61,450)=""
+2 SET ABMR(61,450)=$$FMT^ABMERUTL(ABMR(61,450),"3NR")
+3 QUIT
460 ;213-220 Serum Creatine Date
+1 SET ABMR(61,460)=""
+2 SET ABMR(61,460)=$$FMT^ABMERUTL(ABMR(61,460),8)
+3 QUIT
470 ;221-223 Creatine Result
+1 SET ABMR(61,470)=""
+2 SET ABMR(61,470)=$$FMT^ABMERUTL(ABMR(61,470),"3NR")
+3 QUIT
480 ;224-230 Obligated Accept Amt
+1 SET ABMR(61,480)=""
+2 SET ABMR(61,480)=$$FMT^ABMERUTL(ABMR(61,480),"7NRJ2")
+3 QUIT
490 ;231-237 Drug Discount Amt
+1 SET ABMR(61,490)=""
+2 SET ABMR(61,490)=$$FMT^ABMERUTL(ABMR(61,490),"7NRJ2")
+3 QUIT
500 ;238-320 Filler (National)
+1 SET ABMR(61,500)=""
+2 SET ABMR(61,500)=$$FMT^ABMERUTL(ABMR(61,500),83)
+3 ; TYPE OF SERVICE X(3) POSITIONS 238-240
+4 ; An Envoy-specific extension required by some payers.
+5 ; We use the two-character standard Type of Service code and fill the
+6 ; third space with a blank.
+7 IF $$ENVOY^ABMEF19
Begin DoDot:1
+8 SET $EXTRACT(ABMR(61,500),1,3)=ABMR(61,80)_" "
End DoDot:1
+9 QUIT
EX(ABMX,ABMY,ABMZ) ;EXTRINSIC FUNCTION HERE
+1 ;X=data element, Y=bill internal entry number
+2 SET ABMP("BDFN")=ABMY
DO SET^ABMERUTL
+3 IF '$GET(ABMP("NOFMT"))
SET ABMP("FMT")=0
+4 DO @ABMX
+5 SET Y=ABMR(61,ABMX)
+6 IF $DATA(ABMP("FMT"))
SET ABMP("FMT")=1
+7 KILL ABMR(61,ABMX),ABME,ABMX,ABMY,ABMZ,ABM
+8 QUIT Y
