Routine: HBHCRP26

HBHCRP26 ; LR VAMC(IRMS)/MJT-HBHC report on Medical Foster Home file 633.2, sorted by name, includes: MFH Name, Opened Date, Prim Caregiver, Max Pts, Bedbound Max, Closure Date, & Voluntary Closure ; Mar 2007

 ;;1.0;HOSPITAL BASED HOME CARE;**24**;NOV 01, 1993;Build 201

 S %ZIS="Q",HBHCCC=0 K IOP,ZTIO,ZTSAVE D ^%ZIS G:POP EXIT

 I $D(IO("Q")) S ZTRTN="DQ^HBHCRP26",ZTDESC="HBPC Medical Foster Home File Data Report",ZTSAVE("HBHC*")="" D ^%ZTLOAD G EXIT

DQ ; De-queue

 U IO

 S HBHCPAGE=0,$P(HBHCY,"-",133)="",$P(HBHCZ,"=",133)="",HBHCHEAD="Medical Foster Home (MFH) File Data"

 S HBHCHDR="W !,?35,""Opened"",?87,""Maximum"",?99,""Bedbound"",?111,""Closure"",?123,""Voluntary"",!,""Medical Foster Home (MFH) Name"",?35,""Date"",?48,""Primary Caregiver Name"",?87,""Patients"",?99,""Maximum"",?111,""Date"",?123,""Closure"""

 S HBHCCOLM=(132-(30+$L(HBHCHEAD))\2) S:HBHCCOLM'>0 HBHCCOLM=1

 D TODAY^HBHCUTL D:IO'=IO(0)!($D(IO("S"))) HDR132NR^HBHCUTL

 I '$D(IO("S")),(IO=IO(0)) S HBHCCC=HBHCCC+1 D HDR132NR^HBHCUTL

LOOP ; Loop thru ^HBHC(633.2,"B") MFH Name cross-ref to build report

 S HBHCDFN=0 F  S HBHCDFN=$O(^HBHC(633.2,HBHCDFN)) Q:HBHCDFN'>0  D PROCESS

 I $D(^TMP("HBHC",$J)) D PRTLOOP,PRTTOT

 D END132^HBHCUTL1

EXIT ; Exit module

 D ^%ZISC

 K HBHCCC,HBHCCOLM,HBHCDFN,HBHCHDR,HBHCHEAD,HBHCNAME,HBHCNOD0,HBHCPAGE,HBHCTDY,HBHCTMP,HBHCTOT,HBHCTOT1,HBHCTOT2,HBHCY,HBHCZ,X,Y,^TMP("HBHC",$J)

PROCESS ; Process record & build ^TMP("HBHC",$J) global

 S HBHCNOD0=^HBHC(633.2,HBHCDFN,0)

 S ^TMP("HBHC",$J,$P(HBHCNOD0,U),HBHCDFN)=$P(HBHCNOD0,U,2)_U_$P(HBHCNOD0,U,3)_U_$P(HBHCNOD0,U,4)_U_$P(HBHCNOD0,U,5)_U_$P(HBHCNOD0,U,6)_U_$P(HBHCNOD0,U,7)

PRTLOOP ; Print loop

 S (HBHCTOT,HBHCTOT1,HBHCTOT2)=0

 S HBHCNAME="" F  S HBHCNAME=$O(^TMP("HBHC",$J,HBHCNAME)) Q:HBHCNAME=""  S HBHCDFN="" F  S HBHCDFN=$O(^TMP("HBHC",$J,HBHCNAME,HBHCDFN)) Q:HBHCDFN=""  D PRINT

PRINT ; Print report

 I ($D(ZTRTN)!(HBHCCC=0))&((IOSL-$Y)<5) W @IOF D HDR132NR^HBHCUTL

 S HBHCTMP=^TMP("HBHC",$J,HBHCNAME,HBHCDFN),HBHCTOT=HBHCTOT+1,HBHCTOT1=HBHCTOT1+($P(HBHCTMP,U,3)),HBHCTOT2=HBHCTOT2+($P(HBHCTMP,U,4))

 W !,HBHCNAME,?35,$S($P(HBHCTMP,U)]"":$E($P(HBHCTMP,U),4,5)_"-"_$E($P(HBHCTMP,U),6,7)_"-"_$E($P(HBHCTMP,U),2,3),1:""),?48,$P(HBHCTMP,U,2),?87,$P(HBHCTMP,U,3),?99,$P(HBHCTMP,U,4)

 W ?111,$S($P(HBHCTMP,U,5)]"":$E($P(HBHCTMP,U,5),4,5)_"-"_$E($P(HBHCTMP,U,5),6,7)_"-"_$E($P(HBHCTMP,U,5),2,3),1:""),?123,$S(($P(HBHCTMP,U,6)="Y"):"Yes",($P(HBHCTMP,U,6)="N"):"No",1:""),!,HBHCY

PRTTOT ; Print report totals

 I ($D(ZTRTN)!(HBHCCC=0))&((IOSL-$Y)<1) W @IOF D HDR132NR^HBHCUTL

 W !!,HBHCZ,!,"Maximum Patients Total: ",?34,$J(HBHCTOT1,5),!,"Bedbound Maximum Total: ",?34,$J(HBHCTOT2,5),!!,"Medical Foster Home (MFH) Total: ",?34,$J(HBHCTOT,5),!,HBHCZ

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHBHCRP26   2756     printed  Mar 13, 2025@21:03:20                                                                                                                                                                                                    Page 2

HBHCRP26  ; LR VAMC(IRMS)/MJT-HBHC report on Medical Foster Home file 633.2, sorted by name, includes: MFH Name, Opened Date, Prim Caregiver, Max Pts, Bedbound Max, Closure Date, & Voluntary Closure ; Mar 2007

 +1       ;;1.0;HOSPITAL BASED HOME CARE;**24**;NOV 01, 1993;Build 201

 +2        SET %ZIS="Q"

           SET HBHCCC=0

           KILL IOP,ZTIO,ZTSAVE

           DO ^%ZIS

           if POP

               GOTO EXIT

 +3        IF $DATA(IO("Q"))

               SET ZTRTN="DQ^HBHCRP26"

               SET ZTDESC="HBPC Medical Foster Home File Data Report"

               SET ZTSAVE("HBHC*")=""

               DO ^%ZTLOAD

               GOTO EXIT

DQ        ; De-queue

 +1        USE IO

 +2        SET HBHCPAGE=0

           SET $PIECE(HBHCY,"-",133)=""

           SET $PIECE(HBHCZ,"=",133)=""

           SET HBHCHEAD="Medical Foster Home (MFH) File Data"

 +3        SET HBHCHDR="W !,?35,""Opened"",?87,""Maximum"",?99,""Bedbound"",?111,""Closure"",?123,""Voluntary"",!,""Medical Foster Home (MFH) Name"",?35,""Date"",?48,""Primary Caregiver Name"",?87,""Patients"",?99,""Maximum"",?111,""Date"",?123,""Closure"

""

 +4        SET HBHCCOLM=(132-(30+$LENGTH(HBHCHEAD))\2)

           if HBHCCOLM'>0

               SET HBHCCOLM=1

 +5        DO TODAY^HBHCUTL

           if IO'=IO(0)!($DATA(IO("S")))

               DO HDR132NR^HBHCUTL

 +6        IF '$DATA(IO("S"))

               IF (IO=IO(0))

                   SET HBHCCC=HBHCCC+1

                   DO HDR132NR^HBHCUTL

LOOP      ; Loop thru ^HBHC(633.2,"B") MFH Name cross-ref to build report

 +1        SET HBHCDFN=0

FOR

               SET HBHCDFN=$ORDER(^HBHC(633.2,HBHCDFN))

               if HBHCDFN'>0

                   QUIT

               DO PROCESS

 +2        IF $DATA(^TMP("HBHC",$JOB))

               DO PRTLOOP

               DO PRTTOT

 +3        DO END132^HBHCUTL1

EXIT      ; Exit module

 +1        DO ^%ZISC

 +2        KILL HBHCCC,HBHCCOLM,HBHCDFN,HBHCHDR,HBHCHEAD,HBHCNAME,HBHCNOD0,HBHCPAGE,HBHCTDY,HBHCTMP,HBHCTOT,HBHCTOT1,HBHCTOT2,HBHCY,HBHCZ,X,Y,^TMP("HBHC",$JOB)

 +3        QUIT

PROCESS   ; Process record & build ^TMP("HBHC",$J) global

 +1        SET HBHCNOD0=^HBHC(633.2,HBHCDFN,0)

 +2        SET ^TMP("HBHC",$JOB,$PIECE(HBHCNOD0,U),HBHCDFN)=$PIECE(HBHCNOD0,U,2)_U_$PIECE(HBHCNOD0,U,3)_U_$PIECE(HBHCNOD0,U,4)_U_$PIECE(HBHCNOD0,U,5)_U_$PIECE(HBHCNOD0,U,6)_U_$PIECE(HBHCNOD0,U,7)

 +3        QUIT

PRTLOOP   ; Print loop

 +1        SET (HBHCTOT,HBHCTOT1,HBHCTOT2)=0

 +2        SET HBHCNAME=""

FOR

               SET HBHCNAME=$ORDER(^TMP("HBHC",$JOB,HBHCNAME))

               if HBHCNAME=""

                   QUIT

               SET HBHCDFN=""

FOR

                   SET HBHCDFN=$ORDER(^TMP("HBHC",$JOB,HBHCNAME,HBHCDFN))

                   if HBHCDFN=""

                       QUIT

                   DO PRINT

 +3        QUIT

PRINT     ; Print report

 +1        IF ($DATA(ZTRTN)!(HBHCCC=0))&((IOSL-$Y)<5)

               WRITE @IOF

               DO HDR132NR^HBHCUTL

 +2        SET HBHCTMP=^TMP("HBHC",$JOB,HBHCNAME,HBHCDFN)

           SET HBHCTOT=HBHCTOT+1

           SET HBHCTOT1=HBHCTOT1+($PIECE(HBHCTMP,U,3))

           SET HBHCTOT2=HBHCTOT2+($PIECE(HBHCTMP,U,4))

 +3        WRITE !,HBHCNAME,?35,$SELECT($PIECE(HBHCTMP,U)]"":$EXTRACT($PIECE(HBHCTMP,U),4,5)_"-"_$EXTRACT($PIECE(HBHCTMP,U),6,7)_"-"_$EXTRACT($PIECE(HBHCTMP,U),2,3),1:""),?48,$PIECE(HBHCTMP,U,2),?87,$PIECE(HBHCTMP,U,3),?99,$PIECE(HBHCTMP,U,4)

 +4        WRITE ?111,$SELECT($PIECE(HBHCTMP,U,5)]"":$EXTRACT($PIECE(HBHCTMP,U,5),4,5)_"-"_$EXTRACT($PIECE(HBHCTMP,U,5),6,7)_"-"_$EXTRACT($PIECE(HBHCTMP,U,5),2,3),1:""),?123,$SELECT(($PIECE(HBHCTMP,U,6)="Y"):"Yes",($PIECE(HBHCTMP,U,6)="N"):"No",1:""),!,HB

HCY

 +5        QUIT

PRTTOT    ; Print report totals

 +1        IF ($DATA(ZTRTN)!(HBHCCC=0))&((IOSL-$Y)<1)

               WRITE @IOF

               DO HDR132NR^HBHCUTL

 +2        WRITE !!,HBHCZ,!,"Maximum Patients Total: ",?34,$JUSTIFY(HBHCTOT1,5),!,"Bedbound Maximum Total: ",?34,$JUSTIFY(HBHCTOT2,5),!!,"Medical Foster Home (MFH) Total: ",?34,$JUSTIFY(HBHCTOT,5),!,HBHCZ

 +3        QUIT

HBHCRP26.m