source: FOIAVistA/tag/r/DIETETICS-FH/FHREC.m@ 1618

Last change on this file since 1618 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 1.8 KB
Line 
1FHREC ; HISC/REL - Recipe Management ;2/13/95 14:29
2 ;;5.5;DIETETICS;;Jan 28, 2005
3EN1 ; Enter/Edit Recipes
4 S (DIC,DIE)="^FH(114,",DIC(0)="AEQLM",DIC("DR")=".01",DLAYGO=114 W ! D ^DIC K DIC,DLAYGO G KIL:U[X!$D(DTOUT),EN1:Y<1
5 S DA=+Y,DR="[FHINPR]" S:$D(^XUSEC("FHMGR",DUZ)) DIDEL=114 D ^DIE
6 I $D(DA) S REC=DA D ANAL^FHREC5
7 D KIL G EN1
8EN3 ; Enter/Edit Recipe Categories
9 S (DIC,DIE)="^FH(114.1,",DIC(0)="AEQLM",DIC("DR")=".01",DLAYGO=114.1 W ! D ^DIC K DIC,DLAYGO G KIL:"^"[X!$D(DTOUT),EN3:Y<1
10 S DA=+Y,DR=".01:99" S:$D(^XUSEC("FHMGR",DUZ)) DIDEL=114.1 D ^DIE,KIL G EN3
11EN4 ; List Recipe Categories
12 W ! S L=0,DIC="^FH(114.1,",FLDS="[FHRECC]",BY="2,.01"
13 S FR="@",TO="",DHD="RECIPE CATEGORIES" D EN1^DIP,RSET Q
14EN5 ; Enter/Edit Serving Utensils
15 S (DIC,DIE)="^FH(114.3,",DIC(0)="AEQLM",DIC("DR")=".01",DLAYGO=114.3 W ! D ^DIC K DIC,DLAYGO G KIL:"^"[X!$D(DTOUT),EN5:Y<1
16 S DA=+Y,DR=".01:99" S:$D(^XUSEC("FHMGR",DUZ)) DIDEL=114.3 D ^DIE,KIL G EN5
17EN6 ; List Serving Utensils
18 W ! S L=0,DIC="^FH(114.3,",FLDS="NAME",BY="NAME"
19 S (FR,TO)="",DHD="SERVING UTENSILS" D EN1^DIP,RSET Q
20EN7 ; Enter/Edit Equipment
21 S (DIC,DIE)="^FH(114.4,",DIC(0)="AEQLM",DIC("DR")=".01",DLAYGO=114.4 W ! D ^DIC K DIC,DLAYGO G KIL:"^"[X!$D(DTOUT),EN7:Y<1
22 S DA=+Y,DR=".01:99" S:$D(^XUSEC("FHMGR",DUZ)) DIDEL=114.4 D ^DIE,KIL G EN7
23EN8 ; List Equipment
24 W ! S L=0,DIC="^FH(114.4,",FLDS="NAME",BY="NAME"
25 S (FR,TO)="",DHD="EQUIPMENT" D EN1^DIP,RSET Q
26EN9 ; Enter/Edit Preparation Areas
27 S (DIC,DIE)="^FH(114.2,",DIC(0)="AEQLM",DIC("DR")=".01",DLAYGO=114.2 W ! D ^DIC K DIC,DLAYGO G KIL:U[X!$D(DTOUT),EN9:Y<1
28 S DA=+Y,DR=".01:99" S:$D(^XUSEC("FHMGR",DUZ)) DIDEL=114.2 D ^DIE,KIL G EN9
29EN10 ; List Preparation Areas
30 W ! S L=0,DIC="^FH(114.2,",FLDS="[FHPROP]",BY="PRINT ORDER,NAME"
31 S FR="@",TO="",DHD="PREPARATION AREAS" D EN1^DIP,RSET Q
32RSET K %ZIS S IOP="" D ^%ZIS
33KIL G KILL^XUSCLEAN
Note: See TracBrowser for help on using the repository browser.