- 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 Mar 13, 2025@20:51:14 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
