source: FOIAVistA/trunk/r/DIETETICS-FH/FHREC4.m@ 1437

Last change on this file since 1437 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 1.7 KB
Line 
1FHREC4 ; 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
7Q1 ; 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
13LST 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
23SET 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
25HDR 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
28KIL K ^TMP($J) G KILL^XUSCLEAN
Note: See TracBrowser for help on using the repository browser.