- 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