HBHCR15B ;LR VAMC(IRMS)/MJT-HBHC rpt using file 634.6, called from HBHCR15A, entry points: PROMPT1 & END, & from HBHCXMT, entry point: PROMPT2 ;9804
;;1.0;HOSPITAL BASED HOME CARE;**6,8,9,10,13,15,24**;NOV 01, 1993;Build 201
PROMPT1 ; Prompt user for which transmit date from last 12 batchs to include, default is Most Recent; uses transmit date cross-ref to obtain batch dates
S HBHCDATE="" F S HBHCDATE=$O(^HBHC(634.6,"C",HBHCDATE)) Q:HBHCDATE="" S HBHC(-HBHCDATE)=""
S HBHCDATE="" F HBHCI=1:1 S HBHCDATE=$O(HBHC(HBHCDATE)) Q:(HBHCDATE="")!(HBHCI>12) S Y=$E(HBHCDATE,2,9) D DD^%DT S TMP(HBHCI)=$E(HBHCDATE,2,9) W !,$J(HBHCI,2),".",?6,Y
W !
K DIR,DIRUT
S DIR(0)="N^",DIR("A")="Select Transmit Date",DIR("B")=1,DIR("?")="Select transmit date by number. Press return for 'Most Recent' transmit date"
D ^DIR Q:$D(DIRUT)
I '$D(TMP(Y)) W $C(7),!!,"Please select number from list.",! H 1 G PROMPT1
S HBHCXMDT=TMP(Y)
PROMPT2 ; Prompt user for which forms to include, default is Summary
S HBHCCC=0
D TODAY^HBHCUTL
S:'$D(HBHCXMDT) HBHCXMDT=DT
S:$P(^HBHC(631.9,1,0),U,7)]"" HBHCIOP=$P(^%ZIS(1,$P(^HBHC(631.9,1,0),U,7),0),U)
; Check if MFH Site
D MFHS^HBHCUTL3
K DIR,DIRUT
I '$D(HBHCMFHS) S DIR(0)="S^3:Admission;4:Visit;5:Discharge;6:Correction;A:All;S:Summary;"
I $D(HBHCMFHS) S DIR(0)="S^3:Admission;4:Visit;5:Discharge;6:Correction;7:Medical Foster Home;A:All;S:Summary;"
S DIR("A")="Select Forms to Include",DIR("B")="Summary",DIR("?")="Select form type to be included in report. Press return for 'Summary'." D ^DIR Q:$D(DIRUT)
S HBHCDIR=Y,HBHCY0=Y(0)
S Y=HBHCXMDT D DD^%DT S HBHCHEAD=$S(HBHCDIR="S":Y_" Transmit, "_HBHCY0,1:Y_" Transmit, "_HBHCY0_" Forms,")
Q
END ; End of report processing
; Count number of visits
S HBHCCNT=0,HBHCNAME="" F S HBHCNAME=$O(^TMP($J,HBHCNAME)) Q:HBHCNAME="" S HBHCLST4=0 F S HBHCLST4=$O(^TMP($J,HBHCNAME,HBHCLST4)) Q:HBHCLST4'>0 S HBHCDATE=0 F S HBHCDATE=$O(^TMP($J,HBHCNAME,HBHCLST4,HBHCDATE)) Q:HBHCDATE'>0 D CONT
; Reset HBHCHDR when MFH Form 7 only, or All, selected & MFH recs are all that exist
S:((HBHCCNTA+HBHCCNTR+HBHCCNT4+HBHCCNT5+HBHCCNT6)=0)!(HBHCDIR=7) HBHCHDR="W !?4,""#"",?8,""Medical Foster Home Name"",?38,""Opened Date"""
D:IO'=IO(0)!($D(IO("S"))) HDRPAGE^HBHCUTL
I '$D(IO("S")),IO=IO(0) S HBHCCC=HBHCCC+1 W @IOF D HDRPAGE^HBHCUTL
D:HBHCDIR'="S" PRTLOOP
I HBHCDIR="A" S HBHCHDR="W ?36,""Summary""" W @IOF D HDRPAGE^HBHCUTL
W:(HBHCDIR'="A")&(HBHCDIR'="S") !
W:(HBHCDIR=3)!(HBHCDIR="A")!(HBHCDIR="S") !,"Admit Eval/Adm Form 3 Total:",?35,$J(HBHCCNTA,5),!,"Reject Eval/Adm Form 3 Total:",?35,$J(HBHCCNTR,5)
W:HBHCDIR=3 !?35,"-----",!,"All Eval/Adm Forms Total:",?34,$J(HBHCCNTA+HBHCCNTR,6),!
W:(HBHCDIR=4)!(HBHCDIR="A")!(HBHCDIR="S") !,"Visit Form 4 Total:",?35,$J(HBHCCNT4,5)
W:(HBHCDIR=5)!(HBHCDIR="A")!(HBHCDIR="S") !,"Discharge Form 5 Total:",?35,$J(HBHCCNT5,5)
W:(HBHCDIR=6)!(HBHCDIR="A")!(HBHCDIR="S") !,"Correction Form 6 Total:",?35,$J(HBHCCNT6,5)
I $D(HBHCMFHS) W:(HBHCDIR=7)!(HBHCDIR="A")!(HBHCDIR="S") !,"Medical Foster Home Form 7 Total:",?35,$J(HBHCCNT7,5)
I '$D(HBHCMFHS) W:(HBHCDIR="A")!(HBHCDIR="S") !?35,"-----",!,"All Forms Total:",?34,$J(HBHCCNTA+HBHCCNTR+HBHCCNT4+HBHCCNT5+HBHCCNT6,6)
I $D(HBHCMFHS) W:(HBHCDIR="A")!(HBHCDIR="S") !?35,"-----",!,"All Forms Total:",?34,$J(HBHCCNTA+HBHCCNTR+HBHCCNT4+HBHCCNT5+HBHCCNT6+HBHCCNT7,6)
W:(HBHCDIR=4)!(HBHCDIR="A")!(HBHCDIR="S") !!,"Number of Visits Total:",?35,$J(HBHCCNT,5)
D ENDRPT^HBHCUTL1
Q
CONT ; Continue count of visits loop
S HBHCPRV="" F S HBHCPRV=$O(^TMP($J,HBHCNAME,HBHCLST4,HBHCDATE,HBHCPRV)) Q:HBHCPRV="" S HBHCCNT=HBHCCNT+1
Q
PRTLOOP ; Print loop
S HBHCFORM="" F S HBHCFORM=$O(^TMP("HBHC",$J,HBHCFORM)) Q:HBHCFORM="" D HEADER,PRTLOOP2,SUB
Q
PRTLOOP2 ; Print loop continued
S HBHCACTN="" F S HBHCACTN=$O(^TMP("HBHC",$J,HBHCFORM,HBHCACTN)) Q:HBHCACTN="" S HBHCNAME="" F S HBHCNAME=$O(^TMP("HBHC",$J,HBHCFORM,HBHCACTN,HBHCNAME)) Q:HBHCNAME="" D PRTLOOP3
Q
PRTLOOP3 ; Print loop continued (again)
S HBHCLST4=0 F S HBHCLST4=$O(^TMP("HBHC",$J,HBHCFORM,HBHCACTN,HBHCNAME,HBHCLST4)) Q:HBHCLST4'>0 S HBHCDATE="" F S HBHCDATE=$O(^TMP("HBHC",$J,HBHCFORM,HBHCACTN,HBHCNAME,HBHCLST4,HBHCDATE)) Q:HBHCDATE="" D PRTLOOP4
Q
PRTLOOP4 ; Print loop continued (again & again)
S HBHCPRV="" F S HBHCPRV=$O(^TMP("HBHC",$J,HBHCFORM,HBHCACTN,HBHCNAME,HBHCLST4,HBHCDATE,HBHCPRV)) Q:HBHCPRV="" S HBHCIEN="" F S HBHCIEN=$O(^TMP("HBHC",$J,HBHCFORM,HBHCACTN,HBHCNAME,HBHCLST4,HBHCDATE,HBHCPRV,HBHCIEN)) Q:HBHCIEN="" D PRINT
Q
PRINT ; Print report
S HBHCINFO=^TMP("HBHC",$J,HBHCFORM,HBHCACTN,HBHCNAME,HBHCLST4,HBHCDATE,HBHCPRV,HBHCIEN)
I ($D(ZTRTN)!(HBHCCC=0))&((IOSL-$Y)<10) W:HBHCPAGE>0 @IOF D HDRPAGE^HBHCUTL,HEADER
W !?4,$S(HBHCFORM="A":3,HBHCFORM="V":4,HBHCFORM="D":5,HBHCFORM="Z":7,1:6),?8,HBHCNAME W:HBHCFORM'="Z" ?31,HBHCLST4 W ?38,$E(HBHCDATE,1,2),"-",$E(HBHCDATE,3,4),"-",$E(HBHCDATE,7,8) W:$P(HBHCINFO,U,3)]"" ?46,"@"_$P(HBHCINFO,U,3)
W ?55,$S(HBHCFORM=6:$P(HBHCINFO,U,2),HBHCFORM="A":HBHCACTN,HBHCFORM="V":$P(HBHCINFO,U),1:"") W:HBHCFORM="V" ?60,HBHCPRV
Q
W !,$S(HBHCFORM=6:"Correction Form 6",HBHCFORM="A":"Evaluation/Admission Form 3",HBHCFORM="D":"Discharge Form 5",HBHCFORM="Z":"Medical Foster Home Form 7",1:"Visit Form 4")_" Records"
W ?55,$S(HBHCFORM=6:"Type",HBHCFORM="A":"Action",HBHCFORM="V":"Provider",1:""),!
Q
SUB ; Sub-total module
W:(HBHCDIR="A")&(HBHCFORM=6) !!?4,"Correction Form 6 Total:",?37,$J(HBHCCNT6,5),!,HBHCY
W:(HBHCDIR="A")&(HBHCFORM="A") !!?4,"Admit Eval/Adm Form 3 Total:",?37,$J(HBHCCNTA,5),!?4,"Reject Eval/Adm Form 3 Total:",?37,$J(HBHCCNTR,5),!?37,"-----",!?4,"All Eval/Adm Forms Total:",?39,$J(HBHCCNTA+HBHCCNTR,6),!,HBHCY
W:(HBHCDIR="A")&(HBHCFORM="D") !!?4,"Discharge Form 5 Total:",?37,$J(HBHCCNT5,5),!,HBHCY
W:(HBHCDIR="A")&(HBHCFORM="V") !!?4,"Visit Form 4 Total:",?30,$J(HBHCCNT4,5)
W:(HBHCDIR="A")&(HBHCFORM="V") !!?4,"Number of Visits Total:",?30,$J(HBHCCNT,5),!,HBHCY
W:(HBHCDIR="A")&(HBHCFORM="Z") !!?4,"Medical Foster Home Form 7 Total:",?37,$J(HBHCCNT7,5),!,HBHCY
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHBHCR15B 6111 printed Sep 23, 2025@19:34:16 Page 2
HBHCR15B ;LR VAMC(IRMS)/MJT-HBHC rpt using file 634.6, called from HBHCR15A, entry points: PROMPT1 & END, & from HBHCXMT, entry point: PROMPT2 ;9804
+1 ;;1.0;HOSPITAL BASED HOME CARE;**6,8,9,10,13,15,24**;NOV 01, 1993;Build 201
PROMPT1 ; Prompt user for which transmit date from last 12 batchs to include, default is Most Recent; uses transmit date cross-ref to obtain batch dates
+1 SET HBHCDATE=""
FOR
SET HBHCDATE=$ORDER(^HBHC(634.6,"C",HBHCDATE))
if HBHCDATE=""
QUIT
SET HBHC(-HBHCDATE)=""
+2 SET HBHCDATE=""
FOR HBHCI=1:1
SET HBHCDATE=$ORDER(HBHC(HBHCDATE))
if (HBHCDATE="")!(HBHCI>12)
QUIT
SET Y=$EXTRACT(HBHCDATE,2,9)
DO DD^%DT
SET TMP(HBHCI)=$EXTRACT(HBHCDATE,2,9)
WRITE !,$JUSTIFY(HBHCI,2),".",?6,Y
+3 WRITE !
+4 KILL DIR,DIRUT
+5 SET DIR(0)="N^"
SET DIR("A")="Select Transmit Date"
SET DIR("B")=1
SET DIR("?")="Select transmit date by number. Press return for 'Most Recent' transmit date"
+6 DO ^DIR
if $DATA(DIRUT)
QUIT
+7 IF '$DATA(TMP(Y))
WRITE $CHAR(7),!!,"Please select number from list.",!
HANG 1
GOTO PROMPT1
+8 SET HBHCXMDT=TMP(Y)
PROMPT2 ; Prompt user for which forms to include, default is Summary
+1 SET HBHCCC=0
+2 DO TODAY^HBHCUTL
+3 if '$DATA(HBHCXMDT)
SET HBHCXMDT=DT
+4 if $PIECE(^HBHC(631.9,1,0),U,7)]""
SET HBHCIOP=$PIECE(^%ZIS(1,$PIECE(^HBHC(631.9,1,0),U,7),0),U)
+5 ; Check if MFH Site
+6 DO MFHS^HBHCUTL3
+7 KILL DIR,DIRUT
+8 IF '$DATA(HBHCMFHS)
SET DIR(0)="S^3:Admission;4:Visit;5:Discharge;6:Correction;A:All;S:Summary;"
+9 IF $DATA(HBHCMFHS)
SET DIR(0)="S^3:Admission;4:Visit;5:Discharge;6:Correction;7:Medical Foster Home;A:All;S:Summary;"
+10 SET DIR("A")="Select Forms to Include"
SET DIR("B")="Summary"
SET DIR("?")="Select form type to be included in report. Press return for 'Summary'."
DO ^DIR
if $DATA(DIRUT)
QUIT
+11 SET HBHCDIR=Y
SET HBHCY0=Y(0)
+12 SET Y=HBHCXMDT
DO DD^%DT
SET HBHCHEAD=$SELECT(HBHCDIR="S":Y_" Transmit, "_HBHCY0,1:Y_" Transmit, "_HBHCY0_" Forms,")
+13 QUIT
END ; End of report processing
+1 ; Count number of visits
+2 SET HBHCCNT=0
SET HBHCNAME=""
FOR
SET HBHCNAME=$ORDER(^TMP($JOB,HBHCNAME))
if HBHCNAME=""
QUIT
SET HBHCLST4=0
FOR
SET HBHCLST4=$ORDER(^TMP($JOB,HBHCNAME,HBHCLST4))
if HBHCLST4'>0
QUIT
SET HBHCDATE=0
FOR
SET HBHCDATE=$ORDER(^TMP($JOB,HBHCNAME,HBHCLST4,HBHCDATE))
if HBHCDATE'>0
QUIT
DO CONT
+3 ; Reset HBHCHDR when MFH Form 7 only, or All, selected & MFH recs are all that exist
+4 if ((HBHCCNTA+HBHCCNTR+HBHCCNT4+HBHCCNT5+HBHCCNT6)=0)!(HBHCDIR=7)
SET HBHCHDR="W !?4,""#"",?8,""Medical Foster Home Name"",?38,""Opened Date"""
+5 if IO'=IO(0)!($DATA(IO("S")))
DO HDRPAGE^HBHCUTL
+6 IF '$DATA(IO("S"))
IF IO=IO(0)
SET HBHCCC=HBHCCC+1
WRITE @IOF
DO HDRPAGE^HBHCUTL
+7 if HBHCDIR'="S"
DO PRTLOOP
+8 IF HBHCDIR="A"
SET HBHCHDR="W ?36,""Summary"""
WRITE @IOF
DO HDRPAGE^HBHCUTL
+9 if (HBHCDIR'="A")&(HBHCDIR'="S")
WRITE !
+10 if (HBHCDIR=3)!(HBHCDIR="A")!(HBHCDIR="S")
WRITE !,"Admit Eval/Adm Form 3 Total:",?35,$JUSTIFY(HBHCCNTA,5),!,"Reject Eval/Adm Form 3 Total:",?35,$JUSTIFY(HBHCCNTR,5)
+11 if HBHCDIR=3
WRITE !?35,"-----",!,"All Eval/Adm Forms Total:",?34,$JUSTIFY(HBHCCNTA+HBHCCNTR,6),!
+12 if (HBHCDIR=4)!(HBHCDIR="A")!(HBHCDIR="S")
WRITE !,"Visit Form 4 Total:",?35,$JUSTIFY(HBHCCNT4,5)
+13 if (HBHCDIR=5)!(HBHCDIR="A")!(HBHCDIR="S")
WRITE !,"Discharge Form 5 Total:",?35,$JUSTIFY(HBHCCNT5,5)
+14 if (HBHCDIR=6)!(HBHCDIR="A")!(HBHCDIR="S")
WRITE !,"Correction Form 6 Total:",?35,$JUSTIFY(HBHCCNT6,5)
+15 IF $DATA(HBHCMFHS)
if (HBHCDIR=7)!(HBHCDIR="A")!(HBHCDIR="S")
WRITE !,"Medical Foster Home Form 7 Total:",?35,$JUSTIFY(HBHCCNT7,5)
+16 IF '$DATA(HBHCMFHS)
if (HBHCDIR="A")!(HBHCDIR="S")
WRITE !?35,"-----",!,"All Forms Total:",?34,$JUSTIFY(HBHCCNTA+HBHCCNTR+HBHCCNT4+HBHCCNT5+HBHCCNT6,6)
+17 IF $DATA(HBHCMFHS)
if (HBHCDIR="A")!(HBHCDIR="S")
WRITE !?35,"-----",!,"All Forms Total:",?34,$JUSTIFY(HBHCCNTA+HBHCCNTR+HBHCCNT4+HBHCCNT5+HBHCCNT6+HBHCCNT7,6)
+18 if (HBHCDIR=4)!(HBHCDIR="A")!(HBHCDIR="S")
WRITE !!,"Number of Visits Total:",?35,$JUSTIFY(HBHCCNT,5)
+19 DO ENDRPT^HBHCUTL1
+20 QUIT
CONT ; Continue count of visits loop
+1 SET HBHCPRV=""
FOR
SET HBHCPRV=$ORDER(^TMP($JOB,HBHCNAME,HBHCLST4,HBHCDATE,HBHCPRV))
if HBHCPRV=""
QUIT
SET HBHCCNT=HBHCCNT+1
+2 QUIT
PRTLOOP ; Print loop
+1 SET HBHCFORM=""
FOR
SET HBHCFORM=$ORDER(^TMP("HBHC",$JOB,HBHCFORM))
if HBHCFORM=""
QUIT
DO HEADER
DO PRTLOOP2
DO SUB
+2 QUIT
PRTLOOP2 ; Print loop continued
+1 SET HBHCACTN=""
FOR
SET HBHCACTN=$ORDER(^TMP("HBHC",$JOB,HBHCFORM,HBHCACTN))
if HBHCACTN=""
QUIT
SET HBHCNAME=""
FOR
SET HBHCNAME=$ORDER(^TMP("HBHC",$JOB,HBHCFORM,HBHCACTN,HBHCNAME))
if HBHCNAME=""
QUIT
DO PRTLOOP3
+2 QUIT
PRTLOOP3 ; Print loop continued (again)
+1 SET HBHCLST4=0
FOR
SET HBHCLST4=$ORDER(^TMP("HBHC",$JOB,HBHCFORM,HBHCACTN,HBHCNAME,HBHCLST4))
if HBHCLST4'>0
QUIT
SET HBHCDATE=""
FOR
SET HBHCDATE=$ORDER(^TMP("HBHC",$JOB,HBHCFORM,HBHCACTN,HBHCNAME,HBHCLST4,HBHCDATE))
if HBHCDATE=""
QUIT
DO PRTLOOP4
+2 QUIT
PRTLOOP4 ; Print loop continued (again & again)
+1 SET HBHCPRV=""
FOR
SET HBHCPRV=$ORDER(^TMP("HBHC",$JOB,HBHCFORM,HBHCACTN,HBHCNAME,HBHCLST4,HBHCDATE,HBHCPRV))
if HBHCPRV=""
QUIT
SET HBHCIEN=""
FOR
SET HBHCIEN=$ORDER(^TMP("HBHC",$JOB,HBHCFORM,HBHCACTN,HBHCNAME,HBHCLST4,HBHCDATE,HBHCPRV,HBHCIEN))
if HBHCIEN=""
QUIT
DO PRINT
+2 QUIT
PRINT ; Print report
+1 SET HBHCINFO=^TMP("HBHC",$JOB,HBHCFORM,HBHCACTN,HBHCNAME,HBHCLST4,HBHCDATE,HBHCPRV,HBHCIEN)
+2 IF ($DATA(ZTRTN)!(HBHCCC=0))&((IOSL-$Y)<10)
if HBHCPAGE>0
WRITE @IOF
DO HDRPAGE^HBHCUTL
DO HEADER
+3 WRITE !?4,$SELECT(HBHCFORM="A":3,HBHCFORM="V":4,HBHCFORM="D":5,HBHCFORM="Z":7,1:6),?8,HBHCNAME
if HBHCFORM'="Z"
WRITE ?31,HBHCLST4
WRITE ?38,$EXTRACT(HBHCDATE,1,2),"-",$EXTRACT(HBHCDATE,3,4),"-",$EXTRACT(HBHCDATE,7,8)
if $PIECE(HBHCINFO,U,3)]""
WRITE ?46,"@"_$PIECE(HBHCINFO,U,3)
+4 WRITE ?55,$SELECT(HBHCFORM=6:$PIECE(HBHCINFO,U,2),HBHCFORM="A":HBHCACTN,HBHCFORM="V":$PIECE(HBHCINFO,U),1:"")
if HBHCFORM="V"
WRITE ?60,HBHCPRV
+5 QUIT
+1 WRITE !,$SELECT(HBHCFORM=6:"Correction Form 6",HBHCFORM="A":"Evaluation/Admission Form 3",HBHCFORM="D":"Discharge Form 5",HBHCFORM="Z":"Medical Foster Home Form 7",1:"Visit Form 4")_" Records"
+2 WRITE ?55,$SELECT(HBHCFORM=6:"Type",HBHCFORM="A":"Action",HBHCFORM="V":"Provider",1:""),!
+3 QUIT
SUB ; Sub-total module
+1 if (HBHCDIR="A")&(HBHCFORM=6)
WRITE !!?4,"Correction Form 6 Total:",?37,$JUSTIFY(HBHCCNT6,5),!,HBHCY
+2 if (HBHCDIR="A")&(HBHCFORM="A")
WRITE !!?4,"Admit Eval/Adm Form 3 Total:",?37,$JUSTIFY(HBHCCNTA,5),!?4,"Reject Eval/Adm Form 3 Total:",?37,$JUSTIFY(HBHCCNTR,5),!?37,"-----",!?4,"All Eval/Adm Forms Total:",?39,$JUSTIFY(HBHCCNTA+HBHCCNTR,6),!,HBHCY
+3 if (HBHCDIR="A")&(HBHCFORM="D")
WRITE !!?4,"Discharge Form 5 Total:",?37,$JUSTIFY(HBHCCNT5,5),!,HBHCY
+4 if (HBHCDIR="A")&(HBHCFORM="V")
WRITE !!?4,"Visit Form 4 Total:",?30,$JUSTIFY(HBHCCNT4,5)
+5 if (HBHCDIR="A")&(HBHCFORM="V")
WRITE !!?4,"Number of Visits Total:",?30,$JUSTIFY(HBHCCNT,5),!,HBHCY
+6 if (HBHCDIR="A")&(HBHCFORM="Z")
WRITE !!?4,"Medical Foster Home Form 7 Total:",?37,$JUSTIFY(HBHCCNT7,5),!,HBHCY
+7 QUIT
