FHREC3 ; HISC/REL - Re-cost recipes ;5/14/93 14:53
;;5.5;DIETETICS;;Jan 28, 2005
A1 R !!,"Do you want to re-cost recipes? (Y/N): ",X:DTIME G:'$T!(X="^") KIL S:X="" X="?" D TR^FH I $P("YES",X,1)'="",$P("NO",X,1)'="" W *7," Answer YES or NO" G A1
G:X'?1"Y".E KIL
W !!,"Beginning re-costing of all recipes ..." S CNT=0
F R1=0:0 S R1=$O(^FH(114,R1)) Q:R1<1 D REC S CNT=CNT+1 W:CNT#10=0 "."
W !!,"Done ...",! G KIL
REC S CST=0 F N=0:0 S N=$O(^FH(114,R1,"I",N)) Q:N<1 S X=^(N,0) D I1
F N=0:0 S N=$O(^FH(114,R1,"R",N)) Q:N<1 S X=^(N,0) D R1
S POR=$P(^FH(114,R1,0),"^",2) Q:'POR S CST=+$J(CST/POR,0,3)
S:CST $P(^FH(114,R1,0),"^",13)=CST Q
I1 S I2=$P(X,"^",1),AMT=$P(X,"^",2) Q:'I2 S Y0=$G(^FHING(I2,0))
S C=$P(Y0,"^",17) Q:'C S AMT=AMT/C
S C=$P(Y0,"^",8) Q:'C S AMT=AMT/C
S C=$P(Y0,"^",9),CST=C*AMT+CST Q
R1 S R2=$P(X,"^",1),AMT=$P(X,"^",2) Q:'R2 S C=$P($G(^FH(114,R2,0)),"^",13)
S CST=C*AMT+CST Q
KIL K AMT,C,CNT,CST,I2,N,POR,R1,R2,X,Y0 Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFHREC3 973 printed Dec 13, 2024@01:54:53 Page 2
FHREC3 ; HISC/REL - Re-cost recipes ;5/14/93 14:53
+1 ;;5.5;DIETETICS;;Jan 28, 2005
A1 READ !!,"Do you want to re-cost recipes? (Y/N): ",X:DTIME
if '$TEST!(X="^")
GOTO KIL
if X=""
SET X="?"
DO TR^FH
IF $PIECE("YES",X,1)'=""
IF $PIECE("NO",X,1)'=""
WRITE *7," Answer YES or NO"
GOTO A1
+1 if X'?1"Y".E
GOTO KIL
+2 WRITE !!,"Beginning re-costing of all recipes ..."
SET CNT=0
+3 FOR R1=0:0
SET R1=$ORDER(^FH(114,R1))
if R1<1
QUIT
DO REC
SET CNT=CNT+1
if CNT#10=0
WRITE "."
+4 WRITE !!,"Done ...",!
GOTO KIL
REC SET CST=0
FOR N=0:0
SET N=$ORDER(^FH(114,R1,"I",N))
if N<1
QUIT
SET X=^(N,0)
DO I1
+1 FOR N=0:0
SET N=$ORDER(^FH(114,R1,"R",N))
if N<1
QUIT
SET X=^(N,0)
DO R1
+2 SET POR=$PIECE(^FH(114,R1,0),"^",2)
if 'POR
QUIT
SET CST=+$JUSTIFY(CST/POR,0,3)
+3 if CST
SET $PIECE(^FH(114,R1,0),"^",13)=CST
QUIT
I1 SET I2=$PIECE(X,"^",1)
SET AMT=$PIECE(X,"^",2)
if 'I2
QUIT
SET Y0=$GET(^FHING(I2,0))
+1 SET C=$PIECE(Y0,"^",17)
if 'C
QUIT
SET AMT=AMT/C
+2 SET C=$PIECE(Y0,"^",8)
if 'C
QUIT
SET AMT=AMT/C
+3 SET C=$PIECE(Y0,"^",9)
SET CST=C*AMT+CST
QUIT
R1 SET R2=$PIECE(X,"^",1)
SET AMT=$PIECE(X,"^",2)
if 'R2
QUIT
SET C=$PIECE($GET(^FH(114,R2,0)),"^",13)
+1 SET CST=C*AMT+CST
QUIT
KIL KILL AMT,C,CNT,CST,I2,N,POR,R1,R2,X,Y0
QUIT
