source: WorldVistAEHR/trunk/r/DIETETICS-FH/FHSP.m@ 1593

Last change on this file since 1593 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 9.6 KB
Line 
1FHSP ; HISC/REL/NCA - Standing Orders ;2/13/95 14:30
2 ;;5.5;DIETETICS;**5,8**;Jan 28, 2005;Build 28
3EN1 ; Enter/Edit Standing Orders
4 K DIC W ! S (DIC,DIE)="^FH(118.3,",DIC(0)="AEQLM",DIC("DR")=".01",DLAYGO=118.3 W ! D ^DIC K DIC,DLAYGO G KIL:U[X!$D(DTOUT),EN1:Y<1
5 S DA=+Y,DR=".01:99" S:$D(^XUSEC("FHMGR",DUZ)) DIDEL=118.3 D ^DIE K DA,DIE,DIDEL,DR G EN1
6EN2 ; List Standing Orders
7 W ! S L=0,DIC="^FH(118.3,",FLDS=".01,99,1",BY="NAME"
8 S FR="",TO="",DHD="STANDING ORDERS" D EN1^DIP
9 K %ZIS S IOP="" D ^%ZIS G KIL
10SO ;OutPT SO
11 S FHSOOP=$O(^FHPT(FHDFN,"OP","B",DT-1))
12 I '$D(^FHPT(FHDFN,"OP"))!'$G(FHSOOP) W !!,"** NO OUTPATIENT DATA ON FILE! Please enter outpatient meals from Recurring Meals Menu [FHOMRMGR]." Q
13 W @IOF,!,"Outpatient Recurring Meals... "
14A0 ;Rec Meal entry.
15 K FHDM14,FHEDI,FHEDIF,FHIEN,FHMIEN,FHFLG,FHCK
16 S FHQ=0
17 S (FHTOTML("B"),FHTOTML("N"),FHTOTML("E"),FHTOTML("A"))=0
18 F FHI=DT-1:0 S FHI=$O(^FHPT("RM",FHI)) Q:FHI'>0!FHQ F FHJ=0:0 S FHJ=$O(^FHPT("RM",FHI,FHDFN,FHJ)) Q:FHJ'>0!FHQ I ($P($G(^FHPT(FHDFN,"OP",FHJ,0)),U,15)'="C") D
19 .S FHDA15=$G(^FHPT(FHDFN,"OP",FHJ,0))
20 .S FHDM14(FHI,$P(FHDA15,U,4))=FHI_U_FHJ
21 .S FHMEAL=$P(FHDA15,U,4),FHLOC=$P(FHDA15,U,3),FHLOCN=$P($G(^FH(119.6,FHLOC,0)),U,1),FHMEAL=$S(FHMEAL="B":"Break",FHMEAL="N":"Noon",1:"Even"),FH11=FHMEAL_" "_FHLOCN
22 .S Y=$P(FHDA15,U,1) X ^DD("DD") S DTP=Y
23 .S (FHCOFLG,FHDATL)=0
24 .I $Y>(IOSL-5) K DIR S DIR(0)="E",DIR("A")="Enter RETURN to Continue or '^' to Quit Listing" D ^DIR W:Y @IOF I 'Y S FHQ=1 Q
25 .W !,DTP,?12,FH11,":"
26 .S FHDATL=$L(DTP)+13+$L(FH11)
27 .F FHSF=0:0 S FHSF=$O(^FHPT(FHDFN,"OP",FHJ,"SP",FHSF)) Q:FHSF'>0 D
28 ..S FHDA15SF=$G(^FHPT(FHDFN,"OP",FHJ,"SP",FHSF,0))
29 ..Q:$P(FHDA15SF,U,6)
30 ..S FHDASFNM=$P($G(^FH(118.3,$P(FHDA15SF,U,2),0)),U,1),FHDASFQT=$P(FHDA15SF,U,8)
31 ..I (FHDATL+$L(FHDASFNM)+3+$L(FHDASFQT))>79 W !,?19 S FHDATL=19
32 ..I (FHDATL>19),(FHCOFLG=1) W ","
33 ..S FHDATL=FHDATL+4+$L(FHDASFNM)+3+$L(FHDASFQT)
34 ..W " ",FHDASFNM," = ",FHDASFQT
35 ..S FHCOFLG=1
36 F FHI=0:0 S FHI=$O(FHDM14(FHI)) Q:FHI'>0 D
37 .F FHJ="B","N","E" Q:FHJ="" D
38 ..I (FHJ="B")&$D(FHDM14(FHI,FHJ)) S FHTOTML("B")=FHTOTML("B")+1,FHIEN(FHJ)=FHDM14(FHI,FHJ)
39 ..I (FHJ="N")&$D(FHDM14(FHI,FHJ)) S FHTOTML("N")=FHTOTML("N")+1,FHIEN(FHJ)=FHDM14(FHI,FHJ)
40 ..I (FHJ="E")&$D(FHDM14(FHI,FHJ)) S FHTOTML("E")=FHTOTML("E")+1,FHIEN(FHJ)=FHDM14(FHI,FHJ)
41 I '$D(FHDM14) W !!,"NO OUTPATIENT DATA ON FILE for today's date and the future!!",! Q
42 ;
43R1 S (FHCNSOF,FH1,FHQ)=0,(FHDTML,FHX,FHALML)="" R !!,"Enter a Meal (B,N,E or ALL): ALL// ",FHDTML:DTIME
44 Q:'$T!(FHDTML["^")
45 S:FHDTML="" FHDTML="ALL"
46 I FHDTML["?" S FHQ=1 G MS1
47 S X=FHDTML D TR^FH S (FHX,FHDTML)=X
48 I FHDTML="A" S FHQ=1 G MS1
49 S FHALML=FHX
50 I FHDTML="ALL" S FHDTML=$E(FHDTML,1),FHALML="BNE"
51 I $L(FHDTML)=3 S:("BNE")'[$E(FHDTML,1) FHQ=1 S:("BNE")'[$E(FHDTML,2) FHQ=1 S:("BNE")'[$E(FHDTML,3) FHQ=1 S FHCK($E(FHDTML,1))="",FHCK($E(FHDTML,2))="",FHCK($E(FHDTML,3))=""
52 I $L(FHDTML)=2 S:("BNE")'[$E(FHDTML,1) FHQ=1 S:("BNE")'[$E(FHDTML,2) FHQ=1 S FHCK($E(FHDTML,1))="",FHCK($E(FHDTML,2))=""
53 I $L(FHDTML)=1 S:("ABNE")'[$E(FHDTML,1) FHQ=1 S FHCK(FHDTML)=""
54 I FHDTML="A" S (FHCK("B"),FHCK("N"),FHCK("E"))=""
55 S:$L(FHDTML)>3 FHQ=1
56 G:FHQ MS1
57 I $L(FHDTML)=3 S:'$G(FHTOTML($E(FHDTML,1))) FH1=1 S:'$G(FHTOTML($E(FHDTML,2))) FH1=1 S:'$G(FHTOTML($E(FHDTML,3))) FH1=1 I FH1 W !!,"There is no outpatient data for this Meal!!" G R1
58 I $L(FHDTML)=2 S:'$G(FHTOTML($E(FHDTML,1))) FH1=1 S:'$G(FHTOTML($E(FHDTML,2))) FH1=1 I FH1 W !!,"There is no outpatient data for this Meal!!" G R1
59MS1 I FHQ W *7,!,"Select B for Breakfast, N for Noon, E for Evening or ALL for all meals",!,"Answer may be multiple meals, e.g., BN or NE" G R1
60 S:$L(FHDTML)>1 FHDTML="A"
61 S FHLIS=0
62 I (FHDTML'="A"),(FHTOTML(FHDTML)'>0) W !!,"There is no outpatient data for this Meal!!" G R1
63 I FHDTML'="A",(FHTOTML(FHDTML)=1) S FHEDI($P(FHIEN(FHDTML),U,2))="" G E0
64 I FHDTML="A" G ALL
65 I FHDTML'="A",(FHTOTML(FHDTML)>1) D CHK^FHSPED Q:'$G(FHFLG) ;quit dates are not entered for range.
66 I $G(FHFLG) F FHI=FHDT1-1:0 S FHI=$O(FHDM14(FHI)) Q:(FHI'>0)!(FHI>FHDT2) S:$D(FHDM14(FHI,FHDTML)) FHEDI($P(FHDM14(FHI,FHDTML),U,2))=""
67 G E0
68ALL S FHCT=0,(FHDT1,FHDT2,FHDTSV)=DT F FHI=DT-1:0 S FHI=$O(FHDM14(FHI)) S:'FHI FHDT2=FHDTSV Q:FHI'>0 S FHCT=FHCT+1,FHDTSV=FHI S:FHCT=1 FHDT1=FHI S FHJ="" F S FHJ=$O(FHDM14(FHI,FHJ)) Q:FHJ="" S FHEDI($P(FHDM14(FHI,FHJ),U,2))=""
69E0 S ADM=0
70E1 W ! S FHLOCN="",ADM=$O(FHEDI(ADM)) Q:'ADM S NO=1,MEAL=$P($G(^FHPT(FHDFN,"OP",ADM,0)),U,4),FHLOC=$P($G(^(0)),U,3)
71 I FHX'="ALL",FHX'[MEAL G E1
72 I $G(FHLOC) S FHLOCN=$P($G(^FH(119.6,FHLOC,0)),U,1)
73 D LIS G:'LN N1
74 K DIR W ! S DIR(0)="YA",DIR("A")="Edit a Standing Order? ",DIR("B")="YES" D ^DIR K DIR Q:$D(DIRUT)!$D(DIROUT) G N1:Y<1
75N0 R !!,"Edit which Order #? ",X:DTIME Q:'$T!("^"[X) I X'?1N.N!(X<1)!(X>LN) W *7," Enter # of Order to Edit" G N0
76 S SP=$P(LS,",",+X),SP=$P($G(^FHPT(FHDFN,"OP",ADM,"SP",+SP,0)),"^",2) I $D(P(+X,SP)) S LN=+X G N1A
77 W !!,"Standing Order ",$P($G(^FH(118.3,+SP,0)),"^",1)," added" S LN=LN+1,P(LN,SP)="" G N1A
78N1 K DIC W ! S DIC="^FH(118.3,",DIC("A")="Enter Standing Order: ",DIC(0)="AEQM"
79 D ^DIC K DIC,DLAYGO Q:"^"[X!$D(DTOUT) G SO:Y<1 S SP=+Y
80 W !!,"Standing Order ",$P($G(^FH(118.3,+SP,0)),"^",1)," added"
81 S LN=LN+1,P(LN,SP)=""
82N1A W !,"Standing Order: ",$P($G(^FH(118.3,+SP,0)),"^",1)_" // " R X:DTIME G KIL:'$T
83 I X="^" G E0
84 I X="@" D SO3 W " .. Done" G E0
85 I X'="" W *7,!,"Press Return to take Default or ""@"" to Delete" G N1A
86 S $P(P(LN,SP),"^",5)=SP
87N2 ;
88 S $P(P(LN,SP),"^",6)=MEAL
89N2A W !,"Quantity: ",$S($P(P(LN,SP),"^",4):$P(P(LN,SP),"^",4)_"// ",1:"1// ") R NUM:DTIME S:NUM="" NUM=$S($P(P(LN,SP),"^",4):$P(P(LN,SP),"^",4),1:1) G:'$T!(NUM="^") KIL
90 I NUM="@" S $P(P(LN,SP),"^",4)="" G N2A
91 I NUM'?1N!(NUM<1) W !,*7,"Enter a number from 1-9." G N2A
92 S $P(P(LN,SP),"^",7)=NUM
93 S C1=$P(P(LN,SP),"^",2,4),C2=$P(P(LN,SP),"^",5,7)
94 Q:C1=C2
95N3 W !!,"ADD this Order? Y// " R YN:DTIME G:'$T!(YN="^") KIL S:YN="" YN="Y" S X=YN D TR^FH S YN=X I $P("YES",YN,1)'="",$P("NO",YN,1)'="" W *7," Answer YES or NO" G N3
96 Q:YN?1"N".E
97 I C1'="^^" S OLD=$P(P(LN,SP),"^",1),$P(^FHPT(FHDFN,"OP",ADM,"SP",OLD,0),"^",6,7)=NOW_"^"_DUZ K ^FHPT("ASPO",FHDFN,ADM,OLD) D
98 .S DTP=$P($G(^FHPT(FHDFN,"OP",ADM,0)),U,1) D DTP^FH
99 .S FHACT="O",FHTXT="Outpatient Standing Order: "_NUM_" "_$P($G(^FH(118.3,SP,0)),U,1)_" ("_MEAL_"), "_FHLOCN_", "_DTP D OPFILE^FHORX Q
100 S $P(P(LN,SP),"^",2,4)="^^",$P(P(LN,SP),"^",2,4)=$P(P(LN,SP),"^",5,7),$P(P(LN,SP),"^",5,7)="^^"
101ADD ; Add SO
102 F FHI=0:0 S FHI=$O(FHEDI(FHI)) Q:FHI'>0 S ADM=FHI D AD1
103 D EVNT^FHSP1
104 G E0
105AD1 L +^FHPT(FHDFN,"OP",ADM,"SP",0)
106 S FHLOCN="" S:'$D(FHCNSOF) FHCNSOF=0
107 S MEAL=$P($G(^FHPT(FHDFN,"OP",ADM,0)),U,4) Q:'$D(FHCK(MEAL))
108 S FHLOC=$P($G(^(0)),U,3) I $G(FHLOC) S FHLOCN=$P($G(^FH(119.6,FHLOC,0)),U,1)
109 I '$D(^FHPT(FHDFN,"OP",ADM,"SP",0)) S ^FHPT(FHDFN,"OP",ADM,"SP",0)="^115.1626^^"
110 S X=^FHPT(FHDFN,"OP",ADM,"SP",0),NO=$P(X,"^",3)+1,^(0)=$P(X,"^",1,2)_"^"_NO_"^"_($P(X,"^",4)+1)
111 L -^FHPT(FHDFN,"OP",ADM,"SP",0) I $D(^FHPT(FHDFN,"OP",ADM,"SP",NO)) G AD1
112 S ^FHPT(FHDFN,"OP",ADM,"SP",NO,0)=NO_"^"_SP_"^"_MEAL_"^"_NOW_"^"_DUZ_"^^^"_NUM,^FHPT("ASPO",FHDFN,ADM,NO)="",LS=LS_NO_","
113 S $P(P(LN,SP),"^",1)=NO
114 S DTP=$P($G(^FHPT(FHDFN,"OP",ADM,0)),U,1) D DTP^FH S FHCNSOF=FHCNSOF+1 S:FHCNSOF=1 FHDTP=DTP
115 Q
116SO2 ; SO Inquiry
117 Q:'$G(ADM)
118 S ALL=1 D ^FHOMDPA G:'FHDFN KIL S NO=0 D LIS G SO2
119SO3 ; Cancel SO
120 S (FHLOCN,FHDTP)="" S:'$D(FHCNSOF) FHCNSOF=0
121 F FHI=0:0 S FHI=$O(FHEDI(FHI)) Q:FHI'>0 S ADM=FHI D
122 .S MEAL=$P($G(^FHPT(FHDFN,"OP",ADM,0)),U,4) Q:'$D(FHCK(MEAL))
123 .S FHLOCN=""
124 .S FHLOC=$P($G(^FHPT(FHDFN,"OP",ADM,0)),U,3) I $G(FHLOC) S FHLOCN=$P($G(^FH(119.6,FHLOC,0)),U,1)
125 .F FHJ=0:0 S FHJ=$O(^FHPT(FHDFN,"OP",ADM,"SP",FHJ)) Q:FHJ'>0 D
126 ..S SPD=$P($G(^FHPT(FHDFN,"OP",ADM,"SP",FHJ,0)),U,2)
127 ..S NO=""
128 ..I SP=SPD,$P($G(^FHPT(FHDFN,"OP",ADM,"SP",FHJ,0)),U,6)="" S NO=FHJ
129 ..Q:'NO
130 ..S $P(^FHPT(FHDFN,"OP",ADM,"SP",NO,0),"^",6,7)=NOW_"^"_DUZ
131 ..S X=^FHPT(FHDFN,"OP",ADM,"SP",NO,0),SP=$P(X,"^",2),MEAL=$P(X,"^",3),NUM=$P(X,"^",8)
132 ..K ^FHPT("ASPO",FHDFN,ADM,NO),P(LN,SP)
133 ..S DTP=$P($G(^FHPT(FHDFN,"OP",ADM,0)),U,1) D DTP^FH S FHDTP=DTP
134 S:'$D(FHDTP) FHDTP=DT
135 I $D(FHDT1) S DTP=FHDT1 D DTP^FH S FHDTP=DTP
136 I $D(FHDT2) S DTP=FHDT2 D DTP^FH S:FHDTP'=DTP FHDTP=FHDTP_" to "_DTP
137 S FHACT="C",FHTXT="Outpatient Standing Order: "_$P($G(^FH(118.3,SP,0)),U,1)_" ("_FHALML_"), "_FHLOCN_", Cancelled "_FHDTP D OPFILE^FHORX
138 Q
139LIS ;list outpt SO
140 Q:'$G(ADM)
141 D PATNAME^FHOMUTL
142 S FHDATA0=$G(^FHPT(FHDFN,"OP",ADM,0))
143 S DTP=$P(FHDATA0,U,1) D DTP^FH S FHDTST=DTP
144 S NAM=FHPTNM,Y="",(FHDIETP,FHDIET,WARD)=""
145 S FHDIET=$P(FHDATA0,U,2) I $D(^FH(119.6,$P(FHDATA0,U,3),0)) S WARD=$P(^FH(119.6,$P(FHDATA0,U,3),0),U,1)
146 I $G(FHDIET) S Y=$P(^FH(111,FHDIET,0),U,1)
147 I FHDIET="" S FHRNUM=ADM D DIETPAT^FHOMRR1 S:$D(FHDIETP) Y=FHDIETP
148 W !!,NAM," " W:WARD'="" "( ",WARD," )" W:$D(FHDTST) ?40,"Date: ",FHDTST
149 W !!,"Current Diet: ",$S(Y'="":Y,1:"No current order")
150 D ALG^FHCLN W !," Allergies: ",$S(ALG="":"None on file",1:ALG)
151 K N,P S CTR=0
152 F K=0:0 S K=$O(^FHPT("ASPO",FHDFN,ADM,K)) Q:K<1 S X=^FHPT(FHDFN,"OP",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)
153 S FHSOFG=1
154 S LN=0,LS="" I $O(N(""))="" W !!,"No Active Outpatient Standing Orders." Q
155 W !!,"Active Outpatient Standing Orders: ",!
156 F M="A","B","N","E" D
157 .F K=0:0 S K=$O(N(M,K)) Q:K<1 S Z=+N(M,K) I Z D
158 ..S LN=LN+1,LS=LS_K_"," D L1 W ! W:NO $J(LN,2)
159 ..S NUM=$P(N(M,K),"^",3)
160 ..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:"") I $G(^FH(118.3,Z,"I"))="Y" W " (** INACTIVE **)"
161 ..S P(LN,+Z)=K_"^"_$P(N(M,K),"^",1,3) Q
162 Q
163L1 ; Store SO
164 S M1=$P(N(M,K),"^",2) I M1="BNE" S M2="All Meals" Q
165 S L=$E(M1,1),M2=$S(L="B":"Break",L="N":"Noon",1:"Even")
166 S L=$E(M1,2) Q:L="" S M2=M2_","_$S(L="B":"Break",L="N":"Noon",1:"Even") Q
167 Q
168KIL G KILL^XUSCLEAN
Note: See TracBrowser for help on using the repository browser.