Routine: HBHCRP8

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)

TEAM ; Set team name

 S HBHCTEAM=$S($P(HBHCINFO,U,6)]"":^HBHC(633,$P(HBHCINFO,U,6),0),1:"")

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

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

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHBHCRP8   2023     printed  Feb 18, 2025@23:25:05                                                                                                                                                                                                     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

HBHCRP8.m