FHPRC7.m

FHPRC7 ; HISC/REL - Find Meals Containing a Recipe ;4/26/93  15:53 

 ;;5.5;DIETETICS;;Jan 28, 2005

 S (DIC,DIE)="^FH(114,",DIC(0)="AEQM" W ! D ^DIC K DIC G KIL:U[X!$D(DTOUT),FHPRC7:Y<1 S FHX1=+Y

L0 W ! K IOP,%ZIS S %ZIS("A")="Select LIST Printer: ",%ZIS="MQ" D ^%ZIS K %ZIS,IOP G:POP KIL

 I $D(IO("Q")) S FHPGM="Q1^FHPRC7",FHLST="FHX1" D EN2^FH G KIL

 U IO D Q1 D ^%ZISC K %ZIS,IOP G KIL

Q1 ; List Meals Containing a Recipe

 K ^TMP($J) D NOW^%DTC S DTP=% D DTP^FH

 F M1=0:0 S M1=$O(^FH(116.1,M1)) Q:M1<1  F R1=0:0 S R1=$O(^FH(116.1,M1,"RE",R1)) Q:R1<1  S X=+$G(^FH(116.1,M1,"RE",R1,0)) S:X=FHX1 ^TMP($J,"M",M1)=""

 F C1=0:0 S C1=$O(^FH(116,C1)) Q:C1<1  F D1=0:0 S D1=$O(^FH(116,C1,"DA",D1)) Q:D1<1  D Q2

 S N1=$P(^FH(114,FHX1,0),"^",1),PG=0,LN="",$P(LN,"-",80)="" D HDR,P0

 W ! Q

Q2 S X=$G(^FH(116,C1,"DA",D1,0)) Q:X=""

 F K1=1:1:3 S Z=$P(X,"^",K1+1) I Z,$D(^TMP($J,"M",Z)) S ^TMP($J,"M",Z,"C",C1_"~"_D1_"~"_K1)=""

 Q

P0 F M1=0:0 S M1=$O(^TMP($J,"M",M1)) Q:M1<1  S X=$P($G(^FH(116.1,M1,0)),"^",1) I X'="" D:$Y>(IOSL-9) HDR W !,X D P1

 Q

P1 S A1="" F C1=0:0 S A1=$O(^TMP($J,"M",M1,"C",A1)) Q:A1=""  D P2

 Q

P2 S C1=+A1,D1=$P(A1,"~",2),K1=$P(A1,"~",3)

 W ?31,$P(^FH(116,C1,0),"^",1),", Day ",D1,", ",$S(K1=1:"Breakfast",K1=2:"Noon",1:"Evening"),! D:$Y>(IOSL-6) HDR Q

HDR W:'($E(IOST,1,2)'="C-"&'PG) @IOF S PG=PG+1 W !,DTP,?28,"R E C I P E   U S A G E",?73,"Page ",PG

 W !!?(80-$L(N1)\2),N1

 W !!,"Meal",?31,"Cycle",!,LN,! Q

KIL K ^TMP($J) G KILL^XUSCLEAN

FHPRC7    ; HISC/REL - Find Meals Containing a Recipe ;4/26/93  15:53 

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

 +2        SET (DIC,DIE)="^FH(114,"

           SET DIC(0)="AEQM"

           WRITE !

           DO ^DIC

           KILL DIC

           IF U[X!$DATA(DTOUT)

               GOTO KIL

           IF Y<1

               GOTO FHPRC7

           SET FHX1=+Y

L0         WRITE !

           KILL IOP,%ZIS

           SET %ZIS("A")="Select LIST Printer: "

           SET %ZIS="MQ"

           DO ^%ZIS

           KILL %ZIS,IOP

           IF POP

               GOTO KIL

 +1        IF $DATA(IO("Q"))

               SET FHPGM="Q1^FHPRC7"

               SET FHLST="FHX1"

               DO EN2^FH

               GOTO KIL

 +2        USE IO

           DO Q1

           DO ^%ZISC

           KILL %ZIS,IOP

           GOTO KIL

Q1        ; List Meals Containing a Recipe

 +1        KILL ^TMP($JOB)

           DO NOW^%DTC

           SET DTP=%

           DO DTP^FH

 +2        FOR M1=0:0

               SET M1=$ORDER(^FH(116.1,M1))

               IF M1<1

                   QUIT 

               FOR R1=0:0

                   SET R1=$ORDER(^FH(116.1,M1,"RE",R1))

                   IF R1<1

                       QUIT 

                   SET X=+$GET(^FH(116.1,M1,"RE",R1,0))

                   IF X=FHX1

                       SET ^TMP($JOB,"M",M1)=""

 +3        FOR C1=0:0

               SET C1=$ORDER(^FH(116,C1))

               IF C1<1

                   QUIT 

               FOR D1=0:0

                   SET D1=$ORDER(^FH(116,C1,"DA",D1))

                   IF D1<1

                       QUIT 

                   DO Q2

 +4        SET N1=$PIECE(^FH(114,FHX1,0),"^",1)

           SET PG=0

           SET LN=""

           SET $PIECE(LN,"-",80)=""

           DO HDR

           DO P0

 +5        WRITE !

           QUIT 

Q2         SET X=$GET(^FH(116,C1,"DA",D1,0))

           IF X=""

               QUIT 

 +1        FOR K1=1:1:3

               SET Z=$PIECE(X,"^",K1+1)

               IF Z

                   IF $DATA(^TMP($JOB,"M",Z))

                       SET ^TMP($JOB,"M",Z,"C",C1_"~"_D1_"~"_K1)=""

 +2        QUIT 

P0         FOR M1=0:0

               SET M1=$ORDER(^TMP($JOB,"M",M1))

               IF M1<1

                   QUIT 

               SET X=$PIECE($GET(^FH(116.1,M1,0)),"^",1)

               IF X'=""

                   IF $Y>(IOSL-9)

                       DO HDR

                   WRITE !,X

                   DO P1

 +1        QUIT 

P1         SET A1=""

           FOR C1=0:0

               SET A1=$ORDER(^TMP($JOB,"M",M1,"C",A1))

               IF A1=""

                   QUIT 

               DO P2

 +1        QUIT 

P2         SET C1=+A1

           SET D1=$PIECE(A1,"~",2)

           SET K1=$PIECE(A1,"~",3)

 +1        WRITE ?31,$PIECE(^FH(116,C1,0),"^",1),", Day ",D1,", ",$SELECT(K1=1:"Breakfast",K1=2:"Noon",1:"Evening"),!

           IF $Y>(IOSL-6)

               DO HDR

           QUIT 

HDR        IF '($EXTRACT(IOST,1,2)'="C-"&'PG)

               WRITE @IOF

           SET PG=PG+1

           WRITE !,DTP,?28,"R E C I P E   U S A G E",?73,"Page ",PG

 +1        WRITE !!?(80-$LENGTH(N1)\2),N1

 +2        WRITE !!,"Meal",?31,"Cycle",!,LN,!

           QUIT 

KIL        KILL ^TMP($JOB)

           GOTO KILL^XUSCLEAN