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

ABME660.m

Go to the documentation of this file.
ABME660 ; 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/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
 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
 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,20,30,35 D @(I_"^ABME660"),ADD
 ...F I=40:10:130 D @(I_"^ABME660"),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")),$L(ABMREC(60,ABME("S#")))<192 F  D  Q:$L(ABMREC(60,ABME("S#")))>191
 .S ABMREC(60,ABME("S#"))=ABMREC(60,ABME("S#"))_" "
 Q
 ;
ADD ;ADD TO RECORD
 I '$G(ABMP("NOFMT")) S ABMREC(60,ABME("S#"))=$G(ABMREC(60,ABME("S#")))_ABMR(60,I)
 Q
10 ;1-2 Record type
 S ABMR(60,10)=60
 Q
20 ;3-5 Sequence 
 S ABMR(60,20)=ABME("S#")
 S ABMR(60,20)=$$FMT^ABMERUTL(ABMR(60,20),"3NR")
 Q
30 ;6-25 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
35 ;26-27 Filler (National Use)
 S ABMR(60,35)=""
 S ABMR(60,35)=$$FMT^ABMERUTL(ABMR(60,35),2)
 Q
40 ;28-31 Outpatient Revenue Code 1
 S ABMR(60,40)=$P(ABMRV(J,K,M),U)
 S ABMR(60,40)=$$FMT^ABMERUTL(ABMR(60,40),"4NR")
 Q
50 ;32-36 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 ;37-38 Modifier 1 (CPT-4 and HCPCS) 1
 S ABMR(60,60)=$P(ABMRV(J,K,M),U,3)
 S ABMR(60,60)=$$FMT^ABMERUTL(ABMR(60,60),2)
 Q
70 ;39-40 Modifier 2 (CPT-4 and HCPCS) 1
 S ABMR(60,70)=$P(ABMRV(J,K,M),U,4)
 S ABMR(60,70)=$$FMT^ABMERUTL(ABMR(60,70),2)
 Q
80 ;41-47 Units of Service 1
 S ABMR(60,80)=$P(ABMRV(J,K,M),U,5)
 S ABMR(60,80)=$$FMT^ABMERUTL(ABMR(60,80),"7NR")
 Q
90 ;48-57 Charges Total 1
 S ABMR(60,90)=$P(ABMRV(J,K,M),U,6)
 S ABMR(60,90)=$$FMT^ABMERUTL(ABMR(60,90),"10NRJ2")
 Q
100 ;58-67 Charges Non-Covered 1
 S ABMR(60,100)=""
 S ABMR(60,100)=$$FMT^ABMERUTL(ABMR(60,100),"10NRJ2")
 Q
110 ;68-71 Form Locator 49 1
 S ABMR(60,110)=""
 S ABMR(60,110)=$$FMT^ABMERUTL(ABMR(60,110),4)
 Q
120 ;72-79 Assessment Date (CCYYMMDD)
 S ABMR(60,120)=""
 S ABMR(60,120)=$$FMT^ABMERUTL(ABMR(60,120),8)
 Q
130 ;80-82 Filler (National Use)
 S ABMR(60,130)=""
 S ABMR(60,130)=$$FMT^ABMERUTL(ABMR(60,130),3)
 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