Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: FHREC3

FHREC3.m

Go to the documentation of this file.
  1. FHREC3 ; HISC/REL - Re-cost recipes ;5/14/93 14:53
  1. ;;5.5;DIETETICS;;Jan 28, 2005
  1. 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
  1. G:X'?1"Y".E KIL
  1. W !!,"Beginning re-costing of all recipes ..." S CNT=0
  1. F R1=0:0 S R1=$O(^FH(114,R1)) Q:R1<1 D REC S CNT=CNT+1 W:CNT#10=0 "."
  1. W !!,"Done ...",! G KIL
  1. 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
  1. F N=0:0 S N=$O(^FH(114,R1,"R",N)) Q:N<1 S X=^(N,0) D R1
  1. S POR=$P(^FH(114,R1,0),"^",2) Q:'POR S CST=+$J(CST/POR,0,3)
  1. S:CST $P(^FH(114,R1,0),"^",13)=CST Q
  1. I1 S I2=$P(X,"^",1),AMT=$P(X,"^",2) Q:'I2 S Y0=$G(^FHING(I2,0))
  1. S C=$P(Y0,"^",17) Q:'C S AMT=AMT/C
  1. S C=$P(Y0,"^",8) Q:'C S AMT=AMT/C
  1. S C=$P(Y0,"^",9),CST=C*AMT+CST Q
  1. R1 S R2=$P(X,"^",1),AMT=$P(X,"^",2) Q:'R2 S C=$P($G(^FH(114,R2,0)),"^",13)
  1. S CST=C*AMT+CST Q
  1. KIL K AMT,C,CNT,CST,I2,N,POR,R1,R2,X,Y0 Q