FHNU4 ; HISC/REL - Edit Menu ;11/16/93 09:52
;;5.5;DIETETICS;;Jan 28, 2005
GET 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)
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
S TYP=$P(^FHUM(MENU,0),U,2)
SEL S (DAY,MEAL)=0 K DIC I '$D(^FHUM(MENU,1,0)) S ^FHUM(MENU,1,0)="^112.61^^"
S1 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
K DR I '$D(^FHUM(MENU,1,DAY,1,0)) S ^FHUM(MENU,1,DAY,1,0)="^112.62^^"
S2 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
ED 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
I YN?1"N".E W ! G SEL
E0 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
I $P("YES",YN,1)'="",$P("NO",YN,1)'="" W *7,!," Answer YES or NO" G E0
G E2:YN?1"N".E
E1 R !,"Change item # : ",X:DTIME G KIL:'$T,E2:X="",ED:X["^" I X'?1N.N!(X<1)!(X>NM) W *7," ??" G E1
S X=$P(XT,",",X) I TYP="C" S UNIT=$P(FHM(X),",",2),WT=$P(FHM(X),",",3)
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
W " ",UNIT S Y=+Y,$P(FHM(X),",",1)=Y
S $P(^FHUM(MENU,1,DAY,1,MEAL,1,X,0),"^",2)=Y G E1
E2 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
I $P("YES",YN,1)'="",$P("NO",YN,1)'="" W *7,!," Answer YES or NO" G E2
G E4:YN?1"N".E
E3 R !,"Delete item # : ",X:DTIME G KIL:'$T,E4:X="",ED:X["^" I X'?1N.N!(X<1)!(X>NM) W *7," ??" G E3
S X=$P(XT,",",X) K FHM(X),^FHUM(MENU,1,DAY,1,MEAL,1,X,0) W " ... deleted"
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
E4 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
I $P("YES",YN,1)'="",$P("NO",YN,1)'="" W *7,!," Answer YES or NO" G E4
G E6:YN?1"N".E
E5 D ^FHNU7 I FFN="" G E6
I $D(^FHUM(MENU,1,DAY,1,MEAL,1,FFN,0)) S $P(^(0),"^",2)=AMT G E5
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)
S ^FHUM(MENU,1,DAY,1,MEAL,1,FFN,0)=FFN_"^"_AMT G E5
E6 I $O(^FHUM(MENU,1,DAY,1,MEAL,1,0))>0 G ED
K ^FHUM(MENU,1,DAY,1,MEAL) W !!?5,"No Items Remain - Meal Deleted!"
S $P(^FHUM(MENU,1,DAY,1,0),U,4)=$P(^FHUM(MENU,1,DAY,1,0),U,4)-1
I $O(^FHUM(MENU,1,DAY,1,0))>0 W ! G SEL
K ^FHUM(MENU,1,DAY) W !?5,"No Meals Remain - Day Deleted!"
S $P(^FHUM(MENU,1,0),U,4)=$P(^FHUM(MENU,1,0),U,4)-1 W ! G SEL
KIL G KILL^XUSCLEAN
LIS W @IOF,!!,"Current Food List for Menu: ",MNAM," Day: ",DAY," Meal: ",MEAL,! S (NX,NM)=0,XT="",UNIT="gm." K FHM
L1 S NX=$O(^FHUM(MENU,1,DAY,1,MEAL,1,NX)) I NX="" W:'NM !?5,"No items selected." Q
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
S XT=XT_NX_",",FHM(NX)=AMT I TYP="C" S FHM(NX)=FHM(NX)_","_UNIT_","_WT
W !,$J(NM,4,0)," ",$P(X,"^",1)," - ",AMT," ",UNIT G L1
UNT 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"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFHNU4 3674 printed Dec 13, 2024@01:52:34 Page 2
FHNU4 ; HISC/REL - Edit Menu ;11/16/93 09:52
+1 ;;5.5;DIETETICS;;Jan 28, 2005
GET WRITE !
KILL DIC
SET DIC="^FHUM("
SET DIC(0)="AEQLMZ"
SET DIC("S")="I '$P(^(0),U,5)"
SET DIC("DR")=".01"
SET DLAYGO=112.6
DO ^DIC
KILL DLAYGO
if U[X!$DATA(DTOUT)
GOTO KIL
if Y<1
GOTO GET
SET MENU=+Y
SET MNAM=$PIECE(Y,U,2)
+1 SET NEW=$PIECE(Y,U,3)
SET DIE=DIC
KILL DIC
SET DA=MENU
SET DR=$SELECT(NEW:".6",1:".01")
SET DIDEL=112.6
DO ^DIE
KILL DIDEL
if '$DATA(^FHUM(MENU))
GOTO KIL
IF NEW
SET %DT="X"
SET X="T"
DO ^%DT
SET $PIECE(^FHUM(MENU,0),U,3,4)=Y_"^"_DUZ
+2 SET TYP=$PIECE(^FHUM(MENU,0),U,2)
SEL SET (DAY,MEAL)=0
KILL DIC
IF '$DATA(^FHUM(MENU,1,0))
SET ^FHUM(MENU,1,0)="^112.61^^"
S1 SET DIC="^FHUM(MENU,1,"
SET DIC(0)="AEQLM"
SET DIC("DR")=""
SET DA(1)=MENU
SET DIC("A")="Select DAY #: "
SET DLAYGO=112.6
DO ^DIC
KILL DLAYGO
if U[X!$DATA(DTOUT)
GOTO KIL
if Y<1
GOTO S1
SET (DAY,DA)=+Y
+1 KILL DR
IF '$DATA(^FHUM(MENU,1,DAY,1,0))
SET ^FHUM(MENU,1,DAY,1,0)="^112.62^^"
S2 SET DIC="^FHUM(MENU,1,DAY,1,"
SET DIC("A")="Select MEAL #: "
DO ^DIC
if U[X!$DATA(DTOUT)
GOTO KIL
if Y<1
GOTO S2
SET MEAL=+Y
KILL DIC
IF $PIECE(Y,U,3)
SET ^FHUM(MENU,1,DAY,1,MEAL,1,0)="^112.63P^^"
KILL FHM
GOTO E5
ED DO LIS
READ !!,"Do you wish to EDIT this list? NO// ",YN:DTIME
if '$TEST!(YN["^")
GOTO KIL
if YN=""
SET YN="N"
SET X=YN
DO TR^FH
SET YN=X
IF $PIECE("YES",YN,1)'=""
IF $PIECE("NO",YN,1)'=""
WRITE *7," Answer YES or NO"
GOTO ED
+1 IF YN?1"N".E
WRITE !
GOTO SEL
E0 if 'NM
GOTO E5
READ !!,"Do you wish to change any amounts? NO// ",YN:DTIME
if '$TEST!(YN["^")
GOTO KIL
if YN=""
SET YN="N"
SET X=YN
DO TR^FH
SET YN=X
+1 IF $PIECE("YES",YN,1)'=""
IF $PIECE("NO",YN,1)'=""
WRITE *7,!," Answer YES or NO"
GOTO E0
+2 if YN?1"N".E
GOTO E2
E1 READ !,"Change item # : ",X:DTIME
if '$TEST
GOTO KIL
if X=""
GOTO E2
if X["^"
GOTO ED
IF X'?1N.N!(X<1)!(X>NM)
WRITE *7," ??"
GOTO E1
+1 SET X=$PIECE(XT,",",X)
IF TYP="C"
SET UNIT=$PIECE(FHM(X),",",2)
SET WT=$PIECE(FHM(X),",",3)
+2 WRITE *7," from ",(+FHM(X))," ",UNIT," to: "
READ Y:DTIME
if '$TEST
GOTO KIL
if Y["^"
GOTO E1
IF Y'?.N.1".".N!(Y'>0)!(Y>99999)
WRITE " ??"
GOTO E1
+3 WRITE " ",UNIT
SET Y=+Y
SET $PIECE(FHM(X),",",1)=Y
+4 SET $PIECE(^FHUM(MENU,1,DAY,1,MEAL,1,X,0),"^",2)=Y
GOTO E1
E2 READ !!,"Do you wish to delete any items? NO// ",YN:DTIME
if '$TEST!(YN["^")
GOTO KIL
if YN=""
SET YN="N"
SET X=YN
DO TR^FH
SET YN=X
+1 IF $PIECE("YES",YN,1)'=""
IF $PIECE("NO",YN,1)'=""
WRITE *7,!," Answer YES or NO"
GOTO E2
+2 if YN?1"N".E
GOTO E4
E3 READ !,"Delete item # : ",X:DTIME
if '$TEST
GOTO KIL
if X=""
GOTO E4
if X["^"
GOTO ED
IF X'?1N.N!(X<1)!(X>NM)
WRITE *7," ??"
GOTO E3
+1 SET X=$PIECE(XT,",",X)
KILL FHM(X),^FHUM(MENU,1,DAY,1,MEAL,1,X,0)
WRITE " ... deleted"
+2 SET $PIECE(^FHUM(MENU,1,DAY,1,MEAL,1,0),U,4)=$PIECE(^FHUM(MENU,1,DAY,1,MEAL,1,0),U,4)-1
GOTO E3
E4 READ !!,"Do you wish to add more food items? NO// ",YN:DTIME
if '$TEST!(YN["^")
GOTO KIL
if YN=""
SET YN="N"
SET X=YN
DO TR^FH
SET YN=X
+1 IF $PIECE("YES",YN,1)'=""
IF $PIECE("NO",YN,1)'=""
WRITE *7,!," Answer YES or NO"
GOTO E4
+2 if YN?1"N".E
GOTO E6
E5 DO ^FHNU7
IF FFN=""
GOTO E6
+1 IF $DATA(^FHUM(MENU,1,DAY,1,MEAL,1,FFN,0))
SET $PIECE(^(0),"^",2)=AMT
GOTO E5
+2 SET $PIECE(^FHUM(MENU,1,DAY,1,MEAL,1,0),U,3,4)=FFN_"^"_($PIECE(^FHUM(MENU,1,DAY,1,MEAL,1,0),U,4)+1)
+3 SET ^FHUM(MENU,1,DAY,1,MEAL,1,FFN,0)=FFN_"^"_AMT
GOTO E5
E6 IF $ORDER(^FHUM(MENU,1,DAY,1,MEAL,1,0))>0
GOTO ED
+1 KILL ^FHUM(MENU,1,DAY,1,MEAL)
WRITE !!?5,"No Items Remain - Meal Deleted!"
+2 SET $PIECE(^FHUM(MENU,1,DAY,1,0),U,4)=$PIECE(^FHUM(MENU,1,DAY,1,0),U,4)-1
+3 IF $ORDER(^FHUM(MENU,1,DAY,1,0))>0
WRITE !
GOTO SEL
+4 KILL ^FHUM(MENU,1,DAY)
WRITE !?5,"No Meals Remain - Day Deleted!"
+5 SET $PIECE(^FHUM(MENU,1,0),U,4)=$PIECE(^FHUM(MENU,1,0),U,4)-1
WRITE !
GOTO SEL
KIL GOTO KILL^XUSCLEAN
LIS WRITE @IOF,!!,"Current Food List for Menu: ",MNAM," Day: ",DAY," Meal: ",MEAL,!
SET (NX,NM)=0
SET XT=""
SET UNIT="gm."
KILL FHM
L1 SET NX=$ORDER(^FHUM(MENU,1,DAY,1,MEAL,1,NX))
IF NX=""
if 'NM
WRITE !?5,"No items selected."
QUIT
+1 SET AMT=$PIECE(^FHUM(MENU,1,DAY,1,MEAL,1,NX,0),"^",2)
SET X=^FHNU(NX,0)
SET NM=NM+1
IF TYP="C"
SET UNIT=$PIECE(X,"^",3)
SET WT=$PIECE(X,"^",4)
DO UNT
+2 SET XT=XT_NX_","
SET FHM(NX)=AMT
IF TYP="C"
SET FHM(NX)=FHM(NX)_","_UNIT_","_WT
+3 WRITE !,$JUSTIFY(NM,4,0)," ",$PIECE(X,"^",1)," - ",AMT," ",UNIT
GOTO L1
UNT IF AMT'>1
IF UNIT'["."
SET L=$LENGTH(UNIT)-1
SET L=$SELECT($EXTRACT(UNIT,L)'="e":L,"hos"'[$EXTRACT(UNIT,L-1):L,1:L-1)
SET UNIT=$EXTRACT(UNIT,1,L)
IF $EXTRACT(UNIT,L-1,L)="ie"
SET UNIT=$EXTRACT(UNIT,1,L-2)_"y"
+1 QUIT
