- HBHCRP30 ; LR VAMC(IRMS)/MJT-HBHC report on Medical Foster Home file 633.2 data, sorted by name, includes: MFH Name, Opened Date, Primary Caregiver Name, Date of Birth, & Age, includes # OF MFHs & Average Age @ end of rpt ; Feb 2008
- ;;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^HBHCRP30",ZTDESC="HBPC Medical Foster Home Caregiver Age 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) Caregiver Age"
- S HBHCHDR="W !!,""Medical Foster Home (MFH) Name"",?40,""Opened Date"",?58,""Primary Caregiver Name"",?103,""Date of Birth"",?121,""Age"""
- 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 HBHCAGE,HBHCCC,HBHCCDOB,HBHCCOLM,HBHCDFN,HBHCHDR,HBHCHEAD,HBHCNAME,HBHCNOD0,HBHCPAGE,HBHCTDY,HBHCTMP,HBHCTOT,HBHCTOT1,HBHCY,HBHCZ,X,Y,^TMP("HBHC",$J)
- Q
- PROCESS ; Process record & build ^TMP("HBHC",$J) global
- S HBHCNOD0=^HBHC(633.2,HBHCDFN,0)
- ; Quit if MFH Closed
- Q:$P(HBHCNOD0,U,6)]""
- S HBHCCDOB=$P(HBHCNOD0,U,16)
- ; Quit if Caregiver Date of Birth = null
- Q:HBHCCDOB=""
- S HBHCAGE=$E(DT,1,3)-$E(HBHCCDOB,1,3)
- S:($E(DT,4,7)<$E(HBHCCDOB,4,7)) HBHCAGE=HBHCAGE-1
- S ^TMP("HBHC",$J,$P(HBHCNOD0,U),HBHCDFN)=$E($P(HBHCNOD0,U,2),4,5)_"-"_$E($P(HBHCNOD0,U,2),6,7)_"-"_$E($P(HBHCNOD0,U,2),2,3)_U_$P(HBHCNOD0,U,3)_U_$E($P(HBHCNOD0,U,16),4,5)_"-"_$E($P(HBHCNOD0,U,16),6,7)_"-"_$E($P(HBHCNOD0,U,16),2,3)_U_HBHCAGE
- Q
- PRTLOOP ; Print loop
- S (HBHCTOT,HBHCTOT1)=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
- Q
- 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,4))
- W !,HBHCNAME,?40,$P(HBHCTMP,U),?58,$P(HBHCTMP,U,2),?103,$P(HBHCTMP,U,3),?121,$P(HBHCTMP,U,4),!,HBHCY
- Q
- PRTTOT ; Print report totals
- I ($D(ZTRTN)!(HBHCCC=0))&((IOSL-$Y)<1) W @IOF D HDR132NR^HBHCUTL
- W !!,HBHCZ,!,"Medical Foster Home (MFH) Total: ",?34,$J(HBHCTOT,5),!,"Average Caregiver Age: ",?34,$J(HBHCTOT1/HBHCTOT,5),!,HBHCZ
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHBHCRP30 2650 printed Feb 18, 2025@23:24:59 Page 2
- HBHCRP30 ; LR VAMC(IRMS)/MJT-HBHC report on Medical Foster Home file 633.2 data, sorted by name, includes: MFH Name, Opened Date, Primary Caregiver Name, Date of Birth, & Age, includes # OF MFHs & Average Age @ end of rpt ; Feb 2008
- +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^HBHCRP30"
- SET ZTDESC="HBPC Medical Foster Home Caregiver Age 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) Caregiver Age"
- +3 SET HBHCHDR="W !!,""Medical Foster Home (MFH) Name"",?40,""Opened Date"",?58,""Primary Caregiver Name"",?103,""Date of Birth"",?121,""Age"""
- +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 HBHCAGE,HBHCCC,HBHCCDOB,HBHCCOLM,HBHCDFN,HBHCHDR,HBHCHEAD,HBHCNAME,HBHCNOD0,HBHCPAGE,HBHCTDY,HBHCTMP,HBHCTOT,HBHCTOT1,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 ; Quit if MFH Closed
- +3 if $PIECE(HBHCNOD0,U,6)]""
- QUIT
- +4 SET HBHCCDOB=$PIECE(HBHCNOD0,U,16)
- +5 ; Quit if Caregiver Date of Birth = null
- +6 if HBHCCDOB=""
- QUIT
- +7 SET HBHCAGE=$EXTRACT(DT,1,3)-$EXTRACT(HBHCCDOB,1,3)
- +8 if ($EXTRACT(DT,4,7)<$EXTRACT(HBHCCDOB,4,7))
- SET HBHCAGE=HBHCAGE-1
- +9 SET ^TMP("HBHC",$JOB,$PIECE(HBHCNOD0,U),HBHCDFN)=$EXTRACT(...
- SET $PIECE(HBHCNOD0,U,2),4,5)_"-"_$EXTRACT($PIECE(HBHCNOD0,U,2),6,7)_"-"_$EXTRACT($PIECE(HBHCNOD0,U,2),2,3)_U_$PIECE(HBHCNOD0,U,3)_U_$EXTRACT($PIECE(HBHCNOD0,U,16),4,5)_"-"_$EXTRACT($PIECE(HBHCNOD0,U,16),6,7)_"-"_$EXTRACT(...
- ... $PIECE(HBHCNOD0,U,16),2,3)_U_HBHCAGE
- +10 QUIT
- PRTLOOP ; Print loop
- +1 SET (HBHCTOT,HBHCTOT1)=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,4))
- +3 WRITE !,HBHCNAME,?40,$PIECE(HBHCTMP,U),?58,$PIECE(HBHCTMP,U,2),?103,$PIECE(HBHCTMP,U,3),?121,$PIECE(HBHCTMP,U,4),!,HBHCY
- +4 QUIT
- PRTTOT ; Print report totals
- +1 IF ($DATA(ZTRTN)!(HBHCCC=0))&((IOSL-$Y)<1)
- WRITE @IOF
- DO HDR132NR^HBHCUTL
- +2 WRITE !!,HBHCZ,!,"Medical Foster Home (MFH) Total: ",?34,$JUSTIFY(HBHCTOT,5),!,"Average Caregiver Age: ",?34,$JUSTIFY(HBHCTOT1/HBHCTOT,5),!,HBHCZ
- +3 QUIT