- FHWOR72 ; HISC/CAH - Diet Profile for CPRS (cont) ;3/13/01 15:15
- ;;5.5;DIETETICS;;Jan 28, 2005
- 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
- S FHX=$$SPACNG^FHWOR71(0,FHX) 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
- I 'CT S FHX=$$SPACNG^FHWOR71(0,FHX) S ^TMP($J,"FHPROF",DFN,FHX)="No future Diet Orders exist"
- F4 S FHX=$$SPACNG^FHWOR71(1,FHX) 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
- I 'CT S FHX=$$SPACNG^FHWOR71(0,FHX) S ^TMP($J,"FHPROF",DFN,FHX)="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)
- I $O(N(""))="" S FHX=$$SPACNG^FHWOR71(1,FHX) S ^TMP($J,"FHPROF",DFN,FHX)="No Active Standing Orders" G F5
- S FHX=$$SPACNG^FHWOR71(1,FHX) S ^TMP($J,"FHPROF",DFN,FHX)="Active Standing Orders:" S FHX=$$SPACNG^FHWOR71(0,FHX)
- 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
- . D SP S QTY=$P(N(M,K),"^",3)
- . S FHX=$$SPACNG^FHWOR71(0,FHX)
- . K ST1 S ST1=" "_M2,$E(ST1,20,80)=$S(QTY:QTY,1:1)_" "_$P(^FH(118.3,Z,0),"^",1)
- . S ^TMP($J,"FHPROF",DFN,FHX)=ST1
- 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 CD
- I 'CT S FHX=$$SPACNG^FHWOR71(1,FHX) S ^TMP($J,"FHPROF",DFN,FHX)="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 F K=0:0 S K=$O(^FHPT(FHDFN,"A",ADM,"MO","AC",KK,K)) Q:K<1 D MO
- I 'CT S FHX=$$SPACNG^FHWOR71(1,FHX) S ^TMP($J,"FHPROF",DFN,FHX)="No Monitors for this Admission"
- S FHX=$$SPACNG^FHWOR71(0,FHX) Q
- 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
- S FHX=$$SPACNG^FHWOR71(0,FHX) K ST1 S ST1="Early/Late Meal: "_DTP,$E(ST1,30,45)=$J(TIM,10),ST1=ST1_" "_$S(MEAL="B":"Breakfast",MEAL="N":" Noon ",1:" Evening") S:BAG="Y" ST1=ST1_" Bagged Meal"
- S ^TMP($J,"FHPROF",DFN,FHX)=ST1 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)
- S FHX=$$SPACNG^FHWOR71(1,FHX) S ^TMP($J,"FHPROF",DFN,FHX)="Consult: "_$P($G(^FH(119.5,CON,0)),"^",1)
- I COM'="" S FHX=$$SPACNG^FHWOR71(0,FHX) S ^TMP($J,"FHPROF",DFN,FHX)="Comment: "_COM
- D DTP^FH S FHX=$$SPACNG^FHWOR71(0,FHX) S ^TMP($J,"FHPROF",DFN,FHX)="Ordered: "_DTP Q
- L1 I 'CT S FHX=$$SPACNG^FHWOR71(1,FHX) S ^TMP($J,"FHPROF",DFN,FHX)="Additional Orders Saved or Last 24 Hours:" S FHX=$$SPACNG^FHWOR71(0,FHX) S CT=1
- S DTP=$P(X,"^",2) D DTP^FH S FHX=$$SPACNG^FHWOR71(0,FHX) K ST1 S $P(ST1," ",21)="",ST1=ST1_DTP S $E(ST1,21,(21+$L($P(X,"^",3))))=$P(X,"^",3)
- S ^TMP($J,"FHPROF",DFN,FHX)=ST1 Q
- T1 Q:'$D(^FHPT(FHDFN,"A",ADM,"DI",FHORD,0)) S DTP=KK D DTP^FH,C2^FHORD7
- I 'CT S FHX=$$SPACNG^FHWOR71(0,FHX) S ^TMP($J,"FHPROF",DFN,FHX)="Future Diet Orders:" S FHX=$$SPACNG^FHWOR71(0,FHX)
- S CT=CT+1 S FHX=$$SPACNG^FHWOR71(0,FHX) S ^TMP($J,"FHPROF",DFN,FHX)=" "_DTP_" "_Y Q
- MO ; Monitors
- S Y=$G(^FHPT(FHDFN,"A",ADM,"MO",K,0)) Q:Y="" S CT=CT+1
- S FHX=$$SPACNG^FHWOR71(1,FHX) S DTP=$P(Y,"^",2) D DTP^FH S ^TMP($J,"FHPROF",DFN,FHX)=$P(Y,"^",1)_", "_DTP
- S COM=$P(Y,"^",3) I COM'="" S FHX=$$SPACNG^FHWOR71(0,FHX) S ^TMP($J,"FHPROF",DFN,FHX)=" Action: "_COM
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFHWOR72 3635 printed Feb 18, 2025@23:21:55 Page 2
- FHWOR72 ; HISC/CAH - Diet Profile for CPRS (cont) ;3/13/01 15:15
- +1 ;;5.5;DIETETICS;;Jan 28, 2005
- +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
- +4 SET FHX=$$SPACNG^FHWOR71(0,FHX)
- 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
- +5 IF 'CT
- SET FHX=$$SPACNG^FHWOR71(0,FHX)
- SET ^TMP($JOB,"FHPROF",DFN,FHX)="No future Diet Orders exist"
- F4 SET FHX=$$SPACNG^FHWOR71(1,FHX)
- 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
- +1 IF 'CT
- SET FHX=$$SPACNG^FHWOR71(0,FHX)
- SET ^TMP($JOB,"FHPROF",DFN,FHX)="No future Early or Late Trays ordered"
- +2 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)
- +3 IF $ORDER(N(""))=""
- SET FHX=$$SPACNG^FHWOR71(1,FHX)
- SET ^TMP($JOB,"FHPROF",DFN,FHX)="No Active Standing Orders"
- GOTO F5
- +4 SET FHX=$$SPACNG^FHWOR71(1,FHX)
- SET ^TMP($JOB,"FHPROF",DFN,FHX)="Active Standing Orders:"
- SET FHX=$$SPACNG^FHWOR71(0,FHX)
- +5 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
- Begin DoDot:1
- +6 DO SP
- SET QTY=$PIECE(N(M,K),"^",3)
- +7 SET FHX=$$SPACNG^FHWOR71(0,FHX)
- +8 KILL ST1
- SET ST1=" "_M2
- SET $EXTRACT(ST1,20,80)=$SELECT(QTY:QTY,1:1)_" "_$PIECE(^FH(118.3,Z,0),"^",1)
- +9 SET ^TMP($JOB,"FHPROF",DFN,FHX)=ST1
- End DoDot:1
- +10 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
- DO CD
- +1 IF 'CT
- SET FHX=$$SPACNG^FHWOR71(1,FHX)
- SET ^TMP($JOB,"FHPROF",DFN,FHX)="No Active Consultations for this Admission"
- F6 SET CT=0
- FOR KK=0:0
- SET KK=$ORDER(^FHPT(FHDFN,"A",ADM,"MO","AC",KK))
- if KK<1
- QUIT
- FOR K=0:0
- SET K=$ORDER(^FHPT(FHDFN,"A",ADM,"MO","AC",KK,K))
- if K<1
- QUIT
- DO MO
- +1 IF 'CT
- SET FHX=$$SPACNG^FHWOR71(1,FHX)
- SET ^TMP($JOB,"FHPROF",DFN,FHX)="No Monitors for this Admission"
- +2 SET FHX=$$SPACNG^FHWOR71(0,FHX)
- QUIT
- 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 SET FHX=$$SPACNG^FHWOR71(0,FHX)
- KILL ST1
- SET ST1="Early/Late Meal: "_DTP
- SET $EXTRACT(ST1,30,45)=$JUSTIFY(TIM,10)
- SET ST1=ST1_" "_$SELECT(MEAL="B":"Breakfast",MEAL="N":" Noon ",1:" Evening")
- if BAG="Y"
- SET ST1=ST1_" Bagged Meal"
- +2 SET ^TMP($JOB,"FHPROF",DFN,FHX)=ST1
- 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 SET FHX=$$SPACNG^FHWOR71(1,FHX)
- SET ^TMP($JOB,"FHPROF",DFN,FHX)="Consult: "_$PIECE($GET(^FH(119.5,CON,0)),"^",1)
- +3 IF COM'=""
- SET FHX=$$SPACNG^FHWOR71(0,FHX)
- SET ^TMP($JOB,"FHPROF",DFN,FHX)="Comment: "_COM
- +4 DO DTP^FH
- SET FHX=$$SPACNG^FHWOR71(0,FHX)
- SET ^TMP($JOB,"FHPROF",DFN,FHX)="Ordered: "_DTP
- QUIT
- L1 IF 'CT
- SET FHX=$$SPACNG^FHWOR71(1,FHX)
- SET ^TMP($JOB,"FHPROF",DFN,FHX)="Additional Orders Saved or Last 24 Hours:"
- SET FHX=$$SPACNG^FHWOR71(0,FHX)
- SET CT=1
- +1 SET DTP=$PIECE(X,"^",2)
- DO DTP^FH
- SET FHX=$$SPACNG^FHWOR71(0,FHX)
- KILL ST1
- SET $PIECE(ST1," ",21)=""
- SET ST1=ST1_DTP
- SET $EXTRACT(ST1,21,(21+$LENGTH($PIECE(X,"^",3))))=$PIECE(X,"^",3)
- +2 SET ^TMP($JOB,"FHPROF",DFN,FHX)=ST1
- QUIT
- T1 if '$DATA(^FHPT(FHDFN,"A",ADM,"DI",FHORD,0))
- QUIT
- SET DTP=KK
- DO DTP^FH
- DO C2^FHORD7
- +1 IF 'CT
- SET FHX=$$SPACNG^FHWOR71(0,FHX)
- SET ^TMP($JOB,"FHPROF",DFN,FHX)="Future Diet Orders:"
- SET FHX=$$SPACNG^FHWOR71(0,FHX)
- +2 SET CT=CT+1
- SET FHX=$$SPACNG^FHWOR71(0,FHX)
- SET ^TMP($JOB,"FHPROF",DFN,FHX)=" "_DTP_" "_Y
- QUIT
- MO ; Monitors
- +1 SET Y=$GET(^FHPT(FHDFN,"A",ADM,"MO",K,0))
- if Y=""
- QUIT
- SET CT=CT+1
- +2 SET FHX=$$SPACNG^FHWOR71(1,FHX)
- SET DTP=$PIECE(Y,"^",2)
- DO DTP^FH
- SET ^TMP($JOB,"FHPROF",DFN,FHX)=$PIECE(Y,"^",1)_", "_DTP
- +3 SET COM=$PIECE(Y,"^",3)
- IF COM'=""
- SET FHX=$$SPACNG^FHWOR71(0,FHX)
- SET ^TMP($JOB,"FHPROF",DFN,FHX)=" Action: "_COM
- +4 QUIT
