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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFHNO1 1292 printed Dec 13, 2024@01:52:15 Page 2
FHNO1 ; HISC/REL - Supplement Feeding Management ;3/8/95 13:27
+1 ;;5.5;DIETETICS;;Jan 28, 2005
EN3 ; Edit Supplemental Feedings
+1 DO NOW^%DTC
SET DT=%\1
KILL %,%H,%I
+2 WRITE !
SET (DIC,DIE)="^FH(118,"
SET DIC(0)="AEQLM"
SET DIC("DR")=".01"
SET DLAYGO=118
WRITE !
DO ^DIC
KILL DIC,DLAYGO
if U[X!$DATA(DTOUT)
GOTO KIL
if Y<1
GOTO EN3
+3 SET DA=+Y
SET DR=$SELECT(DA>1:".01;",1:"")_"1;5//Y;6:20;22:99"
if $DATA(^XUSEC("FHMGR",DUZ))
SET DIDEL=118
DO ^DIE
KILL DA,DIE,DIDEL,DR
GOTO EN3
EN4 ; Edit Supp. Feeding Menus
+1 WRITE !
SET (DIC,DIE)="^FH(118.1,"
SET DIC(0)="AEQLM"
SET DIC("DR")=".01"
SET DLAYGO=118.1
WRITE !
DO ^DIC
KILL DIC,DLAYGO
if U[X!$DATA(DTOUT)
GOTO KIL
if Y<1
GOTO EN4
+2 IF +Y=1
WRITE *7,!!,"You cannot edit INDIVIDUALIZED Supplemental Menu",!
GOTO EN4
+3 SET DA=+Y
SET DR=".01:99"
if $DATA(^XUSEC("FHMGR",DUZ))
SET DIDEL=118.1
DO ^DIE
if '$DATA(DA)
GOTO EN41
+4 SET Y=$GET(^FH(118.1,DA,1))
SET E=0
+5 FOR K=2:2:24
IF $PIECE(Y,"^",K)
IF $PIECE(Y,"^",K-1)=""
SET $PIECE(Y,"^",K)=""
SET E=1
+6 if E
SET ^FH(118.1,DA,1)=Y
EN41 KILL DA,DIE,DIDEL,DR,E,K,Y
GOTO EN4
EN6 ; List Supplemental Feedings
+1 WRITE !
SET L=0
SET DIC="^FH(118,"
SET FLDS="[FHSFLST]"
SET BY="NAME"
+2 SET FR=""
SET TO=""
SET DHD="SUPPLEMENTAL FEEDINGS"
DO EN1^DIP
DO RSET
QUIT
EN7 ; List Supplemental Feeding Menus
+1 WRITE !!,"The list requires a 132 column printer.",!
+2 WRITE !
SET L=0
SET DIC="^FH(118.1,"
SET FLDS="[FHSFMENU]"
SET BY="NAME"
+3 SET FR=""
SET TO=""
SET DHD="SUPPLEMENTAL FEEDING MENUS"
DO EN1^DIP
DO RSET
QUIT
RSET KILL %ZIS
SET IOP=""
DO ^%ZIS
KIL GOTO KILL^XUSCLEAN
