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

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

initial load of WorldVistAEHR
File size: 3.5 KB
Line 
1FHNU4 ; HISC/REL - Edit Menu ;11/16/93 09:52
2 ;;5.5;DIETETICS;;Jan 28, 2005
3GET W ! K DIC S DIC="^FHUM(",DIC(0)="AEQLMZ",DIC("S")="I '$P(^(0),U,5)",DIC("DR")=".01",DLAYGO=112.6 D ^DIC K DLAYGO G KIL:U[X!$D(DTOUT),GET:Y<1 S MENU=+Y,MNAM=$P(Y,U,2)
4 S NEW=$P(Y,U,3),DIE=DIC K DIC S DA=MENU,DR=$S(NEW:".6",1:".01"),DIDEL=112.6 D ^DIE K DIDEL G KIL:'$D(^FHUM(MENU)) I NEW S %DT="X",X="T" D ^%DT S $P(^FHUM(MENU,0),U,3,4)=Y_"^"_DUZ
5 S TYP=$P(^FHUM(MENU,0),U,2)
6SEL S (DAY,MEAL)=0 K DIC I '$D(^FHUM(MENU,1,0)) S ^FHUM(MENU,1,0)="^112.61^^"
7S1 S DIC="^FHUM(MENU,1,",DIC(0)="AEQLM",DIC("DR")="",DA(1)=MENU,DIC("A")="Select DAY #: ",DLAYGO=112.6 D ^DIC K DLAYGO G KIL:U[X!$D(DTOUT),S1:Y<1 S (DAY,DA)=+Y
8 K DR I '$D(^FHUM(MENU,1,DAY,1,0)) S ^FHUM(MENU,1,DAY,1,0)="^112.62^^"
9S2 S DIC="^FHUM(MENU,1,DAY,1,",DIC("A")="Select MEAL #: " D ^DIC G KIL:U[X!$D(DTOUT),S2:Y<1 S MEAL=+Y K DIC I $P(Y,U,3) S ^FHUM(MENU,1,DAY,1,MEAL,1,0)="^112.63P^^" K FHM G E5
10ED D LIS R !!,"Do you wish to EDIT this list? NO// ",YN:DTIME G:'$T!(YN["^") KIL S:YN="" YN="N" S X=YN D TR^FH S YN=X I $P("YES",YN,1)'="",$P("NO",YN,1)'="" W *7," Answer YES or NO" G ED
11 I YN?1"N".E W ! G SEL
12E0 G:'NM E5 R !!,"Do you wish to change any amounts? NO// ",YN:DTIME G:'$T!(YN["^") KIL S:YN="" YN="N" S X=YN D TR^FH S YN=X
13 I $P("YES",YN,1)'="",$P("NO",YN,1)'="" W *7,!," Answer YES or NO" G E0
14 G E2:YN?1"N".E
15E1 R !,"Change item # : ",X:DTIME G KIL:'$T,E2:X="",ED:X["^" I X'?1N.N!(X<1)!(X>NM) W *7," ??" G E1
16 S X=$P(XT,",",X) I TYP="C" S UNIT=$P(FHM(X),",",2),WT=$P(FHM(X),",",3)
17 W *7," from ",(+FHM(X))," ",UNIT," to: " R Y:DTIME G KIL:'$T,E1:Y["^" I Y'?.N.1".".N!(Y'>0)!(Y>99999) W " ??" G E1
18 W " ",UNIT S Y=+Y,$P(FHM(X),",",1)=Y
19 S $P(^FHUM(MENU,1,DAY,1,MEAL,1,X,0),"^",2)=Y G E1
20E2 R !!,"Do you wish to delete any items? NO// ",YN:DTIME G:'$T!(YN["^") KIL S:YN="" YN="N" S X=YN D TR^FH S YN=X
21 I $P("YES",YN,1)'="",$P("NO",YN,1)'="" W *7,!," Answer YES or NO" G E2
22 G E4:YN?1"N".E
23E3 R !,"Delete item # : ",X:DTIME G KIL:'$T,E4:X="",ED:X["^" I X'?1N.N!(X<1)!(X>NM) W *7," ??" G E3
24 S X=$P(XT,",",X) K FHM(X),^FHUM(MENU,1,DAY,1,MEAL,1,X,0) W " ... deleted"
25 S $P(^FHUM(MENU,1,DAY,1,MEAL,1,0),U,4)=$P(^FHUM(MENU,1,DAY,1,MEAL,1,0),U,4)-1 G E3
26E4 R !!,"Do you wish to add more food items? NO// ",YN:DTIME G:'$T!(YN["^") KIL S:YN="" YN="N" S X=YN D TR^FH S YN=X
27 I $P("YES",YN,1)'="",$P("NO",YN,1)'="" W *7,!," Answer YES or NO" G E4
28 G E6:YN?1"N".E
29E5 D ^FHNU7 I FFN="" G E6
30 I $D(^FHUM(MENU,1,DAY,1,MEAL,1,FFN,0)) S $P(^(0),"^",2)=AMT G E5
31 S $P(^FHUM(MENU,1,DAY,1,MEAL,1,0),U,3,4)=FFN_"^"_($P(^FHUM(MENU,1,DAY,1,MEAL,1,0),U,4)+1)
32 S ^FHUM(MENU,1,DAY,1,MEAL,1,FFN,0)=FFN_"^"_AMT G E5
33E6 I $O(^FHUM(MENU,1,DAY,1,MEAL,1,0))>0 G ED
34 K ^FHUM(MENU,1,DAY,1,MEAL) W !!?5,"No Items Remain - Meal Deleted!"
35 S $P(^FHUM(MENU,1,DAY,1,0),U,4)=$P(^FHUM(MENU,1,DAY,1,0),U,4)-1
36 I $O(^FHUM(MENU,1,DAY,1,0))>0 W ! G SEL
37 K ^FHUM(MENU,1,DAY) W !?5,"No Meals Remain - Day Deleted!"
38 S $P(^FHUM(MENU,1,0),U,4)=$P(^FHUM(MENU,1,0),U,4)-1 W ! G SEL
39KIL G KILL^XUSCLEAN
40LIS W @IOF,!!,"Current Food List for Menu: ",MNAM," Day: ",DAY," Meal: ",MEAL,! S (NX,NM)=0,XT="",UNIT="gm." K FHM
41L1 S NX=$O(^FHUM(MENU,1,DAY,1,MEAL,1,NX)) I NX="" W:'NM !?5,"No items selected." Q
42 S AMT=$P(^FHUM(MENU,1,DAY,1,MEAL,1,NX,0),"^",2),X=^FHNU(NX,0),NM=NM+1 I TYP="C" S UNIT=$P(X,"^",3),WT=$P(X,"^",4) D UNT
43 S XT=XT_NX_",",FHM(NX)=AMT I TYP="C" S FHM(NX)=FHM(NX)_","_UNIT_","_WT
44 W !,$J(NM,4,0)," ",$P(X,"^",1)," - ",AMT," ",UNIT G L1
45UNT I AMT'>1,UNIT'["." S L=$L(UNIT)-1,L=$S($E(UNIT,L)'="e":L,"hos"'[$E(UNIT,L-1):L,1:L-1),UNIT=$E(UNIT,1,L) I $E(UNIT,L-1,L)="ie" S UNIT=$E(UNIT,1,L-2)_"y"
46 Q
Note: See TracBrowser for help on using the repository browser.