FHPRC.m

FHPRC ; HISC/REL - Menu Cycle Management ;5/10/95  08:29

 ;;5.5;DIETETICS;;Jan 28, 2005

EN2 ; Enter/Edit Menu Cycles

 S (DIC,DIE)="^FH(116,",DIC(0)="AEQLM",DIC("DR")=".01",DLAYGO=116 W ! D ^DIC K DIC,DLAYGO G KIL:U[X!$D(DTOUT),EN2:Y<1

 S DA=+Y,DR=".01;2:99;1" S:$D(^XUSEC("FHMGR",DUZ)) DIDEL=116 D ^DIE K DA,DR,DIDEL,DIE,X,Y G EN2

EN3 ; Enter/Edit Meals

 S (DIC,DIE)="^FH(116.1,",DIC(0)="AEQLM",DIC("DR")=".01",DLAYGO=116.1 W ! D ^DIC K DIC,DLAYGO G KIL:U[X!$D(DTOUT),EN3:Y<1

 S (DA,M1)=+Y,DR=".01:99",DR(2,116.11)=".01;S L1=+X;2;1;S COD=X;3//^S X=$P($G(^FH(114,+L1,0)),U,7),X=$P($G(^FH(114.1,+X,0)),U,1);S REC=X;10"

 S DR(3,116.12)=".01;S CHK=+X;1//^S X=$S(REC=CHK:COD,1:"""")"

 S:$D(^XUSEC("FHMGR",DUZ)) DIDEL=116.1 W ! D ^DIE K DIDEL G:'$D(DA)!($D(Y)) A2

A0 K DIC S DIC="^FH(116.1,",DIC(0)="AEQM",DIC("A")="Select ADD-ON Meal: " W ! D ^DIC K DIC,DIE G EN3:"^"[X!$D(DTOUT),A0:Y<1 S A1=+Y

 I '$D(^FH(116.1,M1,"RE",0)) S ^(0)="^116.11P^^"

 F K=0:0 S K=$O(^FH(116.1,A1,"RE",K)) Q:K<1  S L1=+^(K,0) D A1

A2 K CHK,COD,DA,DR,M1,X,Y,A1,K,L,L1,REC G EN3

A1 I $D(^FH(116.1,M1,"RE","B",L1)) W !,$P(^FH(114,L1,0),"^",1)," already part of meal" Q

 K DIC,DD,DO,DINUM S DIC="^FH(116.1,M1,""RE"",",DIC(0)="LM",DA(1)=M1,DLAYGO=116.1,X=L1 D FILE^DICN K DIC,DLAYGO

 S $P(^FH(116.1,M1,"RE",+Y,0),"^",2,3)=$P(^FH(116.1,A1,"RE",K,0),"^",2,3)

 G:'$D(^FH(116.1,A1,"RE",K,"D",0)) A3 S ^FH(116.1,M1,"RE",+Y,"D",0)=^FH(116.1,A1,"RE",K,"D",0)

 F L=0:0 S L=$O(^FH(116.1,A1,"RE",K,"D",L)) Q:L<1  S X=^(L,0),^FH(116.1,M1,"RE",+Y,"D",L,0)=X,^FH(116.1,M1,"RE",+Y,"D","B",+X,L)=""

A3 Q:'$D(^FH(116.1,A1,"RE",K,"R",0))  S ^FH(116.1,M1,"RE",+Y,"R",0)=^FH(116.1,A1,"RE",K,"R",0)

 F L=0:0 S L=$O(^FH(116.1,A1,"RE",K,"R",L)) Q:L<1  S X=^(L,0),^FH(116.1,M1,"RE",+Y,"R",L,0)=X,^FH(116.1,M1,"RE",+Y,"R","B",+X,L)=""

 Q

EN4 ; Enter/Edit Holiday Meals

 S (DIC,DIE)="^FH(116.3,",DIC(0)="AEQLM",DIC("DR")=".01",DLAYGO=116.3 W ! D ^DIC K DIC,DLAYGO G KIL:U[X!$D(DTOUT),EN4:Y<1

 S DA=+Y,DR=".01:99" S:$D(^XUSEC("FHMGR",DUZ)) DIDEL=116.3 D ^DIE K DA,DR,DIDEL,DIE,X,Y G EN4

KIL G KILL^XUSCLEAN

FHPRC     ; HISC/REL - Menu Cycle Management ;5/10/95  08:29

 +1       ;;5.5;DIETETICS;;Jan 28, 2005

EN2       ; Enter/Edit Menu Cycles

 +1        SET (DIC,DIE)="^FH(116,"

           SET DIC(0)="AEQLM"

           SET DIC("DR")=".01"

           SET DLAYGO=116

           WRITE !

           DO ^DIC

           KILL DIC,DLAYGO

           IF U[X!$DATA(DTOUT)

               GOTO KIL

           IF Y<1

               GOTO EN2

 +2        SET DA=+Y

           SET DR=".01;2:99;1"

           IF $DATA(^XUSEC("FHMGR",DUZ))

               SET DIDEL=116

           DO ^DIE

           KILL DA,DR,DIDEL,DIE,X,Y

           GOTO EN2

EN3       ; Enter/Edit Meals

 +1        SET (DIC,DIE)="^FH(116.1,"

           SET DIC(0)="AEQLM"

           SET DIC("DR")=".01"

           SET DLAYGO=116.1

           WRITE !

           DO ^DIC

           KILL DIC,DLAYGO

           IF U[X!$DATA(DTOUT)

               GOTO KIL

           IF Y<1

               GOTO EN3

 +2        SET (DA,M1)=+Y

           SET DR=".01:99"

           SET DR(2,116.11)=".01;S L1=+X;2;1;S COD=X;3//^S X=$P($G(^FH(114,+L1,0)),U,7),X=$P($G(^FH(114.1,+X,0)),U,1);S REC=X;10"

 +3        SET DR(3,116.12)=".01;S CHK=+X;1//^S X=$S(REC=CHK:COD,1:"""")"

 +4        IF $DATA(^XUSEC("FHMGR",DUZ))

               SET DIDEL=116.1

           WRITE !

           DO ^DIE

           KILL DIDEL

           IF '$DATA(DA)!($DATA(Y))

               GOTO A2

A0         KILL DIC

           SET DIC="^FH(116.1,"

           SET DIC(0)="AEQM"

           SET DIC("A")="Select ADD-ON Meal: "

           WRITE !

           DO ^DIC

           KILL DIC,DIE

           IF "^"[X!$DATA(DTOUT)

               GOTO EN3

           IF Y<1

               GOTO A0

           SET A1=+Y

 +1        IF '$DATA(^FH(116.1,M1,"RE",0))

               SET ^(0)="^116.11P^^"

 +2        FOR K=0:0

               SET K=$ORDER(^FH(116.1,A1,"RE",K))

               IF K<1

                   QUIT 

               SET L1=+^(K,0)

               DO A1

A2         KILL CHK,COD,DA,DR,M1,X,Y,A1,K,L,L1,REC

           GOTO EN3

A1         IF $DATA(^FH(116.1,M1,"RE","B",L1))

               WRITE !,$PIECE(^FH(114,L1,0),"^",1)," already part of meal"

               QUIT 

 +1        KILL DIC,DD,DO,DINUM

           SET DIC="^FH(116.1,M1,""RE"","

           SET DIC(0)="LM"

           SET DA(1)=M1

           SET DLAYGO=116.1

           SET X=L1

           DO FILE^DICN

           KILL DIC,DLAYGO

 +2        SET $PIECE(^FH(116.1,M1,"RE",+Y,0),"^",2,3)=$PIECE(^FH(116.1,A1,"RE",K,0),"^",2,3)

 +3        IF '$DATA(^FH(116.1,A1,"RE",K,"D",0))

               GOTO A3

           SET ^FH(116.1,M1,"RE",+Y,"D",0)=^FH(116.1,A1,"RE",K,"D",0)

 +4        FOR L=0:0

               SET L=$ORDER(^FH(116.1,A1,"RE",K,"D",L))

               IF L<1

                   QUIT 

               SET X=^(L,0)

               SET ^FH(116.1,M1,"RE",+Y,"D",L,0)=X

               SET ^FH(116.1,M1,"RE",+Y,"D","B",+X,L)=""

A3         IF '$DATA(^FH(116.1,A1,"RE",K,"R",0))

               QUIT 

           SET ^FH(116.1,M1,"RE",+Y,"R",0)=^FH(116.1,A1,"RE",K,"R",0)

 +1        FOR L=0:0

               SET L=$ORDER(^FH(116.1,A1,"RE",K,"R",L))

               IF L<1

                   QUIT 

               SET X=^(L,0)

               SET ^FH(116.1,M1,"RE",+Y,"R",L,0)=X

               SET ^FH(116.1,M1,"RE",+Y,"R","B",+X,L)=""

 +2        QUIT 

EN4       ; Enter/Edit Holiday Meals

 +1        SET (DIC,DIE)="^FH(116.3,"

           SET DIC(0)="AEQLM"

           SET DIC("DR")=".01"

           SET DLAYGO=116.3

           WRITE !

           DO ^DIC

           KILL DIC,DLAYGO

           IF U[X!$DATA(DTOUT)

               GOTO KIL

           IF Y<1

               GOTO EN4

 +2        SET DA=+Y

           SET DR=".01:99"

           IF $DATA(^XUSEC("FHMGR",DUZ))

               SET DIDEL=116.3

           DO ^DIE

           KILL DA,DR,DIDEL,DIE,X,Y

           GOTO EN4

KIL        GOTO KILL^XUSCLEAN