- FHPRI1 ; HISC/REL - Find Recipes with Ingredient ;4/27/93 13:31
- ;;5.5;DIETETICS;;Jan 28, 2005
- S (DIC,DIE)="^FHING(",DIC(0)="AEQM" W ! D ^DIC K DIC G KIL:U[X!$D(DTOUT),FHPRI1: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^FHPRI1",FHLST="FHX1" D EN2^FH G KIL
- U IO D Q1 D ^%ZISC K %ZIS,IOP G KIL
- Q1 ; Print Recipes with selected Ingredient
- K ^TMP($J) D NOW^%DTC S DTP=% D DTP^FH
- F R1=0:0 S R1=$O(^FH(114,R1)) Q:R1<1 F I1=0:0 S I1=$O(^FH(114,R1,"I",I1)) Q:I1<1 S X=$G(^FH(114,R1,"I",I1,0)) I +X=FHX1 S ^TMP($J,"R",R1)=$P(X,"^",2)
- F M1=0:0 S M1=$O(^FH(116.1,M1)) Q:M1<1 F I1=0:0 S I1=$O(^FH(116.1,M1,"RE",I1)) Q:I1<1 S R1=+$G(^FH(116.1,M1,"RE",I1,0)) I $D(^TMP($J,"R",R1)) S ^TMP($J,"R",R1,"M",M1)="" D Q2
- S X2=^FHING(FHX1,0),N1=$P(X2,"^",1),UNT=$P(X2,"^",16)
- S PG=0,LN="",$P(LN,"-",80)="" D HDR
- F R1=0:0 S R1=$O(^TMP($J,"R",R1)) Q:R1<1 S Y=^(R1) D P0
- W ! Q
- Q2 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 Q3
- Q
- Q3 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,"R",R1,"M",Z)) S ^TMP($J,"R",R1,"M",Z,"C",C1_"~"_D1_"~"_K1)=""
- Q
- P0 D:$Y>(IOSL-6) HDR S R2=^FH(114,R1,0) D EN2^FHREC1
- W !,$P(R2,"^",1),?32,$J($P(R2,"^",2),5),?45,Y
- F M1=0:0 S M1=$O(^TMP($J,"R",R1,"M",M1)) Q:M1<1 S X=$P($G(^FH(116.1,M1,0)),"^",1) I X'="" D:$Y>(IOSL-6) HDR W !?3,"Meal: ",X D P1
- Q
- P1 S A1="" F C1=0:0 S A1=$O(^TMP($J,"R",R1,"M",M1,"C",A1)) Q:A1="" D P2
- Q
- P2 S C1=+A1,D1=$P(A1,"~",2),K1=$P(A1,"~",3) D:$Y>(IOSL-6) HDR
- W !?6,"Cycle: ",$P(^FH(116,C1,0),"^",1),", Day ",D1,", ",$S(K1=1:"Breakfast",K1=2:"Noon",1:"Evening") Q
- HDR W:'($E(IOST,1,2)'="C-"&'PG) @IOF S PG=PG+1 W !,DTP,?24,"I N G R E D I E N T U S A G E",?73,"Page ",PG
- W !!?(80-$L(N1)\2),N1
- W !!,"Recipe",?30,"# Portions",?45,"Amount",!,LN Q
- KIL K ^TMP($J) G KILL^XUSCLEAN
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFHPRI1 1928 printed Dec 13, 2024@01:54:30 Page 2
- FHPRI1 ; HISC/REL - Find Recipes with Ingredient ;4/27/93 13:31
- +1 ;;5.5;DIETETICS;;Jan 28, 2005
- +2 SET (DIC,DIE)="^FHING("
- SET DIC(0)="AEQM"
- WRITE !
- DO ^DIC
- KILL DIC
- if U[X!$DATA(DTOUT)
- GOTO KIL
- if Y<1
- GOTO FHPRI1
- 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^FHPRI1"
- SET FHLST="FHX1"
- DO EN2^FH
- GOTO KIL
- +2 USE IO
- DO Q1
- DO ^%ZISC
- KILL %ZIS,IOP
- GOTO KIL
- Q1 ; Print Recipes with selected Ingredient
- +1 KILL ^TMP($JOB)
- DO NOW^%DTC
- SET DTP=%
- DO DTP^FH
- +2 FOR R1=0:0
- SET R1=$ORDER(^FH(114,R1))
- if R1<1
- QUIT
- FOR I1=0:0
- SET I1=$ORDER(^FH(114,R1,"I",I1))
- if I1<1
- QUIT
- SET X=$GET(^FH(114,R1,"I",I1,0))
- IF +X=FHX1
- SET ^TMP($JOB,"R",R1)=$PIECE(X,"^",2)
- +3 FOR M1=0:0
- SET M1=$ORDER(^FH(116.1,M1))
- if M1<1
- QUIT
- FOR I1=0:0
- SET I1=$ORDER(^FH(116.1,M1,"RE",I1))
- if I1<1
- QUIT
- SET R1=+$GET(^FH(116.1,M1,"RE",I1,0))
- IF $DATA(^TMP($JOB,"R",R1))
- SET ^TMP($JOB,"R",R1,"M",M1)=""
- DO Q2
- +4 SET X2=^FHING(FHX1,0)
- SET N1=$PIECE(X2,"^",1)
- SET UNT=$PIECE(X2,"^",16)
- +5 SET PG=0
- SET LN=""
- SET $PIECE(LN,"-",80)=""
- DO HDR
- +6 FOR R1=0:0
- SET R1=$ORDER(^TMP($JOB,"R",R1))
- if R1<1
- QUIT
- SET Y=^(R1)
- DO P0
- +7 WRITE !
- QUIT
- Q2 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 Q3
- +1 QUIT
- Q3 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,"R",R1,"M",Z))
- SET ^TMP($JOB,"R",R1,"M",Z,"C",C1_"~"_D1_"~"_K1)=""
- +2 QUIT
- P0 if $Y>(IOSL-6)
- DO HDR
- SET R2=^FH(114,R1,0)
- DO EN2^FHREC1
- +1 WRITE !,$PIECE(R2,"^",1),?32,$JUSTIFY($PIECE(R2,"^",2),5),?45,Y
- +2 FOR M1=0:0
- SET M1=$ORDER(^TMP($JOB,"R",R1,"M",M1))
- if M1<1
- QUIT
- SET X=$PIECE($GET(^FH(116.1,M1,0)),"^",1)
- IF X'=""
- if $Y>(IOSL-6)
- DO HDR
- WRITE !?3,"Meal: ",X
- DO P1
- +3 QUIT
- P1 SET A1=""
- FOR C1=0:0
- SET A1=$ORDER(^TMP($JOB,"R",R1,"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)
- if $Y>(IOSL-6)
- DO HDR
- +1 WRITE !?6,"Cycle: ",$PIECE(^FH(116,C1,0),"^",1),", Day ",D1,", ",$SELECT(K1=1:"Breakfast",K1=2:"Noon",1:"Evening")
- QUIT
- HDR if '($EXTRACT(IOST,1,2)'="C-"&'PG)
- WRITE @IOF
- SET PG=PG+1
- WRITE !,DTP,?24,"I N G R E D I E N T U S A G E",?73,"Page ",PG
- +1 WRITE !!?(80-$LENGTH(N1)\2),N1
- +2 WRITE !!,"Recipe",?30,"# Portions",?45,"Amount",!,LN
- QUIT
- KIL KILL ^TMP($JOB)
- GOTO KILL^XUSCLEAN