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 ---[H[J[2J[HFHORD8 1824 printed Nov 22, 2024@17:03:47 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
