- 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFHPRC 2073 printed Feb 18, 2025@23:20:33 Page 2
- 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
