FHORE2.m

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

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---FHORE2   1579     printed  Apr 09, 2024@20:56:59                                                                                                                                                                                                      Page 2

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