ABME3EA0.m

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