ABMEE61 ; IHS/ASDST/DMJ - UB92 V5 EMC RECORD 61 (Outpatient Services) ;
;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
;Original;DMJ;08/18/95 10:06 AM
;
; IHS/ASDS/DMJ - 04/04/01 - V2.4 P5 - NOIS HQW-0401-100014
; New routine to address Envoy record 61 format
;
; IHS/SD/SDR - v2.5 p10 - IM20395
; Split out lines bundled by rev code
;
START ;START HERE
K ABMR(61),ABMREC(61)
S ABME("RTYPE")=61,ABME("S#")=0
S ABME("SPACE2")="0000 000000000000000000000000000000000 "
S ABME("SPACE1")=ABME("SPACE2")_ABME("SPACE2")
D SET^ABMERUTL
K ABMP("FLAT") D FRATE^ABMDF11
D ^ABMERGRV
D LOOP
S L=0 F S L=$O(ABMREC(61,L)) Q:'L D S90^ABMERUTL
K ABM,ABME,ABMRV
Q
LOOP ;LOOP HERE
S L=0
S J=0 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_"^ABMEE61"),ADD
...F I=40:10:130 D @(I_"^ABMEE61"),ADD
...Q:J=9999
...S ABM("ACTOT")=+$P(ABMRV(J,K),"^",6)
...S ABM("NCTOT")=+$P(ABMRV(J,K),"^",7)
...D ADTT^ABMER60
I '$G(ABMP("NOFMT")) S ABMREC(61,ABME("S#"))=ABMREC(61,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(61,ABME("S#"))=$G(ABMREC(61,ABME("S#")))_ABMR(61,I)
Q
10 ;Record type 1-2
S ABMR(61,10)=61
Q
20 ;Sequence 3-4
S ABMR(61,20)=ABME("S#")
S ABMR(61,20)=$$FMT^ABMERUTL(ABMR(61,20),"2NR")
Q
30 ;Patient Control Number 5-24 (SOURCE: FILE=9000001.41,FIELD=.02)
S ABMR(61,30)=$$EX^ABMER20(30,ABMP("BDFN"))
S ABMR(61,30)=$$FMT^ABMERUTL(ABMR(61,30),20)
Q
40 ;Revenue Code 1, 25-28 (SOURCE: FILE=, FIELD=)
S ABMR(61,40)=$P(ABMRV(J,K,M),U)
S ABMR(61,40)=$$FMT^ABMERUTL(ABMR(61,40),"4NR")
Q
50 ;HCPCS Procedure Code 1, 29-33
S ABMR(61,50)=$P(ABMRV(J,K,M),U,2)
S ABMR(61,50)=$$FMT^ABMERUTL(ABMR(61,50),5)
Q
60 ;Modifier 1 (CPT-4 and HCPCS) 1, 34-35 (SOURCE: FILE=, FIELD=)
S ABMR(61,60)=$P(ABMRV(J,K,M),U,3)
S ABMR(61,60)=$$FMT^ABMERUTL(ABMR(61,60),2)
Q
70 ;Modifier 2 (CPT-4 and HCPCS) 1, 36-37 (SOURCE: FILE=, FIELD=)
S ABMR(61,70)=$P(ABMRV(J,K,M),U,4)
S ABMR(61,70)=$$FMT^ABMERUTL(ABMR(61,70),2)
Q
80 ;Units of Service 1, 38-44 (SOURCE: FILE= FIELD=)
S ABMR(61,80)=$P(ABMRV(J,K,M),U,5)
S ABMR(61,80)=$$FMT^ABMERUTL(ABMR(61,80),"7NR")
Q
90 ;Form Locator 49, 45-50
S ABMR(61,90)=""
S ABMR(61,90)=$$FMT^ABMERUTL(ABMR(61,90),6)
Q
100 ;Charges Total 1, 51-60 (SOURCE: FILE= FIELD=)
S ABMR(61,100)=$P(ABMRV(J,K,M),U,6)
S ABMR(61,100)=$$FMT^ABMERUTL(ABMR(61,100),"10NRJ2")
Q
110 ;Charges Non-Covered 1, 61-70
S ABMR(61,110)=""
S ABMR(61,110)=$$FMT^ABMERUTL(ABMR(61,110),"10NRJ2")
Q
120 ;Date of Service, 71-78 (SOURCE: FILE= FIELD=)
S ABMR(61,120)=$$Y2KD2^ABMDUTL(ABMP("VDT"))
S ABMR(61,120)=$$FMT^ABMERUTL(ABMR(61,120),8)
Q
130 ;Filler (National Use), 79-80
S ABMR(61,130)=""
S ABMR(61,130)=$$FMT^ABMERUTL(ABMR(61,130),2)
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
ABMEE61 ; IHS/ASDST/DMJ - UB92 V5 EMC RECORD 61 (Outpatient Services) ;
+1 ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
+2 ;Original;DMJ;08/18/95 10:06 AM
+3 ;
+4 ; IHS/ASDS/DMJ - 04/04/01 - V2.4 P5 - NOIS HQW-0401-100014
+5 ; New routine to address Envoy record 61 format
+6 ;
+7 ; IHS/SD/SDR - v2.5 p10 - IM20395
+8 ; Split out lines bundled by rev code
+9 ;
START ;START HERE
+1 KILL ABMR(61),ABMREC(61)
+2 SET ABME("RTYPE")=61
SET ABME("S#")=0
+3 SET ABME("SPACE2")="0000 000000000000000000000000000000000 "
+4 SET ABME("SPACE1")=ABME("SPACE2")_ABME("SPACE2")
+5 DO SET^ABMERUTL
+6 KILL ABMP("FLAT")
DO FRATE^ABMDF11
+7 DO ^ABMERGRV
+8 DO LOOP
+9 SET L=0
FOR
SET L=$ORDER(ABMREC(61,L))
IF 'L
QUIT
DO S90^ABMERUTL
+10 KILL ABM,ABME,ABMRV
+11 QUIT
LOOP ;LOOP HERE
+1 SET L=0
+2 SET J=0
FOR
SET J=$ORDER(ABMRV(J))
IF 'J
QUIT
Begin DoDot:1
+3 SET K=-1
FOR
SET K=$ORDER(ABMRV(J,K))
IF K=""
QUIT
Begin DoDot:2
+4 SET M=0
+5 FOR
SET M=$ORDER(ABMRV(J,K,M))
IF M=""
QUIT
Begin DoDot:3
+6 SET L=L+1
IF L#3=1
Begin DoDot:4
+7 SET ABME("S#")=ABME("S#")+1
+8 FOR I=10:10:30
DO @(I_"^ABMEE61")
DO ADD
End DoDot:4
+9 FOR I=40:10:130
DO @(I_"^ABMEE61")
DO ADD
+10 IF J=9999
QUIT
+11 SET ABM("ACTOT")=+$PIECE(ABMRV(J,K),"^",6)
+12 SET ABM("NCTOT")=+$PIECE(ABMRV(J,K),"^",7)
+13 DO ADTT^ABMER60
End DoDot:3
End DoDot:2
End DoDot:1
+14 IF '$GET(ABMP("NOFMT"))
SET ABMREC(61,ABME("S#"))=ABMREC(61,ABME("S#"))_$SELECT(L#3=1:ABME("SPACE1"),L#3=2:ABME("SPACE2"),1:"")
+15 QUIT
ADD ;ADD TO RECORD
+1 IF '$GET(ABMP("NOFMT"))
SET ABMREC(61,ABME("S#"))=$GET(ABMREC(61,ABME("S#")))_ABMR(61,I)
+2 QUIT
10 ;Record type 1-2
+1 SET ABMR(61,10)=61
+2 QUIT
20 ;Sequence 3-4
+1 SET ABMR(61,20)=ABME("S#")
+2 SET ABMR(61,20)=$$FMT^ABMERUTL(ABMR(61,20),"2NR")
+3 QUIT
30 ;Patient Control Number 5-24 (SOURCE: FILE=9000001.41,FIELD=.02)
+1 SET ABMR(61,30)=$$EX^ABMER20(30,ABMP("BDFN"))
+2 SET ABMR(61,30)=$$FMT^ABMERUTL(ABMR(61,30),20)
+3 QUIT
40 ;Revenue Code 1, 25-28 (SOURCE: FILE=, FIELD=)
+1 SET ABMR(61,40)=$PIECE(ABMRV(J,K,M),U)
+2 SET ABMR(61,40)=$$FMT^ABMERUTL(ABMR(61,40),"4NR")
+3 QUIT
50 ;HCPCS Procedure Code 1, 29-33
+1 SET ABMR(61,50)=$PIECE(ABMRV(J,K,M),U,2)
+2 SET ABMR(61,50)=$$FMT^ABMERUTL(ABMR(61,50),5)
+3 QUIT
60 ;Modifier 1 (CPT-4 and HCPCS) 1, 34-35 (SOURCE: FILE=, FIELD=)
+1 SET ABMR(61,60)=$PIECE(ABMRV(J,K,M),U,3)
+2 SET ABMR(61,60)=$$FMT^ABMERUTL(ABMR(61,60),2)
+3 QUIT
70 ;Modifier 2 (CPT-4 and HCPCS) 1, 36-37 (SOURCE: FILE=, FIELD=)
+1 SET ABMR(61,70)=$PIECE(ABMRV(J,K,M),U,4)
+2 SET ABMR(61,70)=$$FMT^ABMERUTL(ABMR(61,70),2)
+3 QUIT
80 ;Units of Service 1, 38-44 (SOURCE: FILE= FIELD=)
+1 SET ABMR(61,80)=$PIECE(ABMRV(J,K,M),U,5)
+2 SET ABMR(61,80)=$$FMT^ABMERUTL(ABMR(61,80),"7NR")
+3 QUIT
90 ;Form Locator 49, 45-50
+1 SET ABMR(61,90)=""
+2 SET ABMR(61,90)=$$FMT^ABMERUTL(ABMR(61,90),6)
+3 QUIT
100 ;Charges Total 1, 51-60 (SOURCE: FILE= FIELD=)
+1 SET ABMR(61,100)=$PIECE(ABMRV(J,K,M),U,6)
+2 SET ABMR(61,100)=$$FMT^ABMERUTL(ABMR(61,100),"10NRJ2")
+3 QUIT
110 ;Charges Non-Covered 1, 61-70
+1 SET ABMR(61,110)=""
+2 SET ABMR(61,110)=$$FMT^ABMERUTL(ABMR(61,110),"10NRJ2")
+3 QUIT
120 ;Date of Service, 71-78 (SOURCE: FILE= FIELD=)
+1 SET ABMR(61,120)=$$Y2KD2^ABMDUTL(ABMP("VDT"))
+2 SET ABMR(61,120)=$$FMT^ABMERUTL(ABMR(61,120),8)
+3 QUIT
130 ;Filler (National Use), 79-80
+1 SET ABMR(61,130)=""
+2 SET ABMR(61,130)=$$FMT^ABMERUTL(ABMR(61,130),2)
+3 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
