- FHORE2 ; HISC/REL/NCA - List Early/Late Trays ;3/15/95 08:59
- ;;5.5;DIETETICS;;Jan 28, 2005
- S FHP=$O(^FH(119.73,0)) I FHP'<1,$O(^FH(119.73,FHP))<1 G N1
- R0 R !!,"Select COMMUNICATION OFFICE (or ALL): ",X:DTIME G:'$T!("^"[X) KIL D:X="all" TR^FH I X="ALL" S FHP=0 G N1
- K DIC S DIC="^FH(119.73,",DIC(0)="EMQ" D ^DIC G:Y<1 R0 S FHP=+Y
- N1 W ! S %DT="AEX",%DT("A")="Select Date: " D ^%DT K %DT G KIL:X[U!$D(DTOUT),N1:Y<1 S DTE=+Y\1
- N2 R !!,"Select Meal (B,N,E or ALL): ",MEAL:DTIME G:'$T!("^"[MEAL) KIL S X=MEAL D TR^FH S MEAL=X
- S:$P("ALL",MEAL,1)="" MEAL="A" I "BNEA"'[MEAL!(MEAL'?1U) W *7,!,"Select B for Breakfast, N for Noon, E for Evening or ALL for all meals" G N2
- N3 R !!,"Do you want Labels? N// ",X:DTIME G:'$T!(X["^") KIL S:X="" X="N" D TR^FH I $P("YES",X,1)'="",$P("NO",X,1)'="" W *7," Enter YES or NO" G N3
- S LAB=X?1"Y".E
- S FHLBFLG=1 I LAB>0 D I FHLBFLG=0 Q
- .W ! K DIR,LABSTART S DIR(0)="NA^1:10",DIR("A")="If using laser label sheets, what row do you want to begin printing at? ",DIR("B")=1 D ^DIR
- .I $D(DIRUT) S FHLBFLG=0 Q
- .S LABSTART=Y Q
- I 'LAB W !!,"The list requires a 132 column printer.",!
- W ! K IOP,%ZIS S %ZIS("A")="Select "_$S(LAB:"LABEL",1:"LIST")_" Printer: ",%ZIS="MQ" D ^%ZIS K %ZIS,IOP G:POP KIL
- I $D(IO("Q")) S FHPGM="^FHORE21",FHLST="FHP^LAB^DTE^MEAL^LABSTART" D EN2^FH G KIL
- U IO D ^FHORE21 D ^%ZISC K %ZIS,IOP G KIL
- KIL K %,%H,%I,%DT,A1,ADM,ANS,BAG,D1,D3,FHDFN,DFN,DIC,DP,DTP,DTE,FHDU,FHLD,FHOR,FHP,H1,IS,K,K1,K2,KK,L,L1,LAB,LABSTART,M1,M2,MEAL,N,N1,N2,O1,OLW,FHORD,P0,P1,P2,PG,POP,RM,S1,TIM,W1,WARD,X,X2,Y K ^TMP($J) Q
- FHORE2 ; HISC/REL/NCA - List Early/Late Trays ;3/15/95 08:59
- +1 ;;5.5;DIETETICS;;Jan 28, 2005
- +2 SET FHP=$ORDER(^FH(119.73,0))
- IF FHP'<1
- IF $ORDER(^FH(119.73,FHP))<1
- GOTO N1
- R0 READ !!,"Select COMMUNICATION OFFICE (or ALL): ",X:DTIME
- IF '$TEST!("^"[X)
- GOTO KIL
- IF X="all"
- DO TR^FH
- IF X="ALL"
- SET FHP=0
- GOTO N1
- +1 KILL DIC
- SET DIC="^FH(119.73,"
- SET DIC(0)="EMQ"
- DO ^DIC
- IF Y<1
- GOTO R0
- SET FHP=+Y
- N1 WRITE !
- SET %DT="AEX"
- SET %DT("A")="Select Date: "
- DO ^%DT
- KILL %DT
- IF X[U!$DATA(DTOUT)
- GOTO KIL
- IF Y<1
- GOTO N1
- SET DTE=+Y\1
- N2 READ !!,"Select Meal (B,N,E or ALL): ",MEAL:DTIME
- IF '$TEST!("^"[MEAL)
- GOTO KIL
- SET X=MEAL
- DO TR^FH
- SET MEAL=X
- +1 IF $PIECE("ALL",MEAL,1)=""
- SET MEAL="A"
- IF "BNEA"'[MEAL!(MEAL'?1U)
- WRITE *7,!,"Select B for Breakfast, N for Noon, E for Evening or ALL for all meals"
- GOTO N2
- N3 READ !!,"Do you want Labels? N// ",X:DTIME
- IF '$TEST!(X["^")
- GOTO KIL
- IF X=""
- SET X="N"
- DO TR^FH
- IF $PIECE("YES",X,1)'=""
- IF $PIECE("NO",X,1)'=""
- WRITE *7," Enter YES or NO"
- GOTO N3
- +1 SET LAB=X?1"Y".E
- +2 SET FHLBFLG=1
- IF LAB>0
- Begin DoDot:1
- +3 WRITE !
- KILL DIR,LABSTART
- SET DIR(0)="NA^1:10"
- SET DIR("A")="If using laser label sheets, what row do you want to begin printing at? "
- SET DIR("B")=1
- DO ^DIR
- +4 IF $DATA(DIRUT)
- SET FHLBFLG=0
- QUIT
- +5 SET LABSTART=Y
- QUIT
- End DoDot:1
- IF FHLBFLG=0
- QUIT
- +6 IF 'LAB
- WRITE !!,"The list requires a 132 column printer.",!
- +7 WRITE !
- KILL IOP,%ZIS
- SET %ZIS("A")="Select "_$SELECT(LAB:"LABEL",1:"LIST")_" Printer: "
- SET %ZIS="MQ"
- DO ^%ZIS
- KILL %ZIS,IOP
- IF POP
- GOTO KIL
- +8 IF $DATA(IO("Q"))
- SET FHPGM="^FHORE21"
- SET FHLST="FHP^LAB^DTE^MEAL^LABSTART"
- DO EN2^FH
- GOTO KIL
- +9 USE IO
- DO ^FHORE21
- DO ^%ZISC
- KILL %ZIS,IOP
- GOTO KIL
- KIL KILL %,%H,%I,%DT,A1,ADM,ANS,BAG,D1,D3,FHDFN,DFN,DIC,DP,DTP,DTE,FHDU,FHLD,FHOR,FHP,H1,IS,K,K1,K2,KK,L,L1,LAB,LABSTART,M1,M2,MEAL,N,N1,N2,O1,OLW,FHORD,P0,P1,P2,PG,POP,RM,S1,TIM,W1,WARD,X,X2,Y
- KILL ^TMP($JOB)
- QUIT
