FHNU11 ; HISC/REL - Recipe Analysis ;3/10/95 12:17
;;5.5;DIETETICS;;Jan 28, 2005
T0 R !!,"Title of Recipe: ",TIT:DTIME G:'$T!("^"[TIT) KIL I TIT'?.ANP W *7," ??" G T0
I $L(TIT)>60!($L(TIT)<3)!(TIT?1P.E) W *7,!,"Answer must be 3-60 characters in length" G T0
T1 R !!,"Number of Portions: ",POR:DTIME G:'$T!(POR["^") KIL I +POR'=POR!(POR<1)!(POR>1000) W *7,"Enter number from 1 to 1000" G T1
D0 R !!,"Do you wish to use common units rather than grams? YES// ",YN:DTIME G:'$T!(YN["^") KIL S:YN="" YN="Y" 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 D0
S TYP=$S(YN?1"N".E:"G",1:"C") S:TYP="G" UNIT="gm."
W !!!,"We will now build the ingredient list." K FHM
D1 D ^FHNU7 I FFN'="" G D1
D2 D LI
D3 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 D3
G ED:YN?1"Y".E,KIL:'NM D ^FHNU12
D4 R !,"Do you wish to analyze another Recipe? NO// ",YN:DTIME G:'$T!("^"[YN) KIL S:YN="" YN="N" S X=YN D TR^FH S YN=X G KIL:$P("NO",YN,1)="",T0:$P("YES",YN,1)="" W *7," Answer YES or NO" G D4
KIL G KILL^XUSCLEAN
LI W @IOF,!!,"Here is your final ingredient list:",! S NX=0,XT="",NM=0
L1 S NX=$O(FHM(NX)) I NX="" W:'NM !?5,"No ingredients selected." Q
S XT=XT_NX_",",NM=NM+1,X=FHM(NX),AMT=+X S:TYP="C" UNIT=$P(X,",",2),WT=$P(X,",",3)
W !,$J(NM,4,0)," ",$P(^FHNU(NX,0),"^",1)," ",AMT," ",UNIT G L1
ED G:'NM E4 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 ED
G:YN?1"N".E E2
E1 R !,"Change item # : ",X:DTIME G KIL:'$T,E2:X="",ED:X["^" I X'?1N.N!(X<1)!(X>NM) W *7," Enter an item #." G E1
S X=$P(XT,",",X) I TYP="C" S UNIT=$P(FHM(X),",",2),WT=$P(FHM(X),",",3)
W " from ",(+FHM(X))," ",UNIT," to: " R Y:DTIME G KIL:'$T,E1:Y["^" I Y'?.N.1".".N!(Y'>0)!(Y>99999) W *7," Enter a number from 1 to 99999." G E1
W " ",UNIT S $P(FHM(X),",",1)=+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:YN?1"N".E E4
E3 R !,"Delete item # : ",X:DTIME G KIL:'$T,E4:X="",ED:X["^" I X'?1N.N!(X<1)!(X>NM) W *7," Enter an item #." G E3
S X=$P(XT,",",X) K FHM(X) W " ... deleted" G E3
E4 R !!,"Do you wish to add more ingredients? 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 D1:YN?1"Y".E,D3
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFHNU11 2639 printed Nov 22, 2024@17:02:41 Page 2
FHNU11 ; HISC/REL - Recipe Analysis ;3/10/95 12:17
+1 ;;5.5;DIETETICS;;Jan 28, 2005
T0 READ !!,"Title of Recipe: ",TIT:DTIME
if '$TEST!("^"[TIT)
GOTO KIL
IF TIT'?.ANP
WRITE *7," ??"
GOTO T0
+1 IF $LENGTH(TIT)>60!($LENGTH(TIT)<3)!(TIT?1P.E)
WRITE *7,!,"Answer must be 3-60 characters in length"
GOTO T0
T1 READ !!,"Number of Portions: ",POR:DTIME
if '$TEST!(POR["^")
GOTO KIL
IF +POR'=POR!(POR<1)!(POR>1000)
WRITE *7,"Enter number from 1 to 1000"
GOTO T1
D0 READ !!,"Do you wish to use common units rather than grams? YES// ",YN:DTIME
if '$TEST!(YN["^")
GOTO KIL
if YN=""
SET YN="Y"
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 D0
+2 SET TYP=$SELECT(YN?1"N".E:"G",1:"C")
if TYP="G"
SET UNIT="gm."
+3 WRITE !!!,"We will now build the ingredient list."
KILL FHM
D1 DO ^FHNU7
IF FFN'=""
GOTO D1
D2 DO LI
D3 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 D3
+1 if YN?1"Y".E
GOTO ED
if 'NM
GOTO KIL
DO ^FHNU12
D4 READ !,"Do you wish to analyze another Recipe? NO// ",YN:DTIME
if '$TEST!("^"[YN)
GOTO KIL
if YN=""
SET YN="N"
SET X=YN
DO TR^FH
SET YN=X
if $PIECE("NO",YN,1)=""
GOTO KIL
if $PIECE("YES",YN,1)=""
GOTO T0
WRITE *7," Answer YES or NO"
GOTO D4
KIL GOTO KILL^XUSCLEAN
LI WRITE @IOF,!!,"Here is your final ingredient list:",!
SET NX=0
SET XT=""
SET NM=0
L1 SET NX=$ORDER(FHM(NX))
IF NX=""
if 'NM
WRITE !?5,"No ingredients selected."
QUIT
+1 SET XT=XT_NX_","
SET NM=NM+1
SET X=FHM(NX)
SET AMT=+X
if TYP="C"
SET UNIT=$PIECE(X,",",2)
SET WT=$PIECE(X,",",3)
+2 WRITE !,$JUSTIFY(NM,4,0)," ",$PIECE(^FHNU(NX,0),"^",1)," ",AMT," ",UNIT
GOTO L1
ED if 'NM
GOTO E4
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
IF $PIECE("YES",YN,1)'=""
IF $PIECE("NO",YN,1)'=""
WRITE *7," Answer YES or NO"
GOTO ED
+1 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," Enter an item #."
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 " 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 *7," Enter a number from 1 to 99999."
GOTO E1
+3 WRITE " ",UNIT
SET $PIECE(FHM(X),",",1)=+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
IF $PIECE("YES",YN,1)'=""
IF $PIECE("NO",YN,1)'=""
WRITE *7," Answer YES or NO"
GOTO E2
+1 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," Enter an item #."
GOTO E3
+1 SET X=$PIECE(XT,",",X)
KILL FHM(X)
WRITE " ... deleted"
GOTO E3
E4 READ !!,"Do you wish to add more ingredients? 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 E4
+1 if YN?1"Y".E
GOTO D1
GOTO D3
