HBHCRP28 ; LR VAMC(IRMS)/MJT-HBHC MFH Rate Paid rpt; user selects: pt or MFH; active only, indiv, or all pts or MFHs; current rate paid only or entire rate paid history, calls ^HBHCUTL5 @ entry points: EN, EXIT, MFH, PT, PRTPT, PRTMFH;Sep 2007
;;1.0;HOSPITAL BASED HOME CARE;**24**;NOV 01, 1993;Build 201
; Prompt for patient or MFH report
D EN^HBHCUTL5
S %ZIS="Q",HBHCCC=0 K IOP,ZTIO,ZTSAVE D ^%ZIS G:POP EXIT
I $D(IO("Q")) S ZTRTN="DQ^HBHCRP28",ZTDESC="HBPC MFH Rate Paid Report",ZTSAVE("HBHC*")="" D ^%ZTLOAD G EXIT
DQ ; De-queue
U IO
D TODAY^HBHCUTL
S HBHCPAGE=0,HBHCHEAD="Medical Foster Home (MFH) Rate Paid",HBHCCOLM=(80-(30+$L(HBHCHEAD))\2) S:HBHCCOLM'>0 HBHCCOLM=1
S HBHC1=$S(HBHCDIR="O":"Active ONLY",HBHCDIR="I":"Individual",1:"All")
S HBHC2=$S(HBHC="C":"Current Rate",1:"All Rates")_" Paid"
S:HBHCXREF="AJ" HBHC3=""
S:HBHCXREF="AK" HBHC3=$S(HBHCYN="Y":"Include",1:"Omit")_" D/C Pts"
S HBHCHDRX="W ""Selected Criteria:"",?20,HBHC1_HBHCWHO,?44,HBHC2,?65,HBHC3"
S:HBHCXREF="AJ" HBHCHDR="W ?33,""Last"",?40,""Rate"",?50,""Start"",!,""Patient Name"",?33,""Four"",?40,""Paid"",?50,""Date"",?61,""Medical Foster Home"""
S:HBHCXREF="AK" HBHCHDR="W ?55,""Last"",?62,""Rate"",?72,""Start"",!,""Medical Foster Home (MFH) Name"",?33,""Patient Name"",?55,""Four"",?62,""Paid"",?72,""Date"""
D:IO'=IO(0)!($D(IO("S"))) HDRXPAGE^HBHCUTL I '$D(IO("S")),(IO=IO(0)) S HBHCCC=HBHCCC+1 D HDRXPAGE^HBHCUTL
D:HBHCXREF="AJ" PT^HBHCUTL5
D:HBHCXREF="AK" MFH^HBHCUTL5
I $D(^TMP("HBHC",$J)) S $P(HBHCY,"-",81)="",(HBHCCNT,HBHCTOT)=0 D:HBHCXREF="AJ" PRTPT^HBHCUTL5 D:HBHCXREF="AK" PRTMFH^HBHCUTL5
I $D(^TMP("HBHC",$J)) W !,HBHCY,!!,HBHCZ,"Lowest Rate: ",$J(HBHCLOW,7,2),?28,"Highest Rate: ",$J(HBHCHI,7,2),?57,"Average Rate: ",$J((HBHCTOT/HBHCCNT),8,2),!,HBHCZ
D ENDRPT^HBHCUTL1
EXIT ; Exit module
D EXIT^HBHCUTL5
Q
PRINTPT ; Print Patient Loop
I ($D(ZTRTN)!(HBHCCC=0))&((IOSL-$Y)<5) W @IOF D HDRXPAGE^HBHCUTL
W !,HBHCM,?33,$P(HBHCINFO,U,2),?40,$J($P(HBHCINFO,U),7,2),?50,$E(HBHCJ,4,5)_"-"_$E(HBHCJ,6,7)_"-"_$E(HBHCJ,2,3),?61,$E($P(^HBHC(633.2,$P(HBHCINFO,U,3),0),U),1,19)
D TOT
Q
PRINTMFH ; Print MFH Loop
I ($D(ZTRTN)!(HBHCCC=0))&((IOSL-$Y)<5) W @IOF D HDRXPAGE^HBHCUTL
W !,HBHCL,?33,$E(HBHCM,1,19),?55,$P(HBHCINFO,U,2),?62,$J($P(HBHCINFO,U),7,2),?72,$E(HBHCJ,4,5)_"-"_$E(HBHCJ,6,7)_"-"_$E(HBHCJ,2,3)
D TOT
Q
TOT ; Update low value, high value, count, & total
S:HBHCCNT=0 HBHCLOW=$P(HBHCINFO,U),HBHCHI=$P(HBHCINFO,U)
S:$P(HBHCINFO,U)<HBHCLOW HBHCLOW=$P(HBHCINFO,U)
S:$P(HBHCINFO,U)>HBHCHI HBHCHI=$P(HBHCINFO,U)
S HBHCCNT=HBHCCNT+1
S HBHCTOT=HBHCTOT+$P(HBHCINFO,U)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHBHCRP28 2634 printed Oct 16, 2024@17:59:20 Page 2
HBHCRP28 ; LR VAMC(IRMS)/MJT-HBHC MFH Rate Paid rpt; user selects: pt or MFH; active only, indiv, or all pts or MFHs; current rate paid only or entire rate paid history, calls ^HBHCUTL5 @ entry points: EN, EXIT, MFH, PT, PRTPT, PRTMFH;Sep 2007
+1 ;;1.0;HOSPITAL BASED HOME CARE;**24**;NOV 01, 1993;Build 201
+2 ; Prompt for patient or MFH report
+3 DO EN^HBHCUTL5
+4 SET %ZIS="Q"
SET HBHCCC=0
KILL IOP,ZTIO,ZTSAVE
DO ^%ZIS
if POP
GOTO EXIT
+5 IF $DATA(IO("Q"))
SET ZTRTN="DQ^HBHCRP28"
SET ZTDESC="HBPC MFH Rate Paid Report"
SET ZTSAVE("HBHC*")=""
DO ^%ZTLOAD
GOTO EXIT
DQ ; De-queue
+1 USE IO
+2 DO TODAY^HBHCUTL
+3 SET HBHCPAGE=0
SET HBHCHEAD="Medical Foster Home (MFH) Rate Paid"
SET HBHCCOLM=(80-(30+$LENGTH(HBHCHEAD))\2)
if HBHCCOLM'>0
SET HBHCCOLM=1
+4 SET HBHC1=$SELECT(HBHCDIR="O":"Active ONLY",HBHCDIR="I":"Individual",1:"All")
+5 SET HBHC2=$SELECT(HBHC="C":"Current Rate",1:"All Rates")_" Paid"
+6 if HBHCXREF="AJ"
SET HBHC3=""
+7 if HBHCXREF="AK"
SET HBHC3=$SELECT(HBHCYN="Y":"Include",1:"Omit")_" D/C Pts"
+8 SET HBHCHDRX="W ""Selected Criteria:"",?20,HBHC1_HBHCWHO,?44,HBHC2,?65,HBHC3"
+9 if HBHCXREF="AJ"
SET HBHCHDR="W ?33,""Last"",?40,""Rate"",?50,""Start"",!,""Patient Name"",?33,""Four"",?40,""Paid"",?50,""Date"",?61,""Medical Foster Home"""
+10 if HBHCXREF="AK"
SET HBHCHDR="W ?55,""Last"",?62,""Rate"",?72,""Start"",!,""Medical Foster Home (MFH) Name"",?33,""Patient Name"",?55,""Four"",?62,""Paid"",?72,""Date"""
+11 if IO'=IO(0)!($DATA(IO("S")))
DO HDRXPAGE^HBHCUTL
IF '$DATA(IO("S"))
IF (IO=IO(0))
SET HBHCCC=HBHCCC+1
DO HDRXPAGE^HBHCUTL
+12 if HBHCXREF="AJ"
DO PT^HBHCUTL5
+13 if HBHCXREF="AK"
DO MFH^HBHCUTL5
+14 IF $DATA(^TMP("HBHC",$JOB))
SET $PIECE(HBHCY,"-",81)=""
SET (HBHCCNT,HBHCTOT)=0
if HBHCXREF="AJ"
DO PRTPT^HBHCUTL5
if HBHCXREF="AK"
DO PRTMFH^HBHCUTL5
+15 IF $DATA(^TMP("HBHC",$JOB))
WRITE !,HBHCY,!!,HBHCZ,"Lowest Rate: ",$JUSTIFY(HBHCLOW,7,2),?28,"Highest Rate: ",$JUSTIFY(HBHCHI,7,2),?57,"Average Rate: ",$JUSTIFY((HBHCTOT/HBHCCNT),8,2),!,HBHCZ
+16 DO ENDRPT^HBHCUTL1
EXIT ; Exit module
+1 DO EXIT^HBHCUTL5
+2 QUIT
PRINTPT ; Print Patient Loop
+1 IF ($DATA(ZTRTN)!(HBHCCC=0))&((IOSL-$Y)<5)
WRITE @IOF
DO HDRXPAGE^HBHCUTL
+2 WRITE !,HBHCM,?33,$PIECE(HBHCINFO,U,2),?40,$JUSTIFY($PIECE(HBHCINFO,U),7,2),?50,$EXTRACT(HBHCJ,4,5)_"-"_$EXTRACT(HBHCJ,6,7)_"-"_$EXTRACT(HBHCJ,2,3),?61,$EXTRACT($PIECE(^HBHC(633.2,$PIECE(HBHCINFO,U,3),0),U),1,19)
+3 DO TOT
+4 QUIT
PRINTMFH ; Print MFH Loop
+1 IF ($DATA(ZTRTN)!(HBHCCC=0))&((IOSL-$Y)<5)
WRITE @IOF
DO HDRXPAGE^HBHCUTL
+2 WRITE !,HBHCL,?33,$EXTRACT(HBHCM,1,19),?55,$PIECE(HBHCINFO,U,2),?62,$JUSTIFY($PIECE(HBHCINFO,U),7,2),?72,$EXTRACT(HBHCJ,4,5)_"-"_$EXTRACT(HBHCJ,6,7)_"-"_$EXTRACT(HBHCJ,2,3)
+3 DO TOT
+4 QUIT
TOT ; Update low value, high value, count, & total
+1 if HBHCCNT=0
SET HBHCLOW=$PIECE(HBHCINFO,U)
SET HBHCHI=$PIECE(HBHCINFO,U)
+2 if $PIECE(HBHCINFO,U)<HBHCLOW
SET HBHCLOW=$PIECE(HBHCINFO,U)
+3 if $PIECE(HBHCINFO,U)>HBHCHI
SET HBHCHI=$PIECE(HBHCINFO,U)
+4 SET HBHCCNT=HBHCCNT+1
+5 SET HBHCTOT=HBHCTOT+$PIECE(HBHCINFO,U)
+6 QUIT
