FHPRW1 ; HISC/REL - List Facilities ;4/27/93 13:34
;;5.5;DIETETICS;;Jan 28, 2005
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^FHPRW1",FHLST="" D EN2^FH G KIL
U IO D Q1 D ^%ZISC K %ZIS,IOP G KIL
Q1 ; Print Facilities' Information
D NOW^%DTC S NOW=%,PG=0
F K1=0:0 S K1=$O(^FH(119.71,K1)) Q:K1'>0 D Q2
D ^FHPRW2,^FHPRW3,^FHPRW4 W ! Q
Q2 S X=^FH(119.71,K1,0) D SVC,HDR
W !!,"Full Names on Daily Menu:",?40,$S($P(X,"^",2)="Y":"YES",1:"NO")
W !,"Print Meal Distribution:",?40,$S($P(X,"^",5)="Y":"YES",1:"NO")
W !,"Separate Production Summary Pages:",?40,$S($P(X,"^",7)="Y":"YES",1:"NO")
W !,"Separate Recipe Preparation Pages:",?40,$S($P(X,"^",4)="Y":"YES",1:"NO")
W !,"Separate Storeroom Pages:",?40,$S($P(X,"^",6)="Y":"YES",1:"NO")
I $D(^TMP($J,"T")) W !!,"Associated Tray Lines:",! S NX="" F S NX=$O(^TMP($J,"T",NX)) Q:NX="" W !?5,$P(NX,"~",1)
I $D(^TMP($J,"C")) W !!,"Associated Cafeterias:",! S NX="" F S NX=$O(^TMP($J,"C",NX)) Q:NX="" W !?5,$P(NX,"~",1)
I $D(^TMP($J,"S")) W !!,"Associated Supplemental Fdg. Sites:",! S NX="" F S NX=$O(^TMP($J,"S",NX)) Q:NX="" W !?5,$P(NX,"~",1)
W ! Q
SVC ; Build Service temp file
K ^TMP($J)
F LL=0:0 S LL=$O(^FH(119.72,LL)) Q:LL<1 S Y=^(LL,0) I $P(Y,"^",3)=K1 S TYP=$P(Y,"^",2) D S1
F LL=0:0 S LL=$O(^FH(119.74,LL)) Q:LL<1 S Y=^(LL,0) I $P(Y,"^",3)=K1 S TYP="S" D S1
Q
S1 I $G(^FH(119.72,LL,"I"))'="Y" S ^TMP($J,TYP,$P(Y,"^",1)_"~"_LL)="" Q
HDR W:'($E(IOST,1,2)'="C-"&'PG) @IOF S PG=PG+1,DTP=NOW D DTP^FH W !,$E(DTP,1,9),?21,"P R O D U C T I O N F A C I L I T Y",?73,"Page ",PG
S Y=$P(X,"^",1) W !!?(78-$L(Y)\2),Y
W !,"-------------------------------------------------------------------------------",! Q
KIL K ^TMP($J) G KILL^XUSCLEAN
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFHPRW1 1806 printed Dec 13, 2024@01:54:44 Page 2
FHPRW1 ; HISC/REL - List Facilities ;4/27/93 13:34
+1 ;;5.5;DIETETICS;;Jan 28, 2005
+2 WRITE !
KILL IOP,%ZIS
SET %ZIS("A")="Select LIST Printer: "
SET %ZIS="MQ"
DO ^%ZIS
KILL %ZIS,IOP
if POP
GOTO KIL
+3 IF $DATA(IO("Q"))
SET FHPGM="Q1^FHPRW1"
SET FHLST=""
DO EN2^FH
GOTO KIL
+4 USE IO
DO Q1
DO ^%ZISC
KILL %ZIS,IOP
GOTO KIL
Q1 ; Print Facilities' Information
+1 DO NOW^%DTC
SET NOW=%
SET PG=0
+2 FOR K1=0:0
SET K1=$ORDER(^FH(119.71,K1))
if K1'>0
QUIT
DO Q2
+3 DO ^FHPRW2
DO ^FHPRW3
DO ^FHPRW4
WRITE !
QUIT
Q2 SET X=^FH(119.71,K1,0)
DO SVC
DO HDR
+1 WRITE !!,"Full Names on Daily Menu:",?40,$SELECT($PIECE(X,"^",2)="Y":"YES",1:"NO")
+2 WRITE !,"Print Meal Distribution:",?40,$SELECT($PIECE(X,"^",5)="Y":"YES",1:"NO")
+3 WRITE !,"Separate Production Summary Pages:",?40,$SELECT($PIECE(X,"^",7)="Y":"YES",1:"NO")
+4 WRITE !,"Separate Recipe Preparation Pages:",?40,$SELECT($PIECE(X,"^",4)="Y":"YES",1:"NO")
+5 WRITE !,"Separate Storeroom Pages:",?40,$SELECT($PIECE(X,"^",6)="Y":"YES",1:"NO")
+6 IF $DATA(^TMP($JOB,"T"))
WRITE !!,"Associated Tray Lines:",!
SET NX=""
FOR
SET NX=$ORDER(^TMP($JOB,"T",NX))
if NX=""
QUIT
WRITE !?5,$PIECE(NX,"~",1)
+7 IF $DATA(^TMP($JOB,"C"))
WRITE !!,"Associated Cafeterias:",!
SET NX=""
FOR
SET NX=$ORDER(^TMP($JOB,"C",NX))
if NX=""
QUIT
WRITE !?5,$PIECE(NX,"~",1)
+8 IF $DATA(^TMP($JOB,"S"))
WRITE !!,"Associated Supplemental Fdg. Sites:",!
SET NX=""
FOR
SET NX=$ORDER(^TMP($JOB,"S",NX))
if NX=""
QUIT
WRITE !?5,$PIECE(NX,"~",1)
+9 WRITE !
QUIT
SVC ; Build Service temp file
+1 KILL ^TMP($JOB)
+2 FOR LL=0:0
SET LL=$ORDER(^FH(119.72,LL))
if LL<1
QUIT
SET Y=^(LL,0)
IF $PIECE(Y,"^",3)=K1
SET TYP=$PIECE(Y,"^",2)
DO S1
+3 FOR LL=0:0
SET LL=$ORDER(^FH(119.74,LL))
if LL<1
QUIT
SET Y=^(LL,0)
IF $PIECE(Y,"^",3)=K1
SET TYP="S"
DO S1
+4 QUIT
S1 IF $GET(^FH(119.72,LL,"I"))'="Y"
SET ^TMP($JOB,TYP,$PIECE(Y,"^",1)_"~"_LL)=""
QUIT
HDR if '($EXTRACT(IOST,1,2)'="C-"&'PG)
WRITE @IOF
SET PG=PG+1
SET DTP=NOW
DO DTP^FH
WRITE !,$EXTRACT(DTP,1,9),?21,"P R O D U C T I O N F A C I L I T Y",?73,"Page ",PG
+1 SET Y=$PIECE(X,"^",1)
WRITE !!?(78-$LENGTH(Y)\2),Y
+2 WRITE !,"-------------------------------------------------------------------------------",!
QUIT
KIL KILL ^TMP($JOB)
GOTO KILL^XUSCLEAN
