FHPRC10 ; HISC/NCA - Meal Analysis ;3/6/95 15:41
;;5.5;DIETETICS;;Jan 28, 2005
K ^TMP($J)
GET W ! K DIC S DIC="^FHUM(",DIC(0)="AEQMZ",DIC("S")="I $P(^(0),U,5)",DIC("DR")=".01" D ^DIC K DLAYGO G KIL:U[X!$D(DTOUT),GET:Y<1 S MENU=+Y,MNAM="Menu: "_$P(Y,U,2) D RET^FHPRC14
ED R !!,"Do you wish to EDIT this Menu? 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 R3
E1 ; Enter/Edit Day
R !,"Select DAY #: ",DAY:DTIME G:'$T!(DAY["^") KIL
I DAY="" S X3=$O(^TMP($J,"RECIPES",0)) G KIL:X3="",R3
I DAY'?1N!(DAY<1)!(DAY>7) W *7," Enter a Day # from 1-7" G E1
E2 ; Enter/Edit Meal #
R !,"Select MEAL #: ",MEAL:DTIME G:'$T!(MEAL["^") KIL
I MEAL="" S X3=$O(^TMP($J,"RECIPES",0)) G KIL:X3="",E1
I MEAL'?1N!(MEAL<1)!(MEAL>6) W *7," Enter a Meal # from 1-6" G E2
R0 ; Edit Meal File
S S1=$G(^TMP($J,"RECIPES",DAY,MEAL,0))
K DIC S DIC="^FH(116.1,",DIC(0)="EQM"
W !,"Select Meal: ",$S($P($G(^FH(116.1,+S1,0)),"^",1)'="":$P(^FH(116.1,+S1,0),"^",1)_" // ",1:"") R X:DTIME G:'$T!(X["^") KIL
I X="@" K ^TMP($J,"RECIPES",DAY,MEAL) W " Meal Deleted" G E2
I X="" S:S1'="" X=$P($G(^FH(116.1,+S1,0)),"^",1) I S1="" S X3=$O(^TMP($J,"RECIPES",0)) G KIL:X3="",E2
D ^DIC G:Y<1 R0 S M1=+Y K DIC
S1 ; Edit Production Diet
K DIC S DIC="^FH(116.2,",DIC(0)="AEQMZ" S:$P(S1,"^",2) DIC("B")=$P($G(^FH(116.2,+$P(S1,"^",2),0)),"^",1) D ^DIC G KIL:U[X!$D(DTOUT),S1:Y<1 S PD=+Y,CODE=$P(Y(0),"^",2) K DIC
S ZZ=M1_"^"_PD I S1=ZZ G:$D(^TMP($J,"RECIPES",DAY,MEAL)) R1
S $P(S1,"^",2)=PD
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["^"),E2: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
R3 ; Select RDA Category
K DIC S DIC="^FH(112.2,",DIC(0)="AEQM",DIC("A")="Select DRI Category: " W ! D ^DIC G:X[U!$D(DTOUT) KIL S RDA=$S(Y<1:0,1:+Y) K DIC
S (AGE,NAM,SEX)=""
F1 S ALL=1 D ^FHDPA G PAT:X="*",S3:X="",KIL:'DFN S NAM=$P(Y(0),U,1),SEX=$P(Y(0),U,2),AGE=$P(Y(0),U,3) G:SEX=""!(AGE="") P1
I $P($G(^DPT(DFN,.35)),"^",1) W *7,!!?5," [ Patient has expired. ]" G KIL
S AGE=$E(DT,1,3)-$E(AGE,1,3)-($E(DT,4,7)<$E(AGE,4,7))
S3 R !!,"Do you wish a detailed analysis? Y// ",SUM:DTIME G:'$T!(SUM["^") KIL S:SUM="" SUM="Y" S X=SUM D TR^FH S SUM=X I $P("YES",SUM,1)'="",$P("NO",SUM,1)'="" W *7,!," Answer YES or NO" G S3
S SUM=$E(SUM,1),SUM=SUM="N" K M
W !!,"The Analysis requires a 132 column printer.",!
K IOP,%ZIS S %ZIS("A")="Print on Device: ",%ZIS="MQ" W ! D ^%ZIS K %ZIS,IOP G:POP KIL
I $D(IO("Q")) D G KIL
.K IO("Q"),ZTUCI,ZTDTH,ZTIO,ZTSAVE
.S ZTRTN="^FHPRC11",ZTREQ="@",ZSAVE("ZTREQ")="",ZTDESC=$P($G(XQY0),U,1)
.F G="AGE","DAY","MEAL","MNAM","NAM","^TMP($J,","RDA","SEX","SUM" S ZTSAVE(G)=""
.D ^%ZTLOAD D ^%ZISC U IO W !,"Request Queued",! K ZTSK Q
U IO X ^%ZOSF("BRK") D ^FHPRC11 X ^%ZOSF("NBRK") D ^%ZISC K %ZIS,IOP G KIL
PAT R !!,"Enter Patient's Name: ",NAM:DTIME G:'$T!("^"[NAM) KIL
I NAM["?"!(NAM'?.ANP)!(NAM["^") W *7,!?5,"Enter Patient's Name to be printed on the report." G PAT
P1 R !,"Sex: ",SEX:DTIME G:'$T!("^"[SEX) KIL S X=SEX D TR^FH S SEX=X I $P("MALE",SEX,1)'="",$P("FEMALE",SEX,1)'="" W *7," Enter M or F" G P1
S SEX=$E(SEX,1)
P2 R !,"Age: ",AGE:DTIME G:'$T!("^"[AGE) KIL I AGE'?1N.N!(AGE<6)!(AGE>124) W !?5,"Enter Age in years between 6 and 124" G P2
G S3
KIL ; Kill all Used Variables
K ^TMP($J) G KILL^XUSCLEAN
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFHPRC10 3924 printed Dec 13, 2024@01:54:12 Page 2
FHPRC10 ; HISC/NCA - Meal Analysis ;3/6/95 15:41
+1 ;;5.5;DIETETICS;;Jan 28, 2005
+2 KILL ^TMP($JOB)
GET WRITE !
KILL DIC
SET DIC="^FHUM("
SET DIC(0)="AEQMZ"
SET DIC("S")="I $P(^(0),U,5)"
SET DIC("DR")=".01"
DO ^DIC
KILL DLAYGO
if U[X!$DATA(DTOUT)
GOTO KIL
if Y<1
GOTO GET
SET MENU=+Y
SET MNAM="Menu: "_$PIECE(Y,U,2)
DO RET^FHPRC14
ED READ !!,"Do you wish to EDIT this Menu? 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 R3
E1 ; Enter/Edit Day
+1 READ !,"Select DAY #: ",DAY:DTIME
if '$TEST!(DAY["^")
GOTO KIL
+2 IF DAY=""
SET X3=$ORDER(^TMP($JOB,"RECIPES",0))
if X3=""
GOTO KIL
GOTO R3
+3 IF DAY'?1N!(DAY<1)!(DAY>7)
WRITE *7," Enter a Day # from 1-7"
GOTO E1
E2 ; Enter/Edit Meal #
+1 READ !,"Select MEAL #: ",MEAL:DTIME
if '$TEST!(MEAL["^")
GOTO KIL
+2 IF MEAL=""
SET X3=$ORDER(^TMP($JOB,"RECIPES",0))
if X3=""
GOTO KIL
GOTO E1
+3 IF MEAL'?1N!(MEAL<1)!(MEAL>6)
WRITE *7," Enter a Meal # from 1-6"
GOTO E2
R0 ; Edit Meal File
+1 SET S1=$GET(^TMP($JOB,"RECIPES",DAY,MEAL,0))
+2 KILL DIC
SET DIC="^FH(116.1,"
SET DIC(0)="EQM"
+3 WRITE !,"Select Meal: ",$SELECT($PIECE($GET(^FH(116.1,+S1,0)),"^",1)'="":$PIECE(^FH(116.1,+S1,0),"^",1)_" // ",1:"")
READ X:DTIME
if '$TEST!(X["^")
GOTO KIL
+4 IF X="@"
KILL ^TMP($JOB,"RECIPES",DAY,MEAL)
WRITE " Meal Deleted"
GOTO E2
+5 IF X=""
if S1'=""
SET X=$PIECE($GET(^FH(116.1,+S1,0)),"^",1)
IF S1=""
SET X3=$ORDER(^TMP($JOB,"RECIPES",0))
if X3=""
GOTO KIL
GOTO E2
+6 DO ^DIC
if Y<1
GOTO R0
SET M1=+Y
KILL DIC
S1 ; Edit Production Diet
+1 KILL DIC
SET DIC="^FH(116.2,"
SET DIC(0)="AEQMZ"
if $PIECE(S1,"^",2)
SET DIC("B")=$PIECE($GET(^FH(116.2,+$PIECE(S1,"^",2),0)),"^",1)
DO ^DIC
if U[X!$DATA(DTOUT)
GOTO KIL
if Y<1
GOTO S1
SET PD=+Y
SET CODE=$PIECE(Y(0),"^",2)
KILL DIC
+2 SET ZZ=M1_"^"_PD
IF S1=ZZ
if $DATA(^TMP($JOB,"RECIPES",DAY,MEAL))
GOTO R1
+3 SET $PIECE(S1,"^",2)=PD
+4 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 E2
+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
R3 ; Select RDA Category
+1 KILL DIC
SET DIC="^FH(112.2,"
SET DIC(0)="AEQM"
SET DIC("A")="Select DRI Category: "
WRITE !
DO ^DIC
if X[U!$DATA(DTOUT)
GOTO KIL
SET RDA=$SELECT(Y<1:0,1:+Y)
KILL DIC
+2 SET (AGE,NAM,SEX)=""
F1 SET ALL=1
DO ^FHDPA
if X="*"
GOTO PAT
if X=""
GOTO S3
if 'DFN
GOTO KIL
SET NAM=$PIECE(Y(0),U,1)
SET SEX=$PIECE(Y(0),U,2)
SET AGE=$PIECE(Y(0),U,3)
if SEX=""!(AGE="")
GOTO P1
+1 IF $PIECE($GET(^DPT(DFN,.35)),"^",1)
WRITE *7,!!?5," [ Patient has expired. ]"
GOTO KIL
+2 SET AGE=$EXTRACT(DT,1,3)-$EXTRACT(AGE,1,3)-($EXTRACT(DT,4,7)<$EXTRACT(AGE,4,7))
S3 READ !!,"Do you wish a detailed analysis? Y// ",SUM:DTIME
if '$TEST!(SUM["^")
GOTO KIL
if SUM=""
SET SUM="Y"
SET X=SUM
DO TR^FH
SET SUM=X
IF $PIECE("YES",SUM,1)'=""
IF $PIECE("NO",SUM,1)'=""
WRITE *7,!," Answer YES or NO"
GOTO S3
+1 SET SUM=$EXTRACT(SUM,1)
SET SUM=SUM="N"
KILL M
+2 WRITE !!,"The Analysis requires a 132 column printer.",!
+3 KILL IOP,%ZIS
SET %ZIS("A")="Print on Device: "
SET %ZIS="MQ"
WRITE !
DO ^%ZIS
KILL %ZIS,IOP
if POP
GOTO KIL
+4 IF $DATA(IO("Q"))
Begin DoDot:1
+5 KILL IO("Q"),ZTUCI,ZTDTH,ZTIO,ZTSAVE
+6 SET ZTRTN="^FHPRC11"
SET ZTREQ="@"
SET ZSAVE("ZTREQ")=""
SET ZTDESC=$PIECE($GET(XQY0),U,1)
+7 FOR G="AGE","DAY","MEAL","MNAM","NAM","^TMP($J,","RDA","SEX","SUM"
SET ZTSAVE(G)=""
+8 DO ^%ZTLOAD
DO ^%ZISC
USE IO
WRITE !,"Request Queued",!
KILL ZTSK
QUIT
End DoDot:1
GOTO KIL
+9 USE IO
XECUTE ^%ZOSF("BRK")
DO ^FHPRC11
XECUTE ^%ZOSF("NBRK")
DO ^%ZISC
KILL %ZIS,IOP
GOTO KIL
PAT READ !!,"Enter Patient's Name: ",NAM:DTIME
if '$TEST!("^"[NAM)
GOTO KIL
+1 IF NAM["?"!(NAM'?.ANP)!(NAM["^")
WRITE *7,!?5,"Enter Patient's Name to be printed on the report."
GOTO PAT
P1 READ !,"Sex: ",SEX:DTIME
if '$TEST!("^"[SEX)
GOTO KIL
SET X=SEX
DO TR^FH
SET SEX=X
IF $PIECE("MALE",SEX,1)'=""
IF $PIECE("FEMALE",SEX,1)'=""
WRITE *7," Enter M or F"
GOTO P1
+1 SET SEX=$EXTRACT(SEX,1)
P2 READ !,"Age: ",AGE:DTIME
if '$TEST!("^"[AGE)
GOTO KIL
IF AGE'?1N.N!(AGE<6)!(AGE>124)
WRITE !?5,"Enter Age in years between 6 and 124"
GOTO P2
+1 GOTO S3
KIL ; Kill all Used Variables
+1 KILL ^TMP($JOB)
GOTO KILL^XUSCLEAN
