- 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 Jan 18, 2025@02:56:11 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