source: FOIAVistA/trunk/r/DIETETICS-FH/FHADR61.m@ 1607

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

initial load of FOIAVistA 6/30/08 version

File size: 1.4 KB
Line 
1FHADR61 ; HISC/NCA - Nutritive Analysis Average ;12/29/93 13:54
2 ;;5.5;DIETETICS;;Jan 28, 2005
3EN1 ; Enter/Edit Nutritive Analysis Average of one wk reg menu
4 D YR^FHADR1 G:'PRE KIL
5 S OLD=$P($G(^FH(117.3,PRE,3)),"^",2),Y=OLD X ^DD("DD") S OLD=Y
6D1 S %DT="AEPX",%DT("A")="Enter Date Nutritive Analysis was taken: " S:OLD'="" %DT("B")=OLD W ! D ^%DT S:$D(DTOUT) X="^" G KIL:U[X,D1:Y<1 S SDT=+Y
7 I SDT'<DT W *7,!?29," [Must Start before Today!] " G D1
8 S YR=$E(SDT,1,3),S1=$E(SDT,4,5),QTR=$S(S1<4:2,S1<7:3,S1<10:4,1:1) S:QTR=1 YR=YR+1
9 I YR'=$E(PRE,1,3) W *7,!?29," [Date Is Not Within the Fiscal Year!] " G D1
10 S $P(^FH(117.3,PRE,3),"^",2)=SDT
11 K DIC,DIE S DIE="^FH(117.3,",DA=PRE,DR="41:46"
12 D ^DIE K DA,DIC,DIE,DR S OLD=PRE
13SET ; Set all three quarters with the Nutritive Analysis Data
14 F QTR=2:1:4 S PRE=$E(OLD,1,4)_QTR_"00",$P(^FH(117.3,PRE,3),"^",2,8)=$P($G(^FH(117.3,OLD,3)),"^",2,8)
15KIL G KILL^XUSCLEAN
16EN2 ; Print the Nutritive Analysis Average of one wk reg menu
17 D HDR
18 S PRE=FHYR_"0000",X1=""
19 F L1=PRE:0 S L1=$O(^FH(117.3,L1)) Q:L1<1!($E(L1,1,3)'=$E(PRE,1,3)) S X=$P($G(^FH(117.3,L1,3)),"^",2,8) S:"^^^^^^"'[X X1=X
20 I X1'="" D
21 .S DTP=$P(X1,"^",1) D DTP^FH
22 .W !?100,"Date Taken: ",DTP,!!
23 .S TIT="Calories^%CHO^%PRO^%FAT^Mg CHOL^Mg Na"
24 .W ?30 F L2=1:1:6 W $P(TIT,"^",L2)_":",$J($P(X1,"^",L2+1),5)," "
25 .Q
26 Q
27HDR ; Print Heading for Nutritive Analysis
28 D:$Y'<(LIN-6) HDR^FHADRPT,HDR2^FHADR3A
29 W !!!,"Nutritive Analysis 7 Days Average Regular Menu",!
30 Q
Note: See TracBrowser for help on using the repository browser.