FHPRI ; HISC/REL/NCA - Ingredient Management ;2/23/00 12:44
;;5.5;DIETETICS;;Jan 28, 2005
EN1 ; Enter/Edit Unit File
S (DIC,DIE)="^FH(119.1,",DIC(0)="AEQLM",DIC("DR")=".01",DLAYGO=119.1 W ! D ^DIC K DIC,DLAYGO G KIL:U[X!$D(DTOUT),EN1:Y<1
I Y<11 W *7,!!,"Cannot edit this unit" G EN1
S DA=+Y,DR=".01" S:$D(^XUSEC("FHMGR",DUZ)) DIDEL=119.1 D ^DIE,KIL G EN1
EN2 ; Enter/Edit Vendor File
S (DIC,DIE)="^FH(113.2,",DIC(0)="AEQLM",DIC("DR")=".01",DLAYGO=113.2 W ! D ^DIC K DIC,DLAYGO G KIL:U[X!$D(DTOUT),EN2:Y<1
S DA=+Y,DR=".01:99" S:$D(^XUSEC("FHMGR",DUZ)) DIDEL=113.2 D ^DIE,KIL G EN2
EN3 ; Enter/Edit Ingredients
S (DIC,DIE)="^FHING(",DIC(0)="AEQLM",DIC("DR")=".01",DLAYGO=113 W ! D ^DIC K DIC,DLAYGO G KIL:$D(DTOUT),E31:U[X,EN3:Y<1
S DA=+Y,DR=".01;31;1;3;2;4;29//^S X=DT;8;6;5;7;23;S REC=X;24;28//^S X=$S(REC=""LB"":1,1:"""");27;11;26;20;99;25;S:X'=""Y"" Y=0;30//^S X=DT;10" S:$D(^XUSEC("FHMGR",DUZ)) DIDEL=113 D ^DIE,KIL G EN3
E31 K DIE D ^FHREC3 G KIL
EN4 ; Enter/Edit Storage Locations
S (DIC,DIE)="^FH(113.1,",DIC(0)="AEQLM",DIC("DR")=".01",DLAYGO=113.1 W ! D ^DIC K DIC,DLAYGO G KIL:U[X!$D(DTOUT),EN4:Y<1
S DA=+Y,DR=".01:99" S:$D(^XUSEC("FHMGR",DUZ)) DIDEL=113.1 D ^DIE,KIL G EN4
EN6 ; List Units
W ! S L=0,DIC="^FH(119.1,",FLDS=".01",BY="NAME"
S FR="",TO="",DHD="UNITS" D EN1^DIP,RSET Q
EN8 ; List Storage Locations
W ! S L=0,DIC="^FH(113.1,",FLDS="[FHPSTO]",BY="PRINT ORDER,NAME"
S FR="@",TO="",DHD="STORAGE LOCATIONS" D EN1^DIP,RSET Q
RSET K %ZIS S IOP="" D ^%ZIS
KIL G KILL^XUSCLEAN
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFHPRI 1528 printed Sep 23, 2025@19:30:29 Page 2
FHPRI ; HISC/REL/NCA - Ingredient Management ;2/23/00 12:44
+1 ;;5.5;DIETETICS;;Jan 28, 2005
EN1 ; Enter/Edit Unit File
+1 SET (DIC,DIE)="^FH(119.1,"
SET DIC(0)="AEQLM"
SET DIC("DR")=".01"
SET DLAYGO=119.1
WRITE !
DO ^DIC
KILL DIC,DLAYGO
if U[X!$DATA(DTOUT)
GOTO KIL
if Y<1
GOTO EN1
+2 IF Y<11
WRITE *7,!!,"Cannot edit this unit"
GOTO EN1
+3 SET DA=+Y
SET DR=".01"
if $DATA(^XUSEC("FHMGR",DUZ))
SET DIDEL=119.1
DO ^DIE
DO KIL
GOTO EN1
EN2 ; Enter/Edit Vendor File
+1 SET (DIC,DIE)="^FH(113.2,"
SET DIC(0)="AEQLM"
SET DIC("DR")=".01"
SET DLAYGO=113.2
WRITE !
DO ^DIC
KILL DIC,DLAYGO
if U[X!$DATA(DTOUT)
GOTO KIL
if Y<1
GOTO EN2
+2 SET DA=+Y
SET DR=".01:99"
if $DATA(^XUSEC("FHMGR",DUZ))
SET DIDEL=113.2
DO ^DIE
DO KIL
GOTO EN2
EN3 ; Enter/Edit Ingredients
+1 SET (DIC,DIE)="^FHING("
SET DIC(0)="AEQLM"
SET DIC("DR")=".01"
SET DLAYGO=113
WRITE !
DO ^DIC
KILL DIC,DLAYGO
if $DATA(DTOUT)
GOTO KIL
if U[X
GOTO E31
if Y<1
GOTO EN3
+2 SET DA=+Y
SET DR=".01;31;1;3;2;4;29//^S X=DT;8;6;5;7;23;S REC=X;24;28//^S X=$S(REC=""LB"":1,1:"""");27;11;26;20;99;25;S:X'=""Y"" Y=0;30//^S X=DT;10"
if $DATA(^XUSEC("FHMGR",DUZ))
SET DIDEL=113
DO ^DIE
DO KIL
GOTO EN3
E31 KILL DIE
DO ^FHREC3
GOTO KIL
EN4 ; Enter/Edit Storage Locations
+1 SET (DIC,DIE)="^FH(113.1,"
SET DIC(0)="AEQLM"
SET DIC("DR")=".01"
SET DLAYGO=113.1
WRITE !
DO ^DIC
KILL DIC,DLAYGO
if U[X!$DATA(DTOUT)
GOTO KIL
if Y<1
GOTO EN4
+2 SET DA=+Y
SET DR=".01:99"
if $DATA(^XUSEC("FHMGR",DUZ))
SET DIDEL=113.1
DO ^DIE
DO KIL
GOTO EN4
EN6 ; List Units
+1 WRITE !
SET L=0
SET DIC="^FH(119.1,"
SET FLDS=".01"
SET BY="NAME"
+2 SET FR=""
SET TO=""
SET DHD="UNITS"
DO EN1^DIP
DO RSET
QUIT
EN8 ; List Storage Locations
+1 WRITE !
SET L=0
SET DIC="^FH(113.1,"
SET FLDS="[FHPSTO]"
SET BY="PRINT ORDER,NAME"
+2 SET FR="@"
SET TO=""
SET DHD="STORAGE LOCATIONS"
DO EN1^DIP
DO RSET
QUIT
RSET KILL %ZIS
SET IOP=""
DO ^%ZIS
KIL GOTO KILL^XUSCLEAN
