FHREC3.m

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 ---FHREC3   973     printed  Apr 09, 2024@20:57:13                                                                                                                                                                                                       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