source: WorldVistAEHR/trunk/r/DIETETICS-FH/FHPRF1A.m

Last change on this file was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.9 KB
Line 
1FHPRF1A ; HISC/REL/RVD - Print Forecast ;4/25/93 16:48
2 ;;5.5;DIETETICS;;Jan 28, 2005
3 ;
4STRT 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
39PRO 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
Note: See TracBrowser for help on using the repository browser.