Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ABME561

ABME561.m

Go to the documentation of this file.
ABME561 ; 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/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 $P(ABME("SPACE1")," ",113)=""
 S $P(ABME("SPACE2")," ",57)=""
 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
 I $$RCID^ABMERUTL(ABMP("INS"))["MAD" D
 . K ABMRV(9999)
 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_"^ABME561"),ADD
 ...F I=40:10:130 D @(I_"^ABME561"),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^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