HBHCRP8 ; LR VAMC(IRMS)/MJT-HBHC report on ^HBHC(631.4, HBHC Provider file, sorted by provider & includes: provider name, provider number, degree, grade/step, HBHC FTEE, HBHC Team, & Inactive Provider Number ;9205
;;1.0;HOSPITAL BASED HOME CARE;**6**;NOV 01, 1993
S %ZIS="Q",HBHCCC=0 K IOP,ZTIO,ZTSAVE D ^%ZIS Q:POP
I $D(IO("Q")) S ZTRTN="DQ^HBHCRP8",ZTSAVE("HBHC*")="",ZTDESC="HBPC Provider File Report" D ^%ZTLOAD G EXIT
DQ ; De-queue
U IO
K ^TMP("HBHC",$J)
S $P(HBHCY,"-",133)="",$P(HBHCZ,"=",133)="",HBHCPAGE=0,HBHCHEAD="Provider File"
S HBHCHDR="W !?40,""Provider"",?69,""Grade"",?80,""HBPC"",?124,""Inactive"",!,""Provider Name"",?40,""Number"",?49,""Degree"",?69,""/Step"",?80,""FTEE"",?89,""HBHC Team"",?124,""Prov #"""
S HBHCCOLM=(132-(30+$L(HBHCHEAD))\2) S:HBHCCOLM'>0 HBHCCOLM=1 D TODAY^HBHCUTL
LOOP ; Loop thru ^HBHC(631.4 to build report
S HBHCIEN=0
F S HBHCIEN=$O(^HBHC(631.4,HBHCIEN)) Q:HBHCIEN'>0 S HBHCINFO=^HBHC(631.4,HBHCIEN,0) D TEAM S ^TMP("HBHC",$J,$P(^VA(200,$P(HBHCINFO,U,2),0),U),$P(HBHCINFO,U))=$P(HBHCINFO,U,3)_U_$P(HBHCINFO,U,4)_U_$P(HBHCINFO,U,5)_U_HBHCTEAM_U_$P(HBHCINFO,U,7)
D PRTLOOP,END132^HBHCUTL1
EXIT ; Exit module
D ^%ZISC
K HBHCCOLM,HBHCHDR,HBHCHEAD,HBHCIEN,HBHCCC,HBHCINFO,HBHCNAME,HBHCPAGE,HBHCPRV,HBHCTDY,HBHCTEAM,HBHCY,HBHCZ,Y,^TMP("HBHC",$J)
Q
TEAM ; Set team name
S HBHCTEAM=$S($P(HBHCINFO,U,6)]"":^HBHC(633,$P(HBHCINFO,U,6),0),1:"")
Q
PRTLOOP ; Print loop
D:IO'=IO(0)!($D(IO("S"))) HDR132NR^HBHCUTL
I '$D(IO("S")),IO=IO(0) S HBHCCC=HBHCCC+1 D HDR132NR^HBHCUTL
S HBHCNAME="" F S HBHCNAME=$O(^TMP("HBHC",$J,HBHCNAME)) Q:HBHCNAME="" S HBHCPRV="" F S HBHCPRV=$O(^TMP("HBHC",$J,HBHCNAME,HBHCPRV)) Q:HBHCPRV="" D PRINT
Q
PRINT ; Print report
S HBHCINFO=^TMP("HBHC",$J,HBHCNAME,HBHCPRV)
I ($D(ZTRTN)!(HBHCCC=0))&((IOSL-$Y)<5) W @IOF D HDR132NR^HBHCUTL
W !,HBHCNAME,?40,HBHCPRV,?49,$P(HBHCINFO,U),?69,$P(HBHCINFO,U,2),?80,$J($P(HBHCINFO,U,3),3,1),?89,$P(HBHCINFO,U,4),?124,$S($P(HBHCINFO,U,5)]"":"Inactive",1:""),!,HBHCY
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHBHCRP8 2023 printed Nov 22, 2024@17:08:49 Page 2
HBHCRP8 ; LR VAMC(IRMS)/MJT-HBHC report on ^HBHC(631.4, HBHC Provider file, sorted by provider & includes: provider name, provider number, degree, grade/step, HBHC FTEE, HBHC Team, & Inactive Provider Number ;9205
+1 ;;1.0;HOSPITAL BASED HOME CARE;**6**;NOV 01, 1993
+2 SET %ZIS="Q"
SET HBHCCC=0
KILL IOP,ZTIO,ZTSAVE
DO ^%ZIS
if POP
QUIT
+3 IF $DATA(IO("Q"))
SET ZTRTN="DQ^HBHCRP8"
SET ZTSAVE("HBHC*")=""
SET ZTDESC="HBPC Provider File Report"
DO ^%ZTLOAD
GOTO EXIT
DQ ; De-queue
+1 USE IO
+2 KILL ^TMP("HBHC",$JOB)
+3 SET $PIECE(HBHCY,"-",133)=""
SET $PIECE(HBHCZ,"=",133)=""
SET HBHCPAGE=0
SET HBHCHEAD="Provider File"
+4 SET HBHCHDR="W !?40,""Provider"",?69,""Grade"",?80,""HBPC"",?124,""Inactive"",!,""Provider Name"",?40,""Number"",?49,""Degree"",?69,""/Step"",?80,""FTEE"",?89,""HBHC Team"",?124,""Prov #"""
+5 SET HBHCCOLM=(132-(30+$LENGTH(HBHCHEAD))\2)
if HBHCCOLM'>0
SET HBHCCOLM=1
DO TODAY^HBHCUTL
LOOP ; Loop thru ^HBHC(631.4 to build report
+1 SET HBHCIEN=0
+2 FOR
SET HBHCIEN=$ORDER(^HBHC(631.4,HBHCIEN))
if HBHCIEN'>0
QUIT
SET HBHCINFO=^HBHC(631.4,HBHCIEN,0)
DO TEAM
SET ^TMP("HBHC",$JOB,$PIECE(^VA(200,$PIECE(HBHCINFO,U,2),0),U),$PIECE(HBHCINFO,U))=$PIECE(HBHCINFO,U,3)_U_$PIECE(HBHCINFO,U,4)_U_$PIECE(HBHCINFO,U,5)_U_HBHCTEAM_U_$PIECE(HBHCINFO,U,7)
+3 DO PRTLOOP
DO END132^HBHCUTL1
EXIT ; Exit module
+1 DO ^%ZISC
+2 KILL HBHCCOLM,HBHCHDR,HBHCHEAD,HBHCIEN,HBHCCC,HBHCINFO,HBHCNAME,HBHCPAGE,HBHCPRV,HBHCTDY,HBHCTEAM,HBHCY,HBHCZ,Y,^TMP("HBHC",$JOB)
+3 QUIT
TEAM ; Set team name
+1 SET HBHCTEAM=$SELECT($PIECE(HBHCINFO,U,6)]"":^HBHC(633,$PIECE(HBHCINFO,U,6),0),1:"")
+2 QUIT
PRTLOOP ; Print loop
+1 if IO'=IO(0)!($DATA(IO("S")))
DO HDR132NR^HBHCUTL
+2 IF '$DATA(IO("S"))
IF IO=IO(0)
SET HBHCCC=HBHCCC+1
DO HDR132NR^HBHCUTL
+3 SET HBHCNAME=""
FOR
SET HBHCNAME=$ORDER(^TMP("HBHC",$JOB,HBHCNAME))
if HBHCNAME=""
QUIT
SET HBHCPRV=""
FOR
SET HBHCPRV=$ORDER(^TMP("HBHC",$JOB,HBHCNAME,HBHCPRV))
if HBHCPRV=""
QUIT
DO PRINT
+4 QUIT
PRINT ; Print report
+1 SET HBHCINFO=^TMP("HBHC",$JOB,HBHCNAME,HBHCPRV)
+2 IF ($DATA(ZTRTN)!(HBHCCC=0))&((IOSL-$Y)<5)
WRITE @IOF
DO HDR132NR^HBHCUTL
+3 WRITE !,HBHCNAME,?40,HBHCPRV,?49,$PIECE(HBHCINFO,U),?69,$PIECE(HBHCINFO,U,2),?80,$JUSTIFY($PIECE(HBHCINFO,U,3),3,1),?89,$PIECE(HBHCINFO,U,4),?124,$SELECT($PIECE(HBHCINFO,U,5)]"":"Inactive",1:""),!,HBHCY
+4 QUIT
