ABMEH40 ; IHS/ASDST/DMJ - HFCA-1500 EA0 (Claim Record) ;
;;2.6;IHS 3P BILLING SYSTEM;**14**;NOV 12, 2009;Build 238
;Original;DMJ;
;
; IHS/ASDS/DMJ - 09/07/00 - V2.4 Patch 3 - NOIS HQW-0900-100015
; Strip special characters for electronic HCFA-1500 claims
;
; IHS/SD/SDR - v2.6 CSV
;IHS/SD/SDR - 2.6*14 - Updated DX^ABMCVAPI call to be numeric
;
START ;start here
K ABMREC(40),ABMR(40),ABM,ABME
S ABME("RTYPE")=40
D SET^ABMERUTL
D LOOP
D S90^ABMERUTL
K ABM,ABME
Q
LOOP ;LOOP HERE
F I=10:10:500 D
.D @I
.I $D(^ABMEXLM("AA",+$G(ABMP("INS")),+$G(ABMP("EXP")),40,I)) D @(^(I))
.I '$G(ABMP("NOFMT")) S ABMREC(40)=$G(ABMREC(40))_ABMR(40,I)
Q
;
10 ;1-3 Record ID
S ABMR(40,10)="EA0"
Q
20 ;4-5 Reserved
S ABMR(40,20)=""
S ABMR(40,20)=$$FMT^ABMERUTL(ABMR(40,20),2)
Q
;
30 ;6-22 Patient Control Number
S ABMR(40,30)=ABMP("PCN")
S ABMR(40,30)=$$FMT^ABMERUTL(ABMR(40,30),17)
Q
40 ;23-23 Empl Related Ind
S ABMR(40,40)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),9)),U)
S:ABMR(40,40)'="Y" ABMR(40,40)="N"
Q
50 ;24-24 Accident Ind
S ABMR(40,50)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),8)),"^",3)
I 'ABMR(40,50) S ABMR(40,50)="N" Q
I ABMR(40,50)<3 S ABMR(40,50)="A" Q
S ABMR(40,50)="O"
Q
60 ;25-25 Symptom Ind
S ABMR(40,60)=0
I $P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),8)),"^",6) S ABMR(40,60)=1
Q
70 ;26-33 Accident/Symptom Date
S ABMR(40,70)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),8)),"^",2)
I ABMR(40,70) S ABMR(40,70)=$$Y2KD2^ABMDUTL(ABMR(40,70)) Q
S ABMR(40,70)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),8)),"^",6)
S ABMR(40,70)=$$Y2KD2^ABMDUTL(ABMR(40,70))
S ABMR(40,70)=$$FMT^ABMERUTL(ABMR(40,70),8)
Q
80 ;34-38 Ext Cause OF Accident
S ABMR(40,80)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),8)),U,12)
;S:ABMR(40,80) ABMR(40,80)=$P($$DX^ABMCVAPI(ABMR(40,80),ABMP("VDT")),U,2) ;CSV-c ;abm*2.6*14 updated API call
S:ABMR(40,80) ABMR(40,80)=$P($$DX^ABMCVAPI(+ABMR(40,80),ABMP("VDT")),U,2) ;CSV-c ;abm*2.6*14 updated API call
S ABMR(40,80)=$TR(ABMR(40,80),".")
S ABMR(40,80)=$$FMT^ABMERUTL(ABMR(40,80),5)
Q
90 ;39-39 Responsibility Ind
S ABMR(40,90)=""
S ABMR(40,90)=$$FMT^ABMERUTL(ABMR(40,90),1)
Q
100 ;40-41 Accident State
S ABMR(40,100)=""
S ABMR(40,100)=$$FMT^ABMERUTL(ABMR(40,100),2)
Q
110 ;42-43 Accident Hour
S ABMR(40,110)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),8)),"^",4)
S ABMR(40,110)=$$FMT^ABMERUTL(ABMR(40,110),"2NR")
Q
120 ;44-44 Abuse Ind
S ABMR(40,120)=""
S ABMR(40,120)=$$FMT^ABMERUTL(ABMR(40,120),1)
Q
130 ;45-45 Release if Info Ind
S ABMR(40,130)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),7)),"^",4)
S:ABMR(40,130)="R" ABMR(40,130)="M"
S ABMR(40,130)=$$FMT^ABMERUTL(ABMR(40,130),1)
Q
140 ;46-53 Release of Info Date
S ABMR(40,140)=$P($G(^AUPNPAT(ABMP("PDFN"),0)),"^",4)
S ABMR(40,140)=$$Y2KD2^ABMDUTL(ABMR(40,140))
S ABMR(40,140)=$$FMT^ABMERUTL(ABMR(40,140),8)
Q
150 ;54-54 Same/Similar Symp Ind
S ABMR(40,150)=""
D 160
S:ABMR(40,160) ABMR(40,150)="Y"
S ABMR(40,150)=$$FMT^ABMERUTL(ABMR(40,150),1)
Q
160 ;55-62 Same/Similar Symp Date
S ABMR(40,160)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),8)),"^",9)
S:ABMR(40,160) ABMR(40,160)=$$Y2KD2^ABMDUTL(ABMR(40,160))
S ABMR(40,160)=$$FMT^ABMERUTL(ABMR(40,160),8)
Q
170 ;63-63 Disability Type
S ABMR(40,170)=""
S ABMR(40,170)=$$FMT^ABMERUTL(ABMR(40,170),1)
Q
180 ;64-71 Disability From Date
S ABMR(40,180)=""
S ABMR(40,180)=$$FMT^ABMERUTL(ABMR(40,180),8)
Q
190 ;72-79 Disability To Date
S ABMR(40,190)=""
S ABMR(40,190)=$$FMT^ABMERUTL(ABMR(40,190),8)
Q
200 ;80-94 Refer Prov ID #
S ABMR(40,200)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),8)),"^",11)
S ABMR(40,200)=$$FMT^ABMERUTL(ABMR(40,200),"15S")
Q
210 ;95-119 Reserved
S ABMR(40,210)=""
S ABMR(40,210)=$$FMT^ABMERUTL(ABMR(40,210),25)
Q
220 ;120-139 Refer Prov Last
S ABMR(40,220)=""
K ABMRPM,ABMRPF
S ABMRP=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),8)),"^",8)
I ABMRP[",",$F(ABMRP,",")<$F(ABMRP," ") D
.S ABMR(40,220)=$P(ABMRP,",",1)
.S ABMRPF=$P(ABMRP,",",2)
.S ABMRPM=$P(ABMRPF," ",2)
.S ABMRPM=$E(ABMRPM)
.S ABMRPF=$P(ABMRPF," ",1)
I ABMRP'="",'$D(ABMRPF) D
.S ABMRP=$P(ABMRP,",",1)
.S ABMRPF=$P(ABMRP," ",1)
.I $L(ABMRP," ")>2 S ABMRPM=$E($P(ABMRP," ",2))
.S ABMR(40,220)=$P(ABMRP," ",$L(ABMRP," "))
S ABMR(40,220)=$$FMT^ABMERUTL(ABMR(40,220),20)
Q
230 ;140-151 Refer Prov First
S ABMR(40,230)=$G(ABMRPF)
S ABMR(40,230)=$$FMT^ABMERUTL(ABMR(40,230),12)
Q
240 ;152-152 Refer Prov MI
S ABMR(40,240)=$G(ABMRPM)
S ABMR(40,240)=$$FMT^ABMERUTL(ABMR(40,240),1)
Q
250 ;153-154 Refer Prov State
S ABMR(40,250)=""
S ABMR(40,250)=$$FMT^ABMERUTL(ABMR(40,250),2)
Q
260 ;155-162 Admission Date
S ABMR(40,260)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),6)),U)
S ABMR(40,260)=$$Y2KD2^ABMDUTL(ABMR(40,260))
S ABMR(40,260)=$$FMT^ABMERUTL(ABMR(40,260),8)
Q
270 ;163-170 Discharge Date
S ABMR(40,270)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),6)),"^",3)
S ABMR(40,270)=$$Y2KD2^ABMDUTL(ABMR(40,270))
S ABMR(40,270)=$$FMT^ABMERUTL(ABMR(40,270),8)
Q
280 ;171-171 Lab Ind
S ABMR(40,280)="N"
D 290
S:ABMR(40,290) ABMR(40,280)="Y"
S ABMR(40,280)=$$FMT^ABMERUTL(ABMR(40,280),1)
Q
290 ;172-178 Lab Charges
S ABMR(40,290)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),8)),U)
S ABMR(40,290)=$$FMT^ABMERUTL(ABMR(40,290),"7NRJ2")
Q
300 ;179-183 Diagnosis Code 1
D GET17
S ABMR(40,300)=ABM(17,1)
S ABMR(40,300)=$$FMT^ABMERUTL(ABMR(40,300),5)
Q
310 ;184-188 Diagnosis Code 2
S ABMR(40,310)=ABM(17,2)
S ABMR(40,310)=$$FMT^ABMERUTL(ABMR(40,310),5)
Q
320 ;189-193 Diagnosis Code 3
S ABMR(40,320)=ABM(17,3)
S ABMR(40,320)=$$FMT^ABMERUTL(ABMR(40,320),5)
Q
330 ;194-198 Diagnosis Code 4
S ABMR(40,330)=ABM(17,4)
S ABMR(40,330)=$$FMT^ABMERUTL(ABMR(40,330),5)
Q
340 ;199-199 Prov Assign Ind
S ABMR(40,340)=""
S ABMR(40,340)=$$FMT^ABMERUTL(ABMR(40,340),1)
Q
350 ;200-200 Prov Signature Ind
S ABMR(40,350)="Y"
S ABMR(40,350)=$$FMT^ABMERUTL(ABMR(40,350),1)
Q
360 ;201-208 Prov Signature Date
S ABMR(40,360)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),1)),"^",5)
S ABMR(40,360)=ABMR(40,360)\1
S ABMR(40,360)=$$Y2KD2^ABMDUTL(ABMR(40,360))
S ABMR(40,360)=$$FMT^ABMERUTL(ABMR(40,360),8)
Q
370 ;209-241 Facility/Lab Name
S ABMR(40,370)=$P(^DIC(4,DUZ(2),0),U)
S ABMR(40,370)=$$FMT^ABMERUTL(ABMR(40,370),33)
Q
380 ;242-242 Documentation Ind
S ABMR(40,380)=""
S ABMR(40,380)=$$FMT^ABMERUTL(ABMR(40,380),1)
Q
390 ;243-243 Type of Documentation
S ABMR(40,390)=""
S ABMR(40,390)=$$FMT^ABMERUTL(ABMR(40,390),1)
Q
400 ;244-245 Functnl Status Code
S ABMR(40,400)=""
S ABMR(40,400)=$$FMT^ABMERUTL(ABMR(40,400),2)
Q
410 ;246-247 Special Program Ind
S ABMR(40,410)=""
S ABMR(40,410)=$$FMT^ABMERUTL(ABMR(40,410),2)
Q
420 ;248-248 Champus Nonavail Ind
S ABMR(40,420)=""
S ABMR(40,420)=$$FMT^ABMERUTL(ABMR(40,420),1)
Q
430 ;249-249 Supv Prov Ind
S ABMR(40,430)=""
S ABMR(40,430)=$$FMT^ABMERUTL(ABMR(40,430),1)
Q
440 ;250-251 Resubmission Code
S ABMR(40,440)=""
D 450
I ABMR(40,450)'?15" " D
.S ABMR(40,440)="01"
.S:$$RCID^ABMERUTL(ABMP("INS"))=99999 ABMR(40,440)="A"
S ABMR(40,440)=$$FMT^ABMERUTL(ABMR(40,440),2)
Q
450 ;252-266 Resub Reference #
S ABMR(40,450)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),4)),"^",9)
S ABMR(40,450)=$$FMT^ABMERUTL(ABMR(40,450),15)
Q
460 ;267-274 Date Last Seen
S ABMR(40,460)=""
S ABMR(40,460)=$$FMT^ABMERUTL(ABMR(40,460),8)
Q
470 ;275-282 Date Document Sent
S ABMR(40,470)=""
S ABMR(40,470)=$$FMT^ABMERUTL(ABMR(40,470),8)
Q
480 ;283-283 Homebound Ind
S ABMR(40,480)=""
S ABMR(40,480)=$$FMT^ABMERUTL(ABMR(40,480),1)
Q
490 ;284-293 Filler (National)
S ABMR(40,490)=""
S ABMR(40,490)=$$FMT^ABMERUTL(ABMR(40,490),10)
Q
500 ;294-320 Filler (Local)
S ABMR(40,500)=""
S ABMR(40,500)=$$FMT^ABMERUTL(ABMR(40,500),27)
Q
GET17 ;GET DIAGNOSES CODES FROM BILL FILE
N I,J
S I=0,CNT=0
F S I=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),17,"C",I)) Q:'I D
.S J=0
.F S J=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),17,"C",I,J)) Q:'J D
..S CNT=CNT+1
..S ABM(17,CNT)=$P(^ABMDBILL(DUZ(2),ABMP("BDFN"),17,J,0),U) ; ICD Diagnosis IEN
..S ABM(17,CNT)=$P($$DX^ABMCVAPI(+ABM(17,CNT),ABMP("VDT")),U,2) ; ICD Diagnosis code ;CSV-c
..Q:$P($G(^ABMDEXP(ABMP("EXP"),1)),"^",5)="H"
..S ABM(17,CNT)=$TR(ABM(17,CNT),".")
F I=1:1:9 S:'$D(ABM(17,I)) ABM(17,I)=""
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(40,ABMX)
I $D(ABMP("FMT")) S ABMP("FMT")=1
K ABMR(40,ABMX),ABMX,ABMY
Q Y
ABMEH40 ; IHS/ASDST/DMJ - HFCA-1500 EA0 (Claim Record) ;
+1 ;;2.6;IHS 3P BILLING SYSTEM;**14**;NOV 12, 2009;Build 238
+2 ;Original;DMJ;
+3 ;
+4 ; IHS/ASDS/DMJ - 09/07/00 - V2.4 Patch 3 - NOIS HQW-0900-100015
+5 ; Strip special characters for electronic HCFA-1500 claims
+6 ;
+7 ; IHS/SD/SDR - v2.6 CSV
+8 ;IHS/SD/SDR - 2.6*14 - Updated DX^ABMCVAPI call to be numeric
+9 ;
START ;start here
+1 KILL ABMREC(40),ABMR(40),ABM,ABME
+2 SET ABME("RTYPE")=40
+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:500
Begin DoDot:1
+2 DO @I
+3 IF $DATA(^ABMEXLM("AA",+$GET(ABMP("INS")),+$GET(ABMP("EXP")),40,I))
DO @(^(I))
+4 IF '$GET(ABMP("NOFMT"))
SET ABMREC(40)=$GET(ABMREC(40))_ABMR(40,I)
End DoDot:1
+5 QUIT
+6 ;
10 ;1-3 Record ID
+1 SET ABMR(40,10)="EA0"
+2 QUIT
20 ;4-5 Reserved
+1 SET ABMR(40,20)=""
+2 SET ABMR(40,20)=$$FMT^ABMERUTL(ABMR(40,20),2)
+3 QUIT
+4 ;
30 ;6-22 Patient Control Number
+1 SET ABMR(40,30)=ABMP("PCN")
+2 SET ABMR(40,30)=$$FMT^ABMERUTL(ABMR(40,30),17)
+3 QUIT
40 ;23-23 Empl Related Ind
+1 SET ABMR(40,40)=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),9)),U)
+2 IF ABMR(40,40)'="Y"
SET ABMR(40,40)="N"
+3 QUIT
50 ;24-24 Accident Ind
+1 SET ABMR(40,50)=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),8)),"^",3)
+2 IF 'ABMR(40,50)
SET ABMR(40,50)="N"
QUIT
+3 IF ABMR(40,50)<3
SET ABMR(40,50)="A"
QUIT
+4 SET ABMR(40,50)="O"
+5 QUIT
60 ;25-25 Symptom Ind
+1 SET ABMR(40,60)=0
+2 IF $PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),8)),"^",6)
SET ABMR(40,60)=1
+3 QUIT
70 ;26-33 Accident/Symptom Date
+1 SET ABMR(40,70)=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),8)),"^",2)
+2 IF ABMR(40,70)
SET ABMR(40,70)=$$Y2KD2^ABMDUTL(ABMR(40,70))
QUIT
+3 SET ABMR(40,70)=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),8)),"^",6)
+4 SET ABMR(40,70)=$$Y2KD2^ABMDUTL(ABMR(40,70))
+5 SET ABMR(40,70)=$$FMT^ABMERUTL(ABMR(40,70),8)
+6 QUIT
80 ;34-38 Ext Cause OF Accident
+1 SET ABMR(40,80)=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),8)),U,12)
+2 ;S:ABMR(40,80) ABMR(40,80)=$P($$DX^ABMCVAPI(ABMR(40,80),ABMP("VDT")),U,2) ;CSV-c ;abm*2.6*14 updated API call
+3 ;CSV-c ;abm*2.6*14 updated API call
IF ABMR(40,80)
SET ABMR(40,80)=$PIECE($$DX^ABMCVAPI(+ABMR(40,80),ABMP("VDT")),U,2)
+4 SET ABMR(40,80)=$TRANSLATE(ABMR(40,80),".")
+5 SET ABMR(40,80)=$$FMT^ABMERUTL(ABMR(40,80),5)
+6 QUIT
90 ;39-39 Responsibility Ind
+1 SET ABMR(40,90)=""
+2 SET ABMR(40,90)=$$FMT^ABMERUTL(ABMR(40,90),1)
+3 QUIT
100 ;40-41 Accident State
+1 SET ABMR(40,100)=""
+2 SET ABMR(40,100)=$$FMT^ABMERUTL(ABMR(40,100),2)
+3 QUIT
110 ;42-43 Accident Hour
+1 SET ABMR(40,110)=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),8)),"^",4)
+2 SET ABMR(40,110)=$$FMT^ABMERUTL(ABMR(40,110),"2NR")
+3 QUIT
120 ;44-44 Abuse Ind
+1 SET ABMR(40,120)=""
+2 SET ABMR(40,120)=$$FMT^ABMERUTL(ABMR(40,120),1)
+3 QUIT
130 ;45-45 Release if Info Ind
+1 SET ABMR(40,130)=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),7)),"^",4)
+2 IF ABMR(40,130)="R"
SET ABMR(40,130)="M"
+3 SET ABMR(40,130)=$$FMT^ABMERUTL(ABMR(40,130),1)
+4 QUIT
140 ;46-53 Release of Info Date
+1 SET ABMR(40,140)=$PIECE($GET(^AUPNPAT(ABMP("PDFN"),0)),"^",4)
+2 SET ABMR(40,140)=$$Y2KD2^ABMDUTL(ABMR(40,140))
+3 SET ABMR(40,140)=$$FMT^ABMERUTL(ABMR(40,140),8)
+4 QUIT
150 ;54-54 Same/Similar Symp Ind
+1 SET ABMR(40,150)=""
+2 DO 160
+3 IF ABMR(40,160)
SET ABMR(40,150)="Y"
+4 SET ABMR(40,150)=$$FMT^ABMERUTL(ABMR(40,150),1)
+5 QUIT
160 ;55-62 Same/Similar Symp Date
+1 SET ABMR(40,160)=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),8)),"^",9)
+2 IF ABMR(40,160)
SET ABMR(40,160)=$$Y2KD2^ABMDUTL(ABMR(40,160))
+3 SET ABMR(40,160)=$$FMT^ABMERUTL(ABMR(40,160),8)
+4 QUIT
170 ;63-63 Disability Type
+1 SET ABMR(40,170)=""
+2 SET ABMR(40,170)=$$FMT^ABMERUTL(ABMR(40,170),1)
+3 QUIT
180 ;64-71 Disability From Date
+1 SET ABMR(40,180)=""
+2 SET ABMR(40,180)=$$FMT^ABMERUTL(ABMR(40,180),8)
+3 QUIT
190 ;72-79 Disability To Date
+1 SET ABMR(40,190)=""
+2 SET ABMR(40,190)=$$FMT^ABMERUTL(ABMR(40,190),8)
+3 QUIT
200 ;80-94 Refer Prov ID #
+1 SET ABMR(40,200)=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),8)),"^",11)
+2 SET ABMR(40,200)=$$FMT^ABMERUTL(ABMR(40,200),"15S")
+3 QUIT
210 ;95-119 Reserved
+1 SET ABMR(40,210)=""
+2 SET ABMR(40,210)=$$FMT^ABMERUTL(ABMR(40,210),25)
+3 QUIT
220 ;120-139 Refer Prov Last
+1 SET ABMR(40,220)=""
+2 KILL ABMRPM,ABMRPF
+3 SET ABMRP=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),8)),"^",8)
+4 IF ABMRP[","
IF $FIND(ABMRP,",")<$FIND(ABMRP," ")
Begin DoDot:1
+5 SET ABMR(40,220)=$PIECE(ABMRP,",",1)
+6 SET ABMRPF=$PIECE(ABMRP,",",2)
+7 SET ABMRPM=$PIECE(ABMRPF," ",2)
+8 SET ABMRPM=$EXTRACT(ABMRPM)
+9 SET ABMRPF=$PIECE(ABMRPF," ",1)
End DoDot:1
+10 IF ABMRP'=""
IF '$DATA(ABMRPF)
Begin DoDot:1
+11 SET ABMRP=$PIECE(ABMRP,",",1)
+12 SET ABMRPF=$PIECE(ABMRP," ",1)
+13 IF $LENGTH(ABMRP," ")>2
SET ABMRPM=$EXTRACT($PIECE(ABMRP," ",2))
+14 SET ABMR(40,220)=$PIECE(ABMRP," ",$LENGTH(ABMRP," "))
End DoDot:1
+15 SET ABMR(40,220)=$$FMT^ABMERUTL(ABMR(40,220),20)
+16 QUIT
230 ;140-151 Refer Prov First
+1 SET ABMR(40,230)=$GET(ABMRPF)
+2 SET ABMR(40,230)=$$FMT^ABMERUTL(ABMR(40,230),12)
+3 QUIT
240 ;152-152 Refer Prov MI
+1 SET ABMR(40,240)=$GET(ABMRPM)
+2 SET ABMR(40,240)=$$FMT^ABMERUTL(ABMR(40,240),1)
+3 QUIT
250 ;153-154 Refer Prov State
+1 SET ABMR(40,250)=""
+2 SET ABMR(40,250)=$$FMT^ABMERUTL(ABMR(40,250),2)
+3 QUIT
260 ;155-162 Admission Date
+1 SET ABMR(40,260)=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),6)),U)
+2 SET ABMR(40,260)=$$Y2KD2^ABMDUTL(ABMR(40,260))
+3 SET ABMR(40,260)=$$FMT^ABMERUTL(ABMR(40,260),8)
+4 QUIT
270 ;163-170 Discharge Date
+1 SET ABMR(40,270)=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),6)),"^",3)
+2 SET ABMR(40,270)=$$Y2KD2^ABMDUTL(ABMR(40,270))
+3 SET ABMR(40,270)=$$FMT^ABMERUTL(ABMR(40,270),8)
+4 QUIT
280 ;171-171 Lab Ind
+1 SET ABMR(40,280)="N"
+2 DO 290
+3 IF ABMR(40,290)
SET ABMR(40,280)="Y"
+4 SET ABMR(40,280)=$$FMT^ABMERUTL(ABMR(40,280),1)
+5 QUIT
290 ;172-178 Lab Charges
+1 SET ABMR(40,290)=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),8)),U)
+2 SET ABMR(40,290)=$$FMT^ABMERUTL(ABMR(40,290),"7NRJ2")
+3 QUIT
300 ;179-183 Diagnosis Code 1
+1 DO GET17
+2 SET ABMR(40,300)=ABM(17,1)
+3 SET ABMR(40,300)=$$FMT^ABMERUTL(ABMR(40,300),5)
+4 QUIT
310 ;184-188 Diagnosis Code 2
+1 SET ABMR(40,310)=ABM(17,2)
+2 SET ABMR(40,310)=$$FMT^ABMERUTL(ABMR(40,310),5)
+3 QUIT
320 ;189-193 Diagnosis Code 3
+1 SET ABMR(40,320)=ABM(17,3)
+2 SET ABMR(40,320)=$$FMT^ABMERUTL(ABMR(40,320),5)
+3 QUIT
330 ;194-198 Diagnosis Code 4
+1 SET ABMR(40,330)=ABM(17,4)
+2 SET ABMR(40,330)=$$FMT^ABMERUTL(ABMR(40,330),5)
+3 QUIT
340 ;199-199 Prov Assign Ind
+1 SET ABMR(40,340)=""
+2 SET ABMR(40,340)=$$FMT^ABMERUTL(ABMR(40,340),1)
+3 QUIT
350 ;200-200 Prov Signature Ind
+1 SET ABMR(40,350)="Y"
+2 SET ABMR(40,350)=$$FMT^ABMERUTL(ABMR(40,350),1)
+3 QUIT
360 ;201-208 Prov Signature Date
+1 SET ABMR(40,360)=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),1)),"^",5)
+2 SET ABMR(40,360)=ABMR(40,360)\1
+3 SET ABMR(40,360)=$$Y2KD2^ABMDUTL(ABMR(40,360))
+4 SET ABMR(40,360)=$$FMT^ABMERUTL(ABMR(40,360),8)
+5 QUIT
370 ;209-241 Facility/Lab Name
+1 SET ABMR(40,370)=$PIECE(^DIC(4,DUZ(2),0),U)
+2 SET ABMR(40,370)=$$FMT^ABMERUTL(ABMR(40,370),33)
+3 QUIT
380 ;242-242 Documentation Ind
+1 SET ABMR(40,380)=""
+2 SET ABMR(40,380)=$$FMT^ABMERUTL(ABMR(40,380),1)
+3 QUIT
390 ;243-243 Type of Documentation
+1 SET ABMR(40,390)=""
+2 SET ABMR(40,390)=$$FMT^ABMERUTL(ABMR(40,390),1)
+3 QUIT
400 ;244-245 Functnl Status Code
+1 SET ABMR(40,400)=""
+2 SET ABMR(40,400)=$$FMT^ABMERUTL(ABMR(40,400),2)
+3 QUIT
410 ;246-247 Special Program Ind
+1 SET ABMR(40,410)=""
+2 SET ABMR(40,410)=$$FMT^ABMERUTL(ABMR(40,410),2)
+3 QUIT
420 ;248-248 Champus Nonavail Ind
+1 SET ABMR(40,420)=""
+2 SET ABMR(40,420)=$$FMT^ABMERUTL(ABMR(40,420),1)
+3 QUIT
430 ;249-249 Supv Prov Ind
+1 SET ABMR(40,430)=""
+2 SET ABMR(40,430)=$$FMT^ABMERUTL(ABMR(40,430),1)
+3 QUIT
440 ;250-251 Resubmission Code
+1 SET ABMR(40,440)=""
+2 DO 450
+3 IF ABMR(40,450)'?15" "
Begin DoDot:1
+4 SET ABMR(40,440)="01"
+5 IF $$RCID^ABMERUTL(ABMP("INS"))=99999
SET ABMR(40,440)="A"
End DoDot:1
+6 SET ABMR(40,440)=$$FMT^ABMERUTL(ABMR(40,440),2)
+7 QUIT
450 ;252-266 Resub Reference #
+1 SET ABMR(40,450)=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),4)),"^",9)
+2 SET ABMR(40,450)=$$FMT^ABMERUTL(ABMR(40,450),15)
+3 QUIT
460 ;267-274 Date Last Seen
+1 SET ABMR(40,460)=""
+2 SET ABMR(40,460)=$$FMT^ABMERUTL(ABMR(40,460),8)
+3 QUIT
470 ;275-282 Date Document Sent
+1 SET ABMR(40,470)=""
+2 SET ABMR(40,470)=$$FMT^ABMERUTL(ABMR(40,470),8)
+3 QUIT
480 ;283-283 Homebound Ind
+1 SET ABMR(40,480)=""
+2 SET ABMR(40,480)=$$FMT^ABMERUTL(ABMR(40,480),1)
+3 QUIT
490 ;284-293 Filler (National)
+1 SET ABMR(40,490)=""
+2 SET ABMR(40,490)=$$FMT^ABMERUTL(ABMR(40,490),10)
+3 QUIT
500 ;294-320 Filler (Local)
+1 SET ABMR(40,500)=""
+2 SET ABMR(40,500)=$$FMT^ABMERUTL(ABMR(40,500),27)
+3 QUIT
GET17 ;GET DIAGNOSES CODES FROM BILL FILE
+1 NEW I,J
+2 SET I=0
SET CNT=0
+3 FOR
SET I=$ORDER(^ABMDBILL(DUZ(2),ABMP("BDFN"),17,"C",I))
IF 'I
QUIT
Begin DoDot:1
+4 SET J=0
+5 FOR
SET J=$ORDER(^ABMDBILL(DUZ(2),ABMP("BDFN"),17,"C",I,J))
IF 'J
QUIT
Begin DoDot:2
+6 SET CNT=CNT+1
+7 ; ICD Diagnosis IEN
SET ABM(17,CNT)=$PIECE(^ABMDBILL(DUZ(2),ABMP("BDFN"),17,J,0),U)
+8 ; ICD Diagnosis code ;CSV-c
SET ABM(17,CNT)=$PIECE($$DX^ABMCVAPI(+ABM(17,CNT),ABMP("VDT")),U,2)
+9 IF $PIECE($GET(^ABMDEXP(ABMP("EXP"),1)),"^",5)="H"
QUIT
+10 SET ABM(17,CNT)=$TRANSLATE(ABM(17,CNT),".")
End DoDot:2
End DoDot:1
+11 FOR I=1:1:9
IF '$DATA(ABM(17,I))
SET ABM(17,I)=""
+12 QUIT
+13 ;
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(40,ABMX)
+10 IF $DATA(ABMP("FMT"))
SET ABMP("FMT")=1
+11 KILL ABMR(40,ABMX),ABMX,ABMY
+12 QUIT Y
