Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ABMDE30

ABMDE30.m

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