Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: FHREP

FHREP.m

Go to the documentation of this file.
  1. FHREP ; HISC/NCA - Inventory Worksheet and Report ;10/1/93 09:24
  1. ;;5.5;DIETETICS;;Jan 28, 2005
  1. EN1 ; Enter/Edit the Current Inventory QOH
  1. 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
  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
  1. I Y=0 K Y S FHR="E" D F1 G:FHXX["^"!("^"[X) KIL D Q1^FHREP1 G REC:CK,KIL
  1. EDIT ; Enter/Edit the Current Inventory
  1. K DIC,DIE S (DIC,DIE)="^FHING(",DIC(0)="AEQM",DIC("DR")=".01" W ! D ^DIC
  1. K DIC G KIL:$D(DTOUT),REC:U[X,EDIT:Y<1
  1. S Z=$P($G(^FHING(+Y,0)),"^",19) I Z'="Y" W *7," Inventory NOT specify." G EDIT
  1. S ZZ=$G(^FHING(+Y,0)),FHD=$P(ZZ,"^",24) S DTP=FHD D:DTP'="" DTP^FH S FHD=DTP
  1. S Z1=$P(ZZ,"^",9),Z2=$P(ZZ,"^",11)
  1. W:FHD'="" !?27,"QOH LAST UPDATED ON ",FHD,!
  1. 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
  1. D ^DIE K FHD,DA,DIC,DIE,DR G EDIT
  1. F1 ; Ask For Food Group or Storage
  1. R !!,"Select by F=FOOD GROUPS or S=STORAGE: F// ",FHXX:DTIME I '$T!(FHXX["^") S FHXX="^" Q
  1. S:FHXX="" FHXX="F" I "fs"[FHXX S X=FHXX D TR^FH S FHXX=X
  1. I FHXX'?1U!("FS"'[FHXX) W *7," Enter return F or S" G F1
  1. I FHXX="S" S SRT=$O(^FH(113.1,0)) I SRT'<1,$O(^FH(113.1,SRT))<1 S SRT=0 Q
  1. I FHXX="S" G D2
  1. D1 ; Get a Food Group
  1. R !!,"Select Food Group (or ALL): ",X:DTIME Q:'$T!("^"[X) D:X="all" TR^FH I X="ALL" S SRT=0 Q
  1. I X'?1N!(X<1)!(X>6) W *7,!?5,"Answer with a number 1 to 6 or ALL for all." G D1
  1. S SRT=+X
  1. Q
  1. D2 ; Get a Storage
  1. R !!,"Select Storage Location (or ALL): ",X:DTIME Q:'$T!("^"[X) D:X="all" TR^FH I X="ALL" S SRT=0 Q
  1. I X'="ALL" K DIC S DIC="^FH(113.1,",DIC(0)="EMQ" D ^DIC G:Y<1 D2 S SRT=+Y
  1. Q
  1. REC ; Re-Cost Recipes
  1. D:OKAY ^FHREC3
  1. KIL K ^TMP($J) G KILL^XUSCLEAN