- FHORE3 ; HISC/REL - Cancel Early/Late Trays ;6/21/96 10:30 ;
- ;;5.5;DIETETICS;;Jan 28, 2005;
- S ALL=0 D ^FHDPA G:'DFN KIL G:'FHDFN KIL D NOW^%DTC S NOW=%
- S0 S CT=0 K N,NN W !!,"Order Date Time Meal",!
- F K=NOW:0 S K=$O(^FHPT(FHDFN,"A",ADM,"EL",K)) Q:K<1 S CT=CT+1,N(CT)=K,Y=^(K,0) D D3
- I 'CT W !,"No future early or late trays to cancel" G KIL
- D0 R !!,"Cancel Which Early/Late Orders (or ALL)? ",MEAL:DTIME G:'$T!("^"[MEAL) AB S:$P("all",MEAL,1)="" MEAL="A" S:$P("ALL",MEAL,1)="" MEAL="1-"_CT
- F K=1:1 S K1=$P(MEAL,",",K) Q:K1="" S K2=$S(K1["-":$P(K1,"-",2),1:+K1),K1=+K1 D CK G:'K1 S0 F K3=K1:1:K2 D D2
- W " ... done" G KIL
- CK I K1<1!(K1>CT)!(K1'?1N.N) G C1
- I K2<1!(K2>CT)!(K2'?1N.N) G C1
- Q:K2'<K1
- C1 W *7,!," Enter numbers, or range, of desired orders or ALL (E.G., 1,3,4 or 3-5 or 1,3-5 etc.)" S K1=0 Q
- D2 S DTE=N(K3) S FHORN=$P($G(^FHPT(FHDFN,"A",ADM,"EL",DTE,0)),"^",7) I FHORN S:'$D(NN(FHORN,DTE)) NN(FHORN,DTE)=""
- K ^FHPT(FHDFN,"A",ADM,"EL",DTE),^FHPT("ADLT",DTE,FHDFN)
- S %=$S($D(^FHPT(FHDFN,"A",ADM,"EL",0)):$P(^(0),"^",4),1:0)-1 S:%'<0 $P(^(0),"^",4)=%
- Q:'FHORN F I9=NOW:0 S I9=$O(^FHPT(FHDFN,"A",ADM,"EL",I9)) Q:I9<1 I $P(^(I9,0),"^",7)=FHORN G D21
- D CODE^FHWOR3 D:$D(MSG) MSG^XQOR("FH EVSEND OR",.MSG) K MSG
- D21 Q
- D3 S MEAL=$P(Y,"^",2),TIM=$P(Y,"^",3),BAG=$P(Y,"^",4),DTP=K\1 D DTP^FH
- W !,$J(CT,4)," ",DTP
- W $J(TIM,10)," ",$S(MEAL="B":"Breakfast",MEAL="N":" Noon ",1:" Evening") W:BAG="Y" ?45,"Bagged Meal" Q
- AB W *7,!!,"Early/Late Tray operation TERMINATED - No change!"
- KIL K %,%H,%I,ADM,ALL,BAG,CT,DA,WARD,FHDFN,DFN,DTE,DTP,FHORN,FHWF,FHPV,I9,K,K1,K2,K3,MEAL,N,NN,NOW,TIM,X,Y Q
- FHORE3 ; HISC/REL - Cancel Early/Late Trays ;6/21/96 10:30 ;
- +1 ;;5.5;DIETETICS;;Jan 28, 2005;
- +2 SET ALL=0
- DO ^FHDPA
- IF 'DFN
- GOTO KIL
- IF 'FHDFN
- GOTO KIL
- DO NOW^%DTC
- SET NOW=%
- S0 SET CT=0
- KILL N,NN
- WRITE !!,"Order Date Time Meal",!
- +1 FOR K=NOW:0
- SET K=$ORDER(^FHPT(FHDFN,"A",ADM,"EL",K))
- IF K<1
- QUIT
- SET CT=CT+1
- SET N(CT)=K
- SET Y=^(K,0)
- DO D3
- +2 IF 'CT
- WRITE !,"No future early or late trays to cancel"
- GOTO KIL
- D0 READ !!,"Cancel Which Early/Late Orders (or ALL)? ",MEAL:DTIME
- IF '$TEST!("^"[MEAL)
- GOTO AB
- IF $PIECE("all",MEAL,1)=""
- SET MEAL="A"
- IF $PIECE("ALL",MEAL,1)=""
- SET MEAL="1-"_CT
- +1 FOR K=1:1
- SET K1=$PIECE(MEAL,",",K)
- IF K1=""
- QUIT
- SET K2=$SELECT(K1["-":$PIECE(K1,"-",2),1:+K1)
- SET K1=+K1
- DO CK
- IF 'K1
- GOTO S0
- FOR K3=K1:1:K2
- DO D2
- +2 WRITE " ... done"
- GOTO KIL
- CK IF K1<1!(K1>CT)!(K1'?1N.N)
- GOTO C1
- +1 IF K2<1!(K2>CT)!(K2'?1N.N)
- GOTO C1
- +2 IF K2'<K1
- QUIT
- C1 WRITE *7,!," Enter numbers, or range, of desired orders or ALL (E.G., 1,3,4 or 3-5 or 1,3-5 etc.)"
- SET K1=0
- QUIT
- D2 SET DTE=N(K3)
- SET FHORN=$PIECE($GET(^FHPT(FHDFN,"A",ADM,"EL",DTE,0)),"^",7)
- IF FHORN
- IF '$DATA(NN(FHORN,DTE))
- SET NN(FHORN,DTE)=""
- +1 KILL ^FHPT(FHDFN,"A",ADM,"EL",DTE),^FHPT("ADLT",DTE,FHDFN)
- +2 SET %=$SELECT($DATA(^FHPT(FHDFN,"A",ADM,"EL",0)):$PIECE(^(0),"^",4),1:0)-1
- IF %'<0
- SET $PIECE(^(0),"^",4)=%
- +3 IF 'FHORN
- QUIT
- FOR I9=NOW:0
- SET I9=$ORDER(^FHPT(FHDFN,"A",ADM,"EL",I9))
- IF I9<1
- QUIT
- IF $PIECE(^(I9,0),"^",7)=FHORN
- GOTO D21
- +4 DO CODE^FHWOR3
- IF $DATA(MSG)
- DO MSG^XQOR("FH EVSEND OR",.MSG)
- KILL MSG
- D21 QUIT
- D3 SET MEAL=$PIECE(Y,"^",2)
- SET TIM=$PIECE(Y,"^",3)
- SET BAG=$PIECE(Y,"^",4)
- SET DTP=K\1
- DO DTP^FH
- +1 WRITE !,$JUSTIFY(CT,4)," ",DTP
- +2 WRITE $JUSTIFY(TIM,10)," ",$SELECT(MEAL="B":"Breakfast",MEAL="N":" Noon ",1:" Evening")
- IF BAG="Y"
- WRITE ?45,"Bagged Meal"
- QUIT
- AB WRITE *7,!!,"Early/Late Tray operation TERMINATED - No change!"
- KIL KILL %,%H,%I,ADM,ALL,BAG,CT,DA,WARD,FHDFN,DFN,DTE,DTP,FHORN,FHWF,FHPV,I9,K,K1,K2,K3,MEAL,N,NN,NOW,TIM,X,Y
- QUIT
