1 | 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
|
---|
2 | ;;1.0;HOSPITAL BASED HOME CARE;**6**;NOV 01, 1993
|
---|
3 | S %ZIS="Q",HBHCCC=0 K IOP,ZTIO,ZTSAVE D ^%ZIS Q:POP
|
---|
4 | I $D(IO("Q")) S ZTRTN="DQ^HBHCRP8",ZTSAVE("HBHC*")="",ZTDESC="HBPC Provider File Report" D ^%ZTLOAD G EXIT
|
---|
5 | DQ ; De-queue
|
---|
6 | U IO
|
---|
7 | K ^TMP("HBHC",$J)
|
---|
8 | S $P(HBHCY,"-",133)="",$P(HBHCZ,"=",133)="",HBHCPAGE=0,HBHCHEAD="Provider File"
|
---|
9 | 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 #"""
|
---|
10 | S HBHCCOLM=(132-(30+$L(HBHCHEAD))\2) S:HBHCCOLM'>0 HBHCCOLM=1 D TODAY^HBHCUTL
|
---|
11 | LOOP ; Loop thru ^HBHC(631.4 to build report
|
---|
12 | S HBHCIEN=0
|
---|
13 | 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)
|
---|
14 | D PRTLOOP,END132^HBHCUTL1
|
---|
15 | EXIT ; Exit module
|
---|
16 | D ^%ZISC
|
---|
17 | K HBHCCOLM,HBHCHDR,HBHCHEAD,HBHCIEN,HBHCCC,HBHCINFO,HBHCNAME,HBHCPAGE,HBHCPRV,HBHCTDY,HBHCTEAM,HBHCY,HBHCZ,Y,^TMP("HBHC",$J)
|
---|
18 | Q
|
---|
19 | TEAM ; Set team name
|
---|
20 | S HBHCTEAM=$S($P(HBHCINFO,U,6)]"":^HBHC(633,$P(HBHCINFO,U,6),0),1:"")
|
---|
21 | Q
|
---|
22 | PRTLOOP ; Print loop
|
---|
23 | D:IO'=IO(0)!($D(IO("S"))) HDR132NR^HBHCUTL
|
---|
24 | I '$D(IO("S")),IO=IO(0) S HBHCCC=HBHCCC+1 D HDR132NR^HBHCUTL
|
---|
25 | 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
|
---|
26 | Q
|
---|
27 | PRINT ; Print report
|
---|
28 | S HBHCINFO=^TMP("HBHC",$J,HBHCNAME,HBHCPRV)
|
---|
29 | I ($D(ZTRTN)!(HBHCCC=0))&((IOSL-$Y)<5) W @IOF D HDR132NR^HBHCUTL
|
---|
30 | 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
|
---|
31 | Q
|
---|