source: WorldVistAEHR/trunk/r/DIETETICS-FH/FHREC3.m@ 808

Last change on this file since 808 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 955 bytes
RevLine 
[613]1FHREC3 ; HISC/REL - Re-cost recipes ;5/14/93 14:53
2 ;;5.5;DIETETICS;;Jan 28, 2005
3A1 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
4 G:X'?1"Y".E KIL
5 W !!,"Beginning re-costing of all recipes ..." S CNT=0
6 F R1=0:0 S R1=$O(^FH(114,R1)) Q:R1<1 D REC S CNT=CNT+1 W:CNT#10=0 "."
7 W !!,"Done ...",! G KIL
8REC S CST=0 F N=0:0 S N=$O(^FH(114,R1,"I",N)) Q:N<1 S X=^(N,0) D I1
9 F N=0:0 S N=$O(^FH(114,R1,"R",N)) Q:N<1 S X=^(N,0) D R1
10 S POR=$P(^FH(114,R1,0),"^",2) Q:'POR S CST=+$J(CST/POR,0,3)
11 S:CST $P(^FH(114,R1,0),"^",13)=CST Q
12I1 S I2=$P(X,"^",1),AMT=$P(X,"^",2) Q:'I2 S Y0=$G(^FHING(I2,0))
13 S C=$P(Y0,"^",17) Q:'C S AMT=AMT/C
14 S C=$P(Y0,"^",8) Q:'C S AMT=AMT/C
15 S C=$P(Y0,"^",9),CST=C*AMT+CST Q
16R1 S R2=$P(X,"^",1),AMT=$P(X,"^",2) Q:'R2 S C=$P($G(^FH(114,R2,0)),"^",13)
17 S CST=C*AMT+CST Q
18KIL K AMT,C,CNT,CST,I2,N,POR,R1,R2,X,Y0 Q
Note: See TracBrowser for help on using the repository browser.