source: WorldVistAEHR/trunk/r/DIETETICS-FH/FHORD91.m@ 1087

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

initial load of WorldVistAEHR

File size: 1.8 KB
RevLine 
[613]1FHORD91 ; HISC/REL/NCA/RVD - Diet Census Cont. ;1/23/98 16:08
2 ;;5.5;DIETETICS;;Jan 28, 2005
3 ;
4 K S S L1=50
5STR F K=0:0 S K=$O(D(K)) Q:K="" S P(0,K)="",X=^FH(119.72,K,0),N1=$P(X,"^",1),N2=$P(X,"^",2),N3=$P(X,"^",4) S:N3="" N3=$E(N1,1,6) S S(N3,K)=$J(N3,8)_"^"_N2,L1=L1+8
6 S:L1<80 L1=80
7LST S DTP=NOW D DTP^FH W:$E(IOST,1,2)="C-" @IOF W !,DTP,?(L1-35\2),"A C T U A L D I E T C E N S U S"
8 S Z=$P(^FH(119.71,FHP,0),"^",1),DTP=TIM D DTP^FH
9 S X=TIM D DOW^%DTC S DOW=Y+1,X=$P("Sun^Mon^Tues^Wednes^Thurs^Fri^Satur","^",DOW)_"day "_DTP
10 S DTP=TIM D DTP^FH W !,FHSITENM
11 W !,?(L1-$L(Z)\2),Z,!!?(L1-$L(X)\2),X
12 W !!?(L1-31\2),"P R O D U C T I O N D I E T S",!!
13 S X="",FHCNTX=0 F S X=$O(S(X)) Q:X="" S FHCNTX=FHCNTX+1
14 S FHSP1=31
15 S:FHCNTX=5 FHSP1=19
16 S:FHCNTX=4 FHSP1=19
17 S:FHCNTX=3 FHSP1=25
18 S:FHCNTX=2 FHSP1=31
19 S:FHCNTX=1 FHSP1=37
20 S FHSP2=33
21 S:FHCNTX=5 FHSP2=21
22 S:FHCNTX=4 FHSP2=21
23 S:FHCNTX=3 FHSP2=27
24 S:FHCNTX=2 FHSP2=33
25 S:FHCNTX=1 FHSP2=39
26 W ?FHSP1
27 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)
28 W " Tray Cafe Total",!
29 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(P(K)) D PRO
30 W !?3,"N P O",?FHSP2 S K=.5 D P1 K P(.5)
31 W !?3,"P A S S",?FHSP2 S K=.8 D P1 K P(.8)
32 W !?3,"TF Only",?FHSP2 S K=.7 D P1 K P(.7)
33 F X=0:0 S X=$O(P(.6,X)) Q:X<1 I $D(P(0,X)) S P(.6,X)=P(.6,X)-P(0,X)
34 W !?3,"No Order",?FHSP2 S K=.6 D P1 K P(.6)
35 W !!,"TOTAL MEALS",?FHSP2 S K=0 D P1 W ! K P(0) Q
36PRO W !,$E($P($G(^FH(116.2,K,0)),"^",1),1,21),?FHSP2
37P1 S (N("T"),N("C"),N("D"),N("G"))=""
38 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(P(K,K1)),TYP=$P(S(X,K1),"^",2) S:Z N(TYP)=N(TYP)+Z W $S(Z:$J(Z,6),1:$J("",6))," " I K>.4,Z S P(0,K1)=P(0,K1)+Z
39 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.