FHPRI.m

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

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