FHORD8.m

FHORD8 ; HISC/REL/NCA - Diet Order Lists ;4/24/95  09:15

 ;;5.5;DIETETICS;;Jan 28, 2005

 W @IOF,!!?20,"NUTRITION LOCATION DIET ORDER LISTS",!!

D0 R !!,"Select by C=COMMUNICATION OFFICE or L=LOCATION: ",FHXX:DTIME G:'$T!("^"[FHXX) KIL I "cl"[FHXX S X=FHXX D TR^FH S FHXX=X

 I FHXX'?1U!("CL"'[FHXX) W *7," Enter C or L" G D0

 I FHXX="C" G D2

F1 R !!,"Select LOCATION (or ALL): ",X:DTIME G:'$T!("^"[X) KIL D:X="all" TR^FH I X="ALL" S WRD=0

 E  K DIC S DIC="^FH(119.6,",DIC(0)="EQM" D ^DIC G:Y<1 F1 S WRD=+Y

 G S0

D2 R !!,"Select COMMUNICATION OFFICE (or ALL): ",X:DTIME G:'$T!("^"[X) KIL D:X="all" TR^FH I X="ALL" S WRD=0

 E  K DIC S DIC="^FH(119.73,",DIC(0)="EMQ" D ^DIC G:Y<1 D2 S WRD=+Y

S0 R !!,"Sort Patients: (A=Alphabetically  R=Room-Bed) R// ",SRT:DTIME G:'$T!(SRT["^") KIL S:SRT="" SRT="R" I "ar"[SRT S X=SRT D TR^FH S SRT=X

 I SRT'?1U!("AR"'[SRT) W *7," Enter A or R" G S0

S1 R !!,"Select Type of Service (T, C, D or ALL): ALL// ",SER:DTIME G:'$T!(SER["^") KIL S:SER="" SER="A" S X=SER D TR^FH S SER=X

 I $P("TRAY",SER,1)'="",$P("CAFETERIA",SER,1)'="",$P("DINING ROOM",SER,1)'="",$P("ALL",SER,1)'="" W *7,!," Enter T for Tray, C for Cafeteria, D for Dining Room, or A for All" G S1

 S SER=$E(SER,1)

L0 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="^FHORD81",FHLST="FHXX^WRD^SRT^SER" D EN2^FH G KIL:'WRD,D0

 U IO D ^FHORD81 D ^%ZISC K %ZIS,IOP G KIL:'WRD,D0

KIL ; Final variable kill

 K ^TMP($J),^TMP("FH",$J),%,%H,%I,%T,A1,ADM,ALG,BAG,BID,C,CAL,COM,CT,D3,DAS,DFN,DIC,DTE,DTP,FHA1,FHDFN,FHDU,FHLD,FHLST,FHOR,FHORD,FHPGM,I,IOP,J,K,K1,K2,K3,KK,L,L1,LEN,LL,LST,MEAL,N,NM,NOW

 K NX,NXW,OLD,OLN,P,POP,P0,P1,P2,P3,PG,PID,Q,QTY,REC,RM,SER,SRT,TF,TF2,TIM,TP,TU,TUN,TW,WRD,WRDN,WRDS,W1,WW,X,X0,X1,X2,X3,X5,FHXX,XX,XY,XZ,Y,YY,Z,Z1,Z5,ZZ Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---FHORD8   1824     printed  Apr 09, 2024@20:55:48                                                                                                                                                                                                      Page 2

FHORD8    ; HISC/REL/NCA - Diet Order Lists ;4/24/95  09:15

 +1       ;;5.5;DIETETICS;;Jan 28, 2005

 +2        WRITE @IOF,!!?20,"NUTRITION LOCATION DIET ORDER LISTS",!!

D0         READ !!,"Select by C=COMMUNICATION OFFICE or L=LOCATION: ",FHXX:DTIME

           if '$TEST!("^"[FHXX)

               GOTO KIL

           IF "cl"[FHXX

               SET X=FHXX

               DO TR^FH

               SET FHXX=X

 +1        IF FHXX'?1U!("CL"'[FHXX)

               WRITE *7," Enter C or L"

               GOTO D0

 +2        IF FHXX="C"

               GOTO D2

F1         READ !!,"Select LOCATION (or ALL): ",X:DTIME

           if '$TEST!("^"[X)

               GOTO KIL

           if X="all"

               DO TR^FH

           IF X="ALL"

               SET WRD=0

 +1       IF '$TEST

               KILL DIC

               SET DIC="^FH(119.6,"

               SET DIC(0)="EQM"

               DO ^DIC

               if Y<1

                   GOTO F1

               SET WRD=+Y

 +2        GOTO S0

D2         READ !!,"Select COMMUNICATION OFFICE (or ALL): ",X:DTIME

           if '$TEST!("^"[X)

               GOTO KIL

           if X="all"

               DO TR^FH

           IF X="ALL"

               SET WRD=0

 +1       IF '$TEST

               KILL DIC

               SET DIC="^FH(119.73,"

               SET DIC(0)="EMQ"

               DO ^DIC

               if Y<1

                   GOTO D2

               SET WRD=+Y

S0         READ !!,"Sort Patients: (A=Alphabetically  R=Room-Bed) R// ",SRT:DTIME

           if '$TEST!(SRT["^")

               GOTO KIL

           if SRT=""

               SET SRT="R"

           IF "ar"[SRT

               SET X=SRT

               DO TR^FH

               SET SRT=X

 +1        IF SRT'?1U!("AR"'[SRT)

               WRITE *7," Enter A or R"

               GOTO S0

S1         READ !!,"Select Type of Service (T, C, D or ALL): ALL// ",SER:DTIME

           if '$TEST!(SER["^")

               GOTO KIL

           if SER=""

               SET SER="A"

           SET X=SER

           DO TR^FH

           SET SER=X

 +1        IF $PIECE("TRAY",SER,1)'=""

               IF $PIECE("CAFETERIA",SER,1)'=""

                   IF $PIECE("DINING ROOM",SER,1)'=""

                       IF $PIECE("ALL",SER,1)'=""

                           WRITE *7,!," Enter T for Tray, C for Cafeteria, D for Dining Room, or A for All"

                           GOTO S1

 +2        SET SER=$EXTRACT(SER,1)

L0         WRITE !

           KILL IOP,%ZIS

           SET %ZIS("A")="Select LIST Printer: "

           SET %ZIS="MQ"

           DO ^%ZIS

           KILL %ZIS,IOP

           if POP

               GOTO KIL

 +1        IF $DATA(IO("Q"))

               SET FHPGM="^FHORD81"

               SET FHLST="FHXX^WRD^SRT^SER"

               DO EN2^FH

               if 'WRD

                   GOTO KIL

               GOTO D0

 +2        USE IO

           DO ^FHORD81

           DO ^%ZISC

           KILL %ZIS,IOP

           if 'WRD

               GOTO KIL

           GOTO D0

KIL       ; Final variable kill

 +1        KILL ^TMP($JOB),^TMP("FH",$JOB),%,%H,%I,%T,A1,ADM,ALG,BAG,BID,C,CAL,COM,CT,D3,DAS,DFN,DIC,DTE,DTP,FHA1,FHDFN,FHDU,FHLD,FHLST,FHOR,FHORD,FHPGM,I,IOP,J,K,K1,K2,K3,KK,L,L1,LEN,LL,LST,MEAL,N,NM,NOW

 +2        KILL NX,NXW,OLD,OLN,P,POP,P0,P1,P2,P3,PG,PID,Q,QTY,REC,RM,SER,SRT,TF,TF2,TIM,TP,TU,TUN,TW,WRD,WRDN,WRDS,W1,WW,X,X0,X1,X2,X3,X5,FHXX,XX,XY,XZ,Y,YY,Z,Z1,Z5,ZZ

           QUIT