FHASC ; HISC/REL/NCA - Clinical Management ;2/13/95 14:12
;;5.5;DIETETICS;;Jan 28, 2005
EN1 ; Enter/Edit Nutrition Classifications
S (DIC,DIE)="^FH(115.3,",DIC(0)="AEQLM",DIC("DR")=".01",DLAYGO=115.3 W ! D ^DIC K DIC,DLAYGO G KIL:"^"[X!$D(DTOUT),EN1:Y<1
S DA=+Y,DR=".01:99" S:$D(^XUSEC("FHMGR",DUZ)) DIDEL=115.3 D ^DIE,KIL G EN1
EN2 ; List Nutrition Classifications
W ! S L=0,DIC="^FH(115.3,",FLDS=".01,99",BY=".01"
S (FR,TO)="",DHD="NUTRITION CLASSIFICATIONS" D EN1^DIP,RSET Q
EN9 ; Enter/Edit Nutrition Plans
S (DIC,DIE)="^FH(115.5,",DIC(0)="AEQLM",DIC("DR")=".01",DLAYGO=115.5 W ! D ^DIC K DIC,DLAYGO G KIL:"^"[X!$D(DTOUT),EN9:Y<1
S DA=+Y,DR=".01:99" S:$D(^XUSEC("FHMGR",DUZ)) DIDEL=115.5 D ^DIE,KIL G EN9
EN10 ; List Nutrition Plans
W ! S L=0,DIC="^FH(115.5,",FLDS=".01",BY=".01"
S (FR,TO)="",DHD="NUTRITION PLANS" 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[HFHASC 912 printed Dec 13, 2024@01:46:42 Page 2
FHASC ; HISC/REL/NCA - Clinical Management ;2/13/95 14:12
+1 ;;5.5;DIETETICS;;Jan 28, 2005
EN1 ; Enter/Edit Nutrition Classifications
+1 SET (DIC,DIE)="^FH(115.3,"
SET DIC(0)="AEQLM"
SET DIC("DR")=".01"
SET DLAYGO=115.3
WRITE !
DO ^DIC
KILL DIC,DLAYGO
if "^"[X!$DATA(DTOUT)
GOTO KIL
if Y<1
GOTO EN1
+2 SET DA=+Y
SET DR=".01:99"
if $DATA(^XUSEC("FHMGR",DUZ))
SET DIDEL=115.3
DO ^DIE
DO KIL
GOTO EN1
EN2 ; List Nutrition Classifications
+1 WRITE !
SET L=0
SET DIC="^FH(115.3,"
SET FLDS=".01,99"
SET BY=".01"
+2 SET (FR,TO)=""
SET DHD="NUTRITION CLASSIFICATIONS"
DO EN1^DIP
DO RSET
QUIT
EN9 ; Enter/Edit Nutrition Plans
+1 SET (DIC,DIE)="^FH(115.5,"
SET DIC(0)="AEQLM"
SET DIC("DR")=".01"
SET DLAYGO=115.5
WRITE !
DO ^DIC
KILL DIC,DLAYGO
if "^"[X!$DATA(DTOUT)
GOTO KIL
if Y<1
GOTO EN9
+2 SET DA=+Y
SET DR=".01:99"
if $DATA(^XUSEC("FHMGR",DUZ))
SET DIDEL=115.5
DO ^DIE
DO KIL
GOTO EN9
EN10 ; List Nutrition Plans
+1 WRITE !
SET L=0
SET DIC="^FH(115.5,"
SET FLDS=".01"
SET BY=".01"
+2 SET (FR,TO)=""
SET DHD="NUTRITION PLANS"
DO EN1^DIP
DO RSET
QUIT
RSET KILL %ZIS
SET IOP=""
DO ^%ZIS
KIL GOTO KILL^XUSCLEAN