- 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
- 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
