FHREP.m

FHREP ; HISC/NCA - Inventory Worksheet and Report ;10/1/93  09:24

 ;;5.5;DIETETICS;;Jan 28, 2005

EN1 ; Enter/Edit the Current Inventory QOH

 S OKAY=0,ANS="",CK=1 W ! K DIR S DIR(0)="YAO",DIR("A")="Want to enter Cost along with QOH (Y/N)? " D ^DIR G:$D(DIRUT)!($D(DIROUT)) KIL S:Y OKAY=1

 W ! K DIR S DIR(0)="YAO",DIR("A")="Enter Current QOH by INDIVIDUAL Ingredient (Y/N)? " D ^DIR G:$D(DIRUT)!($D(DIROUT)) KIL K DIR,DIROUT,DIRUT

 I Y=0 K Y S FHR="E" D F1 G:FHXX["^"!("^"[X) KIL D Q1^FHREP1 G REC:CK,KIL

EDIT ; Enter/Edit the Current Inventory

 K DIC,DIE S (DIC,DIE)="^FHING(",DIC(0)="AEQM",DIC("DR")=".01" W ! D ^DIC

 K DIC G KIL:$D(DTOUT),REC:U[X,EDIT:Y<1

 S Z=$P($G(^FHING(+Y,0)),"^",19) I Z'="Y" W *7,"   Inventory NOT specify." G EDIT

 S ZZ=$G(^FHING(+Y,0)),FHD=$P(ZZ,"^",24) S DTP=FHD D:DTP'="" DTP^FH S FHD=DTP

 S Z1=$P(ZZ,"^",9),Z2=$P(ZZ,"^",11)

 W:FHD'="" !?27,"QOH LAST UPDATED ON ",FHD,!

 S DA=+Y S:OKAY DR="8;S:X=Z1 Y=""@1"";29////"_DT_";@1;10;S:X=Z2 Y="""";30////"_DT S:'OKAY DR="10;S:X=Z2 Y="""";30////"_DT

 D ^DIE K FHD,DA,DIC,DIE,DR G EDIT

F1 ; Ask For Food Group or Storage

 R !!,"Select by F=FOOD GROUPS or S=STORAGE: F// ",FHXX:DTIME I '$T!(FHXX["^") S FHXX="^" Q

 S:FHXX="" FHXX="F" I "fs"[FHXX S X=FHXX D TR^FH S FHXX=X

 I FHXX'?1U!("FS"'[FHXX) W *7," Enter return F or S" G F1

 I FHXX="S" S SRT=$O(^FH(113.1,0)) I SRT'<1,$O(^FH(113.1,SRT))<1 S SRT=0  Q

 I FHXX="S" G D2

D1 ; Get a Food Group

 R !!,"Select Food Group (or ALL): ",X:DTIME Q:'$T!("^"[X)  D:X="all" TR^FH I X="ALL" S SRT=0 Q

 I X'?1N!(X<1)!(X>6) W *7,!?5,"Answer with a number 1 to 6 or ALL for all." G D1

 S SRT=+X

 Q

D2 ; Get a Storage

 R !!,"Select Storage Location (or ALL): ",X:DTIME Q:'$T!("^"[X)  D:X="all" TR^FH I X="ALL" S SRT=0 Q

 I X'="ALL" K DIC S DIC="^FH(113.1,",DIC(0)="EMQ" D ^DIC G:Y<1 D2 S SRT=+Y

 Q

REC ; Re-Cost Recipes

 D:OKAY ^FHREC3

KIL K ^TMP($J) G KILL^XUSCLEAN

FHREP     ; HISC/NCA - Inventory Worksheet and Report ;10/1/93  09:24

 +1       ;;5.5;DIETETICS;;Jan 28, 2005

EN1       ; Enter/Edit the Current Inventory QOH

 +1        SET OKAY=0

           SET ANS=""

           SET CK=1

           WRITE !

           KILL DIR

           SET DIR(0)="YAO"

           SET DIR("A")="Want to enter Cost along with QOH (Y/N)? "

           DO ^DIR

           IF $DATA(DIRUT)!($DATA(DIROUT))

               GOTO KIL

           IF Y

               SET OKAY=1

 +2        WRITE !

           KILL DIR

           SET DIR(0)="YAO"

           SET DIR("A")="Enter Current QOH by INDIVIDUAL Ingredient (Y/N)? "

           DO ^DIR

           IF $DATA(DIRUT)!($DATA(DIROUT))

               GOTO KIL

           KILL DIR,DIROUT,DIRUT

 +3        IF Y=0

               KILL Y

               SET FHR="E"

               DO F1

               IF FHXX["^"!("^"[X)

                   GOTO KIL

               DO Q1^FHREP1

               IF CK

                   GOTO REC

               GOTO KIL

EDIT      ; Enter/Edit the Current Inventory

 +1        KILL DIC,DIE

           SET (DIC,DIE)="^FHING("

           SET DIC(0)="AEQM"

           SET DIC("DR")=".01"

           WRITE !

           DO ^DIC

 +2        KILL DIC

           IF $DATA(DTOUT)

               GOTO KIL

           IF U[X

               GOTO REC

           IF Y<1

               GOTO EDIT

 +3        SET Z=$PIECE($GET(^FHING(+Y,0)),"^",19)

           IF Z'="Y"

               WRITE *7,"   Inventory NOT specify."

               GOTO EDIT

 +4        SET ZZ=$GET(^FHING(+Y,0))

           SET FHD=$PIECE(ZZ,"^",24)

           SET DTP=FHD

           IF DTP'=""

               DO DTP^FH

           SET FHD=DTP

 +5        SET Z1=$PIECE(ZZ,"^",9)

           SET Z2=$PIECE(ZZ,"^",11)

 +6        IF FHD'=""

               WRITE !?27,"QOH LAST UPDATED ON ",FHD,!

 +7        SET DA=+Y

           IF OKAY

               SET DR="8;S:X=Z1 Y=""@1"";29////"_DT_";@1;10;S:X=Z2 Y="""";30////"_DT

           IF 'OKAY

               SET DR="10;S:X=Z2 Y="""";30////"_DT

 +8        DO ^DIE

           KILL FHD,DA,DIC,DIE,DR

           GOTO EDIT

F1        ; Ask For Food Group or Storage

 +1        READ !!,"Select by F=FOOD GROUPS or S=STORAGE: F// ",FHXX:DTIME

           IF '$TEST!(FHXX["^")

               SET FHXX="^"

               QUIT 

 +2        IF FHXX=""

               SET FHXX="F"

           IF "fs"[FHXX

               SET X=FHXX

               DO TR^FH

               SET FHXX=X

 +3        IF FHXX'?1U!("FS"'[FHXX)

               WRITE *7," Enter return F or S"

               GOTO F1

 +4        IF FHXX="S"

               SET SRT=$ORDER(^FH(113.1,0))

               IF SRT'<1

                   IF $ORDER(^FH(113.1,SRT))<1

                       SET SRT=0

                       QUIT 

 +5        IF FHXX="S"

               GOTO D2

D1        ; Get a Food Group

 +1        READ !!,"Select Food Group (or ALL): ",X:DTIME

           IF '$TEST!("^"[X)

               QUIT 

           IF X="all"

               DO TR^FH

           IF X="ALL"

               SET SRT=0

               QUIT 

 +2        IF X'?1N!(X<1)!(X>6)

               WRITE *7,!?5,"Answer with a number 1 to 6 or ALL for all."

               GOTO D1

 +3        SET SRT=+X

 +4        QUIT 

D2        ; Get a Storage

 +1        READ !!,"Select Storage Location (or ALL): ",X:DTIME

           IF '$TEST!("^"[X)

               QUIT 

           IF X="all"

               DO TR^FH

           IF X="ALL"

               SET SRT=0

               QUIT 

 +2        IF X'="ALL"

               KILL DIC

               SET DIC="^FH(113.1,"

               SET DIC(0)="EMQ"

               DO ^DIC

               IF Y<1

                   GOTO D2

               SET SRT=+Y

 +3        QUIT 

REC       ; Re-Cost Recipes

 +1        IF OKAY

               DO ^FHREC3

KIL        KILL ^TMP($JOB)

           GOTO KILL^XUSCLEAN