source: FOIAVistA/trunk/r/DIETETICS-FH/FHNO1.m

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

initial load of FOIAVistA 6/30/08 version

File size: 1.2 KB
Line 
1FHNO1 ; HISC/REL - Supplement Feeding Management ;3/8/95 13:27
2 ;;5.5;DIETETICS;;Jan 28, 2005
3EN3 ; Edit Supplemental Feedings
4 D NOW^%DTC S DT=%\1 K %,%H,%I
5 W ! S (DIC,DIE)="^FH(118,",DIC(0)="AEQLM",DIC("DR")=".01",DLAYGO=118 W ! D ^DIC K DIC,DLAYGO G KIL:U[X!$D(DTOUT),EN3:Y<1
6 S DA=+Y,DR=$S(DA>1:".01;",1:"")_"1;5//Y;6:20;22:99" S:$D(^XUSEC("FHMGR",DUZ)) DIDEL=118 D ^DIE K DA,DIE,DIDEL,DR G EN3
7EN4 ; Edit Supp. Feeding Menus
8 W ! S (DIC,DIE)="^FH(118.1,",DIC(0)="AEQLM",DIC("DR")=".01",DLAYGO=118.1 W ! D ^DIC K DIC,DLAYGO G KIL:U[X!$D(DTOUT),EN4:Y<1
9 I +Y=1 W *7,!!,"You cannot edit INDIVIDUALIZED Supplemental Menu",! G EN4
10 S DA=+Y,DR=".01:99" S:$D(^XUSEC("FHMGR",DUZ)) DIDEL=118.1 D ^DIE G:'$D(DA) EN41
11 S Y=$G(^FH(118.1,DA,1)),E=0
12 F K=2:2:24 I $P(Y,"^",K),$P(Y,"^",K-1)="" S $P(Y,"^",K)="",E=1
13 S:E ^FH(118.1,DA,1)=Y
14EN41 K DA,DIE,DIDEL,DR,E,K,Y G EN4
15EN6 ; List Supplemental Feedings
16 W ! S L=0,DIC="^FH(118,",FLDS="[FHSFLST]",BY="NAME"
17 S FR="",TO="",DHD="SUPPLEMENTAL FEEDINGS" D EN1^DIP,RSET Q
18EN7 ; List Supplemental Feeding Menus
19 W !!,"The list requires a 132 column printer.",!
20 W ! S L=0,DIC="^FH(118.1,",FLDS="[FHSFMENU]",BY="NAME"
21 S FR="",TO="",DHD="SUPPLEMENTAL FEEDING MENUS" D EN1^DIP,RSET Q
22RSET K %ZIS S IOP="" D ^%ZIS
23KIL G KILL^XUSCLEAN
Note: See TracBrowser for help on using the repository browser.