| [613] | 1 | FHMTK4 ; HISC/NCA - Patient Diet Pattern Utility ;4/25/95 10:01
|
|---|
| 2 | ;;5.5;DIETETICS;;Jan 28, 2005
|
|---|
| 3 | LIS ; List Diet Pattern of Diet Order
|
|---|
| 4 | S ANS="" D SO Q:ANS="^" S STR=$G(^FHPT(FHDFN,"A",ADM,"DI",FHORD,2))
|
|---|
| 5 | W !!!?33,"Diet Pattern"
|
|---|
| 6 | W !! F CTR=1:1:3 W ?$S(CTR=1:9,CTR=2:35,1:61),$S(CTR=1:"Breakfast",CTR=2:"Noon",1:"Evening")
|
|---|
| 7 | I STR'="" D DECOD G L1
|
|---|
| 8 | F MEAL="B","N","E" D L3^FHMTK21
|
|---|
| 9 | K MM,P S M1=0 F MEAL="B","N","E" S N1=0,M1=M1+1 D
|
|---|
| 10 | .S NX="" F S NX=$O(^TMP($J,"FHMP",MP,MEAL,NX)) Q:NX="" S S1=$G(^(NX)),QTY=$S(S1="":1,1:+S1),N1=N1+1,PAD=$E(" ",1,4-$L(QTY)),MM(N1,M1)=PAD_QTY_" "_$P(NX,"~",2),P(M1,$P(S1,"^",2))=QTY
|
|---|
| 11 | .;S NX="" F S NX=$O(^TMP($J,"FHMP",MP,MEAL,NX)) Q:NX="" S S1=$G(^(NX)),QTY=$S(S1="":1,1:+S1),N1=N1+1,MM(N1,M1)=$S(QTY#1>0:$J(QTY,3,2),1:QTY_" ")_" "_$P(NX,"~",2),P(M1,$P(S1,"^",2))=QTY
|
|---|
| 12 | .Q
|
|---|
| 13 | L1 W ! F N1=1:1 W ! Q:'$D(MM(N1)) F M1=1:1:3 I $D(MM(N1,M1)) W ?$S(M1=1:2,M1=2:28,1:54),MM(N1,M1)
|
|---|
| 14 | Q
|
|---|
| 15 | LIST ; List Recipe Category of a selected meal
|
|---|
| 16 | W ! F NO=1:1 Q:'$D(MM(NO,MEAL)) W !,MM(NO,MEAL)
|
|---|
| 17 | Q
|
|---|
| 18 | SO ; List Standing Orders
|
|---|
| 19 | W !?16,"Standing Orders",!
|
|---|
| 20 | K N F K=0:0 S K=$O(^FHPT("ASP",FHDFN,ADM,K)) Q:K<1 S X=$G(^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(X,"^",8,9)
|
|---|
| 21 | S LN=0 F M="A","B","N","E" D Q:ANS="^"
|
|---|
| 22 | .F K=0:0 S K=$O(N(M,K)) Q:K<1 S Z=+N(M,K) I Z D Q:ANS="^"
|
|---|
| 23 | ..D L1^FHSPED W ! S NUM=$P(N(M,K),"^",3),LN=LN+1
|
|---|
| 24 | ..W ?5,M2,?18,$S(NUM:NUM,1:1)," ",$P(^FH(118.3,Z,0),"^",1),$S($P(N(M,K),"^",4)'="Y":" (I)",1:"")
|
|---|
| 25 | ..I LN>15 D PSE S LN=0
|
|---|
| 26 | ..Q
|
|---|
| 27 | .Q
|
|---|
| 28 | Q
|
|---|
| 29 | SORT ; Sort Recipe Category in print order
|
|---|
| 30 | F L1=1:1 Q:'$D(MM(L1,MEAL)) K MM(L1,MEAL)
|
|---|
| 31 | S N1=0,M3=$S(MEAL=1:"B",MEAL=2:"N",1:"E"),NX=""
|
|---|
| 32 | F S NX=$O(^TMP($J,"FHMP",MP,M3,NX)) Q:NX="" S S1=$G(^(NX)),Z=$P(S1,"^",2) I $D(P(MEAL,+Z)) S N1=N1+1,QTY=$S($G(P(MEAL,+Z))="":1,1:+$G(P(MEAL,+Z))),PAD=$E(" ",1,4-$L(QTY)),MM(N1,MEAL)=PAD_QTY_" "_$P(NX,"~",2)
|
|---|
| 33 | ;F S NX=$O(^TMP($J,"FHMP",MP,M3,NX)) Q:NX="" S S1=$G(^(NX)),Z=$P(S1,"^",2) I $D(P(MEAL,+Z)) S N1=N1+1,QTY=$S($G(P(MEAL,+Z))="":1,1:+$G(P(MEAL,+Z))),MM(N1,MEAL)=$S(QTY#1>0:$J(QTY,3,2),1:QTY_" ")_" "_$P(NX,"~",2)
|
|---|
| 34 | Q
|
|---|
| 35 | DECOD ; Decode code string
|
|---|
| 36 | K MM,P F M1=1:1:3 S S1=$P(STR,";",M1),M3=$S(M1=1:"B",M1=2:"N",1:"E") D
|
|---|
| 37 | .F X4=1:1 Q:$P(S1," ",X4,99)="" D
|
|---|
| 38 | ..S X1=$P(S1," ",X4),NAM=$P($G(^FH(114.1,+X1,0)),"^",1),$P(X1,",",2)=$S($P(X1,",",2)'="":$P(X1,",",2),1:1)
|
|---|
| 39 | ..S PAD=$E(" ",1,4-$L($P(X1,",",2)))
|
|---|
| 40 | ..S MM(X4,M1)=PAD_$P(X1,",",2)_" "_NAM,P(M1,+X1)=$P(X1,",",2)
|
|---|
| 41 | ..;S MM(X4,M1)=$S($P(X1,",",2)#1>0:$J($P(X1,",",2),3,2),1:$P(X1,",",2)_" ")_" "_NAM,P(M1,+X1)=$P(X1,",",2)
|
|---|
| 42 | ..S K1=$P($G(^FH(114.1,+X1,0)),"^",3),K1=$S('K1:99,K1<10:"0"_K1,1:K1)_"~"_NAM
|
|---|
| 43 | ..S ^TMP($J,"FHMP",MP,M3,K1)=$P(X1,",",2)_"^"_+X1 Q
|
|---|
| 44 | .Q
|
|---|
| 45 | Q
|
|---|
| 46 | PSE I IOST?1"C-".E R !!,"Press RETURN to Continue ",X:DTIME W ! S:'$T!(X["^") ANS="^" Q:ANS="^" I "^"'[X W !,"Enter a RETURN to Continue." G PSE
|
|---|
| 47 | Q
|
|---|
