ABME3EA1 ; IHS/ASDST/DMJ - HFCA-1500 NSF 3.01 EA1 (Claim Record) ;
;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
;Original;DMJ;
;
; IHS/SD/SDR - v2.5 p3 - 2/26/2003 - NDA-0402-180192
; Added new block 19 stuff
;
START ;start here
K ABMREC(41),ABMR(41),ABM,ABME
S ABME("RTYPE")=41
D SET^ABMERUTL
D LOOP
D S90^ABMERUTL
K ABM,ABME
Q
LOOP ;LOOP HERE
F I=10:10:300 D
.D @I
.I $D(^ABMEXLM("AA",+$G(ABMP("INS")),+$G(ABMP("EXP")),41,I)) D @(^(I))
.I '$G(ABMP("NOFMT")) S ABMREC(41)=$G(ABMREC(41))_ABMR(41,I)
Q
;
10 ;1-3 Record ID
S ABMR(41,10)="EA1"
Q
20 ;4-5 Reserved
S ABMR(41,20)=""
S ABMR(41,20)=$$FMT^ABMERUTL(ABMR(41,20),2)
Q
;
30 ;6-22 Patient Control Number
S ABMR(41,30)=ABMP("PCN")
S ABMR(41,30)=$$FMT^ABMERUTL(ABMR(41,30),17)
Q
40 ;23-37 Facility/Laboratory National Provider Identifier
S ABMR(41,40)=""
S ABMR(41,40)=$$FMT^ABMERUTL(ABMR(41,40),15)
Q
50 ;38-52 Reserved - Filler
S ABMR(41,50)=""
S ABMR(41,50)=$$FMT^ABMERUTL(ABMR(41,50),15)
Q
60 ;53-82 Facility/Laboratory Street Address 1
S ABMR(41,60)=$P($G(^AUTTLOC(ABMP("LDFN"),0)),"^",12)
S ABMR(41,60)=$$FMT^ABMERUTL(ABMR(41,60),30)
Q
70 ;83-112 Facility/Laboratory Street Address 2
S ABMR(41,70)=""
S ABMR(41,70)=$$FMT^ABMERUTL(ABMR(41,70),30)
Q
80 ;113-132 Facility/Laboratory City
S ABMR(41,80)=$P($G(^AUTTLOC(ABMP("LDFN"),0)),"^",13)
S ABMR(41,80)=$$FMT^ABMERUTL(ABMR(41,80),20)
Q
90 ;133-134 Facility/Laboratory State
S ABMR(41,90)=$P($G(^AUTTLOC(ABMP("LDFN"),0)),"^",14)
S ABMR(41,90)=$P($G(^DIC(5,+ABMR(41,90),0)),"^",2)
S ABMR(41,90)=$$FMT^ABMERUTL(ABMR(41,90),2)
Q
100 ;135-143 Facility/Laboratory Zip Code
S ABMR(41,100)=$P($G(^AUTTLOC(ABMP("LDFN"),0)),"^",15)
S ABMR(41,100)=$TR(ABMR(41,100),"-")
S ABMR(41,100)=$$FMT^ABMERUTL(ABMR(41,100),9)
Q
110 ;144-160 Medical Record Number
S ABMR(41,110)=""
S ABMR(41,110)=$$FMT^ABMERUTL(ABMR(41,110),17)
Q
120 ;161-168 Return to Work Date
S ABMR(41,120)=""
S ABMR(41,120)=$$FMT^ABMERUTL(ABMR(41,120),8)
Q
130 ;169-176 Consult/Surgery Date
S ABMR(41,130)=""
S ABMR(41,130)=$$FMT^ABMERUTL(ABMR(41,130),8)
Q
140 ;177-184 Admission Date-2
S ABMR(41,140)=""
S ABMR(41,140)=$$FMT^ABMERUTL(ABMR(41,140),8)
Q
150 ;185-192 Discharge Date-2
S ABMR(41,150)=""
S ABMR(41,150)=$$FMT^ABMERUTL(ABMR(41,150),8)
Q
160 ;193-207 Supervising Provider National Provider Identifier
S ABMR(41,160)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),9)),"^",12)
S ABMR(41,160)=$$FMT^ABMERUTL(ABMR(41,160),15)
Q
170 ;208-222 Reserved-Filler
S ABMR(41,170)=""
S ABMR(41,170)=$$FMT^ABMERUTL(ABMR(41,170),15)
Q
180 ;223-242 Supervising Provider Last Name
S ABMR(41,180)=""
S ABMR(41,180)=$$FMT^ABMERUTL(ABMR(41,180),20)
Q
190 ;243-254 Suoervising Provider First Name
S ABMR(41,190)=""
S ABMR(41,190)=$$FMT^ABMERUTL(ABMR(41,190),12)
Q
200 ;255-255 Supervising Provider Middle Initial
S ABMR(41,200)=""
S ABMR(41,200)=$$FMT^ABMERUTL(ABMR(41,200),1)
Q
210 ;256-257 Supervising Provider State
S ABMR(41,210)=""
S ABMR(41,210)=$$FMT^ABMERUTL(ABMR(41,210),2)
Q
220 ;258-277 EMT/Paramedic Last
S ABMR(41,220)=""
S ABMR(41,220)=$$FMT^ABMERUTL(ABMR(41,220),20)
Q
230 ;278-289 EMT/Paramedic First
S ABMR(41,230)=""
S ABMR(41,230)=$$FMT^ABMERUTL(ABMR(41,230),12)
Q
240 ;290-290 EMT/Paramedic MI
S ABMR(41,240)=""
S ABMR(41,240)=$$FMT^ABMERUTL(ABMR(41,240),1)
Q
250 ;291-298 Date Care was Assumed
S ABMR(41,250)=""
S ABMR(41,250)=$$FMT^ABMERUTL(ABMR(41,250),8)
Q
260 ;299-303 Diagnosis Code-5
S ABMR(41,260)=""
S ABMR(41,260)=$$FMT^ABMERUTL(ABMR(41,260),5)
Q
270 ;304-308 Diagnosis Code-6
S ABMR(41,270)=""
S ABMR(41,270)=$$FMT^ABMERUTL(ABMR(41,270),5)
Q
280 ;309-313 Diagnosis Code-7
S ABMR(41,280)=""
S ABMR(41,280)=$$FMT^ABMERUTL(ABMR(41,280),5)
Q
290 ;314-318 Diagnosis Code-8
S ABMR(41,290)=""
S ABMR(41,290)=$$FMT^ABMERUTL(ABMR(41,290),5)
Q
300 ;319-32- Filler - National
S ABMR(41,300)=""
S ABMR(41,300)=$$FMT^ABMERUTL(ABMR(41,300),2)
Q
;
EX(ABMX,ABMY) ;EXTRINSIC FUNCTION HERE
;
; INPUT: ABMX = data element
; Y = bill internal entry number
;
; OUTPUT: Y = bill internal entry number
;
I '$G(ABMP("NOFMT")) S ABMP("FMT")=0
D @ABMX
S Y=ABMR(41,ABMX)
I $D(ABMP("FMT")) S ABMP("FMT")=1
K ABMR(41,ABMX),ABMX,ABMY
Q Y
ABME3EA1 ; IHS/ASDST/DMJ - HFCA-1500 NSF 3.01 EA1 (Claim Record) ;
+1 ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
+2 ;Original;DMJ;
+3 ;
+4 ; IHS/SD/SDR - v2.5 p3 - 2/26/2003 - NDA-0402-180192
+5 ; Added new block 19 stuff
+6 ;
START ;start here
+1 KILL ABMREC(41),ABMR(41),ABM,ABME
+2 SET ABME("RTYPE")=41
+3 DO SET^ABMERUTL
+4 DO LOOP
+5 DO S90^ABMERUTL
+6 KILL ABM,ABME
+7 QUIT
LOOP ;LOOP HERE
+1 FOR I=10:10:300
Begin DoDot:1
+2 DO @I
+3 IF $DATA(^ABMEXLM("AA",+$GET(ABMP("INS")),+$GET(ABMP("EXP")),41,I))
DO @(^(I))
+4 IF '$GET(ABMP("NOFMT"))
SET ABMREC(41)=$GET(ABMREC(41))_ABMR(41,I)
End DoDot:1
+5 QUIT
+6 ;
10 ;1-3 Record ID
+1 SET ABMR(41,10)="EA1"
+2 QUIT
20 ;4-5 Reserved
+1 SET ABMR(41,20)=""
+2 SET ABMR(41,20)=$$FMT^ABMERUTL(ABMR(41,20),2)
+3 QUIT
+4 ;
30 ;6-22 Patient Control Number
+1 SET ABMR(41,30)=ABMP("PCN")
+2 SET ABMR(41,30)=$$FMT^ABMERUTL(ABMR(41,30),17)
+3 QUIT
40 ;23-37 Facility/Laboratory National Provider Identifier
+1 SET ABMR(41,40)=""
+2 SET ABMR(41,40)=$$FMT^ABMERUTL(ABMR(41,40),15)
+3 QUIT
50 ;38-52 Reserved - Filler
+1 SET ABMR(41,50)=""
+2 SET ABMR(41,50)=$$FMT^ABMERUTL(ABMR(41,50),15)
+3 QUIT
60 ;53-82 Facility/Laboratory Street Address 1
+1 SET ABMR(41,60)=$PIECE($GET(^AUTTLOC(ABMP("LDFN"),0)),"^",12)
+2 SET ABMR(41,60)=$$FMT^ABMERUTL(ABMR(41,60),30)
+3 QUIT
70 ;83-112 Facility/Laboratory Street Address 2
+1 SET ABMR(41,70)=""
+2 SET ABMR(41,70)=$$FMT^ABMERUTL(ABMR(41,70),30)
+3 QUIT
80 ;113-132 Facility/Laboratory City
+1 SET ABMR(41,80)=$PIECE($GET(^AUTTLOC(ABMP("LDFN"),0)),"^",13)
+2 SET ABMR(41,80)=$$FMT^ABMERUTL(ABMR(41,80),20)
+3 QUIT
90 ;133-134 Facility/Laboratory State
+1 SET ABMR(41,90)=$PIECE($GET(^AUTTLOC(ABMP("LDFN"),0)),"^",14)
+2 SET ABMR(41,90)=$PIECE($GET(^DIC(5,+ABMR(41,90),0)),"^",2)
+3 SET ABMR(41,90)=$$FMT^ABMERUTL(ABMR(41,90),2)
+4 QUIT
100 ;135-143 Facility/Laboratory Zip Code
+1 SET ABMR(41,100)=$PIECE($GET(^AUTTLOC(ABMP("LDFN"),0)),"^",15)
+2 SET ABMR(41,100)=$TRANSLATE(ABMR(41,100),"-")
+3 SET ABMR(41,100)=$$FMT^ABMERUTL(ABMR(41,100),9)
+4 QUIT
110 ;144-160 Medical Record Number
+1 SET ABMR(41,110)=""
+2 SET ABMR(41,110)=$$FMT^ABMERUTL(ABMR(41,110),17)
+3 QUIT
120 ;161-168 Return to Work Date
+1 SET ABMR(41,120)=""
+2 SET ABMR(41,120)=$$FMT^ABMERUTL(ABMR(41,120),8)
+3 QUIT
130 ;169-176 Consult/Surgery Date
+1 SET ABMR(41,130)=""
+2 SET ABMR(41,130)=$$FMT^ABMERUTL(ABMR(41,130),8)
+3 QUIT
140 ;177-184 Admission Date-2
+1 SET ABMR(41,140)=""
+2 SET ABMR(41,140)=$$FMT^ABMERUTL(ABMR(41,140),8)
+3 QUIT
150 ;185-192 Discharge Date-2
+1 SET ABMR(41,150)=""
+2 SET ABMR(41,150)=$$FMT^ABMERUTL(ABMR(41,150),8)
+3 QUIT
160 ;193-207 Supervising Provider National Provider Identifier
+1 SET ABMR(41,160)=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),9)),"^",12)
+2 SET ABMR(41,160)=$$FMT^ABMERUTL(ABMR(41,160),15)
+3 QUIT
170 ;208-222 Reserved-Filler
+1 SET ABMR(41,170)=""
+2 SET ABMR(41,170)=$$FMT^ABMERUTL(ABMR(41,170),15)
+3 QUIT
180 ;223-242 Supervising Provider Last Name
+1 SET ABMR(41,180)=""
+2 SET ABMR(41,180)=$$FMT^ABMERUTL(ABMR(41,180),20)
+3 QUIT
190 ;243-254 Suoervising Provider First Name
+1 SET ABMR(41,190)=""
+2 SET ABMR(41,190)=$$FMT^ABMERUTL(ABMR(41,190),12)
+3 QUIT
200 ;255-255 Supervising Provider Middle Initial
+1 SET ABMR(41,200)=""
+2 SET ABMR(41,200)=$$FMT^ABMERUTL(ABMR(41,200),1)
+3 QUIT
210 ;256-257 Supervising Provider State
+1 SET ABMR(41,210)=""
+2 SET ABMR(41,210)=$$FMT^ABMERUTL(ABMR(41,210),2)
+3 QUIT
220 ;258-277 EMT/Paramedic Last
+1 SET ABMR(41,220)=""
+2 SET ABMR(41,220)=$$FMT^ABMERUTL(ABMR(41,220),20)
+3 QUIT
230 ;278-289 EMT/Paramedic First
+1 SET ABMR(41,230)=""
+2 SET ABMR(41,230)=$$FMT^ABMERUTL(ABMR(41,230),12)
+3 QUIT
240 ;290-290 EMT/Paramedic MI
+1 SET ABMR(41,240)=""
+2 SET ABMR(41,240)=$$FMT^ABMERUTL(ABMR(41,240),1)
+3 QUIT
250 ;291-298 Date Care was Assumed
+1 SET ABMR(41,250)=""
+2 SET ABMR(41,250)=$$FMT^ABMERUTL(ABMR(41,250),8)
+3 QUIT
260 ;299-303 Diagnosis Code-5
+1 SET ABMR(41,260)=""
+2 SET ABMR(41,260)=$$FMT^ABMERUTL(ABMR(41,260),5)
+3 QUIT
270 ;304-308 Diagnosis Code-6
+1 SET ABMR(41,270)=""
+2 SET ABMR(41,270)=$$FMT^ABMERUTL(ABMR(41,270),5)
+3 QUIT
280 ;309-313 Diagnosis Code-7
+1 SET ABMR(41,280)=""
+2 SET ABMR(41,280)=$$FMT^ABMERUTL(ABMR(41,280),5)
+3 QUIT
290 ;314-318 Diagnosis Code-8
+1 SET ABMR(41,290)=""
+2 SET ABMR(41,290)=$$FMT^ABMERUTL(ABMR(41,290),5)
+3 QUIT
300 ;319-32- Filler - National
+1 SET ABMR(41,300)=""
+2 SET ABMR(41,300)=$$FMT^ABMERUTL(ABMR(41,300),2)
+3 QUIT
+4 ;
EX(ABMX,ABMY) ;EXTRINSIC FUNCTION HERE
+1 ;
+2 ; INPUT: ABMX = data element
+3 ; Y = bill internal entry number
+4 ;
+5 ; OUTPUT: Y = bill internal entry number
+6 ;
+7 IF '$GET(ABMP("NOFMT"))
SET ABMP("FMT")=0
+8 DO @ABMX
+9 SET Y=ABMR(41,ABMX)
+10 IF $DATA(ABMP("FMT"))
SET ABMP("FMT")=1
+11 KILL ABMR(41,ABMX),ABMX,ABMY
+12 QUIT Y
