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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFHREC4 1796 printed Apr 09, 2024@20:58:19 Page 2
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
