FHORD61 ; HISC/REL/NCA - Diet Inquiry (cont) ;3/13/01 15:08
;;5.5;DIETETICS;**5**;Jan 28, 2005;Build 53
S X1=NOW,X2=-1 D C^%DTC S LST=X,CT=0
F K=0:0 S K=$O(^FHPT(FHDFN,"A",ADM,"OO",K)) Q:K<1 S X=^(K,0) I $P(X,"^",2)'<LST!($P(X,"^",5)="S"),$P(X,"^",5)'="X" D L1 Q:QT="^"
G:QT="^" KIL^FHORD6
W ! S CT=0 F KK=NOW:0 S KK=$O(^FHPT(FHDFN,"A",ADM,"AC",KK)) Q:KK<1 S FHORD=$P(^(KK,0),"^",2) D T1 Q:QT="^"
G:QT="^" KIL^FHORD6
D:$Y>(IOSL-2) HDR^FHORD6 G:QT="^" KIL^FHORD6 I 'CT W !,"No future Diet Orders exist"
F4 W ! S CT=0 F K=NOW:0 S K=$O(^FHPT(FHDFN,"A",ADM,"EL",K)) Q:K<1 S CT=CT+1,Y=^(K,0) D EL Q:QT="^"
G:QT="^" KIL^FHORD6
D:$Y>(IOSL-2) HDR^FHORD6 G:QT="^" KIL^FHORD6 I 'CT W !,"No future Early or Late Trays ordered"
K N F K=0:0 S K=$O(^FHPT("ASP",FHDFN,ADM,K)) Q:K<1 S X=^FHPT(FHDFN,"A",ADM,"SP",K,0),M=$P(X,"^",3),M=$S(M="BNE":"A",1:$E(M,1)),N(M,K)=$P(X,"^",2,3),$P(N(M,K),"^",3)=$P(X,"^",8)
D:$Y>(IOSL-4) HDR^FHORD6 G:QT="^" KIL^FHORD6 I $O(N(""))="" W !!,"No Active Standing Orders" G F5
W !!,"Active Standing Orders:",!
F M="A","B","N","E" F K=0:0 S K=$O(N(M,K)) Q:K<1 S Z=+N(M,K) I Z D:$Y>(IOSL-2) HDR^FHORD6 Q:QT="^" D SP S QTY=$P(N(M,K),"^",3) W !?5,M2,?18,$S(QTY:QTY,1:1)," ",$P(^FH(118.3,Z,0),"^",1)
G:QT="^" KIL^FHORD6
K L,N,M,M1,M2
F5 S CT=0 F K=0:0 S K=$O(^FHPT(FHDFN,"A",ADM,"DR",K)) Q:K<1 D:$Y>(IOSL-5) HDR^FHORD6 Q:QT="^" D CD
G:QT="^" KIL^FHORD6
I 'CT D:$Y>(IOSL-4) HDR^FHORD6 G:QT="^" KIL^FHORD6 W !!,"No Active Consultations for this Admission"
F6 ;S CT=0 F KK=0:0 S KK=$O(^FHPT(FHDFN,"A",ADM,"MO","AC",KK)) Q:KK<1!(QT="^") F K=0:0 S K=$O(^FHPT(FHDFN,"A",ADM,"MO","AC",KK,K)) Q:K<1 D:$Y>(IOSL-5) HDR^FHORD6 Q:QT="^" D MO
S FHTTLM="",FHTTLM=$P($G(^FHPT(FHDFN,"A",ADM,"MO",0)),U,3)
I FHTTLM="" W !!,"No Monitors on file" G KIL^FHORD6
S FHMONS=$S(FHTTLM-FHNUM<0:0,1:FHTTLM-FHNUM)
F NDT=FHMONS:0 S NDT=$O(^FHPT(FHDFN,"A",ADM,"MO",NDT)) Q:NDT<1!(QT="^") S K=NDT D MO
Q:QT="^" I 'CT W !,"No Monitors on file."
I 'CT D:$Y>(IOSL-4) HDR^FHORD6 G:QT="^" KIL^FHORD6 W !!,"No Monitors for this Admission"
I $E(IOST,1,2)="C-" R !!,"Press return to continue ",YN:DTIME
W ! G KIL^FHORD6
SP S M1=$P(N(M,K),"^",2) I M1="BNE" S M2="All Meals" Q
S L=$E(M1,1),M2=$S(L="B":"Break",L="N":"Noon",1:"Even")
S L=$E(M1,2) Q:L="" S M2=M2_","_$S(L="B":"Break",L="N":"Noon",1:"Even") Q
EL S MEAL=$P(Y,"^",2),TIM=$P(Y,"^",3),BAG=$P(Y,"^",4),DTP=K\1 D DTP^FH
D:$Y>(IOSL-2) HDR^FHORD6 Q:QT="^" W !,"Early/Late Meal: ",DTP,?29,$J(TIM,10)," ",$S(MEAL="B":"Breakfast",MEAL="N":" Noon ",1:" Evening") W:BAG="Y" ?62,"Bagged Meal" Q
CD S Y=^FHPT(FHDFN,"A",ADM,"DR",K,0) Q:$P(Y,"^",8)'="A" S CT=CT+1
S CON=$P(Y,"^",2),DTP=$P(Y,"^",1),COM=$P(Y,"^",3)
W !!,"Consult: ",$P($G(^FH(119.5,CON,0)),"^",1)
W:COM'="" !,"Comment: ",COM
D DTP^FH W !,"Ordered: ",DTP Q
L1 D:$Y>(IOSL-4) HDR^FHORD6 Q:QT="^" I 'CT W !!,"Additional Orders Saved or Last 24 Hours:",! S CT=1
S DTP=$P(X,"^",2) D DTP^FH W !,DTP,?20,$P(X,"^",3) Q
T1 Q:'$D(^FHPT(FHDFN,"A",ADM,"DI",FHORD,0)) S DTP=KK D DTP^FH,C2^FHORD7
D:$Y>(IOSL-3) HDR^FHORD6 Q:QT="^" I 'CT W !,"Future Diet Orders:",!
S CT=CT+1 W !?5,DTP,?25,Y Q
MO ; Display Monitors
S Y=$G(^FHPT(FHDFN,"A",ADM,"MO",K,0)) Q:Y="" S CT=CT+1
D:$Y'<(IOSL-4) HDR^FHORD6 Q:QT="^"
W !!,$P(Y,"^",1) S DTP=$P(Y,"^",2) D DTP^FH W ", ",DTP
S COM=$P(Y,"^",3) W:COM'="" !?5,"Action: ",COM Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFHORD61 3387 printed Dec 13, 2024@01:53:33 Page 2
FHORD61 ; HISC/REL/NCA - Diet Inquiry (cont) ;3/13/01 15:08
+1 ;;5.5;DIETETICS;**5**;Jan 28, 2005;Build 53
+2 SET X1=NOW
SET X2=-1
DO C^%DTC
SET LST=X
SET CT=0
+3 FOR K=0:0
SET K=$ORDER(^FHPT(FHDFN,"A",ADM,"OO",K))
if K<1
QUIT
SET X=^(K,0)
IF $PIECE(X,"^",2)'<LST!($PIECE(X,"^",5)="S")
IF $PIECE(X,"^",5)'="X"
DO L1
if QT="^"
QUIT
+4 if QT="^"
GOTO KIL^FHORD6
+5 WRITE !
SET CT=0
FOR KK=NOW:0
SET KK=$ORDER(^FHPT(FHDFN,"A",ADM,"AC",KK))
if KK<1
QUIT
SET FHORD=$PIECE(^(KK,0),"^",2)
DO T1
if QT="^"
QUIT
+6 if QT="^"
GOTO KIL^FHORD6
+7 if $Y>(IOSL-2)
DO HDR^FHORD6
if QT="^"
GOTO KIL^FHORD6
IF 'CT
WRITE !,"No future Diet Orders exist"
F4 WRITE !
SET CT=0
FOR K=NOW:0
SET K=$ORDER(^FHPT(FHDFN,"A",ADM,"EL",K))
if K<1
QUIT
SET CT=CT+1
SET Y=^(K,0)
DO EL
if QT="^"
QUIT
+1 if QT="^"
GOTO KIL^FHORD6
+2 if $Y>(IOSL-2)
DO HDR^FHORD6
if QT="^"
GOTO KIL^FHORD6
IF 'CT
WRITE !,"No future Early or Late Trays ordered"
+3 KILL N
FOR K=0:0
SET K=$ORDER(^FHPT("ASP",FHDFN,ADM,K))
if K<1
QUIT
SET X=^FHPT(FHDFN,"A",ADM,"SP",K,0)
SET M=$PIECE(X,"^",3)
SET M=$SELECT(M="BNE":"A",1:$EXTRACT(M,1))
SET N(M,K)=$PIECE(X,"^",2,3)
SET $PIECE(N(M,K),"^",3)=$PIECE(X,"^",8)
+4 if $Y>(IOSL-4)
DO HDR^FHORD6
if QT="^"
GOTO KIL^FHORD6
IF $ORDER(N(""))=""
WRITE !!,"No Active Standing Orders"
GOTO F5
+5 WRITE !!,"Active Standing Orders:",!
+6 FOR M="A","B","N","E"
FOR K=0:0
SET K=$ORDER(N(M,K))
if K<1
QUIT
SET Z=+N(M,K)
IF Z
if $Y>(IOSL-2)
DO HDR^FHORD6
if QT="^"
QUIT
DO SP
SET QTY=$PIECE(N(M,K),"^",3)
WRITE !?5,M2,?18,$SELECT(QTY:QTY,1:1)," ",$PIECE(^FH(118.3,Z,0),"^",1)
+7 if QT="^"
GOTO KIL^FHORD6
+8 KILL L,N,M,M1,M2
F5 SET CT=0
FOR K=0:0
SET K=$ORDER(^FHPT(FHDFN,"A",ADM,"DR",K))
if K<1
QUIT
if $Y>(IOSL-5)
DO HDR^FHORD6
if QT="^"
QUIT
DO CD
+1 if QT="^"
GOTO KIL^FHORD6
+2 IF 'CT
if $Y>(IOSL-4)
DO HDR^FHORD6
if QT="^"
GOTO KIL^FHORD6
WRITE !!,"No Active Consultations for this Admission"
F6 ;S CT=0 F KK=0:0 S KK=$O(^FHPT(FHDFN,"A",ADM,"MO","AC",KK)) Q:KK<1!(QT="^") F K=0:0 S K=$O(^FHPT(FHDFN,"A",ADM,"MO","AC",KK,K)) Q:K<1 D:$Y>(IOSL-5) HDR^FHORD6 Q:QT="^" D MO
+1 SET FHTTLM=""
SET FHTTLM=$PIECE($GET(^FHPT(FHDFN,"A",ADM,"MO",0)),U,3)
+2 IF FHTTLM=""
WRITE !!,"No Monitors on file"
GOTO KIL^FHORD6
+3 SET FHMONS=$SELECT(FHTTLM-FHNUM<0:0,1:FHTTLM-FHNUM)
+4 FOR NDT=FHMONS:0
SET NDT=$ORDER(^FHPT(FHDFN,"A",ADM,"MO",NDT))
if NDT<1!(QT="^")
QUIT
SET K=NDT
DO MO
+5 if QT="^"
QUIT
IF 'CT
WRITE !,"No Monitors on file."
+6 IF 'CT
if $Y>(IOSL-4)
DO HDR^FHORD6
if QT="^"
GOTO KIL^FHORD6
WRITE !!,"No Monitors for this Admission"
+7 IF $EXTRACT(IOST,1,2)="C-"
READ !!,"Press return to continue ",YN:DTIME
+8 WRITE !
GOTO KIL^FHORD6
SP SET M1=$PIECE(N(M,K),"^",2)
IF M1="BNE"
SET M2="All Meals"
QUIT
+1 SET L=$EXTRACT(M1,1)
SET M2=$SELECT(L="B":"Break",L="N":"Noon",1:"Even")
+2 SET L=$EXTRACT(M1,2)
if L=""
QUIT
SET M2=M2_","_$SELECT(L="B":"Break",L="N":"Noon",1:"Even")
QUIT
EL SET MEAL=$PIECE(Y,"^",2)
SET TIM=$PIECE(Y,"^",3)
SET BAG=$PIECE(Y,"^",4)
SET DTP=K\1
DO DTP^FH
+1 if $Y>(IOSL-2)
DO HDR^FHORD6
if QT="^"
QUIT
WRITE !,"Early/Late Meal: ",DTP,?29,$JUSTIFY(TIM,10)," ",$SELECT(MEAL="B":"Breakfast",MEAL="N":" Noon ",1:" Evening")
if BAG="Y"
WRITE ?62,"Bagged Meal"
QUIT
CD SET Y=^FHPT(FHDFN,"A",ADM,"DR",K,0)
if $PIECE(Y,"^",8)'="A"
QUIT
SET CT=CT+1
+1 SET CON=$PIECE(Y,"^",2)
SET DTP=$PIECE(Y,"^",1)
SET COM=$PIECE(Y,"^",3)
+2 WRITE !!,"Consult: ",$PIECE($GET(^FH(119.5,CON,0)),"^",1)
+3 if COM'=""
WRITE !,"Comment: ",COM
+4 DO DTP^FH
WRITE !,"Ordered: ",DTP
QUIT
L1 if $Y>(IOSL-4)
DO HDR^FHORD6
if QT="^"
QUIT
IF 'CT
WRITE !!,"Additional Orders Saved or Last 24 Hours:",!
SET CT=1
+1 SET DTP=$PIECE(X,"^",2)
DO DTP^FH
WRITE !,DTP,?20,$PIECE(X,"^",3)
QUIT
T1 if '$DATA(^FHPT(FHDFN,"A",ADM,"DI",FHORD,0))
QUIT
SET DTP=KK
DO DTP^FH
DO C2^FHORD7
+1 if $Y>(IOSL-3)
DO HDR^FHORD6
if QT="^"
QUIT
IF 'CT
WRITE !,"Future Diet Orders:",!
+2 SET CT=CT+1
WRITE !?5,DTP,?25,Y
QUIT
MO ; Display Monitors
+1 SET Y=$GET(^FHPT(FHDFN,"A",ADM,"MO",K,0))
if Y=""
QUIT
SET CT=CT+1
+2 if $Y'<(IOSL-4)
DO HDR^FHORD6
if QT="^"
QUIT
+3 WRITE !!,$PIECE(Y,"^",1)
SET DTP=$PIECE(Y,"^",2)
DO DTP^FH
WRITE ", ",DTP
+4 SET COM=$PIECE(Y,"^",3)
if COM'=""
WRITE !?5,"Action: ",COM
QUIT
