- 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 Jan 18, 2025@02:56:06 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