FHREC2 ; HISC/REL - Adjust Recipe ;4/28/95 09:45
;;5.5;DIETETICS;;Jan 28, 2005
EN1 ; Adjust Recipe - R1 = Recipe File No., S1 = No. Portions
S R0=^FH(114,R1,0),P1=$P(R0,"^",2) Q:P1<1!(S1<1)
D DISP D LN S N=0,MUL=S1/P1 W !
N1 S N=$O(^FH(114,R1,"I",N)) G:N<1 N2 S X=^(N,0),I2=+$P(X,"^",1),Y=$P(X,"^",2)*MUL
S Y(0)=$G(^FHING(I2,0)),UNT=$P(Y(0),"^",16) D EN2^FHREC1
W !!,$P(Y(0),"^",1),?60,Y G N1
N2 F K=0:0 S K=$O(^FH(114,R1,"R",K)) Q:K<1 S Y(0)=^(K,0) I +Y(0) W !!,"*",$P(^FH(114,+Y(0),0),"^",1),?60,$J(MUL*$P(Y(0),"^",2),0,0)," Portions"
D LN W ! F K=0:0 S K=$O(^FH(114,R1,"X",K)) Q:K<1 W !,^(K,0)
D LN W ! Q:$G(^FH(114,R1,"DBX",0))=""
S P="" W !,"Diabetic Exchange: "
F K=0:0 S K=$O(^FH(114,R1,"DBX",K)) Q:K<1 S Z=^(K,0) S:P'="" P=P_", " S Z1=$S($P(Z,"^",2):$P(Z,"^",2),1:1)_" "_$P($G(^FH(114.1,+Z,0)),"^",1) D:$L(P)+$L(Z1)'<60 EX S P=P_Z1
W:P'="" ?19,P,!
D LN W ! Q
EX W ?19,P S P="" W !
Q
DISP W:PG @IOF W !?25,"A D J U S T E D R E C I P E",?71,$E(DTP,1,9)
S N=$P(R0,"^",1) W !!?(80-$L(N)\2),N
W !!,"Portion Size: ",$P(R0,"^",3),?40,"No. Portions: ",S1
W !,"Prep. Time: ",$P(R0,"^",4),?40,"Srv. Utensil: " S Z=$P(R0,"^",6) I Z W $P(^FH(114.3,Z,0),"^",1)
W !,"Equipment: " S N=$O(^FH(114,R1,"E",0)) I N>0 S Z=^(N,0) W $P(^FH(114.4,Z,0),"^",1)
W ?40,"Category: " S Z=$P(R0,"^",7) I Z W $P(^FH(114.1,Z,0),"^",1)
I N>0 F N=N:0 S N=$O(^FH(114,R1,"E",N)) Q:N<1 S Z=^(N,0) W !?14,$P(^FH(114.4,Z,0),"^",1)
Q
LN W !!,"- - - - - - - - - - - - - - - - - - - - - - - - - - -" Q
EN2 ; Print adjusted recipe
S X="T",%DT="X" D ^%DT K %DT S DTP=Y D DTP^FH
K DIC S DIC="^FH(114,",DIC(0)="AEQM" W ! D ^DIC K DIC G KIL:"^"[X!$D(DTOUT),EN2:Y<1 S R1=+Y
R0 R !!,"Number of Portions: ",S1:DTIME G KIL:'$T!("^"[S1) I +S1'=S1!(S1<1)!(S1>5000) W *7," Enter a number from 1 to 5000" G R0
W ! K IOP,%ZIS S %ZIS("A")="Select Printer: ",%ZIS="MQ" D ^%ZIS K %ZIS,IOP G:POP KIL
I $D(IO("Q")) S FHPGM="R1^FHREC2",FHLST="R1^S1^DTP" D EN2^FH G EN2
U IO D R1 D ^%ZISC K %ZIS,IOP G EN2
R1 ; Entry Point to Print adjusted recipe
K R F K1=0:0 S K1=$O(^FH(114,R1,"R",K1)) Q:K1<1 S Y=^(K1,0) D R2
S PG=0 D EN1 S PG=1
F R1=0:0 S R1=$O(R(R1)) Q:R1="" S S1=R(R1) D EN1
Q
R2 S MUL=$P(^FH(114,R1,0),"^",2) Q:'MUL S MUL=S1/MUL
S P1=$P(Y,"^",2)*MUL S:'$D(R(+Y)) R(+Y)=0 S R(+Y)=R(+Y)+P1 Q
KIL G KILL^XUSCLEAN
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFHREC2 2379 printed Dec 13, 2024@01:54:52 Page 2
FHREC2 ; HISC/REL - Adjust Recipe ;4/28/95 09:45
+1 ;;5.5;DIETETICS;;Jan 28, 2005
EN1 ; Adjust Recipe - R1 = Recipe File No., S1 = No. Portions
+1 SET R0=^FH(114,R1,0)
SET P1=$PIECE(R0,"^",2)
if P1<1!(S1<1)
QUIT
+2 DO DISP
DO LN
SET N=0
SET MUL=S1/P1
WRITE !
N1 SET N=$ORDER(^FH(114,R1,"I",N))
if N<1
GOTO N2
SET X=^(N,0)
SET I2=+$PIECE(X,"^",1)
SET Y=$PIECE(X,"^",2)*MUL
+1 SET Y(0)=$GET(^FHING(I2,0))
SET UNT=$PIECE(Y(0),"^",16)
DO EN2^FHREC1
+2 WRITE !!,$PIECE(Y(0),"^",1),?60,Y
GOTO N1
N2 FOR K=0:0
SET K=$ORDER(^FH(114,R1,"R",K))
if K<1
QUIT
SET Y(0)=^(K,0)
IF +Y(0)
WRITE !!,"*",$PIECE(^FH(114,+Y(0),0),"^",1),?60,$JUSTIFY(MUL*$PIECE(Y(0),"^",2),0,0)," Portions"
+1 DO LN
WRITE !
FOR K=0:0
SET K=$ORDER(^FH(114,R1,"X",K))
if K<1
QUIT
WRITE !,^(K,0)
+2 DO LN
WRITE !
if $GET(^FH(114,R1,"DBX",0))=""
QUIT
+3 SET P=""
WRITE !,"Diabetic Exchange: "
+4 FOR K=0:0
SET K=$ORDER(^FH(114,R1,"DBX",K))
if K<1
QUIT
SET Z=^(K,0)
if P'=""
SET P=P_", "
SET Z1=$SELECT($PIECE(Z,"^",2):$PIECE(Z,"^",2),1:1)_" "_$PIECE($GET(^FH(114.1,+Z,0)),"^",1)
if $LENGTH(P)+$LENGTH(Z1)'<60
DO EX
SET P=P_Z1
+5 if P'=""
WRITE ?19,P,!
+6 DO LN
WRITE !
QUIT
EX WRITE ?19,P
SET P=""
WRITE !
+1 QUIT
DISP if PG
WRITE @IOF
WRITE !?25,"A D J U S T E D R E C I P E",?71,$EXTRACT(DTP,1,9)
+1 SET N=$PIECE(R0,"^",1)
WRITE !!?(80-$LENGTH(N)\2),N
+2 WRITE !!,"Portion Size: ",$PIECE(R0,"^",3),?40,"No. Portions: ",S1
+3 WRITE !,"Prep. Time: ",$PIECE(R0,"^",4),?40,"Srv. Utensil: "
SET Z=$PIECE(R0,"^",6)
IF Z
WRITE $PIECE(^FH(114.3,Z,0),"^",1)
+4 WRITE !,"Equipment: "
SET N=$ORDER(^FH(114,R1,"E",0))
IF N>0
SET Z=^(N,0)
WRITE $PIECE(^FH(114.4,Z,0),"^",1)
+5 WRITE ?40,"Category: "
SET Z=$PIECE(R0,"^",7)
IF Z
WRITE $PIECE(^FH(114.1,Z,0),"^",1)
+6 IF N>0
FOR N=N:0
SET N=$ORDER(^FH(114,R1,"E",N))
if N<1
QUIT
SET Z=^(N,0)
WRITE !?14,$PIECE(^FH(114.4,Z,0),"^",1)
+7 QUIT
LN WRITE !!,"- - - - - - - - - - - - - - - - - - - - - - - - - - -"
QUIT
EN2 ; Print adjusted recipe
+1 SET X="T"
SET %DT="X"
DO ^%DT
KILL %DT
SET DTP=Y
DO DTP^FH
+2 KILL DIC
SET DIC="^FH(114,"
SET DIC(0)="AEQM"
WRITE !
DO ^DIC
KILL DIC
if "^"[X!$DATA(DTOUT)
GOTO KIL
if Y<1
GOTO EN2
SET R1=+Y
R0 READ !!,"Number of Portions: ",S1:DTIME
if '$TEST!("^"[S1)
GOTO KIL
IF +S1'=S1!(S1<1)!(S1>5000)
WRITE *7," Enter a number from 1 to 5000"
GOTO R0
+1 WRITE !
KILL IOP,%ZIS
SET %ZIS("A")="Select Printer: "
SET %ZIS="MQ"
DO ^%ZIS
KILL %ZIS,IOP
if POP
GOTO KIL
+2 IF $DATA(IO("Q"))
SET FHPGM="R1^FHREC2"
SET FHLST="R1^S1^DTP"
DO EN2^FH
GOTO EN2
+3 USE IO
DO R1
DO ^%ZISC
KILL %ZIS,IOP
GOTO EN2
R1 ; Entry Point to Print adjusted recipe
+1 KILL R
FOR K1=0:0
SET K1=$ORDER(^FH(114,R1,"R",K1))
if K1<1
QUIT
SET Y=^(K1,0)
DO R2
+2 SET PG=0
DO EN1
SET PG=1
+3 FOR R1=0:0
SET R1=$ORDER(R(R1))
if R1=""
QUIT
SET S1=R(R1)
DO EN1
+4 QUIT
R2 SET MUL=$PIECE(^FH(114,R1,0),"^",2)
if 'MUL
QUIT
SET MUL=S1/MUL
+1 SET P1=$PIECE(Y,"^",2)*MUL
if '$DATA(R(+Y))
SET R(+Y)=0
SET R(+Y)=R(+Y)+P1
QUIT
KIL GOTO KILL^XUSCLEAN
