ABMER60 ; IHS/ASDST/DMJ - UB92 EMC RECORD 60 (Inpatient Ancillary Services) ;
;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
;Original;DMJ;07/08/96 4:56 PM
;
; IHS/FCS/DRS 09/17/01 ABM*2.4*9
; Part 17 - Proper init of ancillary charges slots.
; They demand that even unused slots have 0 in numeric bytes,
; not spaces.
;
; IHS/SD/SDR - v2.5 p10 - IM20395
; Split out lines bundled by rev code
;
START ;START HERE
K ABMR(60),ABMREC(60)
S ABME("RTYPE")=60,ABME("S#")=0
S $P(ABME("SPACE1")," ",113)=""
S $P(ABME("SPACE2")," ",57)=""
I $$ENVOY^ABMEF16 D
.N X S X="0000 000000000000000000000000000 000000 "
.S ABME("SPACE1")=X_X,ABME("SPACE2")=X
D SET^ABMERUTL
K ABMP("FLAT") D FRATE^ABMDF11
D ^ABMERGRV
D LOOP
S L=0 F S L=$O(ABMREC(60,L)) Q:'L D S90^ABMERUTL
K ABM,ABME,ABMRV
Q
;
LOOP ;LOOP HERE
I $$RCID^ABMERUTL(ABMP("INS"))["MAD" D
.K ABMRV(9999)
S L=0
S J=219 F S J=$O(ABMRV(J)) Q:'J D
.S K=-1 F S K=$O(ABMRV(J,K)) Q:K="" D
..S M=0
..F S M=$O(ABMRV(J,K,M)) Q:M="" D
...S L=L+1 I L#3=1 D
....S ABME("S#")=ABME("S#")+1
....F I=10:10:30 D @(I_"^ABMER60"),ADD
...F I=40:10:120 D @(I_"^ABMER60"),ADD
...Q:J=9999
...S ABM("ACTOT")=+$P(ABMRV(J,K,M),U,6)
...S ABM("NCTOT")=+$P(ABMRV(J,K,M),U,7)
...D ADTT
I '$G(ABMP("NOFMT")) S ABMREC(60,ABME("S#"))=ABMREC(60,ABME("S#"))_$S(L#3=1:ABME("SPACE1"),L#3=2:ABME("SPACE2"),1:"")
Q
;
ADD ;ADD TO RECORD
I '$G(ABMP("NOFMT")) S ABMREC(60,ABME("S#"))=$G(ABMREC(60,ABME("S#")))_ABMR(60,I)
Q
;
10 ;Record type
S ABMR(60,10)=60
Q
;
20 ;Sequence
S ABMR(60,20)=ABME("S#")
S ABMR(60,20)=$$FMT^ABMERUTL(ABMR(60,20),"2NR")
Q
;
30 ;Patient Control Number, (SOURCE: FILE=9000001.41,FIELD=.02)
S ABMR(60,30)=$$EX^ABMER20(30,ABMP("BDFN"))
S ABMR(60,30)=$$FMT^ABMERUTL(ABMR(60,30),20)
Q
;
40 ;Outpatient Revenue Code 1 (SOURCE: FILE=, FIELD=)
S ABMR(60,40)=$P(ABMRV(J,K,M),U)
S ABMR(60,40)=$$FMT^ABMERUTL(ABMR(60,40),"4NR")
Q
;
50 ;HCPCS Procedure Code 1
S ABMR(60,50)=$P(ABMRV(J,K,M),U,2)
S ABMR(60,50)=$$FMT^ABMERUTL(ABMR(60,50),5)
Q
;
60 ;Modifier 1 (CPT-4 and HCPCS) 1 (SOURCE: FILE=, FIELD=)
S ABMR(60,60)=$P(ABMRV(J,K,M),U,3)
S ABMR(60,60)=$$FMT^ABMERUTL(ABMR(60,60),2)
Q
;
70 ;Modifier 2 (CPT-4 and HCPCS) 1 (SOURCE: FILE=, FIELD=)
S ABMR(60,70)=$P(ABMRV(J,K,M),U,4)
S ABMR(60,70)=$$FMT^ABMERUTL(ABMR(60,70),2)
Q
;
80 ;Units of Service 1 (SOURCE: FILE= FIELD=)
S ABMR(60,80)=$P(ABMRV(J,K,M),U,5)
S ABMR(60,80)=$$FMT^ABMERUTL(ABMR(60,80),"7NR")
Q
;
90 ;Charges Total 1 (SOURCE: FILE= FIELD=)
S ABMR(60,90)=$P(ABMRV(J,K,M),U,6)
S ABMR(60,90)=$$FMT^ABMERUTL(ABMR(60,90),"10NRJ2")
Q
;
100 ;Charges Non-Covered 1
S ABMR(60,100)=""
S ABMR(60,100)=$$FMT^ABMERUTL(ABMR(60,100),"10NRJ2")
Q
;
110 ;Form Locator 49 1 (SOURCE: FILE= FIELD=)
S ABMR(60,110)=""
S ABMR(60,110)=$$FMT^ABMERUTL(ABMR(60,110),4)
Q
;
120 ;Filler (National Use)
S ABMR(60,120)=""
S ABMR(60,120)=$$FMT^ABMERUTL(ABMR(60,120),12)
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(60,ABMX)
I $D(ABMP("FMT")) S ABMP("FMT")=1
K ABMR(60,ABMX),ABME,ABMX,ABMY,ABMZ,ABM
Q Y
;
ADTT ; EP
; Add to totals
S ABMRT(90,150)=+$G(ABMRT(90,150))+ABM("ACTOT")
S ABMRT(90,160)=+$G(ABMRT(90,160))+ABM("NCTOT")
S ABMRT(95,100)=+$G(ABMRT(95,100))+ABM("ACTOT")
S ABMRT(95,110)=+$G(ABMRT(95,110))+ABM("NCTOT")
S ABMRT(99,80)=+$G(ABMRT(99,80))+ABM("ACTOT")
S ABMRT(99,90)=+$G(ABMRT(99,90))+ABM("NCTOT")
Q
ABMER60 ; IHS/ASDST/DMJ - UB92 EMC RECORD 60 (Inpatient Ancillary Services) ;
+1 ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
+2 ;Original;DMJ;07/08/96 4:56 PM
+3 ;
+4 ; IHS/FCS/DRS 09/17/01 ABM*2.4*9
+5 ; Part 17 - Proper init of ancillary charges slots.
+6 ; They demand that even unused slots have 0 in numeric bytes,
+7 ; not spaces.
+8 ;
+9 ; IHS/SD/SDR - v2.5 p10 - IM20395
+10 ; Split out lines bundled by rev code
+11 ;
START ;START HERE
+1 KILL ABMR(60),ABMREC(60)
+2 SET ABME("RTYPE")=60
SET ABME("S#")=0
+3 SET $PIECE(ABME("SPACE1")," ",113)=""
+4 SET $PIECE(ABME("SPACE2")," ",57)=""
+5 IF $$ENVOY^ABMEF16
Begin DoDot:1
+6 NEW X
SET X="0000 000000000000000000000000000 000000 "
+7 SET ABME("SPACE1")=X_X
SET ABME("SPACE2")=X
End DoDot:1
+8 DO SET^ABMERUTL
+9 KILL ABMP("FLAT")
DO FRATE^ABMDF11
+10 DO ^ABMERGRV
+11 DO LOOP
+12 SET L=0
FOR
SET L=$ORDER(ABMREC(60,L))
IF 'L
QUIT
DO S90^ABMERUTL
+13 KILL ABM,ABME,ABMRV
+14 QUIT
+15 ;
LOOP ;LOOP HERE
+1 IF $$RCID^ABMERUTL(ABMP("INS"))["MAD"
Begin DoDot:1
+2 KILL ABMRV(9999)
End DoDot:1
+3 SET L=0
+4 SET J=219
FOR
SET J=$ORDER(ABMRV(J))
IF 'J
QUIT
Begin DoDot:1
+5 SET K=-1
FOR
SET K=$ORDER(ABMRV(J,K))
IF K=""
QUIT
Begin DoDot:2
+6 SET M=0
+7 FOR
SET M=$ORDER(ABMRV(J,K,M))
IF M=""
QUIT
Begin DoDot:3
+8 SET L=L+1
IF L#3=1
Begin DoDot:4
+9 SET ABME("S#")=ABME("S#")+1
+10 FOR I=10:10:30
DO @(I_"^ABMER60")
DO ADD
End DoDot:4
+11 FOR I=40:10:120
DO @(I_"^ABMER60")
DO ADD
+12 IF J=9999
QUIT
+13 SET ABM("ACTOT")=+$PIECE(ABMRV(J,K,M),U,6)
+14 SET ABM("NCTOT")=+$PIECE(ABMRV(J,K,M),U,7)
+15 DO ADTT
End DoDot:3
End DoDot:2
End DoDot:1
+16 IF '$GET(ABMP("NOFMT"))
SET ABMREC(60,ABME("S#"))=ABMREC(60,ABME("S#"))_$SELECT(L#3=1:ABME("SPACE1"),L#3=2:ABME("SPACE2"),1:"")
+17 QUIT
+18 ;
ADD ;ADD TO RECORD
+1 IF '$GET(ABMP("NOFMT"))
SET ABMREC(60,ABME("S#"))=$GET(ABMREC(60,ABME("S#")))_ABMR(60,I)
+2 QUIT
+3 ;
10 ;Record type
+1 SET ABMR(60,10)=60
+2 QUIT
+3 ;
20 ;Sequence
+1 SET ABMR(60,20)=ABME("S#")
+2 SET ABMR(60,20)=$$FMT^ABMERUTL(ABMR(60,20),"2NR")
+3 QUIT
+4 ;
30 ;Patient Control Number, (SOURCE: FILE=9000001.41,FIELD=.02)
+1 SET ABMR(60,30)=$$EX^ABMER20(30,ABMP("BDFN"))
+2 SET ABMR(60,30)=$$FMT^ABMERUTL(ABMR(60,30),20)
+3 QUIT
+4 ;
40 ;Outpatient Revenue Code 1 (SOURCE: FILE=, FIELD=)
+1 SET ABMR(60,40)=$PIECE(ABMRV(J,K,M),U)
+2 SET ABMR(60,40)=$$FMT^ABMERUTL(ABMR(60,40),"4NR")
+3 QUIT
+4 ;
50 ;HCPCS Procedure Code 1
+1 SET ABMR(60,50)=$PIECE(ABMRV(J,K,M),U,2)
+2 SET ABMR(60,50)=$$FMT^ABMERUTL(ABMR(60,50),5)
+3 QUIT
+4 ;
60 ;Modifier 1 (CPT-4 and HCPCS) 1 (SOURCE: FILE=, FIELD=)
+1 SET ABMR(60,60)=$PIECE(ABMRV(J,K,M),U,3)
+2 SET ABMR(60,60)=$$FMT^ABMERUTL(ABMR(60,60),2)
+3 QUIT
+4 ;
70 ;Modifier 2 (CPT-4 and HCPCS) 1 (SOURCE: FILE=, FIELD=)
+1 SET ABMR(60,70)=$PIECE(ABMRV(J,K,M),U,4)
+2 SET ABMR(60,70)=$$FMT^ABMERUTL(ABMR(60,70),2)
+3 QUIT
+4 ;
80 ;Units of Service 1 (SOURCE: FILE= FIELD=)
+1 SET ABMR(60,80)=$PIECE(ABMRV(J,K,M),U,5)
+2 SET ABMR(60,80)=$$FMT^ABMERUTL(ABMR(60,80),"7NR")
+3 QUIT
+4 ;
90 ;Charges Total 1 (SOURCE: FILE= FIELD=)
+1 SET ABMR(60,90)=$PIECE(ABMRV(J,K,M),U,6)
+2 SET ABMR(60,90)=$$FMT^ABMERUTL(ABMR(60,90),"10NRJ2")
+3 QUIT
+4 ;
100 ;Charges Non-Covered 1
+1 SET ABMR(60,100)=""
+2 SET ABMR(60,100)=$$FMT^ABMERUTL(ABMR(60,100),"10NRJ2")
+3 QUIT
+4 ;
110 ;Form Locator 49 1 (SOURCE: FILE= FIELD=)
+1 SET ABMR(60,110)=""
+2 SET ABMR(60,110)=$$FMT^ABMERUTL(ABMR(60,110),4)
+3 QUIT
+4 ;
120 ;Filler (National Use)
+1 SET ABMR(60,120)=""
+2 SET ABMR(60,120)=$$FMT^ABMERUTL(ABMR(60,120),12)
+3 QUIT
+4 ;
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(60,ABMX)
+6 IF $DATA(ABMP("FMT"))
SET ABMP("FMT")=1
+7 KILL ABMR(60,ABMX),ABME,ABMX,ABMY,ABMZ,ABM
+8 QUIT Y
+9 ;
ADTT ; EP
+1 ; Add to totals
+2 SET ABMRT(90,150)=+$GET(ABMRT(90,150))+ABM("ACTOT")
+3 SET ABMRT(90,160)=+$GET(ABMRT(90,160))+ABM("NCTOT")
+4 SET ABMRT(95,100)=+$GET(ABMRT(95,100))+ABM("ACTOT")
+5 SET ABMRT(95,110)=+$GET(ABMRT(95,110))+ABM("NCTOT")
+6 SET ABMRT(99,80)=+$GET(ABMRT(99,80))+ABM("ACTOT")
+7 SET ABMRT(99,90)=+$GET(ABMRT(99,90))+ABM("NCTOT")
+8 QUIT
