ABME3EA0 ; IHS/ASDST/DMJ - HFCA-1500 NSF 3.01 EA0 (Claim Record) ;
;;2.6;IHS 3P BILLING SYSTEM;**14**;NOV 12, 2009;Build 238
;Original;DMJ;
;
; IHS/ASDS/DMJ - 09/06/01 - V2.4 Patch 7 - NOIS HQW-0701-100066
; This is a new routine related to Medicare Part B.
; IHS/ASDS/DMJ - 10/05/01 - V2.4 Patch 9 - NOIS NDA-1001-180035
; Use location address for 209-241 Facility/Lab name
;
; IHS/SD/SDR - v2.5 p3 - 2/26/2003 - NDA-0402-180192
; Added new block 19 stuff
;
; 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:550 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)),U,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)),U,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 Referring Provider National Provider Identifier
S ABMR(40,200)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),8)),"^",11)
I ABMR(40,200)="" D
.S ABMR(40,200)=$$UPIN^ABMEEPRV(ABMAPRV)
S ABMR(40,200)=$$FMT^ABMERUTL(ABMR(40,200),"15S")
Q
210 ;95-109 Refer Prov UPIN
S ABMR(40,210)=""
S ABMR(40,210)=$$FMT^ABMERUTL(ABMR(40,210),15)
Q
220 ;110-110 Refer Prov Tax Type
S ABMR(40,220)=""
S ABMR(40,220)=$$FMT^ABMERUTL(ABMR(40,220),1)
Q
230 ;111-119 Refer Prov Tax ID
S ABMR(40,230)=""
S ABMR(40,230)=$$FMT^ABMERUTL(ABMR(40,230),9)
Q
240 ;120-139 Refer Prov Last Name
S ABMR(40,240)=""
K ABMRPM,ABMRPF
S ABMRP=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),8)),"^",8)
I ABMRP[",",$F(ABMRP,",")<$F(ABMRP," ") D
.S ABMR(40,240)=$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,240)=$P(ABMRP," ",$L(ABMRP," "))
S ABMR(40,240)=$$FMT^ABMERUTL(ABMR(40,240),20)
Q
250 ;140-151 Refer Prov First Name
S ABMR(40,250)=$G(ABMRPF)
S ABMR(40,250)=$$FMT^ABMERUTL(ABMR(40,250),12)
Q
260 ;152-152 Refer Prov MI
S ABMR(40,260)=$G(ABMRPM)
S ABMR(40,260)=$$FMT^ABMERUTL(ABMR(40,260),1)
Q
270 ;153-154 Refer Prov State
S ABMR(40,270)=""
S ABMR(40,270)=$$FMT^ABMERUTL(ABMR(40,270),2)
Q
280 ;155-162 Admission Date
S ABMR(40,280)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),6)),U)
S ABMR(40,280)=$$Y2KD2^ABMDUTL(ABMR(40,280))
S ABMR(40,280)=$$FMT^ABMERUTL(ABMR(40,280),8)
Q
290 ;163-170 Discharge Date
S ABMR(40,290)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),6)),"^",3)
S ABMR(40,290)=$$Y2KD2^ABMDUTL(ABMR(40,290))
S ABMR(40,290)=$$FMT^ABMERUTL(ABMR(40,290),8)
Q
300 ;171-171 Lab Ind
S ABMR(40,300)="N"
D 310
S:ABMR(40,310) ABMR(40,300)="Y"
S ABMR(40,300)=$$FMT^ABMERUTL(ABMR(40,300),1)
Q
310 ;172-178 Lab Charges
S ABMR(40,310)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),8)),U)
S ABMR(40,310)=$$FMT^ABMERUTL(ABMR(40,310),"7NRJ2")
Q
320 ;179-183 Diagnosis Code 1
D GET17
S ABMR(40,320)=ABM(17,1)
S ABMR(40,320)=$$FMT^ABMERUTL(ABMR(40,320),5)
Q
330 ;184-188 Diagnosis Code 2
S ABMR(40,330)=ABM(17,2)
S ABMR(40,330)=$$FMT^ABMERUTL(ABMR(40,330),5)
Q
340 ;189-193 Diagnosis Code 3
S ABMR(40,340)=ABM(17,3)
S ABMR(40,340)=$$FMT^ABMERUTL(ABMR(40,340),5)
Q
350 ;194-198 Diagnosis Code 4
S ABMR(40,350)=ABM(17,4)
S ABMR(40,350)=$$FMT^ABMERUTL(ABMR(40,350),5)
Q
360 ;199-199 Prov Assign Ind
S ABMR(40,360)="N"
S:$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),7)),"^",5)="Y" ABMR(40,360)="A"
S ABMR(40,360)=$$FMT^ABMERUTL(ABMR(40,360),1)
Q
370 ;200-200 Prov Signature Ind
S ABMR(40,370)="Y"
S ABMR(40,370)=$$FMT^ABMERUTL(ABMR(40,370),1)
Q
380 ;201-208 Prov Signature Date
S ABMR(40,380)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),1)),"^",5)
S ABMR(40,380)=ABMR(40,380)\1
S ABMR(40,380)=$$Y2KD2^ABMDUTL(ABMR(40,380))
S ABMR(40,380)=$$FMT^ABMERUTL(ABMR(40,380),8)
Q
390 ;209-241 Facility/Lab Name
S ABMR(40,390)=$P(^DIC(4,ABMP("LDFN"),0),U)
S ABMR(40,390)=$$FMT^ABMERUTL(ABMR(40,390),33)
Q
400 ;242-242 Documentation Ind
S ABMR(40,400)=""
S ABMR(40,400)=$$FMT^ABMERUTL(ABMR(40,400),1)
Q
410 ;243-243 Type of Documentation
S ABMR(40,410)=""
S ABMR(40,410)=$$FMT^ABMERUTL(ABMR(40,410),1)
Q
420 ;244-245 Functnl Status Code
S ABMR(40,420)=""
S ABMR(40,420)=$$FMT^ABMERUTL(ABMR(40,420),2)
Q
430 ;246-247 Special Program Ind
S ABMR(40,430)=""
S ABMR(40,430)=$$FMT^ABMERUTL(ABMR(40,430),2)
Q
440 ;248-248 Champus Nonavail Ind
S ABMR(40,440)=""
S ABMR(40,440)=$$FMT^ABMERUTL(ABMR(40,440),1)
Q
450 ;249-249 Supv Prov Ind
S ABMR(40,450)=""
S ABMR(40,450)=$$FMT^ABMERUTL(ABMR(40,450),1)
Q
460 ;250-251 Resubmission Code
S ABMR(40,460)=""
D 470
I ABMR(40,470)'?15" " D
.S ABMR(40,460)="01"
S ABMR(40,460)=$$FMT^ABMERUTL(ABMR(40,460),2)
Q
470 ;252-266 Resub Reference #
S ABMR(40,470)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),4)),"^",9)
S ABMR(40,470)=$$FMT^ABMERUTL(ABMR(40,470),15)
Q
480 ;267-274 Date Last Seen
S ABMR(40,480)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),9)),"^",11)
S ABMR(40,480)=$$Y2KD2^ABMDUTL(ABMR(40,480))
S ABMR(40,480)=$$FMT^ABMERUTL(ABMR(40,480),8)
Q
490 ;275-282 Date Document Sent
S ABMR(40,490)=""
S ABMR(40,490)=$$FMT^ABMERUTL(ABMR(40,490),8)
Q
500 ;283-283 Homebound Ind
S ABMR(40,500)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),9)),"^",14)
S ABMR(40,500)=$$FMT^ABMERUTL(ABMR(40,500),1)
Q
510 ;284-286 Blood Units Paid
S ABMR(40,510)=""
S ABMR(40,510)=$$FMT^ABMERUTL(ABMR(40,510),3)
Q
520 ;287-289 Blood Units Remaining
S ABMR(40,520)=""
S ABMR(40,520)=$$FMT^ABMERUTL(ABMR(40,520),3)
Q
530 ;290-295 Care Plan Oversight Provider Number
S ABMR(40,530)=""
S ABMR(40,530)=$$FMT^ABMERUTL(ABMR(40,530),6)
Q
540 ;296-310 Investigatinal Device Exemption Number
S ABMR(40,540)=""
S ABMR(40,540)=$$FMT^ABMERUTL(ABMR(40,540),15)
Q
550 ;311-320 Filler - National
S ABMR(40,550)=""
S ABMR(40,550)=$$FMT^ABMERUTL(ABMR(40,550),10)
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
ABME3EA0 ; IHS/ASDST/DMJ - HFCA-1500 NSF 3.01 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/06/01 - V2.4 Patch 7 - NOIS HQW-0701-100066
+5 ; This is a new routine related to Medicare Part B.
+6 ; IHS/ASDS/DMJ - 10/05/01 - V2.4 Patch 9 - NOIS NDA-1001-180035
+7 ; Use location address for 209-241 Facility/Lab name
+8 ;
+9 ; IHS/SD/SDR - v2.5 p3 - 2/26/2003 - NDA-0402-180192
+10 ; Added new block 19 stuff
+11 ;
+12 ; IHS/SD/SDR - v2.6 CSV
+13 ;IHS/SD/SDR - 2.6*14 - Updated DX^ABMCVAPI call to be numeric
+14 ;
+15 ; *********************************************************************
+16 ;
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:550
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)),U,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)),U,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 Referring Provider National Provider Identifier
+1 SET ABMR(40,200)=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),8)),"^",11)
+2 IF ABMR(40,200)=""
Begin DoDot:1
+3 SET ABMR(40,200)=$$UPIN^ABMEEPRV(ABMAPRV)
End DoDot:1
+4 SET ABMR(40,200)=$$FMT^ABMERUTL(ABMR(40,200),"15S")
+5 QUIT
210 ;95-109 Refer Prov UPIN
+1 SET ABMR(40,210)=""
+2 SET ABMR(40,210)=$$FMT^ABMERUTL(ABMR(40,210),15)
+3 QUIT
220 ;110-110 Refer Prov Tax Type
+1 SET ABMR(40,220)=""
+2 SET ABMR(40,220)=$$FMT^ABMERUTL(ABMR(40,220),1)
+3 QUIT
230 ;111-119 Refer Prov Tax ID
+1 SET ABMR(40,230)=""
+2 SET ABMR(40,230)=$$FMT^ABMERUTL(ABMR(40,230),9)
+3 QUIT
240 ;120-139 Refer Prov Last Name
+1 SET ABMR(40,240)=""
+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,240)=$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,240)=$PIECE(ABMRP," ",$LENGTH(ABMRP," "))
End DoDot:1
+15 SET ABMR(40,240)=$$FMT^ABMERUTL(ABMR(40,240),20)
+16 QUIT
250 ;140-151 Refer Prov First Name
+1 SET ABMR(40,250)=$GET(ABMRPF)
+2 SET ABMR(40,250)=$$FMT^ABMERUTL(ABMR(40,250),12)
+3 QUIT
260 ;152-152 Refer Prov MI
+1 SET ABMR(40,260)=$GET(ABMRPM)
+2 SET ABMR(40,260)=$$FMT^ABMERUTL(ABMR(40,260),1)
+3 QUIT
270 ;153-154 Refer Prov State
+1 SET ABMR(40,270)=""
+2 SET ABMR(40,270)=$$FMT^ABMERUTL(ABMR(40,270),2)
+3 QUIT
280 ;155-162 Admission Date
+1 SET ABMR(40,280)=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),6)),U)
+2 SET ABMR(40,280)=$$Y2KD2^ABMDUTL(ABMR(40,280))
+3 SET ABMR(40,280)=$$FMT^ABMERUTL(ABMR(40,280),8)
+4 QUIT
290 ;163-170 Discharge Date
+1 SET ABMR(40,290)=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),6)),"^",3)
+2 SET ABMR(40,290)=$$Y2KD2^ABMDUTL(ABMR(40,290))
+3 SET ABMR(40,290)=$$FMT^ABMERUTL(ABMR(40,290),8)
+4 QUIT
300 ;171-171 Lab Ind
+1 SET ABMR(40,300)="N"
+2 DO 310
+3 IF ABMR(40,310)
SET ABMR(40,300)="Y"
+4 SET ABMR(40,300)=$$FMT^ABMERUTL(ABMR(40,300),1)
+5 QUIT
310 ;172-178 Lab Charges
+1 SET ABMR(40,310)=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),8)),U)
+2 SET ABMR(40,310)=$$FMT^ABMERUTL(ABMR(40,310),"7NRJ2")
+3 QUIT
320 ;179-183 Diagnosis Code 1
+1 DO GET17
+2 SET ABMR(40,320)=ABM(17,1)
+3 SET ABMR(40,320)=$$FMT^ABMERUTL(ABMR(40,320),5)
+4 QUIT
330 ;184-188 Diagnosis Code 2
+1 SET ABMR(40,330)=ABM(17,2)
+2 SET ABMR(40,330)=$$FMT^ABMERUTL(ABMR(40,330),5)
+3 QUIT
340 ;189-193 Diagnosis Code 3
+1 SET ABMR(40,340)=ABM(17,3)
+2 SET ABMR(40,340)=$$FMT^ABMERUTL(ABMR(40,340),5)
+3 QUIT
350 ;194-198 Diagnosis Code 4
+1 SET ABMR(40,350)=ABM(17,4)
+2 SET ABMR(40,350)=$$FMT^ABMERUTL(ABMR(40,350),5)
+3 QUIT
360 ;199-199 Prov Assign Ind
+1 SET ABMR(40,360)="N"
+2 IF $PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),7)),"^",5)="Y"
SET ABMR(40,360)="A"
+3 SET ABMR(40,360)=$$FMT^ABMERUTL(ABMR(40,360),1)
+4 QUIT
370 ;200-200 Prov Signature Ind
+1 SET ABMR(40,370)="Y"
+2 SET ABMR(40,370)=$$FMT^ABMERUTL(ABMR(40,370),1)
+3 QUIT
380 ;201-208 Prov Signature Date
+1 SET ABMR(40,380)=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),1)),"^",5)
+2 SET ABMR(40,380)=ABMR(40,380)\1
+3 SET ABMR(40,380)=$$Y2KD2^ABMDUTL(ABMR(40,380))
+4 SET ABMR(40,380)=$$FMT^ABMERUTL(ABMR(40,380),8)
+5 QUIT
390 ;209-241 Facility/Lab Name
+1 SET ABMR(40,390)=$PIECE(^DIC(4,ABMP("LDFN"),0),U)
+2 SET ABMR(40,390)=$$FMT^ABMERUTL(ABMR(40,390),33)
+3 QUIT
400 ;242-242 Documentation Ind
+1 SET ABMR(40,400)=""
+2 SET ABMR(40,400)=$$FMT^ABMERUTL(ABMR(40,400),1)
+3 QUIT
410 ;243-243 Type of Documentation
+1 SET ABMR(40,410)=""
+2 SET ABMR(40,410)=$$FMT^ABMERUTL(ABMR(40,410),1)
+3 QUIT
420 ;244-245 Functnl Status Code
+1 SET ABMR(40,420)=""
+2 SET ABMR(40,420)=$$FMT^ABMERUTL(ABMR(40,420),2)
+3 QUIT
430 ;246-247 Special Program Ind
+1 SET ABMR(40,430)=""
+2 SET ABMR(40,430)=$$FMT^ABMERUTL(ABMR(40,430),2)
+3 QUIT
440 ;248-248 Champus Nonavail Ind
+1 SET ABMR(40,440)=""
+2 SET ABMR(40,440)=$$FMT^ABMERUTL(ABMR(40,440),1)
+3 QUIT
450 ;249-249 Supv Prov Ind
+1 SET ABMR(40,450)=""
+2 SET ABMR(40,450)=$$FMT^ABMERUTL(ABMR(40,450),1)
+3 QUIT
460 ;250-251 Resubmission Code
+1 SET ABMR(40,460)=""
+2 DO 470
+3 IF ABMR(40,470)'?15" "
Begin DoDot:1
+4 SET ABMR(40,460)="01"
End DoDot:1
+5 SET ABMR(40,460)=$$FMT^ABMERUTL(ABMR(40,460),2)
+6 QUIT
470 ;252-266 Resub Reference #
+1 SET ABMR(40,470)=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),4)),"^",9)
+2 SET ABMR(40,470)=$$FMT^ABMERUTL(ABMR(40,470),15)
+3 QUIT
480 ;267-274 Date Last Seen
+1 SET ABMR(40,480)=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),9)),"^",11)
+2 SET ABMR(40,480)=$$Y2KD2^ABMDUTL(ABMR(40,480))
+3 SET ABMR(40,480)=$$FMT^ABMERUTL(ABMR(40,480),8)
+4 QUIT
490 ;275-282 Date Document Sent
+1 SET ABMR(40,490)=""
+2 SET ABMR(40,490)=$$FMT^ABMERUTL(ABMR(40,490),8)
+3 QUIT
500 ;283-283 Homebound Ind
+1 SET ABMR(40,500)=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),9)),"^",14)
+2 SET ABMR(40,500)=$$FMT^ABMERUTL(ABMR(40,500),1)
+3 QUIT
510 ;284-286 Blood Units Paid
+1 SET ABMR(40,510)=""
+2 SET ABMR(40,510)=$$FMT^ABMERUTL(ABMR(40,510),3)
+3 QUIT
520 ;287-289 Blood Units Remaining
+1 SET ABMR(40,520)=""
+2 SET ABMR(40,520)=$$FMT^ABMERUTL(ABMR(40,520),3)
+3 QUIT
530 ;290-295 Care Plan Oversight Provider Number
+1 SET ABMR(40,530)=""
+2 SET ABMR(40,530)=$$FMT^ABMERUTL(ABMR(40,530),6)
+3 QUIT
540 ;296-310 Investigatinal Device Exemption Number
+1 SET ABMR(40,540)=""
+2 SET ABMR(40,540)=$$FMT^ABMERUTL(ABMR(40,540),15)
+3 QUIT
550 ;311-320 Filler - National
+1 SET ABMR(40,550)=""
+2 SET ABMR(40,550)=$$FMT^ABMERUTL(ABMR(40,550),10)
+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
