ABMDE30 ; IHS/ASDST/DMJ - Page 3 - QUESTIONS - Display ;
;;2.6;IHS 3P BILLING SYSTEM;**6,9,14**;NOV 12, 2009;Build 238
;
; IHS/SD/SDR - v2.5 p3 - nda-0402-180192 - Added new block 19 stuff
; IHS/SD/SDR - V2.5 p5 - Added code to change PATIENT to DISCHARGE STATUS
; IHS/SD/SDR - v2.5 p8 - IM14693/IM16105 - Added code for Number of Enclosures and Accident State
; IHS/SD/SDR - V2.5 P8 - IM12246/IM17548 - Reference and In-House CLIA numbers
; IHS/SD/SDR - v2.5 p9 - IM18516 - Delayed Reason Code
; IHS/SD/SDR - v2.5 p10 - IM20022 - Changed to use ROI/AOB multiples
; IHS/SD/SDR - v2.5 p10 - IM20076 - Added EPSDT referral info
; IHS/SD/SDR - v2.5 p10 - IM20462 - Fixed outside lab charges prompt
; NOTE: all old code removed due to routine size
; IHS/SD/SDR - v2.5 p10 - IM21944 - Fix for error <SUBSCR>W34+3^ABMDE30
; IHS/SD/SDR - v2.5 p11 - NPI - Split routine due to size; new routine ABMDE301
;
; IHS/SD/SDR - v2.6 CSV
; IHS/SD/SDR - abm*2.6*6 - 5010 - modified AoB to accept "W"
; IHS/SD/SDR - 2.6*9 - NOHEAT - added accident state to display if populated
;IHS/SD/SDR - 2.6*14 - fixed discharge status display
; *********************************************************************
W1 ;EP - release of information
W "Release of Information..: "
D W1SET
W $S($P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),7)),U,4)="Y":"YES",1:"NO")
I $E(ABMP("BTYP"),2)'<3 D
.I $P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),7)),U,4)="Y" D
..;ROI date
..I $P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),7)),U,11)'="" D
...W ?37,"From: ",$$SDT^ABMDUTL($P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),7)),U,11))
..E I $D(^AUPNPAT(ABMP("PDFN"),36,0)) D
...S ABMROIDT=$O(^AUPNPAT(ABMP("PDFN"),36,"B",""),-1)
...I $G(ABMROIDT)'="" D
....S DIE="^ABMDCLM(DUZ(2),"
....S DA=ABMP("CDFN")
....S DR=".711////"_ABMROIDT
....D ^DIE
....W ?37,"From: ",$$SDT^ABMDUTL($P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),7)),U,11))
Q
;**********************************************************************
W1SET ;CHECK FOR RELEASE OF INFORMATION & SET
Q:$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),7)),U,11)'=""
Q:(+$O(^AUPNPAT(ABMP("PDFN"),36,0)))=0
S DIE="^ABMDCLM(DUZ(2),",DA=ABMP("CDFN"),DR=".74////Y;.711////"_$P($G(^AUPNPAT(ABMP("PDFN"),36,$O(^AUPNPAT(ABMP("PDFN"),36,9999999),-1),0)),U)
D ^DIE K DR
Q
;**********************************************************************
W2 ;EP - assignment of benefits
W "Assignment of Benefits..: "
D W2SET
;W $S($P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),7)),U,5)="Y":"YES",1:"NO") ;abm*2.6*6 5010
W $S($P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),7)),U,5)="Y":"YES",$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),7)),U,5)="W":"Patient Refused",1:"NO") ;abm*2.6*6 5010
I $E(ABMP("BTYP"),2)'<3 D
.I $P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),7)),U,5)="Y" D
..;AOB date
..I $P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),7)),U,12)'="" D
...W ?37,"From: ",$$SDT^ABMDUTL($P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),7)),U,12))
..E I $D(^AUPNPAT(ABMP("PDFN"),71,0)) D
...S ABMAOBDT=$O(^AUPNPAT(ABMP("PDFN"),71,"B",""),-1)
...I $G(ABMAOBDT)'="" D
....S DIE="^ABMDCLM(DUZ(2),"
....S DA=ABMP("CDFN")
....S DR=".712////"_ABMAOBDT
....D ^DIE
...W ?37,"From: ",$$SDT^ABMDUTL($P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),7)),U,12))
Q
;**********************************************************************
W2SET ;SET ASSIGNMENT OF BENEFITS
Q:$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),7)),U,12)'=""
Q:(+$O(^AUPNPAT(ABMP("PDFN"),71,0)))=0
S DIE="^ABMDCLM(DUZ(2),",DA=ABMP("CDFN"),DR=".75////Y;.712////"_$P($G(^AUPNPAT(ABMP("PDFN"),71,$O(^AUPNPAT(ABMP("PDFN"),71,9999999),-1),0)),U)
D ^DIE K DR
Q
;**********************************************************************
W3 ;
W "Accident Related........: "
S ABM8=$G(^ABMDCLM(DUZ(2),ABMP("CDFN"),8))
I '$P(ABM8,U,2),'$P(ABM8,U,3) D Q
.W "NO"
.K ABM8
W "YES"
I $P(ABM8,U,3) D
.S ABM("Y")=$P(ABM8,U,3)
DD ;
I D
.S ABM("Y0")=$P(^DD(9002274.3,.83,0),U,3)
.S ABM("Y0")=$P($P(ABM("Y0"),ABM("Y")_":",2),";",1)
.W " ",ABM("Y0")
.W " ",$$SDT^ABMDUTL($P(^ABMDCLM(DUZ(2),ABMP("CDFN"),8),U,2))," "
.W:$P(^ABMDCLM(DUZ(2),ABMP("CDFN"),8),U,4)]"" $P(^(8),U,4),"00HRS"
K ABM8
;I ABMP("EXP")=25,($P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),8)),U,16)'="") D ;abm*2.6*9 NOHEAT
I ($P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),8)),U,16)'="") D ;abm*2.6*9 NOHEAT
.;W " ",$P($G(^DIC(5,$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),8)),U,16),0)),U,2) ;abm*2.6*9 NOHEAT
.W " ST: ",$P($G(^DIC(5,$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),8)),U,16),0)),U,2) ;abm*2.6*9 NOHEAT
Q
;**********************************************************************
W4 ;EP - for Employment Info
W "Employment Related......: "
I $P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),9)),U)'="Y" D Q
.W "NO"
W "YES"
I $E(ABM("QU"),$L(ABM("QU")))="B",$P(^ABMDCLM(DUZ(2),ABMP("CDFN"),9),U,3)]"" D Q
.W ?36,"Unable to Work Fr: ",$$SDT^ABMDUTL($P(^ABMDCLM(DUZ(2),ABMP("CDFN"),9),U,3))
.W ?66,"To: ",$$SDT^ABMDUTL($P(^ABMDCLM(DUZ(2),ABMP("CDFN"),9),U,4))
I $P(^ABMDCLM(DUZ(2),ABMP("CDFN"),9),U,2)]"" D
.W ?37,"Date Able to Work...: "
.W $$SDT^ABMDUTL($P(^ABMDCLM(DUZ(2),ABMP("CDFN"),9),U,2))
I $P(^ABMDCLM(DUZ(2),ABMP("CDFN"),9),U,3)]"" D
.W !?37,"Total Disab. From...: "
.W $$SDT^ABMDUTL($P(^ABMDCLM(DUZ(2),ABMP("CDFN"),9),U,3))
.W ?68,"To: ",$$SDT^ABMDUTL($P(^ABMDCLM(DUZ(2),ABMP("CDFN"),9),U,4))
I $P(^ABMDCLM(DUZ(2),ABMP("CDFN"),9),U,5)]"" D
.W !?37,"Partial Disab. From.: "
.W $$SDT^ABMDUTL($P(^ABMDCLM(DUZ(2),ABMP("CDFN"),9),U,5))
.W ?68,"To: ",$$SDT^ABMDUTL($P(^ABMDCLM(DUZ(2),ABMP("CDFN"),9),U,6))
Q
;**********************************************************************
W5 ;EP to Disp ER Info
W "Emergency Room Required.: "
I $D(^ABMDCLM(DUZ(2),ABMP("CDFN"),8)) D
.I $P(^ABMDCLM(DUZ(2),ABMP("CDFN"),8),U,5)="Y" D
..W "YES"
..I ABMP("PAGE")[8&($P(^ABMDCLM(DUZ(2),ABMP("CDFN"),8),U,10)) D
...W " $",$FN($P(^ABMDCLM(DUZ(2),ABMP("CDFN"),8),U,10),",",2)
.E W "NO"
Q
;**********************************************************************
W6 ;EP to Disp Sp Prog
W "Special Program.........: "
I $D(^ABMDCLM(DUZ(2),ABMP("CDFN"),59))=10 D
.S ABM("X")=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),59,0))
.I ABM("X")]"" D
..S ABM("X")=$P(^ABMDCLM(DUZ(2),ABMP("CDFN"),59,ABM("X"),0),U)
..I $D(^ABMDCODE(ABM("X"),0)) D
...W "YES ",$P(^ABMDCODE(ABM("X"),0),U,3)
...I $D(^ABMDCLM(DUZ(2),ABMP("CDFN"),59,ABM("X"),1,0)) D
....S ABMIEN=0
....W ?60,"Referral: "
....F S ABMIEN=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),59,ABM("X"),1,ABMIEN)) Q:+ABMIEN=0 D
.....W $P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),59,ABM("X"),1,ABMIEN,0)),U)_" "
I +$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),59,0))=0 W "NO"
Q
;**********************************************************************
W7 ;EP to Disp Lab Info
W "Outside Lab Charges.....: "
I $D(^ABMDCLM(DUZ(2),ABMP("CDFN"),8)) D
.I $P(^ABMDCLM(DUZ(2),ABMP("CDFN"),8),U,1)>0 D
..W "YES $",$FN($P(^ABMDCLM(DUZ(2),ABMP("CDFN"),8),U),",",2)
.E W "NO $",$FN($P(^ABMDCLM(DUZ(2),ABMP("CDFN"),8),U),",",2)
Q
;**********************************************************************
W8 ;EP to Disp Blood Info
W "Blood Furnished.(pints).: "
I $D(^ABMDCLM(DUZ(2),ABMP("CDFN"),7)) D
.I $P(^ABMDCLM(DUZ(2),ABMP("CDFN"),7),U,6)>0 D
..W "YES"
..W ?37,"Furnished.....: ",$P(^ABMDCLM(DUZ(2),ABMP("CDFN"),7),U,6)
..W ?59,"Replaced...: ",$P(^ABMDCLM(DUZ(2),ABMP("CDFN"),7),U,7)
..W !?37,"Not Replaced..: ",$P(^ABMDCLM(DUZ(2),ABMP("CDFN"),7),U,8)
..W ?59,"Deductible.: ",$P(^ABMDCLM(DUZ(2),ABMP("CDFN"),7),U,9)
.E W "NO"
Q
;**********************************************************************
W9 ;EP to Disp 1st Symp
W "Date of First Symptom...: "
W $$SDT^ABMDUTL($P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),8)),U,6))
Q
;**********************************************************************
W10 ;EP to Disp Siml Symptom
W "Date of Similar Symptom.: "
W $$SDT^ABMDUTL($P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),8)),U,9))
Q
;**********************************************************************
W11 ;EP to Disp 1st Consult
W "Date of 1st Consultation: "
W $$SDT^ABMDUTL($P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),8)),U,7))
Q
;**********************************************************************
W12 ;EP to Disp Referring Phys
W "Referring Phys. (FL17) : "
I $D(^ABMDCLM(DUZ(2),ABMP("CDFN"),8)) D
.I $P(^ABMDCLM(DUZ(2),ABMP("CDFN"),8),U,8)]"" D
..W $P(^ABMDCLM(DUZ(2),ABMP("CDFN"),8),U,8)
..S ABMNPIU=$$NPIUSAGE^ABMUTLF(ABMP("LDFN"),ABMP("INS"))
..I ABMNPIU="N" D
...W " NPI: ",$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),8)),U,17)
..I ABMNPIU="B" D
...W " ID/NPI: ",$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),8)),U,11)_"/"_$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),8)),U,17)
..I ABMNPIU=""!(ABMNPIU="L") D
...W:$P(^ABMDCLM(DUZ(2),ABMP("CDFN"),8),U,11) " I.D. Number: ",$P(^ABMDCLM(DUZ(2),ABMP("CDFN"),8),U,11)
Q
;**********************************************************************
W13 ;EP to Disp Revenue Info
W "Revenue Code/Charge.....: "
I $D(^ABMDCLM(DUZ(2),ABMP("CDFN"),9)) D
.Q:'$P(^ABMDCLM(DUZ(2),ABMP("CDFN"),9),U,8)
.W $P(^ABMDCLM(DUZ(2),ABMP("CDFN"),9),U,7)," $"
.W $FN($P(^ABMDCLM(DUZ(2),ABMP("CDFN"),9),U,8),",",2)
Q
;**********************************************************************
W14 ;EP to Disp Case Number
W "Case No. (External ID)..: "
I $P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),4)),U,8)]"" D
.W $P(^ABMDCLM(DUZ(2),ABMP("CDFN"),4),U,8)
Q
;**********************************************************************
W15 ;EP to Disp MCD Number
W "Resubmission(Control) No: "
I $P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),4)),U,9)]"" D
.W $P(^ABMDCLM(DUZ(2),ABMP("CDFN"),4),U,9)
Q
;**********************************************************************
W16 ;EP to Disp Radiographs
W "Radiographs Enclosed....: "
I $P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),4)),U,3) D
.W "YES"
.W ?37,"Number Submitted....: "
.W $P(^ABMDCLM(DUZ(2),ABMP("CDFN"),4),U,3)
E W "NO"
Q
;**********************************************************************
W17 ;EP to Disp Orthodontics
W "Orthodontic Related.....: "
I $P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),4)),U,4) D
.W "YES"
.W ?37,"Placement Date...: "
.W $$SDT^ABMDUTL($P(^ABMDCLM(DUZ(2),ABMP("CDFN"),4),U,5))
.W " for "_$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),4)),U,13)_" mths"
E W "NO"
Q
;**********************************************************************
W18 ;EP to Disp Prosthesis
W "Init Prosthesis Placed..: "
I $P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),4)),U,6) W "YES" Q
I $P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),4)),U,6)=0 D
.W "NO"
.W ?37,"Prior Placement Date: "
.W $$SDT^ABMDUTL($P(^ABMDCLM(DUZ(2),ABMP("CDFN"),4),U,7))
E W "NO"
Q
;**********************************************************************
W19 ;EP to Disp PRO Number
W "PRO Approval Number.....: "
I $P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),5)),U,8)]"" D
.W $P(^ABMDCLM(DUZ(2),ABMP("CDFN"),5),U,8)
Q
;**********************************************************************
W20 ;EP to Disp HCFA-1500B Block 19
W "HCFA-1500B Block 19.....: "
S ABMWRIT=$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),10)),U)
I $L(ABMWRIT)<48 W ABMWRIT
E S ABMU("TXT")=ABMWRIT,ABMU("LM")=25,ABMU("RM")=78,ABM("TAB")=5 D PRTTXT^ABMDWRAP
K ABMWRIT
Q
;**********************************************************************
W21 ;EP Admission Type
W "Type of Admission.......: "
S ABM(21)=$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),5)),U)
I $D(^ABMDCODE(+ABM(21),0)) D
.W " ",$P(^ABMDCODE(+ABM(21),0),U)," "
.W $E($P(^ABMDCODE(+ABM(21),0),U,3),1,40)
Q
;**********************************************************************
W22 ;EP Admission Source
W "Source of Admission.....: "
S ABM(22)=$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),5)),U,2)
I $D(^ABMDCODE(+ABM(22),0)) D
.W " ",$P(^ABMDCODE(+ABM(22),0),U)," "
.W $E($P(^ABMDCODE(+ABM(22),0),U,3),1,40)
Q
;**********************************************************************
W23 ;EP Patient Status
;W "Discharge Status..........: " ;abm*2.6*14
W "Discharge Status........: " ;abm*2.6*14
S ABM(23)=$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),5)),U,3)
I $D(^ABMDCODE(+ABM(23),0)) D
.I $L($P(^ABMDCODE(+ABM(23),0),U))=1 W 0
.W $P(^ABMDCODE(+ABM(23),0),U)," "
.N I
.F I=1:1:$L($P(^ABMDCODE(+ABM(23),0),U,3)," ") D
..W $P($P(^ABMDCODE(+ABM(23),0),U,3)," ",I)," "
..I $X>70 W !,?35
Q
;**********************************************************************
W24 ;EP Admitting DX
W "Admitting Diagnosis.....: "
S ABM(24)=$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),5)),U,9)
Q:'ABM(24)
W $P($$DX^ABMCVAPI(ABM(24),""),U,2)," ",$P($$DX^ABMCVAPI(ABM(24),ABMP("VDT")),U,4) ;CSV-c
Q
W25 ;EP Supervising Prov UPIN
W "Supervising Prov.(FL19).: "
S ABM(25)=$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),9)),U,12)
W ABM(25)
S ABMNPIU=$$NPIUSAGE^ABMUTLF(ABMP("LDFN"),ABMP("INS"))
I ABMNPIU="N" D
.W " NPI: ",$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),9)),U,25)
I ABMNPIU="B" D
.W " ID/NPI: ",$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),9)),U,24)_"/"_$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),9)),U,25)
I ABMNPIU=""!(ABMNPIU="L") D
.W " I.D. Number: ",$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),9)),U,24)
W !,?7,"Date Last Seen: "
S ABMDTSN=$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),9)),U,11)
Q:'ABMDTSN
W $$SDT^ABMDUTL(ABMDTSN)
K ABMDTSN
Q
;**********************************************************************
W26 ;EP Date of Last X-Ray
W "Date of Last X-Ray......: "
S ABM(26)=$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),9)),U,13)
Q:'ABM(26)
W $$SDT^ABMDUTL(ABM(26))
Q
;**********************************************************************
W27 ;EP Referral Number
W "Referral Number.........: "
S ABM(27)=$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),5)),U,11)
W ABM(27)
Q
W28 ;EP Prior Authorization Number
W "Prior Authorization #...: "
S ABM(28)=$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),5)),U,12)
W ABM(28)
Q
;**********************************************************************
W29 ;EP Homebound Indicator
W "Homebound Indicator.....: "
S ABM(29)=$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),9)),U,14)
W ABM(29)
Q
ABMDE30 ; IHS/ASDST/DMJ - Page 3 - QUESTIONS - Display ;
+1 ;;2.6;IHS 3P BILLING SYSTEM;**6,9,14**;NOV 12, 2009;Build 238
+2 ;
+3 ; IHS/SD/SDR - v2.5 p3 - nda-0402-180192 - Added new block 19 stuff
+4 ; IHS/SD/SDR - V2.5 p5 - Added code to change PATIENT to DISCHARGE STATUS
+5 ; IHS/SD/SDR - v2.5 p8 - IM14693/IM16105 - Added code for Number of Enclosures and Accident State
+6 ; IHS/SD/SDR - V2.5 P8 - IM12246/IM17548 - Reference and In-House CLIA numbers
+7 ; IHS/SD/SDR - v2.5 p9 - IM18516 - Delayed Reason Code
+8 ; IHS/SD/SDR - v2.5 p10 - IM20022 - Changed to use ROI/AOB multiples
+9 ; IHS/SD/SDR - v2.5 p10 - IM20076 - Added EPSDT referral info
+10 ; IHS/SD/SDR - v2.5 p10 - IM20462 - Fixed outside lab charges prompt
+11 ; NOTE: all old code removed due to routine size
+12 ; IHS/SD/SDR - v2.5 p10 - IM21944 - Fix for error <SUBSCR>W34+3^ABMDE30
+13 ; IHS/SD/SDR - v2.5 p11 - NPI - Split routine due to size; new routine ABMDE301
+14 ;
+15 ; IHS/SD/SDR - v2.6 CSV
+16 ; IHS/SD/SDR - abm*2.6*6 - 5010 - modified AoB to accept "W"
+17 ; IHS/SD/SDR - 2.6*9 - NOHEAT - added accident state to display if populated
+18 ;IHS/SD/SDR - 2.6*14 - fixed discharge status display
+19 ; *********************************************************************
W1 ;EP - release of information
+1 WRITE "Release of Information..: "
+2 DO W1SET
+3 WRITE $SELECT($PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),7)),U,4)="Y":"YES",1:"NO")
+4 IF $EXTRACT(ABMP("BTYP"),2)'<3
Begin DoDot:1
+5 IF $PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),7)),U,4)="Y"
Begin DoDot:2
+6 ;ROI date
+7 IF $PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),7)),U,11)'=""
Begin DoDot:3
+8 WRITE ?37,"From: ",$$SDT^ABMDUTL($PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),7)),U,11))
End DoDot:3
+9 IF '$TEST
IF $DATA(^AUPNPAT(ABMP("PDFN"),36,0))
Begin DoDot:3
+10 SET ABMROIDT=$ORDER(^AUPNPAT(ABMP("PDFN"),36,"B",""),-1)
+11 IF $GET(ABMROIDT)'=""
Begin DoDot:4
+12 SET DIE="^ABMDCLM(DUZ(2),"
+13 SET DA=ABMP("CDFN")
+14 SET DR=".711////"_ABMROIDT
+15 DO ^DIE
+16 WRITE ?37,"From: ",$$SDT^ABMDUTL($PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),7)),U,11))
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+17 QUIT
+18 ;**********************************************************************
W1SET ;CHECK FOR RELEASE OF INFORMATION & SET
+1 IF $PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),7)),U,11)'=""
QUIT
+2 IF (+$ORDER(^AUPNPAT(ABMP("PDFN"),36,0)))=0
QUIT
+3 SET DIE="^ABMDCLM(DUZ(2),"
SET DA=ABMP("CDFN")
SET DR=".74////Y;.711////"_$PIECE($GET(^AUPNPAT(ABMP("PDFN"),36,$ORDER(^AUPNPAT(ABMP("PDFN"),36,9999999),-1),0)),U)
+4 DO ^DIE
KILL DR
+5 QUIT
+6 ;**********************************************************************
W2 ;EP - assignment of benefits
+1 WRITE "Assignment of Benefits..: "
+2 DO W2SET
+3 ;W $S($P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),7)),U,5)="Y":"YES",1:"NO") ;abm*2.6*6 5010
+4 ;abm*2.6*6 5010
WRITE $SELECT($PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),7)),U,5)="Y":"YES",$PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),7)),U,5)="W":"Patient Refused",1:"NO")
+5 IF $EXTRACT(ABMP("BTYP"),2)'<3
Begin DoDot:1
+6 IF $PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),7)),U,5)="Y"
Begin DoDot:2
+7 ;AOB date
+8 IF $PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),7)),U,12)'=""
Begin DoDot:3
+9 WRITE ?37,"From: ",$$SDT^ABMDUTL($PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),7)),U,12))
End DoDot:3
+10 IF '$TEST
IF $DATA(^AUPNPAT(ABMP("PDFN"),71,0))
Begin DoDot:3
+11 SET ABMAOBDT=$ORDER(^AUPNPAT(ABMP("PDFN"),71,"B",""),-1)
+12 IF $GET(ABMAOBDT)'=""
Begin DoDot:4
+13 SET DIE="^ABMDCLM(DUZ(2),"
+14 SET DA=ABMP("CDFN")
+15 SET DR=".712////"_ABMAOBDT
+16 DO ^DIE
End DoDot:4
+17 WRITE ?37,"From: ",$$SDT^ABMDUTL($PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),7)),U,12))
End DoDot:3
End DoDot:2
End DoDot:1
+18 QUIT
+19 ;**********************************************************************
W2SET ;SET ASSIGNMENT OF BENEFITS
+1 IF $PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),7)),U,12)'=""
QUIT
+2 IF (+$ORDER(^AUPNPAT(ABMP("PDFN"),71,0)))=0
QUIT
+3 SET DIE="^ABMDCLM(DUZ(2),"
SET DA=ABMP("CDFN")
SET DR=".75////Y;.712////"_$PIECE($GET(^AUPNPAT(ABMP("PDFN"),71,$ORDER(^AUPNPAT(ABMP("PDFN"),71,9999999),-1),0)),U)
+4 DO ^DIE
KILL DR
+5 QUIT
+6 ;**********************************************************************
W3 ;
+1 WRITE "Accident Related........: "
+2 SET ABM8=$GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),8))
+3 IF '$PIECE(ABM8,U,2)
IF '$PIECE(ABM8,U,3)
Begin DoDot:1
+4 WRITE "NO"
+5 KILL ABM8
End DoDot:1
QUIT
+6 WRITE "YES"
+7 IF $PIECE(ABM8,U,3)
Begin DoDot:1
+8 SET ABM("Y")=$PIECE(ABM8,U,3)
End DoDot:1
DD ;
+1 IF $TEST
Begin DoDot:1
+2 SET ABM("Y0")=$PIECE(^DD(9002274.3,.83,0),U,3)
+3 SET ABM("Y0")=$PIECE($PIECE(ABM("Y0"),ABM("Y")_":",2),";",1)
+4 WRITE " ",ABM("Y0")
+5 WRITE " ",$$SDT^ABMDUTL($PIECE(^ABMDCLM(DUZ(2),ABMP("CDFN"),8),U,2))," "
+6 IF $PIECE(^ABMDCLM(DUZ(2),ABMP("CDFN"),8),U,4)]""
WRITE $PIECE(^(8),U,4),"00HRS"
End DoDot:1
+7 KILL ABM8
+8 ;I ABMP("EXP")=25,($P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),8)),U,16)'="") D ;abm*2.6*9 NOHEAT
+9 ;abm*2.6*9 NOHEAT
IF ($PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),8)),U,16)'="")
Begin DoDot:1
+10 ;W " ",$P($G(^DIC(5,$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),8)),U,16),0)),U,2) ;abm*2.6*9 NOHEAT
+11 ;abm*2.6*9 NOHEAT
WRITE " ST: ",$PIECE($GET(^DIC(5,$PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),8)),U,16),0)),U,2)
End DoDot:1
+12 QUIT
+13 ;**********************************************************************
W4 ;EP - for Employment Info
+1 WRITE "Employment Related......: "
+2 IF $PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),9)),U)'="Y"
Begin DoDot:1
+3 WRITE "NO"
End DoDot:1
QUIT
+4 WRITE "YES"
+5 IF $EXTRACT(ABM("QU"),$LENGTH(ABM("QU")))="B"
IF $PIECE(^ABMDCLM(DUZ(2),ABMP("CDFN"),9),U,3)]""
Begin DoDot:1
+6 WRITE ?36,"Unable to Work Fr: ",$$SDT^ABMDUTL($PIECE(^ABMDCLM(DUZ(2),ABMP("CDFN"),9),U,3))
+7 WRITE ?66,"To: ",$$SDT^ABMDUTL($PIECE(^ABMDCLM(DUZ(2),ABMP("CDFN"),9),U,4))
End DoDot:1
QUIT
+8 IF $PIECE(^ABMDCLM(DUZ(2),ABMP("CDFN"),9),U,2)]""
Begin DoDot:1
+9 WRITE ?37,"Date Able to Work...: "
+10 WRITE $$SDT^ABMDUTL($PIECE(^ABMDCLM(DUZ(2),ABMP("CDFN"),9),U,2))
End DoDot:1
+11 IF $PIECE(^ABMDCLM(DUZ(2),ABMP("CDFN"),9),U,3)]""
Begin DoDot:1
+12 WRITE !?37,"Total Disab. From...: "
+13 WRITE $$SDT^ABMDUTL($PIECE(^ABMDCLM(DUZ(2),ABMP("CDFN"),9),U,3))
+14 WRITE ?68,"To: ",$$SDT^ABMDUTL($PIECE(^ABMDCLM(DUZ(2),ABMP("CDFN"),9),U,4))
End DoDot:1
+15 IF $PIECE(^ABMDCLM(DUZ(2),ABMP("CDFN"),9),U,5)]""
Begin DoDot:1
+16 WRITE !?37,"Partial Disab. From.: "
+17 WRITE $$SDT^ABMDUTL($PIECE(^ABMDCLM(DUZ(2),ABMP("CDFN"),9),U,5))
+18 WRITE ?68,"To: ",$$SDT^ABMDUTL($PIECE(^ABMDCLM(DUZ(2),ABMP("CDFN"),9),U,6))
End DoDot:1
+19 QUIT
+20 ;**********************************************************************
W5 ;EP to Disp ER Info
+1 WRITE "Emergency Room Required.: "
+2 IF $DATA(^ABMDCLM(DUZ(2),ABMP("CDFN"),8))
Begin DoDot:1
+3 IF $PIECE(^ABMDCLM(DUZ(2),ABMP("CDFN"),8),U,5)="Y"
Begin DoDot:2
+4 WRITE "YES"
+5 IF ABMP("PAGE")[8&($PIECE(^ABMDCLM(DUZ(2),ABMP("CDFN"),8),U,10))
Begin DoDot:3
+6 WRITE " $",$FNUMBER($PIECE(^ABMDCLM(DUZ(2),ABMP("CDFN"),8),U,10),",",2)
End DoDot:3
End DoDot:2
+7 IF '$TEST
WRITE "NO"
End DoDot:1
+8 QUIT
+9 ;**********************************************************************
W6 ;EP to Disp Sp Prog
+1 WRITE "Special Program.........: "
+2 IF $DATA(^ABMDCLM(DUZ(2),ABMP("CDFN"),59))=10
Begin DoDot:1
+3 SET ABM("X")=$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),59,0))
+4 IF ABM("X")]""
Begin DoDot:2
+5 SET ABM("X")=$PIECE(^ABMDCLM(DUZ(2),ABMP("CDFN"),59,ABM("X"),0),U)
+6 IF $DATA(^ABMDCODE(ABM("X"),0))
Begin DoDot:3
+7 WRITE "YES ",$PIECE(^ABMDCODE(ABM("X"),0),U,3)
+8 IF $DATA(^ABMDCLM(DUZ(2),ABMP("CDFN"),59,ABM("X"),1,0))
Begin DoDot:4
+9 SET ABMIEN=0
+10 WRITE ?60,"Referral: "
+11 FOR
SET ABMIEN=$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),59,ABM("X"),1,ABMIEN))
IF +ABMIEN=0
QUIT
Begin DoDot:5
+12 WRITE $PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),59,ABM("X"),1,ABMIEN,0)),U)_" "
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+13 IF +$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),59,0))=0
WRITE "NO"
+14 QUIT
+15 ;**********************************************************************
W7 ;EP to Disp Lab Info
+1 WRITE "Outside Lab Charges.....: "
+2 IF $DATA(^ABMDCLM(DUZ(2),ABMP("CDFN"),8))
Begin DoDot:1
+3 IF $PIECE(^ABMDCLM(DUZ(2),ABMP("CDFN"),8),U,1)>0
Begin DoDot:2
+4 WRITE "YES $",$FNUMBER($PIECE(^ABMDCLM(DUZ(2),ABMP("CDFN"),8),U),",",2)
End DoDot:2
+5 IF '$TEST
WRITE "NO $",$FNUMBER($PIECE(^ABMDCLM(DUZ(2),ABMP("CDFN"),8),U),",",2)
End DoDot:1
+6 QUIT
+7 ;**********************************************************************
W8 ;EP to Disp Blood Info
+1 WRITE "Blood Furnished.(pints).: "
+2 IF $DATA(^ABMDCLM(DUZ(2),ABMP("CDFN"),7))
Begin DoDot:1
+3 IF $PIECE(^ABMDCLM(DUZ(2),ABMP("CDFN"),7),U,6)>0
Begin DoDot:2
+4 WRITE "YES"
+5 WRITE ?37,"Furnished.....: ",$PIECE(^ABMDCLM(DUZ(2),ABMP("CDFN"),7),U,6)
+6 WRITE ?59,"Replaced...: ",$PIECE(^ABMDCLM(DUZ(2),ABMP("CDFN"),7),U,7)
+7 WRITE !?37,"Not Replaced..: ",$PIECE(^ABMDCLM(DUZ(2),ABMP("CDFN"),7),U,8)
+8 WRITE ?59,"Deductible.: ",$PIECE(^ABMDCLM(DUZ(2),ABMP("CDFN"),7),U,9)
End DoDot:2
+9 IF '$TEST
WRITE "NO"
End DoDot:1
+10 QUIT
+11 ;**********************************************************************
W9 ;EP to Disp 1st Symp
+1 WRITE "Date of First Symptom...: "
+2 WRITE $$SDT^ABMDUTL($PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),8)),U,6))
+3 QUIT
+4 ;**********************************************************************
W10 ;EP to Disp Siml Symptom
+1 WRITE "Date of Similar Symptom.: "
+2 WRITE $$SDT^ABMDUTL($PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),8)),U,9))
+3 QUIT
+4 ;**********************************************************************
W11 ;EP to Disp 1st Consult
+1 WRITE "Date of 1st Consultation: "
+2 WRITE $$SDT^ABMDUTL($PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),8)),U,7))
+3 QUIT
+4 ;**********************************************************************
W12 ;EP to Disp Referring Phys
+1 WRITE "Referring Phys. (FL17) : "
+2 IF $DATA(^ABMDCLM(DUZ(2),ABMP("CDFN"),8))
Begin DoDot:1
+3 IF $PIECE(^ABMDCLM(DUZ(2),ABMP("CDFN"),8),U,8)]""
Begin DoDot:2
+4 WRITE $PIECE(^ABMDCLM(DUZ(2),ABMP("CDFN"),8),U,8)
+5 SET ABMNPIU=$$NPIUSAGE^ABMUTLF(ABMP("LDFN"),ABMP("INS"))
+6 IF ABMNPIU="N"
Begin DoDot:3
+7 WRITE " NPI: ",$PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),8)),U,17)
End DoDot:3
+8 IF ABMNPIU="B"
Begin DoDot:3
+9 WRITE " ID/NPI: ",$PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),8)),U,11)_"/"_$PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),8)),U,17)
End DoDot:3
+10 IF ABMNPIU=""!(ABMNPIU="L")
Begin DoDot:3
+11 IF $PIECE(^ABMDCLM(DUZ(2),ABMP("CDFN"),8),U,11)
WRITE " I.D. Number: ",$PIECE(^ABMDCLM(DUZ(2),ABMP("CDFN"),8),U,11)
End DoDot:3
End DoDot:2
End DoDot:1
+12 QUIT
+13 ;**********************************************************************
W13 ;EP to Disp Revenue Info
+1 WRITE "Revenue Code/Charge.....: "
+2 IF $DATA(^ABMDCLM(DUZ(2),ABMP("CDFN"),9))
Begin DoDot:1
+3 IF '$PIECE(^ABMDCLM(DUZ(2),ABMP("CDFN"),9),U,8)
QUIT
+4 WRITE $PIECE(^ABMDCLM(DUZ(2),ABMP("CDFN"),9),U,7)," $"
+5 WRITE $FNUMBER($PIECE(^ABMDCLM(DUZ(2),ABMP("CDFN"),9),U,8),",",2)
End DoDot:1
+6 QUIT
+7 ;**********************************************************************
W14 ;EP to Disp Case Number
+1 WRITE "Case No. (External ID)..: "
+2 IF $PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),4)),U,8)]""
Begin DoDot:1
+3 WRITE $PIECE(^ABMDCLM(DUZ(2),ABMP("CDFN"),4),U,8)
End DoDot:1
+4 QUIT
+5 ;**********************************************************************
W15 ;EP to Disp MCD Number
+1 WRITE "Resubmission(Control) No: "
+2 IF $PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),4)),U,9)]""
Begin DoDot:1
+3 WRITE $PIECE(^ABMDCLM(DUZ(2),ABMP("CDFN"),4),U,9)
End DoDot:1
+4 QUIT
+5 ;**********************************************************************
W16 ;EP to Disp Radiographs
+1 WRITE "Radiographs Enclosed....: "
+2 IF $PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),4)),U,3)
Begin DoDot:1
+3 WRITE "YES"
+4 WRITE ?37,"Number Submitted....: "
+5 WRITE $PIECE(^ABMDCLM(DUZ(2),ABMP("CDFN"),4),U,3)
End DoDot:1
+6 IF '$TEST
WRITE "NO"
+7 QUIT
+8 ;**********************************************************************
W17 ;EP to Disp Orthodontics
+1 WRITE "Orthodontic Related.....: "
+2 IF $PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),4)),U,4)
Begin DoDot:1
+3 WRITE "YES"
+4 WRITE ?37,"Placement Date...: "
+5 WRITE $$SDT^ABMDUTL($PIECE(^ABMDCLM(DUZ(2),ABMP("CDFN"),4),U,5))
+6 WRITE " for "_$PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),4)),U,13)_" mths"
End DoDot:1
+7 IF '$TEST
WRITE "NO"
+8 QUIT
+9 ;**********************************************************************
W18 ;EP to Disp Prosthesis
+1 WRITE "Init Prosthesis Placed..: "
+2 IF $PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),4)),U,6)
WRITE "YES"
QUIT
+3 IF $PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),4)),U,6)=0
Begin DoDot:1
+4 WRITE "NO"
+5 WRITE ?37,"Prior Placement Date: "
+6 WRITE $$SDT^ABMDUTL($PIECE(^ABMDCLM(DUZ(2),ABMP("CDFN"),4),U,7))
End DoDot:1
+7 IF '$TEST
WRITE "NO"
+8 QUIT
+9 ;**********************************************************************
W19 ;EP to Disp PRO Number
+1 WRITE "PRO Approval Number.....: "
+2 IF $PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),5)),U,8)]""
Begin DoDot:1
+3 WRITE $PIECE(^ABMDCLM(DUZ(2),ABMP("CDFN"),5),U,8)
End DoDot:1
+4 QUIT
+5 ;**********************************************************************
W20 ;EP to Disp HCFA-1500B Block 19
+1 WRITE "HCFA-1500B Block 19.....: "
+2 SET ABMWRIT=$PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),10)),U)
+3 IF $LENGTH(ABMWRIT)<48
WRITE ABMWRIT
+4 IF '$TEST
SET ABMU("TXT")=ABMWRIT
SET ABMU("LM")=25
SET ABMU("RM")=78
SET ABM("TAB")=5
DO PRTTXT^ABMDWRAP
+5 KILL ABMWRIT
+6 QUIT
+7 ;**********************************************************************
W21 ;EP Admission Type
+1 WRITE "Type of Admission.......: "
+2 SET ABM(21)=$PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),5)),U)
+3 IF $DATA(^ABMDCODE(+ABM(21),0))
Begin DoDot:1
+4 WRITE " ",$PIECE(^ABMDCODE(+ABM(21),0),U)," "
+5 WRITE $EXTRACT($PIECE(^ABMDCODE(+ABM(21),0),U,3),1,40)
End DoDot:1
+6 QUIT
+7 ;**********************************************************************
W22 ;EP Admission Source
+1 WRITE "Source of Admission.....: "
+2 SET ABM(22)=$PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),5)),U,2)
+3 IF $DATA(^ABMDCODE(+ABM(22),0))
Begin DoDot:1
+4 WRITE " ",$PIECE(^ABMDCODE(+ABM(22),0),U)," "
+5 WRITE $EXTRACT($PIECE(^ABMDCODE(+ABM(22),0),U,3),1,40)
End DoDot:1
+6 QUIT
+7 ;**********************************************************************
W23 ;EP Patient Status
+1 ;W "Discharge Status..........: " ;abm*2.6*14
+2 ;abm*2.6*14
WRITE "Discharge Status........: "
+3 SET ABM(23)=$PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),5)),U,3)
+4 IF $DATA(^ABMDCODE(+ABM(23),0))
Begin DoDot:1
+5 IF $LENGTH($PIECE(^ABMDCODE(+ABM(23),0),U))=1
WRITE 0
+6 WRITE $PIECE(^ABMDCODE(+ABM(23),0),U)," "
+7 NEW I
+8 FOR I=1:1:$LENGTH($PIECE(^ABMDCODE(+ABM(23),0),U,3)," ")
Begin DoDot:2
+9 WRITE $PIECE($PIECE(^ABMDCODE(+ABM(23),0),U,3)," ",I)," "
+10 IF $X>70
WRITE !,?35
End DoDot:2
End DoDot:1
+11 QUIT
+12 ;**********************************************************************
W24 ;EP Admitting DX
+1 WRITE "Admitting Diagnosis.....: "
+2 SET ABM(24)=$PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),5)),U,9)
+3 IF 'ABM(24)
QUIT
+4 ;CSV-c
WRITE $PIECE($$DX^ABMCVAPI(ABM(24),""),U,2)," ",$PIECE($$DX^ABMCVAPI(ABM(24),ABMP("VDT")),U,4)
+5 QUIT
W25 ;EP Supervising Prov UPIN
+1 WRITE "Supervising Prov.(FL19).: "
+2 SET ABM(25)=$PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),9)),U,12)
+3 WRITE ABM(25)
+4 SET ABMNPIU=$$NPIUSAGE^ABMUTLF(ABMP("LDFN"),ABMP("INS"))
+5 IF ABMNPIU="N"
Begin DoDot:1
+6 WRITE " NPI: ",$PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),9)),U,25)
End DoDot:1
+7 IF ABMNPIU="B"
Begin DoDot:1
+8 WRITE " ID/NPI: ",$PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),9)),U,24)_"/"_$PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),9)),U,25)
End DoDot:1
+9 IF ABMNPIU=""!(ABMNPIU="L")
Begin DoDot:1
+10 WRITE " I.D. Number: ",$PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),9)),U,24)
End DoDot:1
+11 WRITE !,?7,"Date Last Seen: "
+12 SET ABMDTSN=$PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),9)),U,11)
+13 IF 'ABMDTSN
QUIT
+14 WRITE $$SDT^ABMDUTL(ABMDTSN)
+15 KILL ABMDTSN
+16 QUIT
+17 ;**********************************************************************
W26 ;EP Date of Last X-Ray
+1 WRITE "Date of Last X-Ray......: "
+2 SET ABM(26)=$PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),9)),U,13)
+3 IF 'ABM(26)
QUIT
+4 WRITE $$SDT^ABMDUTL(ABM(26))
+5 QUIT
+6 ;**********************************************************************
W27 ;EP Referral Number
+1 WRITE "Referral Number.........: "
+2 SET ABM(27)=$PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),5)),U,11)
+3 WRITE ABM(27)
+4 QUIT
W28 ;EP Prior Authorization Number
+1 WRITE "Prior Authorization #...: "
+2 SET ABM(28)=$PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),5)),U,12)
+3 WRITE ABM(28)
+4 QUIT
+5 ;**********************************************************************
W29 ;EP Homebound Indicator
+1 WRITE "Homebound Indicator.....: "
+2 SET ABM(29)=$PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),9)),U,14)
+3 WRITE ABM(29)
+4 QUIT
