HBHCRP5 ;LR VAMC(IRMS)/MJT - HBHC report on file 631 (Discharge); May 22, 2021@15:09
;;1.0;HOSPITAL BASED HOME CARE;**2,5,6,22,25,32**;NOV 01, 1993;Build 58
;
; This routine references the following supported ICRs:
; 5747 $$CODEC^ICDEX
;
PROMPT ; Prompt user for patient name
K DIC S DIC="^HBHC(631,",DIC(0)="AEMQZ" D ^DIC
G:Y=-1 EXIT
S HBHCDFN=+Y,HBHCY0=Y(0),%ZIS="Q" K IOP,ZTIO,ZTSAVE D ^%ZIS G:POP EXIT
I $D(IO("Q")) S ZTRTN="DQ^HBHCRP5",ZTDESC="HBPC Patient Discharge Data Report",ZTSAVE("HBHC*")="" D ^%ZTLOAD G EXIT
DQ ; De-queue
U IO
S $P(HBHCY,"-",81)="",HBHCHOSP=$S($P(^HBHC(631.9,1,0),U,5)]"":$E($P($G(^DIC(4,$P(^HBHC(631.9,1,0),U,5),99)),U),1,7),1:""),HBHCHEAD="Patient Discharge Data",HBHCCOLM=(80-(20+$L(HBHCHEAD))\2) S:HBHCCOLM'>0 HBHCCOLM=1
N HBHCHOSPX
S HBHCHOSPX=""
;Find patient's parent site
D PARENT^HBHCUTL1
;strip off spaces added by HBHCUTL1
S HBHCHOSPX=$P(HBHCHOSPX," ")
;If patient does not have a parent site, use default site.
;(The patient might have been admitted before the install of HBH*1.0*32.)
I HBHCHOSPX="" S HBHCHOSPX=HBHCHOSP
D TODAY^HBHCUTL
W ?HBHCCOLM,">>> HBPC ",HBHCHEAD," Report <<<" W !!,"Run Date: ",HBHCTDY,!!,HBHCZ
PROCESS ; Process record
S HBHCDPT0=^DPT(+(HBHCY0),0),HBHCNOD1=$G(^HBHC(631,HBHCDFN,1))
W !,"Patient Name: ",$P(HBHCDPT0,U),?46,"Last Four:",?58,$E($P(HBHCDPT0,U,9),6,9),!,HBHCZ
;HBH*1.0*32 - Display patient's parent site as Hospital Number.
W !," 1. Hospital Number:",?29,$J(HBHCHOSPX,7),?38,"|"
W ?41,"20. Primary Diagnosis @ D/C:",?72,$J($S($P(HBHCY0,U,47)]"":$$CODEC^ICDEX(80,$P(HBHCY0,U,47)),1:""),8),!,HBHCY
W !," 2. Discharge Date:",?28,$S($P(HBHCY0,U,40)]"":$E($P(HBHCY0,U,40),4,5)_"-"_$E($P(HBHCY0,U,40),6,7)_"-"_$E($P(HBHCY0,U,40),2,3),1:""),?38,"|",?41,"21. Secondary Diagnoses @ D/C:"
I HBHCNOD1]"" W:$P(HBHCNOD1,U,16)]"" !?38,"|",?46,$P(HBHCNOD1,U,16)
W !,HBHCY
W !," 3. Eligibility @ Discharge:",?34,$P(HBHCY0,U,41),?38,"|",?41,"22. Vision @ Discharge:",?79,$P(HBHCY0,U,48),!,HBHCY
W !," 4. Marital Status @ Discharge:",?35,$P(HBHCY0,U,42),?38,"|",?46,"Hearing @ Discharge:",?79,$P(HBHCY0,U,49),!,HBHCY
W !," 5. Living Arrangements @ D/C:",?35,$P(HBHCY0,U,43),?38,"|",?41,"23. Expressive Communication @ D/C:",?79,$P(HBHCY0,U,50),!,HBHCY
W !," 6. Discharge Status:",?35,$P(HBHCY0,U,44),?38,"|",?41,"24. Receptive Communication @ D/C:",?79,$P(HBHCY0,U,51),!,HBHCY
W !," 7. Transfer Destination:",?35,$P(HBHCY0,U,45),?38,"|",?41,"25. Bathing @ Discharge:",?79,$P(HBHCY0,U,52),!,HBHCY
W !," 8. Type of Destination Agency:",?35,$P(HBHCY0,U,46),?38,"|",?46,"Dressing @ Discharge:",?79,$P(HBHCY0,U,53),!,HBHCY
W !," 9. Cause of Death:",?38,"|",?46,"Toilet Usage @ Discharge:",?79,$P(HBHCY0,U,54) I HBHCNOD1]"" W:$P(HBHCNOD1,U,15)]"" !?5,$P(HBHCNOD1,U,15),?38,"|"
W !,HBHCY
W !?5,"Name:",?25,$S($P(HBHCY0,U,18)]"":$E($P(HBHCY0,U,18),4,5)_$E($P(HBHCY0,U,18),6,7)_$E($P(HBHCY0,U,18),2,3),1:"")_$E($P(HBHCDPT0,U),1,5),?38,"|",?46,"Transferring @ Discharge:",?79,$P(HBHCY0,U,55),!,HBHCY
W !?5,"Last Four:",?25,$E($P(HBHCDPT0,U,9),6,9),?38,"|",?46,"Eating @ Discharge:",?79,$S($P(HBHCNOD1,U)]"":$P(HBHCNOD1,U),1:""),!,HBHCY
W !?38,"|",?46,"Walking @ Discharge:",?79,$S($P(HBHCNOD1,U,2)]"":$P(HBHCNOD1,U,2),1:""),!,HBHCY
W !?38,"|",?41,"26. Bowel Continence @ Discharge:",?79,$S($P(HBHCNOD1,U,3)]"":$P(HBHCNOD1,U,3),1:""),!,HBHCY
W !?38,"|",?46,"Bladder Continence @ Discharge:",?79,$S($P(HBHCNOD1,U,4)]"":$P(HBHCNOD1,U,4),1:""),!,HBHCY
W !?38,"|",?41,"27. Mobility @ Discharge:",?79,$S($P(HBHCNOD1,U,5)]"":$P(HBHCNOD1,U,5),1:""),!,HBHCY
W !?38,"|",?41,"28. Adaptive Tasks @ Discharge:",?79,$S($P(HBHCNOD1,U,6)]"":$P(HBHCNOD1,U,6),1:""),!,HBHCY
W !?38,"|",?41,"29. Behavior Problems @ Discharge:",?79,$S($P(HBHCNOD1,U,7)]"":$P(HBHCNOD1,U,7),1:""),!,HBHCY
W !?38,"|",?41,"30. Disorientation @ Discharge:",?79,$S($P(HBHCNOD1,U,8)]"":$P(HBHCNOD1,U,8),1:""),!,HBHCY
W !?38,"|",?41,"31. Mood Disturbance @ Discharge:",?79,$S($P(HBHCNOD1,U,9)]"":$P(HBHCNOD1,U,9),1:""),!,HBHCY
W !?38,"|",?41,"32. Caregiver Limitations @ D/C:",?79,$S($P(HBHCNOD1,U,10)]"":$P(HBHCNOD1,U,10),1:""),!,HBHCY
W !?38,"|",?41,"33. Person Completing Discharge:",?76,$J($S($P(HBHCNOD1,U,11)]"":$P(^HBHC(631.4,$P(HBHCNOD1,U,11),0),U),1:""),4),!,HBHCY
W !?38,"|",?46,"Date Discharge Completed:",?72,$S($P(HBHCNOD1,U,12)]"":$E($P(HBHCNOD1,U,12),4,5)_"-"_$E($P(HBHCNOD1,U,12),6,7)_"-"_$E($P(HBHCNOD1,U,12),2,3),1:""),!,HBHCY
EXIT ; Exit module
D ^%ZISC
K DIC,HBHCCOLM,HBHCDFN,HBHCDPT0,HBHCHEAD,HBHCHOSP,HBHCNOD1,HBHCTDY,HBHCY,HBHCY0,HBHCZ,Y
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHBHCRP5 4610 printed Oct 16, 2024@17:59:26 Page 2
HBHCRP5 ;LR VAMC(IRMS)/MJT - HBHC report on file 631 (Discharge); May 22, 2021@15:09
+1 ;;1.0;HOSPITAL BASED HOME CARE;**2,5,6,22,25,32**;NOV 01, 1993;Build 58
+2 ;
+3 ; This routine references the following supported ICRs:
+4 ; 5747 $$CODEC^ICDEX
+5 ;
PROMPT ; Prompt user for patient name
+1 KILL DIC
SET DIC="^HBHC(631,"
SET DIC(0)="AEMQZ"
DO ^DIC
+2 if Y=-1
GOTO EXIT
+3 SET HBHCDFN=+Y
SET HBHCY0=Y(0)
SET %ZIS="Q"
KILL IOP,ZTIO,ZTSAVE
DO ^%ZIS
if POP
GOTO EXIT
+4 IF $DATA(IO("Q"))
SET ZTRTN="DQ^HBHCRP5"
SET ZTDESC="HBPC Patient Discharge Data Report"
SET ZTSAVE("HBHC*")=""
DO ^%ZTLOAD
GOTO EXIT
DQ ; De-queue
+1 USE IO
+2 SET $PIECE(HBHCY,"-",81)=""
SET HBHCHOSP=$SELECT($PIECE(^HBHC(631.9,1,0),U,5)]"":$EXTRACT($PIECE($GET(^DIC(4,$PIECE(^HBHC(631.9,1,0),U,5),99)),U),1,7),1:"")
SET HBHCHEAD="Patient Discharge Data"
SET HBHCCOLM=(80-(20+$LENGTH(HBHCHEAD))\2)
if HBHCCOLM'>0
SET HBHCCOLM=1
+3 NEW HBHCHOSPX
+4 SET HBHCHOSPX=""
+5 ;Find patient's parent site
+6 DO PARENT^HBHCUTL1
+7 ;strip off spaces added by HBHCUTL1
+8 SET HBHCHOSPX=$PIECE(HBHCHOSPX," ")
+9 ;If patient does not have a parent site, use default site.
+10 ;(The patient might have been admitted before the install of HBH*1.0*32.)
+11 IF HBHCHOSPX=""
SET HBHCHOSPX=HBHCHOSP
+12 DO TODAY^HBHCUTL
+13 WRITE ?HBHCCOLM,">>> HBPC ",HBHCHEAD," Report <<<"
WRITE !!,"Run Date: ",HBHCTDY,!!,HBHCZ
PROCESS ; Process record
+1 SET HBHCDPT0=^DPT(+(HBHCY0),0)
SET HBHCNOD1=$GET(^HBHC(631,HBHCDFN,1))
+2 WRITE !,"Patient Name: ",$PIECE(HBHCDPT0,U),?46,"Last Four:",?58,$EXTRACT($PIECE(HBHCDPT0,U,9),6,9),!,HBHCZ
+3 ;HBH*1.0*32 - Display patient's parent site as Hospital Number.
+4 WRITE !," 1. Hospital Number:",?29,$JUSTIFY(HBHCHOSPX,7),?38,"|"
+5 WRITE ?41,"20. Primary Diagnosis @ D/C:",?72,$JUSTIFY($SELECT($PIECE(HBHCY0,U,47)]"":$$CODEC^ICDEX(80,$PIECE(HBHCY0,U,47)),1:""),8),!,HBHCY
+6 WRITE !," 2. Discharge Date:",?28,$SELECT($PIECE(HBHCY0,U,40)]"":$EXTRACT($PIECE(HBHCY0,U,40),4,5)_"-"_$EXTRACT($PIECE(HBHCY0,U,40),6,7)_"-"_$EXTRACT($PIECE(HBHCY0,U,40),2,3),1:""),?38,"|",?41,"21. Secondary Diagnoses @ D/C:"
+7 IF HBHCNOD1]""
if $PIECE(HBHCNOD1,U,16)]""
WRITE !?38,"|",?46,$PIECE(HBHCNOD1,U,16)
+8 WRITE !,HBHCY
+9 WRITE !," 3. Eligibility @ Discharge:",?34,$PIECE(HBHCY0,U,41),?38,"|",?41,"22. Vision @ Discharge:",?79,$PIECE(HBHCY0,U,48),!,HBHCY
+10 WRITE !," 4. Marital Status @ Discharge:",?35,$PIECE(HBHCY0,U,42),?38,"|",?46,"Hearing @ Discharge:",?79,$PIECE(HBHCY0,U,49),!,HBHCY
+11 WRITE !," 5. Living Arrangements @ D/C:",?35,$PIECE(HBHCY0,U,43),?38,"|",?41,"23. Expressive Communication @ D/C:",?79,$PIECE(HBHCY0,U,50),!,HBHCY
+12 WRITE !," 6. Discharge Status:",?35,$PIECE(HBHCY0,U,44),?38,"|",?41,"24. Receptive Communication @ D/C:",?79,$PIECE(HBHCY0,U,51),!,HBHCY
+13 WRITE !," 7. Transfer Destination:",?35,$PIECE(HBHCY0,U,45),?38,"|",?41,"25. Bathing @ Discharge:",?79,$PIECE(HBHCY0,U,52),!,HBHCY
+14 WRITE !," 8. Type of Destination Agency:",?35,$PIECE(HBHCY0,U,46),?38,"|",?46,"Dressing @ Discharge:",?79,$PIECE(HBHCY0,U,53),!,HBHCY
+15 WRITE !," 9. Cause of Death:",?38,"|",?46,"Toilet Usage @ Discharge:",?79,$PIECE(HBHCY0,U,54)
IF HBHCNOD1]""
if $PIECE(HBHCNOD1,U,15)]""
WRITE !?5,$PIECE(HBHCNOD1,U,15),?38,"|"
+16 WRITE !,HBHCY
+17 WRITE !?5,"Name:",?25,$SELECT($PIECE(HBHCY0,U,18)]"":$EXTRACT($PIECE(HBHCY0,U,18),4,5)_$EXTRACT($PIECE(HBHCY0,U,18),6,7)_$EXTRACT($PIECE(HBHCY0,U,18),2,3),1:"")_$EXTRACT(...
... $PIECE(HBHCDPT0,U),1,5),?38,"|",?46,"Transferring @ Discharge:",?79,$PIECE(HBHCY0,U,55),!,HBHCY
+18 WRITE !?5,"Last Four:",?25,$EXTRACT($PIECE(HBHCDPT0,U,9),6,9),?38,"|",?46,"Eating @ Discharge:",?79,$SELECT($PIECE(HBHCNOD1,U)]"":$PIECE(HBHCNOD1,U),1:""),!,HBHCY
+19 WRITE !?38,"|",?46,"Walking @ Discharge:",?79,$SELECT($PIECE(HBHCNOD1,U,2)]"":$PIECE(HBHCNOD1,U,2),1:""),!,HBHCY
+20 WRITE !?38,"|",?41,"26. Bowel Continence @ Discharge:",?79,$SELECT($PIECE(HBHCNOD1,U,3)]"":$PIECE(HBHCNOD1,U,3),1:""),!,HBHCY
+21 WRITE !?38,"|",?46,"Bladder Continence @ Discharge:",?79,$SELECT($PIECE(HBHCNOD1,U,4)]"":$PIECE(HBHCNOD1,U,4),1:""),!,HBHCY
+22 WRITE !?38,"|",?41,"27. Mobility @ Discharge:",?79,$SELECT($PIECE(HBHCNOD1,U,5)]"":$PIECE(HBHCNOD1,U,5),1:""),!,HBHCY
+23 WRITE !?38,"|",?41,"28. Adaptive Tasks @ Discharge:",?79,$SELECT($PIECE(HBHCNOD1,U,6)]"":$PIECE(HBHCNOD1,U,6),1:""),!,HBHCY
+24 WRITE !?38,"|",?41,"29. Behavior Problems @ Discharge:",?79,$SELECT($PIECE(HBHCNOD1,U,7)]"":$PIECE(HBHCNOD1,U,7),1:""),!,HBHCY
+25 WRITE !?38,"|",?41,"30. Disorientation @ Discharge:",?79,$SELECT($PIECE(HBHCNOD1,U,8)]"":$PIECE(HBHCNOD1,U,8),1:""),!,HBHCY
+26 WRITE !?38,"|",?41,"31. Mood Disturbance @ Discharge:",?79,$SELECT($PIECE(HBHCNOD1,U,9)]"":$PIECE(HBHCNOD1,U,9),1:""),!,HBHCY
+27 WRITE !?38,"|",?41,"32. Caregiver Limitations @ D/C:",?79,$SELECT($PIECE(HBHCNOD1,U,10)]"":$PIECE(HBHCNOD1,U,10),1:""),!,HBHCY
+28 WRITE !?38,"|",?41,"33. Person Completing Discharge:",?76,$JUSTIFY($SELECT($PIECE(HBHCNOD1,U,11)]"":$PIECE(^HBHC(631.4,$PIECE(HBHCNOD1,U,11),0),U),1:""),4),!,HBHCY
+29 WRITE !?38,"|",?46,"Date Discharge Completed:",?72,$SELECT($PIECE(HBHCNOD1,U,12)]"":$EXTRACT($PIECE(HBHCNOD1,U,12),4,5)_"-"_$EXTRACT($PIECE(HBHCNOD1,U,12),6,7)_"-"_$EXTRACT($PIECE(HBHCNOD1,U,12),2,3),1:""),!,HBHCY
EXIT ; Exit module
+1 DO ^%ZISC
+2 KILL DIC,HBHCCOLM,HBHCDFN,HBHCDPT0,HBHCHEAD,HBHCHOSP,HBHCNOD1,HBHCTDY,HBHCY,HBHCY0,HBHCZ,Y
+3 QUIT
