| 1 | FHPRF1A ; HISC/REL/RVD - Print Forecast ;4/25/93  16:48 | 
|---|
| 2 | ;;5.5;DIETETICS;;Jan 28, 2005 | 
|---|
| 3 | ; | 
|---|
| 4 | STRT D NOW^%DTC S NOW=% | 
|---|
| 5 | S DTP=D1\1 D DTP^FH S TIM=$P("SUN^MON^TUES^WEDNES^THURS^FRI^SATUR","^",DOW)_"DAY  "_DTP | 
|---|
| 6 | S:'$D(FHSITENM) FHSITENM="" | 
|---|
| 7 | K S,D,N S L1=50 | 
|---|
| 8 | F P0=0:0 S P0=$O(^TMP($J,P0)) Q:P0'>0  S X=^FH(119.72,P0,0),N1=$P(X,"^",1),N2=$P(X,"^",2),N3=$P(X,"^",4) S:N3="" N3=$E(N1,1,6) S S(N3,P0)=$J(N3,8)_"^"_N2,L1=L1+8 | 
|---|
| 9 | S:L1<80 L1=80 | 
|---|
| 10 | S Z="F O R E C A S T E D   D I E T   C E N S U S" | 
|---|
| 11 | S DTP=NOW D DTP^FH W:$E(IOST,1,2)="C-" @IOF W !,DTP,?(L1-$L(Z)\2),Z | 
|---|
| 12 | S Z=$P(^FH(119.71,FHP,0),"^",1) | 
|---|
| 13 | W !,FHSITENM | 
|---|
| 14 | W !,?(L1-$L(Z)\2),Z,!!?(L1-$L(TIM)\2),TIM | 
|---|
| 15 | W !!?(L1-31\2),"P R O D U C T I O N   D I E T S",!! | 
|---|
| 16 | S X="",FHCNTX=0 F  S X=$O(S(X)) Q:X=""  S FHCNTX=FHCNTX+1 | 
|---|
| 17 | S FHSP1=31 | 
|---|
| 18 | S:FHCNTX=5 FHSP1=18 | 
|---|
| 19 | S:FHCNTX=4 FHSP1=19 | 
|---|
| 20 | S:FHCNTX=3 FHSP1=25 | 
|---|
| 21 | S:FHCNTX=2 FHSP1=31 | 
|---|
| 22 | S:FHCNTX=1 FHSP1=37 | 
|---|
| 23 | S FHSP2=33 | 
|---|
| 24 | S:FHCNTX=5 FHSP2=20 | 
|---|
| 25 | S:FHCNTX=4 FHSP2=21 | 
|---|
| 26 | S:FHCNTX=3 FHSP2=27 | 
|---|
| 27 | S:FHCNTX=2 FHSP2=33 | 
|---|
| 28 | S:FHCNTX=1 FHSP2=39 | 
|---|
| 29 | W ?FHSP1 | 
|---|
| 30 | ; | 
|---|
| 31 | S X="" F  S X=$O(S(X)) Q:X=""  F K=0:0 S K=$O(S(X,K)) Q:K=""  W $P(S(X,K),"^",1) | 
|---|
| 32 | W "    Tray  Cafe  Total" | 
|---|
| 33 | S:L1>80 L1=80 S LN="",$P(LN,"-",L1)="" W !,LN,! K LN | 
|---|
| 34 | F P1=0:0 S P1=$O(^FH(116.2,"AP",P1)) Q:P1<1  F K=0:0 S K=$O(^FH(116.2,"AP",P1,K)) Q:K<1  I $D(^TMP($J,0,K)) D PRO | 
|---|
| 35 | W !!,"TOTAL MEALS",?FHSP2 S (N("T"),N("C"),N("D"),N("G"))="" | 
|---|
| 36 | S X="" F  S X=$O(S(X)) Q:X=""  F K1=0:0 S K1=$O(S(X,K1)) Q:K1=""  S Z=$G(^TMP($J,K1)),TYP=$P(S(X,K1),"^",2) S:Z N(TYP)=N(TYP)+Z W $J(Z,6),"  " | 
|---|
| 37 | S:N("D") N("T")=N("T")+N("D") W $J(N("T"),6),$J(N("C"),6),$J(N("T")+N("C"),7) Q | 
|---|
| 38 | W !!!,"*** Includes other gratuitous/paid meals.",! K S,D,N,P Q | 
|---|
| 39 | PRO S (N("T"),N("C"),N("D"),N("G"))="" W !,$E($P($G(^FH(116.2,K,0)),"^",1),1,20),?FHSP2 | 
|---|
| 40 | S X="" F  S X=$O(S(X)) Q:X=""  F K1=0:0 S K1=$O(S(X,K1)) Q:K1=""  S Z=$G(^TMP($J,K1,K)),TYP=$P(S(X,K1),"^",2) S:Z N(TYP)=N(TYP)+Z W $J(Z,6),"  " | 
|---|
| 41 | S:N("D") N("T")=N("T")+N("D") W $J(N("T"),6),$J(N("C"),6),$J(N("T")+N("C"),7) Q | 
|---|