- 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 Feb 18, 2025@23:18:37 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
