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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFHREP 1905 printed Sep 23, 2025@19:30:57 Page 2
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
