- 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 Mar 13, 2025@21:03:22 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
