- FHREC4 ; HISC/REL - Recipe List ;3/6/95 15:50
- ;;5.5;DIETETICS;**8**;Jan 28, 2005;Build 28
- W !!,"The list requires a 132 column printer.",!
- 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^FHREC4",FHLST="" D EN2^FH G KIL
- U IO D Q1 D ^%ZISC K %ZIS,IOP G KIL
- Q1 ; Print Recipe List
- D NOW^%DTC S DTP=% D DTP^FH
- K ^TMP($J) F D0=0:0 S D0=$O(^FH(114,D0)) Q:D0<1 S X=^(D0,0) D SET
- 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;"
- 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
- W ! Q
- LST D:$Y>(IOSL-8) HDR S X=$G(^FH(114,D0,0))
- W !,$P(X,"^",1),?31,$P(X,"^",9) W:N2'="*****" ?58,N2
- S Y=$P(X,"^",11) I Y'="" S %=$F(CAT,";"_Y_":") S:%>0 Y=$P($E(CAT,%,999),";",1)
- W ?74,Y,?93,$P(X,"^",10),?101,$S($P(X,"^",8)="N":"NO",1:"")
- S Y=$P(X,"^",13) W:Y ?107,$J(Y,6,3)
- 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
- .S FHEMZ=$P($G(^FH(114,D0,"R",FHEM,0)),U,1)
- .I FHLN=1 W !
- .W ?23,$E($P($G(^FH(114,FHEMZ,0)),U,1),1,31) S FHLN=1
- Q
- SET S N1=$P(X,"^",1),N2=$P(X,"^",7) I N2 S N2=$P($G(^FH(114.1,N2,0)),"^",1)
- S:N2="" N2="*****" S ^TMP($J,N2,N1,D0)="" Q
- 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
- W !!,"NAME",?31,"SYNONYM",?58,"CATEGORY",?74,"PRE-PREP STATE",?91,"E-PREP",?100,"PRINT COST",?115,"RECIPES EMBEDDED?"
- W !,"------------------------------------------------------------------------------------------------------------------------------------",! Q
- KIL K ^TMP($J) G KILL^XUSCLEAN
- FHREC4 ; HISC/REL - Recipe List ;3/6/95 15:50
- +1 ;;5.5;DIETETICS;**8**;Jan 28, 2005;Build 28
- +2 WRITE !!,"The list requires a 132 column printer.",!
- +3 WRITE !
- KILL IOP,%ZIS
- SET %ZIS("A")="Select LIST Printer: "
- SET %ZIS="MQ"
- DO ^%ZIS
- KILL %ZIS,IOP
- IF POP
- GOTO KIL
- +4 IF $DATA(IO("Q"))
- SET FHPGM="Q1^FHREC4"
- SET FHLST=""
- DO EN2^FH
- GOTO KIL
- +5 USE IO
- DO Q1
- DO ^%ZISC
- KILL %ZIS,IOP
- GOTO KIL
- Q1 ; Print Recipe List
- +1 DO NOW^%DTC
- SET DTP=%
- DO DTP^FH
- +2 KILL ^TMP($JOB)
- FOR D0=0:0
- SET D0=$ORDER(^FH(114,D0))
- IF D0<1
- QUIT
- SET X=^(D0,0)
- DO SET
- +3 SET PG=0
- DO HDR
- SET 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;"
- +4 SET N2=""
- FOR K=0:0
- SET N2=$ORDER(^TMP($JOB,N2))
- IF N2=""
- QUIT
- SET N1=""
- FOR L=0:0
- SET N1=$ORDER(^TMP($JOB,N2,N1))
- IF N1=""
- QUIT
- FOR D0=0:0
- SET D0=$ORDER(^TMP($JOB,N2,N1,D0))
- IF D0<1
- QUIT
- DO LST
- +5 WRITE !
- QUIT
- LST IF $Y>(IOSL-8)
- DO HDR
- SET X=$GET(^FH(114,D0,0))
- +1 WRITE !,$PIECE(X,"^",1),?31,$PIECE(X,"^",9)
- IF N2'="*****"
- WRITE ?58,N2
- +2 SET Y=$PIECE(X,"^",11)
- IF Y'=""
- SET %=$FIND(CAT,";"_Y_":")
- IF %>0
- SET Y=$PIECE($EXTRACT(CAT,%,999),";",1)
- +3 WRITE ?74,Y,?93,$PIECE(X,"^",10),?101,$SELECT($PIECE(X,"^",8)="N":"NO",1:"")
- +4 SET Y=$PIECE(X,"^",13)
- IF Y
- WRITE ?107,$JUSTIFY(Y,6,3)
- +5 IF $ORDER(^FH(114,D0,"R",0))
- SET FHLN=""
- WRITE ?115," YES",!?5,"EMBEDDED RECIPES: "
- FOR FHEM=0:0
- SET FHEM=$ORDER(^FH(114,D0,"R",FHEM))
- IF FHEM'>0
- QUIT
- Begin DoDot:1
- +6 SET FHEMZ=$PIECE($GET(^FH(114,D0,"R",FHEM,0)),U,1)
- +7 IF FHLN=1
- WRITE !
- +8 WRITE ?23,$EXTRACT($PIECE($GET(^FH(114,FHEMZ,0)),U,1),1,31)
- SET FHLN=1
- End DoDot:1
- +9 QUIT
- SET SET N1=$PIECE(X,"^",1)
- SET N2=$PIECE(X,"^",7)
- IF N2
- SET N2=$PIECE($GET(^FH(114.1,N2,0)),"^",1)
- +1 IF N2=""
- SET N2="*****"
- SET ^TMP($JOB,N2,N1,D0)=""
- QUIT
- HDR IF '($EXTRACT(IOST,1,2)'="C-"&'PG)
- WRITE @IOF
- SET PG=PG+1
- WRITE !,DTP,?54,"R E C I P E L I S T",?124,"Page ",PG
- +1 WRITE !!,"NAME",?31,"SYNONYM",?58,"CATEGORY",?74,"PRE-PREP STATE",?91,"E-PREP",?100,"PRINT COST",?115,"RECIPES EMBEDDED?"
- +2 WRITE !,"------------------------------------------------------------------------------------------------------------------------------------",!
- QUIT
- KIL KILL ^TMP($JOB)
- GOTO KILL^XUSCLEAN
