FHADR7 ; HISC/NCA - Staffing Yearly Average ;1/5/94 14:44
;;5.5;DIETETICS;;Jan 28, 2005
EN1 ; Enter/Edit Staffing Data
D QR^FHADR1 G:'PRE KIL S FHYR=$E(PRE,1,3) D Q2^FHADRPT
G:'SDT!('EDT) KIL
F I=1:1:6 S S(I)=0
S D1=SDT,ND=0 F L1=0:0 D N2 S X1=D1,X2=1 D C^%DTC Q:X>EDT S D1=X
F L=1:1:6 S S(L)=$S(ND:S(L)/ND,1:""),S(L)=+$J(S(L),0,1)
K DIC,DIE S DIE="^FH(117.3,",DA=PRE
S DR="27//^S X=S(1);28//^S X=S(2);29//^S X=S(3);30//^S X=S(4);31//^S X=S(5);31.6//^S X=S(6)"
L +^FH(117.3,PRE,1):0 I '$T W !?5,"Another user is editing this entry." G KIL
D ^DIE L -^FH(117.3,PRE,1) K DA,DIE,DR
S (P1,X1)=$E(PRE,1,4)_"100",X2=-356 D C^%DTC S OLD=$E(X,1,4)_"400"
S PRE=P1 I "^^^"[$P($G(^FH(117.3,P1,1)),"^",14,17) D S1 S OLD=PRE D SET S PRE=P1
W ! K DIR S DIR(0)="YAO",DIR("A")="Change the number of Specialty Staffing? ",DIR("B")="NO" D ^DIR I $D(DIRUT)!($D(DIROUT)) G KIL
G:'Y KIL
K DIE S DIE="^FH(117.3,",DA=PRE,DR="47:50" D ^DIE K DA,DIE,DR S OLD=PRE D SET
KIL G KILL^XUSCLEAN
SET ; Set three quarters with the number of Specialty Staffing
F QTR=2:1:4 S PRE=$E(OLD,1,4)_QTR_"00" D S1
Q
S1 Q:$G(^FH(117.3,OLD,1))=""
S $P(^FH(117.3,PRE,1),"^",14,17)=$P($G(^FH(117.3,OLD,1)),"^",14,17) Q
N2 S Y0=$G(^FH(117.1,D1,0)) Q:Y0="" S ND=ND+1
F L=2:1:6 S S(L-1)=S(L-1)+$P(Y0,"^",L)
S S(6)=S(6)+$P(Y0,"^",10)+$P(Y0,"^",11)
Q
EN2 ; Print the Staffing Data
D HDR
K T1 S (TQ,TQ1)=0,Z1="" F I=1:1:8 S T1(I)=""
F QR=1:1:4 S QTR=QR,PRE=FHYR_"0"_QTR_"00" D Q2^FHADRPT,Q11
D Q2
W !!!,"Specialty Staffing",!
W !,"Staff Certified Diabetes Educators (CDE): ",$J($P(Z1,"^",1),2)
W !,"Staff Certified in Nutrition Support: ",$J($P(Z1,"^",2),2)
W !,"Staff Registered Clinical Dietetic Technicians: ",$J($P(Z1,"^",3),2)
W !,"Staff With Clinical Privileges (Not Scope of Practice): ",$J($P(Z1,"^",4),2)
K S,T1 Q
Q11 Q:'SDT!('EDT)
S AV=0 F K=1:1:7 S S(K)=""
S Y0=$G(^FH(117.3,PRE,1)) Q:Y0=""
F I=1:1:5 S S(I)=$P(Y0,"^",I+5)
S S(7)=$P(Y0,"^",13),Z=$P(Y0,"^",14,17) S:"^^^"'[Z Z1=Z
S:S(1) TQ=TQ+1 S S(7)=S(7)/8,S(1)=S(1)+S(7)
S S(6)=S(1)-S(2)-S(3)-S(4)-S(5)
F L=1:1:6 S $P(T1(QTR),"^",L)=$P(T1(QTR),"^",L)+S(L),$P(T1(6),"^",L)=$P(T1(6),"^",L)+S(L)
; AMS is the Average meals served for four quarters.
S:S(6) AV=$P(AMS,"^",QTR)/S(6) S:AV TQ1=TQ1+1 S $P(T1(5),"^",QTR)=$P(T1(5),"^",QTR)+AV
Q
Q2 S K=0 F TIT="CLINICAL","ADMINISTRATIVE","SUPPORT STAFF","SUPERVISORY","ADJUSTED MEASURED" S K=K+1 D Q3
W !,"TOTAL",?36 F I=1:1:4 W $S(+$P(T1(I),"^",1)'<1:$J($P(T1(I),"^",1),7,1),1:$J("",7))_$J("",13)
W $S(TQ:$J($P(T1(6),"^",1)/TQ,7,1),1:$J("",7))
W !!,"Average Daily",!,"Meals/Adj Measured FTEE"
W ?36 F I=1:1:4 W $S($P(T1(5),"^",I):$J($P(T1(5),"^",I),7,2),1:$J("",7))_$J("",13) S $P(T1(5),"^",5)=$P(T1(5),"^",5)+$P(T1(5),"^",I)
S $P(T1(5),"^",5)=$S(TQ1:$P(T1(5),"^",5)/TQ1,1:"") W $S($P(T1(5),"^",5)'="":$J($P(T1(5),"^",5),7,2),1:$J("",7))
Q
Q3 W !,TIT,?36 F I=1:1:4 W $S(+$P(T1(I),"^",K+1)'<1:$J($P(T1(I),"^",K+1),7,1),1:$J("",7))_$J("",13)
W $S(TQ:$J($P(T1(6),"^",K+1)/TQ,7,1),1:$J("",7))
Q
HDR ; Print Heading for Staffing
D:$Y'<(LIN-25) HDR^FHADRPT
W !!!,"S E C T I O N IV S T A F F I N G"
W !!!,"FTEE Summary",!?37,"1st Qtr",?57,"2nd Qtr",?77,"3rd Qtr",?97,"4th Qtr",?120,"YTD"
W !,?38,"Total",?58,"Total",?78,"Total",?98,"Total",?116,"Average",! Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFHADR7 3326 printed Apr 09, 2024@20:58:13 Page 2
FHADR7 ; HISC/NCA - Staffing Yearly Average ;1/5/94 14:44
+1 ;;5.5;DIETETICS;;Jan 28, 2005
EN1 ; Enter/Edit Staffing Data
+1 DO QR^FHADR1
if 'PRE
GOTO KIL
SET FHYR=$EXTRACT(PRE,1,3)
DO Q2^FHADRPT
+2 if 'SDT!('EDT)
GOTO KIL
+3 FOR I=1:1:6
SET S(I)=0
+4 SET D1=SDT
SET ND=0
FOR L1=0:0
DO N2
SET X1=D1
SET X2=1
DO C^%DTC
if X>EDT
QUIT
SET D1=X
+5 FOR L=1:1:6
SET S(L)=$SELECT(ND:S(L)/ND,1:"")
SET S(L)=+$JUSTIFY(S(L),0,1)
+6 KILL DIC,DIE
SET DIE="^FH(117.3,"
SET DA=PRE
+7 SET DR="27//^S X=S(1);28//^S X=S(2);29//^S X=S(3);30//^S X=S(4);31//^S X=S(5);31.6//^S X=S(6)"
+8 LOCK +^FH(117.3,PRE,1):0
IF '$TEST
WRITE !?5,"Another user is editing this entry."
GOTO KIL
+9 DO ^DIE
LOCK -^FH(117.3,PRE,1)
KILL DA,DIE,DR
+10 SET (P1,X1)=$EXTRACT(PRE,1,4)_"100"
SET X2=-356
DO C^%DTC
SET OLD=$EXTRACT(X,1,4)_"400"
+11 SET PRE=P1
IF "^^^"[$PIECE($GET(^FH(117.3,P1,1)),"^",14,17)
DO S1
SET OLD=PRE
DO SET
SET PRE=P1
+12 WRITE !
KILL DIR
SET DIR(0)="YAO"
SET DIR("A")="Change the number of Specialty Staffing? "
SET DIR("B")="NO"
DO ^DIR
IF $DATA(DIRUT)!($DATA(DIROUT))
GOTO KIL
+13 if 'Y
GOTO KIL
+14 KILL DIE
SET DIE="^FH(117.3,"
SET DA=PRE
SET DR="47:50"
DO ^DIE
KILL DA,DIE,DR
SET OLD=PRE
DO SET
KIL GOTO KILL^XUSCLEAN
SET ; Set three quarters with the number of Specialty Staffing
+1 FOR QTR=2:1:4
SET PRE=$EXTRACT(OLD,1,4)_QTR_"00"
DO S1
+2 QUIT
S1 if $GET(^FH(117.3,OLD,1))=""
QUIT
+1 SET $PIECE(^FH(117.3,PRE,1),"^",14,17)=$PIECE($GET(^FH(117.3,OLD,1)),"^",14,17)
QUIT
N2 SET Y0=$GET(^FH(117.1,D1,0))
if Y0=""
QUIT
SET ND=ND+1
+1 FOR L=2:1:6
SET S(L-1)=S(L-1)+$PIECE(Y0,"^",L)
+2 SET S(6)=S(6)+$PIECE(Y0,"^",10)+$PIECE(Y0,"^",11)
+3 QUIT
EN2 ; Print the Staffing Data
+1 DO HDR
+2 KILL T1
SET (TQ,TQ1)=0
SET Z1=""
FOR I=1:1:8
SET T1(I)=""
+3 FOR QR=1:1:4
SET QTR=QR
SET PRE=FHYR_"0"_QTR_"00"
DO Q2^FHADRPT
DO Q11
+4 DO Q2
+5 WRITE !!!,"Specialty Staffing",!
+6 WRITE !,"Staff Certified Diabetes Educators (CDE): ",$JUSTIFY($PIECE(Z1,"^",1),2)
+7 WRITE !,"Staff Certified in Nutrition Support: ",$JUSTIFY($PIECE(Z1,"^",2),2)
+8 WRITE !,"Staff Registered Clinical Dietetic Technicians: ",$JUSTIFY($PIECE(Z1,"^",3),2)
+9 WRITE !,"Staff With Clinical Privileges (Not Scope of Practice): ",$JUSTIFY($PIECE(Z1,"^",4),2)
+10 KILL S,T1
QUIT
Q11 if 'SDT!('EDT)
QUIT
+1 SET AV=0
FOR K=1:1:7
SET S(K)=""
+2 SET Y0=$GET(^FH(117.3,PRE,1))
if Y0=""
QUIT
+3 FOR I=1:1:5
SET S(I)=$PIECE(Y0,"^",I+5)
+4 SET S(7)=$PIECE(Y0,"^",13)
SET Z=$PIECE(Y0,"^",14,17)
if "^^^"'[Z
SET Z1=Z
+5 if S(1)
SET TQ=TQ+1
SET S(7)=S(7)/8
SET S(1)=S(1)+S(7)
+6 SET S(6)=S(1)-S(2)-S(3)-S(4)-S(5)
+7 FOR L=1:1:6
SET $PIECE(T1(QTR),"^",L)=$PIECE(T1(QTR),"^",L)+S(L)
SET $PIECE(T1(6),"^",L)=$PIECE(T1(6),"^",L)+S(L)
+8 ; AMS is the Average meals served for four quarters.
+9 if S(6)
SET AV=$PIECE(AMS,"^",QTR)/S(6)
if AV
SET TQ1=TQ1+1
SET $PIECE(T1(5),"^",QTR)=$PIECE(T1(5),"^",QTR)+AV
+10 QUIT
Q2 SET K=0
FOR TIT="CLINICAL","ADMINISTRATIVE","SUPPORT STAFF","SUPERVISORY","ADJUSTED MEASURED"
SET K=K+1
DO Q3
+1 WRITE !,"TOTAL",?36
FOR I=1:1:4
WRITE $SELECT(+$PIECE(T1(I),"^",1)'<1:$JUSTIFY($PIECE(T1(I),"^",1),7,1),1:$JUSTIFY("",7))_$JUSTIFY("",13)
+2 WRITE $SELECT(TQ:$JUSTIFY($PIECE(T1(6),"^",1)/TQ,7,1),1:$JUSTIFY("",7))
+3 WRITE !!,"Average Daily",!,"Meals/Adj Measured FTEE"
+4 WRITE ?36
FOR I=1:1:4
WRITE $SELECT($PIECE(T1(5),"^",I):$JUSTIFY($PIECE(T1(5),"^",I),7,2),1:$JUSTIFY("",7))_$JUSTIFY("",13)
SET $PIECE(T1(5),"^",5)=$PIECE(T1(5),"^",5)+$PIECE(T1(5),"^",I)
+5 SET $PIECE(T1(5),"^",5)=$SELECT(TQ1:$PIECE(T1(5),"^",5)/TQ1,1:"")
WRITE $SELECT($PIECE(T1(5),"^",5)'="":$JUSTIFY($PIECE(T1(5),"^",5),7,2),1:$JUSTIFY("",7))
+6 QUIT
Q3 WRITE !,TIT,?36
FOR I=1:1:4
WRITE $SELECT(+$PIECE(T1(I),"^",K+1)'<1:$JUSTIFY($PIECE(T1(I),"^",K+1),7,1),1:$JUSTIFY("",7))_$JUSTIFY("",13)
+1 WRITE $SELECT(TQ:$JUSTIFY($PIECE(T1(6),"^",K+1)/TQ,7,1),1:$JUSTIFY("",7))
+2 QUIT
HDR ; Print Heading for Staffing
+1 if $Y'<(LIN-25)
DO HDR^FHADRPT
+2 WRITE !!!,"S E C T I O N IV S T A F F I N G"
+3 WRITE !!!,"FTEE Summary",!?37,"1st Qtr",?57,"2nd Qtr",?77,"3rd Qtr",?97,"4th Qtr",?120,"YTD"
+4 WRITE !,?38,"Total",?58,"Total",?78,"Total",?98,"Total",?116,"Average",!
QUIT
