| 1 | FHADR61 ; HISC/NCA - Nutritive Analysis Average ;12/29/93 13:54
|
|---|
| 2 | ;;5.5;DIETETICS;;Jan 28, 2005
|
|---|
| 3 | EN1 ; 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
|
|---|
| 6 | D1 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
|
|---|
| 13 | SET ; 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)
|
|---|
| 15 | KIL G KILL^XUSCLEAN
|
|---|
| 16 | EN2 ; 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
|
|---|
| 27 | HDR ; 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
|
|---|
