- FHPRC13 ; HISC/NCA - Enter/Edit Recipe Menu ;3/13/95 11:16
- ;;5.5;DIETETICS;;Jan 28, 2005
- K ^TMP($J)
- 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,NEW=$P(Y,U,3)
- I 'NEW S DIE=DIC K DIC S DA=MENU,DR=".01",DIDEL=112.6 D ^DIE K DIDEL G:'$D(^FHUM(MENU))!($D(Y)) KIL D PD^FHPRC14 G SEL
- S %DT="X",X="T" D ^%DT S $P(^FHUM(MENU,0),U,2,5)="C"_"^"_Y_"^"_DUZ_"^"_1
- 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)="EQLM",DIC("DR")="",DA(1)=MENU,DLAYGO=112.6
- R !,"Select Day #: ",X:DTIME G:'$T!(X["^") KIL
- I X="" W ! G STOR:$O(M(0))>0,E8
- D ^DIC K DIC,DLAYGO G:Y<1 S1 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(0)="EQLM",DLAYGO=112.6
- R !,"Select Meal #: ",X:DTIME G:'$T!(X["^") KIL
- I X="" W ! G S1:$G(M(DAY))'="",E7
- D ^DIC K DLAYGO G:Y<1 S2 S MEAL=+Y K DIC
- S OLD=$S($G(M(DAY))'="":$P(M(DAY),"^",MEAL),1:""),M1=$P(OLD,";",1),P=$P(OLD,";",2),PD=+P,CODE=$P(P,"~",2),OLD=M1_"^"_CODE I 'NEW D OLD^FHPRC14
- S3 K DIC S DIC="^FH(116.1,",DIC(0)="EQM"
- W !,"Select Meal: " W:M1'="" $S($G(^FH(116.1,M1,0))'="":$P(^FH(116.1,M1,0),"^",1)_" // ",1:"") R X:DTIME G:'$T!(X["^") KIL
- I X="@" G DEL
- I X="" S:M1'="" X=$P($G(^FH(116.1,M1,0)),"^",1) W ! G:M1="" E6
- D ^DIC G:Y<1 S3 S M1=+Y K DIC
- S4 K DIC S DIC="^FH(116.2,",DIC(0)="EQMZ"
- W !,"Select Production Diet: " W:PD $S($G(^FH(116.2,+PD,0))'="":$P(^FH(116.2,+PD,0),"^",1)_" // ",1:"") R X:DTIME G:'$T!(X["^") KIL
- I X="@" I PD S PD=0 G S4
- I X="@" I 'PD W *7,?27,"No Production Diet to Delete!" G S4
- I X="" S:PD X=$P($G(^FH(116.2,+PD,0)),"^",1)
- D ^DIC G:Y<1 S4 K DIC
- S PD=+Y,CODE=$P(Y(0),"^",2),ZZ=M1_"^"_CODE
- I $P(OLD,"^",1,2)=ZZ G:$D(^TMP($J,"RECIPES",DAY,MEAL)) R1
- S S1=M1_";"_PD_"~"_CODE,$P(M(DAY),"^",MEAL)=S1
- D SRCH^FHPRC14
- R1 ; Edit Recipe and Portion
- K DIC S DIC="^FH(114,",DIC(0)="EQM"
- R !!,"Select Recipe: ",X:DTIME G KIL:'$T!(X["^"),S2:X=""
- I X="?" D LIS^FHPRC14 G R1
- D ^DIC G:Y<1 R1 K DIC S REC=+Y S:'$D(^TMP($J,"RECIPES",DAY,MEAL,REC)) ^TMP($J,"RECIPES",DAY,MEAL,REC)=1_"^"_$P($G(^FH(114,REC,0)),"^",14)
- R2 W !,"Serving Portion: ",+$G(^TMP($J,"RECIPES",DAY,MEAL,REC))_"// " R X:DTIME G:'$T!(X["^") KIL G:X="" R1
- I X'?.N.1".".N!(X<0)!(X>9999) W *7,!,"Enter amount of serving portion. Enter 0 to omit recipe;",!,"otherwise enter a number greater than 0 but less than 9999." G R2
- S $P(^TMP($J,"RECIPES",DAY,MEAL,REC),"^",1)=X
- G R1
- STOR D L1^FHPRC14 R !!,"Okay to Save the Menu? 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 STOR
- I YN?1"Y".E W ! G E5
- G SEL
- E5 W !,"...Storing Recipes and Food Nutrient"
- F DAY=0:0 S DAY=$O(^TMP($J,"RECIPES",DAY)) Q:DAY<1 F MEAL=0:0 S MEAL=$O(^TMP($J,"RECIPES",DAY,MEAL)) Q:MEAL<1 D A1
- W !,"...Done"
- G KIL
- DEL ; Delete Meal
- I '$D(^TMP($J,"RECIPES",DAY,MEAL)) W *7,?17,"No Meal to Delete!" G S2
- K ^TMP($J,"RECIPES",DAY,MEAL)
- G E6
- A1 S ZZ=$G(^TMP($J,"RECIPES",DAY,MEAL,0)),$P(^FHUM(MENU,1,DAY,1,MEAL,0),"^",2,3)=ZZ
- I 'NEW,$D(^FHUM(MENU,1,DAY,1,MEAL,2,0)) K ^FHUM(MENU,1,DAY,1,MEAL,2),^FHUM(MENU,1,DAY,1,MEAL,1)
- I '$D(^FHUM(MENU,1,DAY,1,MEAL,1,0)) S ^(0)="^112.63P^^"
- I '$D(^FHUM(MENU,1,DAY,1,MEAL,2,0)) S ^(0)="^112.64P^^"
- S K=0
- A2 S K=$O(^TMP($J,"RECIPES",DAY,MEAL,K)) Q:K<1 S L1=K,Y=$G(^(K)),QTY=+Y,NP=$P(Y,"^",2) G:'NP A2
- S $P(^FHUM(MENU,1,DAY,1,MEAL,2,0),U,3,4)=L1_"^"_($P(^FHUM(MENU,1,DAY,1,MEAL,2,0),U,4)+1)
- S ^FHUM(MENU,1,DAY,1,MEAL,2,L1,0)=L1_"^"_QTY
- S $P(^FHUM(MENU,1,DAY,1,MEAL,1,0),U,3,4)=+NP_"^"_($P(^FHUM(MENU,1,DAY,1,MEAL,1,0),"^",4)+1)
- S ^FHUM(MENU,1,DAY,1,MEAL,1,+NP,0)=+NP_"^"_QTY
- G A2
- E6 I $D(^FHUM(MENU,1,DAY,1,MEAL)) K ^FHUM(MENU,1,DAY,1,MEAL) S $P(^FHUM(MENU,1,DAY,1,0),U,4)=$P(^FHUM(MENU,1,DAY,1,0),U,4)-1 S:$D(M(DAY)) $P(M(DAY),"^",MEAL)="" W !,"No Meal-Meal Deleted"
- E7 I $O(^FHUM(MENU,1,DAY,1,0))>0 G S2
- K ^FHUM(MENU,1,DAY) W !,"No Meals Remains-Day Deleted"
- S $P(^FHUM(MENU,1,0),U,4)=$P(^FHUM(MENU,1,0),U,4)-1 I $D(M(DAY)) K M(DAY)
- I $O(^FHUM(MENU,1,0))>0 W ! G SEL
- E8 K DA,DIC,DIE,DIK S DIK="^FHUM(",DA=MENU D ^DIK W !,"...Menu Deleted"
- W !
- KIL K ^TMP($J) G KILL^XUSCLEAN
- FHPRC13 ; HISC/NCA - Enter/Edit Recipe Menu ;3/13/95 11:16
- +1 ;;5.5;DIETETICS;;Jan 28, 2005
- +2 KILL ^TMP($JOB)
- 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 NEW=$PIECE(Y,U,3)
- +1 IF 'NEW
- SET DIE=DIC
- KILL DIC
- SET DA=MENU
- SET DR=".01"
- SET DIDEL=112.6
- DO ^DIE
- KILL DIDEL
- IF '$DATA(^FHUM(MENU))!($DATA(Y))
- GOTO KIL
- DO PD^FHPRC14
- GOTO SEL
- +2 SET %DT="X"
- SET X="T"
- DO ^%DT
- SET $PIECE(^FHUM(MENU,0),U,2,5)="C"_"^"_Y_"^"_DUZ_"^"_1
- 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)="EQLM"
- SET DIC("DR")=""
- SET DA(1)=MENU
- SET DLAYGO=112.6
- +1 READ !,"Select Day #: ",X:DTIME
- IF '$TEST!(X["^")
- GOTO KIL
- +2 IF X=""
- WRITE !
- IF $ORDER(M(0))>0
- GOTO STOR
- GOTO E8
- +3 DO ^DIC
- KILL DIC,DLAYGO
- IF Y<1
- GOTO S1
- SET (DAY,DA)=+Y
- +4 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(0)="EQLM"
- SET DLAYGO=112.6
- +1 READ !,"Select Meal #: ",X:DTIME
- IF '$TEST!(X["^")
- GOTO KIL
- +2 IF X=""
- WRITE !
- IF $GET(M(DAY))'=""
- GOTO S1
- GOTO E7
- +3 DO ^DIC
- KILL DLAYGO
- IF Y<1
- GOTO S2
- SET MEAL=+Y
- KILL DIC
- +4 SET OLD=$SELECT($GET(M(DAY))'="":$PIECE(M(DAY),"^",MEAL),1:"")
- SET M1=$PIECE(OLD,";",1)
- SET P=$PIECE(OLD,";",2)
- SET PD=+P
- SET CODE=$PIECE(P,"~",2)
- SET OLD=M1_"^"_CODE
- IF 'NEW
- DO OLD^FHPRC14
- S3 KILL DIC
- SET DIC="^FH(116.1,"
- SET DIC(0)="EQM"
- +1 WRITE !,"Select Meal: "
- IF M1'=""
- WRITE $SELECT($GET(^FH(116.1,M1,0))'="":$PIECE(^FH(116.1,M1,0),"^",1)_" // ",1:"")
- READ X:DTIME
- IF '$TEST!(X["^")
- GOTO KIL
- +2 IF X="@"
- GOTO DEL
- +3 IF X=""
- IF M1'=""
- SET X=$PIECE($GET(^FH(116.1,M1,0)),"^",1)
- WRITE !
- IF M1=""
- GOTO E6
- +4 DO ^DIC
- IF Y<1
- GOTO S3
- SET M1=+Y
- KILL DIC
- S4 KILL DIC
- SET DIC="^FH(116.2,"
- SET DIC(0)="EQMZ"
- +1 WRITE !,"Select Production Diet: "
- IF PD
- WRITE $SELECT($GET(^FH(116.2,+PD,0))'="":$PIECE(^FH(116.2,+PD,0),"^",1)_" // ",1:"")
- READ X:DTIME
- IF '$TEST!(X["^")
- GOTO KIL
- +2 IF X="@"
- IF PD
- SET PD=0
- GOTO S4
- +3 IF X="@"
- IF 'PD
- WRITE *7,?27,"No Production Diet to Delete!"
- GOTO S4
- +4 IF X=""
- IF PD
- SET X=$PIECE($GET(^FH(116.2,+PD,0)),"^",1)
- +5 DO ^DIC
- IF Y<1
- GOTO S4
- KILL DIC
- +6 SET PD=+Y
- SET CODE=$PIECE(Y(0),"^",2)
- SET ZZ=M1_"^"_CODE
- +7 IF $PIECE(OLD,"^",1,2)=ZZ
- IF $DATA(^TMP($JOB,"RECIPES",DAY,MEAL))
- GOTO R1
- +8 SET S1=M1_";"_PD_"~"_CODE
- SET $PIECE(M(DAY),"^",MEAL)=S1
- +9 DO SRCH^FHPRC14
- R1 ; Edit Recipe and Portion
- +1 KILL DIC
- SET DIC="^FH(114,"
- SET DIC(0)="EQM"
- +2 READ !!,"Select Recipe: ",X:DTIME
- IF '$TEST!(X["^")
- GOTO KIL
- IF X=""
- GOTO S2
- +3 IF X="?"
- DO LIS^FHPRC14
- GOTO R1
- +4 DO ^DIC
- IF Y<1
- GOTO R1
- KILL DIC
- SET REC=+Y
- IF '$DATA(^TMP($JOB,"RECIPES",DAY,MEAL,REC))
- SET ^TMP($JOB,"RECIPES",DAY,MEAL,REC)=1_"^"_$PIECE($GET(^FH(114,REC,0)),"^",14)
- R2 WRITE !,"Serving Portion: ",+$GET(^TMP($JOB,"RECIPES",DAY,MEAL,REC))_"// "
- READ X:DTIME
- IF '$TEST!(X["^")
- GOTO KIL
- IF X=""
- GOTO R1
- +1 IF X'?.N.1".".N!(X<0)!(X>9999)
- WRITE *7,!,"Enter amount of serving portion. Enter 0 to omit recipe;",!,"otherwise enter a number greater than 0 but less than 9999."
- GOTO R2
- +2 SET $PIECE(^TMP($JOB,"RECIPES",DAY,MEAL,REC),"^",1)=X
- +3 GOTO R1
- STOR DO L1^FHPRC14
- READ !!,"Okay to Save the Menu? YES// ",YN:DTIME
- IF '$TEST!(YN["^")
- GOTO KIL
- IF YN=""
- SET YN="Y"
- 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 STOR
- +1 IF YN?1"Y".E
- WRITE !
- GOTO E5
- +2 GOTO SEL
- E5 WRITE !,"...Storing Recipes and Food Nutrient"
- +1 FOR DAY=0:0
- SET DAY=$ORDER(^TMP($JOB,"RECIPES",DAY))
- IF DAY<1
- QUIT
- FOR MEAL=0:0
- SET MEAL=$ORDER(^TMP($JOB,"RECIPES",DAY,MEAL))
- IF MEAL<1
- QUIT
- DO A1
- +2 WRITE !,"...Done"
- +3 GOTO KIL
- DEL ; Delete Meal
- +1 IF '$DATA(^TMP($JOB,"RECIPES",DAY,MEAL))
- WRITE *7,?17,"No Meal to Delete!"
- GOTO S2
- +2 KILL ^TMP($JOB,"RECIPES",DAY,MEAL)
- +3 GOTO E6
- A1 SET ZZ=$GET(^TMP($JOB,"RECIPES",DAY,MEAL,0))
- SET $PIECE(^FHUM(MENU,1,DAY,1,MEAL,0),"^",2,3)=ZZ
- +1 IF 'NEW
- IF $DATA(^FHUM(MENU,1,DAY,1,MEAL,2,0))
- KILL ^FHUM(MENU,1,DAY,1,MEAL,2),^FHUM(MENU,1,DAY,1,MEAL,1)
- +2 IF '$DATA(^FHUM(MENU,1,DAY,1,MEAL,1,0))
- SET ^(0)="^112.63P^^"
- +3 IF '$DATA(^FHUM(MENU,1,DAY,1,MEAL,2,0))
- SET ^(0)="^112.64P^^"
- +4 SET K=0
- A2 SET K=$ORDER(^TMP($JOB,"RECIPES",DAY,MEAL,K))
- IF K<1
- QUIT
- SET L1=K
- SET Y=$GET(^(K))
- SET QTY=+Y
- SET NP=$PIECE(Y,"^",2)
- IF 'NP
- GOTO A2
- +1 SET $PIECE(^FHUM(MENU,1,DAY,1,MEAL,2,0),U,3,4)=L1_"^"_($PIECE(^FHUM(MENU,1,DAY,1,MEAL,2,0),U,4)+1)
- +2 SET ^FHUM(MENU,1,DAY,1,MEAL,2,L1,0)=L1_"^"_QTY
- +3 SET $PIECE(^FHUM(MENU,1,DAY,1,MEAL,1,0),U,3,4)=+NP_"^"_($PIECE(^FHUM(MENU,1,DAY,1,MEAL,1,0),"^",4)+1)
- +4 SET ^FHUM(MENU,1,DAY,1,MEAL,1,+NP,0)=+NP_"^"_QTY
- +5 GOTO A2
- E6 IF $DATA(^FHUM(MENU,1,DAY,1,MEAL))
- KILL ^FHUM(MENU,1,DAY,1,MEAL)
- SET $PIECE(^FHUM(MENU,1,DAY,1,0),U,4)=$PIECE(^FHUM(MENU,1,DAY,1,0),U,4)-1
- IF $DATA(M(DAY))
- SET $PIECE(M(DAY),"^",MEAL)=""
- WRITE !,"No Meal-Meal Deleted"
- E7 IF $ORDER(^FHUM(MENU,1,DAY,1,0))>0
- GOTO S2
- +1 KILL ^FHUM(MENU,1,DAY)
- WRITE !,"No Meals Remains-Day Deleted"
- +2 SET $PIECE(^FHUM(MENU,1,0),U,4)=$PIECE(^FHUM(MENU,1,0),U,4)-1
- IF $DATA(M(DAY))
- KILL M(DAY)
- +3 IF $ORDER(^FHUM(MENU,1,0))>0
- WRITE !
- GOTO SEL
- E8 KILL DA,DIC,DIE,DIK
- SET DIK="^FHUM("
- SET DA=MENU
- DO ^DIK
- WRITE !,"...Menu Deleted"
- +1 WRITE !
- KIL KILL ^TMP($JOB)
- GOTO KILL^XUSCLEAN
