Ignore:
Timestamp:
Dec 4, 2009, 12:11:15 AM (14 years ago)
Author:
George Lilly
Message:

revised back to 6/30/08 version

File:
1 edited

Legend:

Unmodified
Added
Removed

  • WorldVistAEHR/trunk/r/DIETETICS-FH/FHPRO.m

    r613 r623  
    1 FHPRO   ; HISC/REL/RTK - Food Production Manager ;4/12/06  15:53
    2         ;;5.5;DIETETICS;**4,5,12**;Jan 28, 2005;Build 3
    3         ;
    4         ; 10/16/2007 BY/KAM FH*5.5*12 Rem Call 210883 Remove access to old
    5         ;                             Clinician field
    6 EN2     ; Enter/Edit Nutrition Locations (Inpatient Wards/Outpatient Clinics)
    7         W ! K DIR,DIC S DIR("A")="Select WARD or OUTPATIENT Location: "
    8         S DIR(0)="SAO^W:Ward Location;O:Outpatient Location" D ^DIR I $D(DIRUT) G KIL
    9         I Y'=-1 S FHANS=Y
    10         I FHANS="W" D EN2WRD Q
    11         I FHANS="O" D EN2OL Q
    12         Q
    13 EN2WRD  ;Ward locations
    14         K DIC S (DIC,DIE)="^FH(119.6,",DIC(0)="AEQLM",DLAYGO=119.6
    15         S DIC("DR")=".01" W ! D ^DIC K DIC,DLAYGO G KIL:U[X!$D(DTOUT),EN2:Y<1
    16         ; S DR=".01;2:2.5;... POTENTIAL CHG FOR 210883 WAS S DR=".01:2.5;3"
    17         ; 10/16/2007 BP/KAM FH*5.5*12 changed next line to remove access to field # 1 Clinician (Old Clinician field)
    18         S DA=+Y,DR=".01;2: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
    19 EN2OL   ;Outpatient locations
    20         K DIC S (DIC,DIE)="^FH(119.6,",DIC(0)="AEQLM",DLAYGO=119.6
    21         S DIC("DR")=".01" W ! D ^DIC K DIC,DLAYGO G KIL:U[X!$D(DTOUT),EN2:Y<1
    22         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
    23 EN3     ; Enter/Edit Production Diets
    24         K DIC S (DIC,DIE)="^FH(116.2,",DIC(0)="AEQLM",DLAYGO=116.2
    25         S DIC("DR")=".01" W ! D ^DIC K DIC,DLAYGO G KIL:U[X!$D(DTOUT),EN3:Y<1
    26         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
    27         S:$O(^FH(116.2,DA,"R",0))<1 $P(^FH(116.2,DA,0),"^",4)="N" D KIL G EN3
    28 EN4     ; List Production Diets
    29         W !!,"The list requires a 132 column printer.",!
    30         W ! S L=0,DIC="^FH(116.2,",FLDS="[FHPROD]",BY="8,.01"
    31         S FR="@",TO="",DHD="PRODUCTION DIETS" D EN1^DIP,RSET Q
    32 EN5     ; Enter/Edit Production Facilities
    33         K DIC S (DIC,DIE)="^FH(119.71,",DIC(0)="AEQLM",DLAYGO=119.71
    34         S DIC("DR")=".01" W ! D ^DIC K DIC,DLAYGO G KIL:U[X!$D(DTOUT),EN5:Y<1
    35         S DA=+Y,DR=".01:99" S:$D(^XUSEC("FHMGR",DUZ)) DIDEL=119.71 D ^DIE,KIL G EN5
    36 EN6     ; Enter/Edit Service Points
    37         K DIC S (DIC,DIE)="^FH(119.72,",DIC(0)="AEQLM",DLAYGO=119.72
    38         S DIC("DR")=".01" W ! D ^DIC K DIC,DLAYGO G KIL:U[X!$D(DTOUT),EN6:Y<1
    39         S DA=+Y S DR=".01:99" S:$D(^XUSEC("FHMGR",DUZ)) DIDEL=119.72 D ^DIE I '$D(DA) D KIL G EN6
    40         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
    41         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
    42         D KIL G EN6
    43 EN7     ; Enter/Edit Communication Offices
    44         K DIC S (DIC,DIE)="^FH(119.73,",DIC(0)="AEQLM",DLAYGO=119.73
    45         S DIC("DR")=".01" W ! D ^DIC K DIC,DLAYGO G KIL:U[X!$D(DTOUT),EN7:Y<1
    46         S DA=+Y,DR=".01:99" S:$D(^XUSEC("FHMGR",DUZ)) DIDEL=119.73 D ^DIE,KIL G EN7
    47 EN8     ; Enter/Edit Supplemental Feeding Sites
    48         K DIC S (DIC,DIE)="^FH(119.74,",DIC(0)="AEQLM",DLAYGO=119.74
    49         S DIC("DR")=".01" W ! D ^DIC K DIC,DLAYGO G KIL:U[X!$D(DTOUT),EN8:Y<1
    50         S DA=+Y,DR=".01:99" S:$D(^XUSEC("FHMGR",DUZ)) DIDEL=119.74 D ^DIE,KIL G EN8
    51 RSET    K %ZIS S IOP="" D ^%ZIS
    52 KIL     G KILL^XUSCLEAN
     1FHPRO ; HISC/REL/RTK - Food Production Manager ;4/12/06  15:53
     2 ;;5.5;DIETETICS;**4,5**;Jan 28, 2005;Build 53
     3EN2 ; 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
     10EN2WRD ;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
     14EN2OL ;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
     18EN3 ; 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
     23EN4 ; 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
     27EN5 ; 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
     31EN6 ; 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
     38EN7 ; 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
     42EN8 ; 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
     46RSET K %ZIS S IOP="" D ^%ZIS
     47KIL G KILL^XUSCLEAN
Note: See TracChangeset for help on using the changeset viewer.