| 1 | FHMTK21 ; HISC/NCA - List Diet Patterns (cont.) ;5/1/95 11:46
|
|---|
| 2 | ;;5.5;DIETETICS;;Jan 28, 2005
|
|---|
| 3 | L1 ; List the Diet Pattern(s)
|
|---|
| 4 | K ^TMP($J) D NOW^%DTC S DTP=% D DTP^FH S PG=0,RES="" D HDR
|
|---|
| 5 | I ANS'?1"Y".E S MP=+FHDA,X=$G(^FH(111.1,MP,0)) D L2 G PRT
|
|---|
| 6 | F MP=0:0 S MP=$O(^FH(111.1,MP)) Q:MP<1 S X=$G(^(MP,0)) D L2
|
|---|
| 7 | G PRT
|
|---|
| 8 | L2 S PD=$P(X,"^",7) Q:'PD
|
|---|
| 9 | S NAM=$P(X,"^",1),FHPD=$P($G(^FH(116.2,PD,0)),"^",1),NM=$P(X,"^",8),SF=$P($G(^FH(118.1,+NM,0)),"^",1)
|
|---|
| 10 | S P0=$P($G(^FH(116.2,PD,0)),"^",6),P0=$S('P0:99,P0<10:"0"_P0,1:P0)
|
|---|
| 11 | S P0=P0_"~"_FHPD
|
|---|
| 12 | S:'$D(^TMP($J,"FHPD",P0)) ^TMP($J,"FHPD",P0)=PD S M0=NAM
|
|---|
| 13 | S ^TMP($J,"FHO",PD,M0)=MP_"^"_SF
|
|---|
| 14 | F MEAL="B","N","E" D L3
|
|---|
| 15 | F MEAL="BS","NS","ES" D L5
|
|---|
| 16 | F R1=0:0 S R1=$O(^FH(111.1,MP,"RES",R1)) Q:R1<1 S FP=$G(^(R1,0)) D
|
|---|
| 17 | .Q:$P(FP,"^",2)=""
|
|---|
| 18 | .S K1=99_R1,K1=K1_"~"_$E($P($G(^FH(115.2,+FP,0)),"^",1),1,30)
|
|---|
| 19 | .F MEAL="B","N","E" I $P(FP,"^",2)[MEAL S ^TMP($J,"FHFP",MP,MEAL,K1)=""
|
|---|
| 20 | .Q
|
|---|
| 21 | Q
|
|---|
| 22 | L3 ; Get Diet pattern in print order
|
|---|
| 23 | S LP=0
|
|---|
| 24 | L4 S LP=$O(^FH(111.1,MP,MEAL,LP)) Q:LP<1 S R1=$G(^(LP,0))
|
|---|
| 25 | S K1=$P($G(^FH(114.1,+R1,0)),"^",3)
|
|---|
| 26 | S K1=$S('K1:99,K1<10:"0"_K1,1:K1)
|
|---|
| 27 | S K1=K1_"~"_$E($P($G(^FH(114.1,+R1,0)),"^",1),1,15)
|
|---|
| 28 | S ^TMP($J,"FHMP",MP,MEAL,K1)=$P(R1,"^",2)_"^"_+R1
|
|---|
| 29 | G L4
|
|---|
| 30 | L5 ; Get Standing Orders associated with Diet pattern
|
|---|
| 31 | S LP=0
|
|---|
| 32 | L6 S LP=$O(^FH(111.1,MP,MEAL,LP)) Q:LP<1 S R1=$G(^(LP,0))
|
|---|
| 33 | S K1=99_LP,K1=K1_"~"_$E($P($G(^FH(118.3,+R1,0)),"^",1),1,30)
|
|---|
| 34 | S ^TMP($J,"FHMP",MP,$E(MEAL,1),K1)=$P(R1,"^",2)_"^"_+R1
|
|---|
| 35 | G L6
|
|---|
| 36 | PRT ; Print Diet Pattern
|
|---|
| 37 | S P0="" F S P0=$O(^TMP($J,"FHPD",P0)) Q:P0=""!(RES="^") S PD=+$G(^(P0)),M0="" F S M0=$O(^TMP($J,"FHO",PD,M0)) Q:M0="" S MP=+$G(^(M0)),SF=$P($G(^(M0)),"^",2) D P1,P2 Q:RES="^"
|
|---|
| 38 | Q
|
|---|
| 39 | P1 K MM S CTR=0 F MEAL="B","N","E" S N1=0,CTR=CTR+1 D
|
|---|
| 40 | .S NX="" F S NX=$O(^TMP($J,"FHMP",MP,MEAL,NX)) Q:NX="" S QTY=$G(^(NX)) D
|
|---|
| 41 | ..S QTY=$S(QTY="":1,1:+QTY),N1=N1+1
|
|---|
| 42 | ..S PAD=$E(" ",1,4-$L(QTY)),MM(N1,CTR)=PAD_QTY_" "_$E($P(NX,"~",2),1,21)
|
|---|
| 43 | ..;S MM(N1,CTR)=$S(QTY#1>0:$J(QTY,3,1),1:QTY_" ")_" "_$E($P(NX,"~",2),1,21)
|
|---|
| 44 | ..Q
|
|---|
| 45 | .S R1="" F S R1=$O(^TMP($J,"FHFP",MP,MEAL,R1)) Q:R1="" S N1=N1+1,MM(N1,CTR)=$J("",4)_$E($P(R1,"~",2),1,21)
|
|---|
| 46 | .Q
|
|---|
| 47 | Q
|
|---|
| 48 | P2 I $Y'<(IOSL-8) D HDR Q:RES="^"
|
|---|
| 49 | W !!,"Production Diet: ",$P(P0,"~",2),!,"Diet Order: ",M0
|
|---|
| 50 | W !,"Associated Supp. Fdgs. Menu: ",$E(SF,1,30),!
|
|---|
| 51 | W ! F N1=1:1 W ! Q:'$D(MM(N1))!(RES="^") F CTR=1:1:3 I $D(MM(N1,CTR)) D Q:RES="^"
|
|---|
| 52 | .I $Y'<(IOSL-6) D HDR Q:RES="^"
|
|---|
| 53 | .W ?$S(CTR=1:0,CTR=2:27,1:54),MM(N1,CTR) Q
|
|---|
| 54 | Q
|
|---|
| 55 | HDR D PAUSE Q:RES="^" W:'($E(IOST,1,2)'="C-"&'PG) @IOF
|
|---|
| 56 | S PG=PG+1 W !,DTP,?23,"D I E T P A T T E R N L I S T",?73,"Page ",PG
|
|---|
| 57 | W !,"-------------------------------------------------------------------------------",!
|
|---|
| 58 | W ! F CT=1:1:3 W ?$S(CT=1:8,CT=2:38,1:63),$S(CT=1:"BREAKFAST",CT=2:"NOON",1:"EVENING")
|
|---|
| 59 | W ! Q
|
|---|
| 60 | PAUSE ; Check to pause for reading
|
|---|
| 61 | I PG,IOST?1"C-".E R !!,"Press RETURN to continue or ""^"" to exit. ",RES:DTIME S:'$T!(RES["^") RES="^" Q:RES="^" I "^"'[RES W !,"Enter Return or ""^""." G PAUSE
|
|---|
| 62 | Q
|
|---|
