24 lines
1.2 KiB
Mathematica
24 lines
1.2 KiB
Mathematica
|
FHNO1 ; HISC/REL - Supplement Feeding Management ;3/8/95 13:27
|
||
|
|
;;5.5;DIETETICS;;Jan 28, 2005
|
||
|
|
EN3 ; Edit Supplemental Feedings
|
||
|
|
D NOW^%DTC S DT=%\1 K %,%H,%I
|
||
|
|
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
|
||
|
|
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
|
||
|
|
EN4 ; Edit Supp. Feeding Menus
|
||
|
|
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
|
||
|
|
I +Y=1 W *7,!!,"You cannot edit INDIVIDUALIZED Supplemental Menu",! G EN4
|
||
|
|
S DA=+Y,DR=".01:99" S:$D(^XUSEC("FHMGR",DUZ)) DIDEL=118.1 D ^DIE G:'$D(DA) EN41
|
||
|
|
S Y=$G(^FH(118.1,DA,1)),E=0
|
||
|
|
F K=2:2:24 I $P(Y,"^",K),$P(Y,"^",K-1)="" S $P(Y,"^",K)="",E=1
|
||
|
|
S:E ^FH(118.1,DA,1)=Y
|
||
|
|
EN41 K DA,DIE,DIDEL,DR,E,K,Y G EN4
|
||
|
|
EN6 ; List Supplemental Feedings
|
||
|
|
W ! S L=0,DIC="^FH(118,",FLDS="[FHSFLST]",BY="NAME"
|
||
|
|
S FR="",TO="",DHD="SUPPLEMENTAL FEEDINGS" D EN1^DIP,RSET Q
|
||
|
|
EN7 ; List Supplemental Feeding Menus
|
||
|
|
W !!,"The list requires a 132 column printer.",!
|
||
|
|
W ! S L=0,DIC="^FH(118.1,",FLDS="[FHSFMENU]",BY="NAME"
|
||
|
|
S FR="",TO="",DHD="SUPPLEMENTAL FEEDING MENUS" D EN1^DIP,RSET Q
|
||
|
|
RSET K %ZIS S IOP="" D ^%ZIS
|
||
|
|
KIL G KILL^XUSCLEAN
|