| 1 | FHREC4 ; HISC/REL - Recipe List ;3/6/95 15:50
|
|---|
| 2 | ;;5.5;DIETETICS;**8**;Jan 28, 2005;Build 28
|
|---|
| 3 | W !!,"The list requires a 132 column printer.",!
|
|---|
| 4 | W ! K IOP,%ZIS S %ZIS("A")="Select LIST Printer: ",%ZIS="MQ" D ^%ZIS K %ZIS,IOP G:POP KIL
|
|---|
| 5 | I $D(IO("Q")) S FHPGM="Q1^FHREC4",FHLST="" D EN2^FH G KIL
|
|---|
| 6 | U IO D Q1 D ^%ZISC K %ZIS,IOP G KIL
|
|---|
| 7 | Q1 ; Print Recipe List
|
|---|
| 8 | D NOW^%DTC S DTP=% D DTP^FH
|
|---|
| 9 | K ^TMP($J) F D0=0:0 S D0=$O(^FH(114,D0)) Q:D0<1 S X=^(D0,0) D SET
|
|---|
| 10 | S PG=0 D HDR S CAT=";M:MIX;D:DEHYDRATED;F:FROZEN;C:CANNED;X:CONCENTRATED;S:SCRATCH;I:IND/R-T-S;P:PARTIALLY PREP;R:R-T-S;"
|
|---|
| 11 | S N2="" F K=0:0 S N2=$O(^TMP($J,N2)) Q:N2="" S N1="" F L=0:0 S N1=$O(^TMP($J,N2,N1)) Q:N1="" F D0=0:0 S D0=$O(^TMP($J,N2,N1,D0)) Q:D0<1 D LST
|
|---|
| 12 | W ! Q
|
|---|
| 13 | LST D:$Y>(IOSL-8) HDR S X=$G(^FH(114,D0,0))
|
|---|
| 14 | W !,$P(X,"^",1),?31,$P(X,"^",9) W:N2'="*****" ?58,N2
|
|---|
| 15 | S Y=$P(X,"^",11) I Y'="" S %=$F(CAT,";"_Y_":") S:%>0 Y=$P($E(CAT,%,999),";",1)
|
|---|
| 16 | W ?74,Y,?93,$P(X,"^",10),?101,$S($P(X,"^",8)="N":"NO",1:"")
|
|---|
| 17 | S Y=$P(X,"^",13) W:Y ?107,$J(Y,6,3)
|
|---|
| 18 | I $O(^FH(114,D0,"R",0)) S FHLN="" W ?115," YES",!?5,"EMBEDDED RECIPES: " F FHEM=0:0 S FHEM=$O(^FH(114,D0,"R",FHEM)) Q:FHEM'>0 D
|
|---|
| 19 | .S FHEMZ=$P($G(^FH(114,D0,"R",FHEM,0)),U,1)
|
|---|
| 20 | .I FHLN=1 W !
|
|---|
| 21 | .W ?23,$E($P($G(^FH(114,FHEMZ,0)),U,1),1,31) S FHLN=1
|
|---|
| 22 | Q
|
|---|
| 23 | SET S N1=$P(X,"^",1),N2=$P(X,"^",7) I N2 S N2=$P($G(^FH(114.1,N2,0)),"^",1)
|
|---|
| 24 | S:N2="" N2="*****" S ^TMP($J,N2,N1,D0)="" Q
|
|---|
| 25 | HDR W:'($E(IOST,1,2)'="C-"&'PG) @IOF S PG=PG+1 W !,DTP,?54,"R E C I P E L I S T",?124,"Page ",PG
|
|---|
| 26 | W !!,"NAME",?31,"SYNONYM",?58,"CATEGORY",?74,"PRE-PREP STATE",?91,"E-PREP",?100,"PRINT COST",?115,"RECIPES EMBEDDED?"
|
|---|
| 27 | W !,"------------------------------------------------------------------------------------------------------------------------------------",! Q
|
|---|
| 28 | KIL K ^TMP($J) G KILL^XUSCLEAN
|
|---|
