- 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 Feb 18, 2025@23:19:59 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
