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
|
---|