| [623] | 1 | FHPRO ; HISC/REL/RTK - Food Production Manager ;4/12/06 15:53
|
|---|
| 2 | ;;5.5;DIETETICS;**4,5**;Jan 28, 2005;Build 53
|
|---|
| 3 | EN2 ; Enter/Edit Nutrition Locations (Inpatient Wards/Outpatient Clinics)
|
|---|
| 4 | W ! K DIR,DIC S DIR("A")="Select WARD or OUTPATIENT Location: "
|
|---|
| 5 | S DIR(0)="SAO^W:Ward Location;O:Outpatient Location" D ^DIR Q:$D(DIRUT)
|
|---|
| 6 | I Y'=-1 S FHANS=Y
|
|---|
| 7 | I FHANS="W" D EN2WRD Q
|
|---|
| 8 | I FHANS="O" D EN2OL Q
|
|---|
| 9 | Q
|
|---|
| 10 | EN2WRD ;Ward locations
|
|---|
| 11 | K DIC S (DIC,DIE)="^FH(119.6,",DIC(0)="AEQLM",DLAYGO=119.6
|
|---|
| 12 | S DIC("DR")=".01" W ! D ^DIC K DIC,DLAYGO G KIL:U[X!$D(DTOUT),EN2:Y<1
|
|---|
| 13 | S DA=+Y,DR=".01:2.5;3;S:X="""" Y=4;3.5;4;S:X="""" Y=5;4.5;5;S:'X Y=6;5.5;6:29;99;107;107.5;108;108.5;109;109.5;110;110.5;111;111.5;112" S:$D(^XUSEC("FHMGR",DUZ)) DIDEL=119.6 D ^DIE,KIL G EN2
|
|---|
| 14 | EN2OL ;Outpatient locations
|
|---|
| 15 | K DIC S (DIC,DIE)="^FH(119.6,",DIC(0)="AEQLM",DLAYGO=119.6
|
|---|
| 16 | S DIC("DR")=".01" W ! D ^DIC K DIC,DLAYGO G KIL:U[X!$D(DTOUT),EN2:Y<1
|
|---|
| 17 | S DA=+Y,DR=".01;2;2.6;3;S:X="""" Y=4;3.5;4;S:X="""" Y=5;4.5;5;S:'X Y=6;5.5;6;7;103:106;11;20:99;107;107.5;108;108.5;109;109.5;110;110.5;111;111.5;112" S:$D(^XUSEC("FHMGR",DUZ)) DIDEL=119.6 D ^DIE,KIL G EN2
|
|---|
| 18 | EN3 ; Enter/Edit Production Diets
|
|---|
| 19 | K DIC S (DIC,DIE)="^FH(116.2,",DIC(0)="AEQLM",DLAYGO=116.2
|
|---|
| 20 | S DIC("DR")=".01" W ! D ^DIC K DIC,DLAYGO G KIL:U[X!$D(DTOUT),EN3:Y<1
|
|---|
| 21 | S DA=+Y,DR=$S(DA=1:"1:8",1:".01:7.5;10;S:X'=""Y"" Y=8;11;8;12:99") S:$D(^XUSEC("FHMGR",DUZ)) DIDEL=116.2 D ^DIE I '$D(DA) D KIL G EN3
|
|---|
| 22 | S:$O(^FH(116.2,DA,"R",0))<1 $P(^FH(116.2,DA,0),"^",4)="N" D KIL G EN3
|
|---|
| 23 | EN4 ; List Production Diets
|
|---|
| 24 | W !!,"The list requires a 132 column printer.",!
|
|---|
| 25 | W ! S L=0,DIC="^FH(116.2,",FLDS="[FHPROD]",BY="8,.01"
|
|---|
| 26 | S FR="@",TO="",DHD="PRODUCTION DIETS" D EN1^DIP,RSET Q
|
|---|
| 27 | EN5 ; Enter/Edit Production Facilities
|
|---|
| 28 | K DIC S (DIC,DIE)="^FH(119.71,",DIC(0)="AEQLM",DLAYGO=119.71
|
|---|
| 29 | S DIC("DR")=".01" W ! D ^DIC K DIC,DLAYGO G KIL:U[X!$D(DTOUT),EN5:Y<1
|
|---|
| 30 | S DA=+Y,DR=".01:99" S:$D(^XUSEC("FHMGR",DUZ)) DIDEL=119.71 D ^DIE,KIL G EN5
|
|---|
| 31 | EN6 ; Enter/Edit Service Points
|
|---|
| 32 | K DIC S (DIC,DIE)="^FH(119.72,",DIC(0)="AEQLM",DLAYGO=119.72
|
|---|
| 33 | S DIC("DR")=".01" W ! D ^DIC K DIC,DLAYGO G KIL:U[X!$D(DTOUT),EN6:Y<1
|
|---|
| 34 | S DA=+Y S DR=".01:99" S:$D(^XUSEC("FHMGR",DUZ)) DIDEL=119.72 D ^DIE I '$D(DA) D KIL G EN6
|
|---|
| 35 | S DA(1)=DA S DIK="^FH(119.72,DA(1),""A""," F DA=0:0 S DA=$O(^FH(119.72,DA(1),"A",DA)) Q:DA'>0 I $P($G(^(DA,0)),"^",2,8)?."^" D ^DIK
|
|---|
| 36 | S DIK="^FH(119.72,DA(1),""B""," F DA=0:0 S DA=$O(^FH(119.72,DA(1),"B",DA)) Q:DA'>0 I $P($G(^(DA,0)),"^",2,22)?."^" D ^DIK
|
|---|
| 37 | D KIL G EN6
|
|---|
| 38 | EN7 ; Enter/Edit Communication Offices
|
|---|
| 39 | K DIC S (DIC,DIE)="^FH(119.73,",DIC(0)="AEQLM",DLAYGO=119.73
|
|---|
| 40 | S DIC("DR")=".01" W ! D ^DIC K DIC,DLAYGO G KIL:U[X!$D(DTOUT),EN7:Y<1
|
|---|
| 41 | S DA=+Y,DR=".01:99" S:$D(^XUSEC("FHMGR",DUZ)) DIDEL=119.73 D ^DIE,KIL G EN7
|
|---|
| 42 | EN8 ; Enter/Edit Supplemental Feeding Sites
|
|---|
| 43 | K DIC S (DIC,DIE)="^FH(119.74,",DIC(0)="AEQLM",DLAYGO=119.74
|
|---|
| 44 | S DIC("DR")=".01" W ! D ^DIC K DIC,DLAYGO G KIL:U[X!$D(DTOUT),EN8:Y<1
|
|---|
| 45 | S DA=+Y,DR=".01:99" S:$D(^XUSEC("FHMGR",DUZ)) DIDEL=119.74 D ^DIE,KIL G EN8
|
|---|
| 46 | RSET K %ZIS S IOP="" D ^%ZIS
|
|---|
| 47 | KIL G KILL^XUSCLEAN
|
|---|
