1 | PSJLIVMD ;BIR/MV-SETUP LM TEMPLATE FOR INPT MED. IV ;4 Aug 00 / 4:29 PM
|
---|
2 | ;;5.0; INPATIENT MEDICATIONS ;**37,50,63,58,81,91,80,116,110,111,180,134**;16 DEC 97;Build 124
|
---|
3 | ;
|
---|
4 | ;Reference to ^PS(55 is supported by DBIA #2191.
|
---|
5 | ;
|
---|
6 | EN ; Build LM template to display IV order.
|
---|
7 | D GTOT^PSIVUTL(P(4))
|
---|
8 | S:'$D(PSJSTAR) PSJSTAR="" S:'$D(PSGP) PSGP=DFN
|
---|
9 | I $E(P("OT"))'="I" D EN^PSJLIVFD Q
|
---|
10 | K ^TMP("PSJI",$J)
|
---|
11 | S UL80="",$P(UL80,"=",80)=""
|
---|
12 | S PSJLN=1
|
---|
13 | I $G(PSIV531),P("PON")["P" S (P(2),P(3),P(4))=""
|
---|
14 | AD ;
|
---|
15 | NEW VALMEVL S VALMEVL=1
|
---|
16 | S PSJL="" D FLDNO^PSJLIUTL("(1)",1)
|
---|
17 | S PSJL=PSJL_" Additives:"
|
---|
18 | S:$G(P("PON"))["V"&(P(17)'="N") PSJL=$$SETSTR^VALM1("Order number:",PSJL,28,14)_+P("PON")
|
---|
19 | S PSJL=$$SETSTR^VALM1("Type:",PSJL,57,6)_$$TYPE^PSJLIUTL
|
---|
20 | NEW PSJVD S PSJVD=$$DINFLIV^PSJDIN(.DRG)
|
---|
21 | S PSJL=$$SETSTR^VALM1(PSJVD,PSJL,75,6)
|
---|
22 | I $D(IORVON),(PSJVD]"") D CNTRL^VALM10(1,76,5,IORVON,IORVOFF,0) K PSJVD
|
---|
23 | D SETTMP^PSJLMPRU("PSJI",PSJL)
|
---|
24 | D:+$G(PSJLMX) CLRDSPL
|
---|
25 | ;PSJLMX count number of lines needed to display the add/sol
|
---|
26 | S PSJLMX=0 D WRTDRG^PSJLIUTL("AD")
|
---|
27 | SOL ;
|
---|
28 | S PSJL="" D FLDNO^PSJLIUTL("(2)",1)
|
---|
29 | S PSJL=PSJL_" Solutions:"
|
---|
30 | I P("SYRS")]"" D
|
---|
31 | . S PSJL=$$SETSTR^VALM1("Syr. Size:",PSJL,52,11)_$E(P("SYRS"),1,13)
|
---|
32 | . S:$L(P("SYRS"))>13 PSJL=PSJL_"..."
|
---|
33 | D SETTMP^PSJLMPRU("PSJI",PSJL)
|
---|
34 | D WRTDRG^PSJLIUTL("SOL")
|
---|
35 | D DUR
|
---|
36 | START ;
|
---|
37 | NEW PSGRSD,PSGRSDN,PSGRFD,PSGRFDN
|
---|
38 | I $G(P("OT"))="I",$G(P(4))]"" D
|
---|
39 | .Q:$G(ON)["V" I $G(PSIVAC)="" N PSIVAC S PSIVAC="CF"
|
---|
40 | .Q:$G(P(3))
|
---|
41 | .D ENT^PSIVCAL,ENSTOP^PSIVCAL
|
---|
42 | D REQDT(ON)
|
---|
43 | D FLDNO^PSJLIUTL("(4)",47)
|
---|
44 | S PSJL=$$SETSTR^VALM1("Start:",PSJL,56,7)_$$STARTDT^PSJLIUTL
|
---|
45 | D SETTMP^PSJLMPRU("PSJI",PSJL)
|
---|
46 | INFRATE ;
|
---|
47 | S PSJL="" D FLDNO^PSJLIUTL("(3)",1)
|
---|
48 | S PSJL=$$SETSTR^VALM1("Infusion Rate:",PSJL,7,15)
|
---|
49 | D LONG^PSJLIUTL(P(8),22,23)
|
---|
50 | RSTART ;
|
---|
51 | I $G(ON)["P" N PSGNDT S PSGRNDT=$$LASTREN^PSJLMPRI(DFN,ON) D
|
---|
52 | . I PSGRNDT S PSGRNDT=$$ENDTC^PSGMI(+PSGRNDT),PSJL=$$SETSTR^VALM1("Renewed: "_PSGRNDT,PSJL,54,32) Q
|
---|
53 | . Q:'$G(PSGRDTX) N PSJRQB,PSJRQL,RSDLABL,PSGRSD,PSGRSDN
|
---|
54 | . S RSDLABL=" REQUESTED START: ",PSJRQB=41,PSJRQL=39,PSGRSD="",PSGRSDN=""
|
---|
55 | . I $G(PSGRDTX(+$G(PSJORD),"PSGRSD")),$G(P(2)) S PSJRQB=51,PSJRQL=29 D
|
---|
56 | .. S PSGRSD=PSGRDTX(+$G(PSJORD),"PSGRSD"),PSGRSDN=$$ENDTC^PSGMI(+PSGRSD),RSDLABL="Calc Start: "
|
---|
57 | . I '$G(P(2)),'$P(PSGRDTX,U,3) S PSGRSD=+PSGRDTX,PSGRSDN=$$ENDTC^PSGMI(PSGRSD)
|
---|
58 | . I $G(PSGRSD),($G(PSGRSDN)]"") D DSPLYDT(PSJLMX+5,.PSGRSD,.PSGRSDN,RSDLABL,1,PSJRQB,PSJRQL) ;,SETTMP^PSJLMPRU("PSJI",PSJL)
|
---|
59 | I $G(ON)["V" N PSGRNDT S PSGRNDT=$$LASTREN^PSJLMPRI(DFN,ON) I PSGRNDT S PSGRNDT=$$ENDTC^PSGMI(+PSGRNDT),PSJL=$$SETSTR^VALM1("Renewed: "_PSGRNDT,PSJL,54,32)
|
---|
60 | I PSJL]"" D SETTMP^PSJLMPRU("PSJI",PSJL)
|
---|
61 | ;
|
---|
62 | MR ;
|
---|
63 | S PSJL="" D FLDNO^PSJLIUTL("(5)",1)
|
---|
64 | S PSJL=$$SETSTR^VALM1("Med Route:",PSJL,11,11)
|
---|
65 | S PSJL=PSJL_$P(P("MR"),U,2)
|
---|
66 | STOP ;
|
---|
67 | S:'$D(PSGP) PSGP=DFN
|
---|
68 | D FLDNO^PSJLIUTL("(6)",47)
|
---|
69 | ;PSJ*5*180 - If CPRS sends invalid duration/limit - Cannot Calculate Stop Date.
|
---|
70 | S PSJL=$$SETSTR^VALM1("Stop:",PSJL,57,6)_$S($G(PSJBADD)=1:"CANNOT CALCULATE",1:$$STOPDT^PSJLIUTL)
|
---|
71 | D SETTMP^PSJLMPRU("PSJI",PSJL)
|
---|
72 | S PSJL=""
|
---|
73 | N PSJBCMA S PSJBCMA=$$BCMALG^PSJUTL2(PSGP,PSJORD)
|
---|
74 | I $G(PSJBCMA)]"",$G(DFN) S PSJL=$$SETSTR^VALM1(PSJBCMA,PSJL,1,52)
|
---|
75 | I $G(PSJORD)["P",$G(PSGRDTX(+$G(PSJORD),"PSGRFD")),$G(P(3)) S PSGRFDN=$$ENDTC^PSGMI(PSGRDTX(+PSJORD,"PSGRFD")) D
|
---|
76 | . D DSPLYDT(PSJLMX+7,.PSGRFD,.PSGRFDN," Calc Stop: ",1,51,29)
|
---|
77 | I ($G(PSJBCMA)]"")!($G(PSGRDTX(+$G(PSJORD),"PSGRFD"))&$G(P(3))) D SETTMP^PSJLMPRU("PSJI",PSJL)
|
---|
78 | SCH ;
|
---|
79 | S PSJL="" D FLDNO^PSJLIUTL("(7)",1)
|
---|
80 | S PSJL=$$SETSTR^VALM1("Schedule:",PSJL,12,11)
|
---|
81 | D LONG^PSJLIUTL(P(9)_$S(P(7):"@0 labels a day",1:"")_$G(SCHMSG),22,31)
|
---|
82 | LASTFL ;
|
---|
83 | S PSJL=$$SETSTR^VALM1("Last Fill:",PSJL,52,11)
|
---|
84 | S PSJL=PSJL_$$ENDTC^PSGMI(P("LF"))
|
---|
85 | D SETTMP^PSJLMPRU("PSJI",PSJL)
|
---|
86 | ADM ;
|
---|
87 | S PSJL="" D FLDNO^PSJLIUTL("(8)",1)
|
---|
88 | S PSJL=$$SETSTR^VALM1("Admin Times:",PSJL,9,14)
|
---|
89 | NEW NOECH
|
---|
90 | D LONG^PSJLIUTL(P(11),22,29)
|
---|
91 | QTY ;
|
---|
92 | S PSJL=$$SETSTR^VALM1("Quantity:",PSJL,53,10)_+P("LFA")
|
---|
93 | D SETTMP^PSJLMPRU("PSJI",PSJL)
|
---|
94 | PROVIDER ;
|
---|
95 | S PSJL="" D FLDNO^PSJLIUTL("(9)",1)
|
---|
96 | S PSJL=$$SETSTR^VALM1("Provider:",PSJL,12,10)_$$PROVIDER^PSJLIUTL
|
---|
97 | CUMDOSES ;
|
---|
98 | S PSJL=$$SETSTR^VALM1("Cum. Doses:",PSJL,51,12)_P("CUM")
|
---|
99 | D SETTMP^PSJLMPRU("PSJI",PSJL)
|
---|
100 | OI ;
|
---|
101 | S PSJL="" D FLDNO^PSJLIUTL("(10)",1)
|
---|
102 | S PSJL=$$SETSTR^VALM1("Orderable Item:",PSJL,6,16)_$P(P("PD"),U,2)_$$OINF^PSJDIN(+P("PD"))
|
---|
103 | D SETTMP^PSJLMPRU("PSJI",PSJL)
|
---|
104 | INS ;
|
---|
105 | S PSJL=""
|
---|
106 | S PSJL=$$SETSTR^VALM1("Instructions:",PSJL,8,14)
|
---|
107 | D LONG^PSJLIUTL(P("INS"),22,58)
|
---|
108 | D SETTMP^PSJLMPRU("PSJI",PSJL)
|
---|
109 | OPI ;
|
---|
110 | S PSJL="" D FLDNO^PSJLIUTL("(11)",1)
|
---|
111 | S PSJL=$$SETSTR^VALM1("Other Print"_$S($P(P("OPI"),"^",2)=1:"!: ",1:": "),PSJL,9,13)_$P(P("OPI"),"^")
|
---|
112 | D SETTMP^PSJLMPRU("PSJI",PSJL)
|
---|
113 | PC ;
|
---|
114 | S PSJL=""
|
---|
115 | S PSJL=$$SETSTR^VALM1("Provider Comments:",PSJL,3,18) D WTPC^PSJLIUTL
|
---|
116 | REMARK ;
|
---|
117 | D SETTMP^PSJLMPRU("PSJI","")
|
---|
118 | S PSJL="" D FLDNO^PSJLIUTL("(12)",1)
|
---|
119 | S PSJL=$$SETSTR^VALM1("Remarks :",PSJL,8,10)
|
---|
120 | D LONG^PSJLIUTL(P("REM"),18,62)
|
---|
121 | D SETTMP^PSJLMPRU("PSJI",PSJL)
|
---|
122 | IVROOM ;
|
---|
123 | S PSJL=""
|
---|
124 | S PSJL=$$SETSTR^VALM1("IV Room:",PSJL,9,9)_$P(P("IVRM"),U,2)
|
---|
125 | D SETTMP^PSJLMPRU("PSJI",PSJL)
|
---|
126 | ENTRY ;
|
---|
127 | S PSJL="",PSJL=$$SETSTR^VALM1("Entry By:",PSJL,8,10)
|
---|
128 | S PSJL=PSJL_$S($P(P("CLRK"),U,2)]"":$E($P(P("CLRK"),U,2),1,24),1:"*** Undefined")
|
---|
129 | S PSJL=$$SETSTR^VALM1("Entry Date:",PSJL,51,12)_$$ENDTC^PSGMI(P("LOG"))
|
---|
130 | D SETTMP^PSJLMPRU("PSJI",PSJL)
|
---|
131 | S PSJL="" S PSGLRN=$$LASTRNBY^PSJLMPRI(DFN,$S($G(PSJORD):PSJORD,1:$G(ON))) I PSGLRN D
|
---|
132 | . S PSJL=$$SETSTR^VALM1("Renewed By: ",PSJL,6,12)_$$ENNPN^PSGMI(PSGLRN) D SETTMP^PSJLMPRU("PSJI",PSJL) K PSGLRN
|
---|
133 | S VALM("TITLE")=$$CODES^PSIVUTL(P(17),$S($G(ON)["P":53.1,1:55.01),$S($G(ON)["P":28,1:100))_" IV "
|
---|
134 | I $G(P("PRY"))="D"!($G(P("PON"))["P") S VALM("TITLE")=VALM("TITLE")_$S($G(P("PRY"))="":"",1:"("_$$CODES^PSIVUTL(P("PRY"),53.1,.24)_")")
|
---|
135 | I $G(P("PON"))["P" D ORDCHK^PSJLIVFD
|
---|
136 | S VALMCNT=PSJLN-1,^TMP("PSJI",$J,0)=VALMCNT
|
---|
137 | Q
|
---|
138 | DSPLYDT(PSJLN,PSGRDT,PSGRDTN,TXT,PSJFSH,PSJRDBEG,PSJRDLEN) ;
|
---|
139 | ;LINE : Line number the Requested Start and Stop dates are display in
|
---|
140 | ;PSGRDT : Either it is the requested start or stop date in FM format
|
---|
141 | ;PSGRDTN: Either it is the requested start or stop date in IPM format
|
---|
142 | ;TXT : The display text
|
---|
143 | ;PSJFSH : if it is 1 then flash
|
---|
144 | ;
|
---|
145 | S:'$G(PSJRDBEG) PSJRDBEG=41,PSJRDLEN=39
|
---|
146 | S PSJL=$$SETSTR^VALM1(TXT_PSGRDTN,PSJL,PSJRDBEG,PSJRDLEN)
|
---|
147 | Q
|
---|
148 | CLRDSPL ;
|
---|
149 | ;Clear the blinking after edit the pending order.
|
---|
150 | ;Without it more than the requested start and stop dates are blinking at the ac/edit screen
|
---|
151 | ;PSJLMX: # ad/sol counted in WRTDRG^PSJLIUTL
|
---|
152 | Q:'$D(IOBOFF)
|
---|
153 | NEW PSJX
|
---|
154 | F PSJX=5:1:PSJLMX+7 D CNTRL^VALM10(PSJX,36,80,IOBOFF,IOINORM)
|
---|
155 | Q
|
---|
156 | REQDT(ORDER) ;Get requested date if it is a pending order
|
---|
157 | ;ORDER : Pending Order Number (PSJORD or PSGORD)
|
---|
158 | Q:ORDER'["P" D REQDT^PSJLIUTL(ORDER)
|
---|
159 | Q
|
---|
160 | ;
|
---|
161 | GETDUR(PAT,ORD,PKG,RAW) ;
|
---|
162 | ; PAT= Patient DFN
|
---|
163 | ; ORD= Order #
|
---|
164 | ; PKG= 5(UD), "IV"(IV), "P"(Pending)
|
---|
165 | N ACT,DUR,ND,ND25,F25,ND0,ND2,OLDORD S DUR="",ORD=+ORD K IVLIMIT
|
---|
166 | S:PKG="V" PKG="IV"
|
---|
167 | I PKG="P" S ND=$G(^PS(53.1,+ORD,0)) D I '$G(OLDORD) Q DUR
|
---|
168 | . I $G(P("OVRIDE")) S DUR="" Q
|
---|
169 | . D PENDING(ORD) Q:DUR]""
|
---|
170 | . S ND0=$G(^PS(53.1,ORD,0)) I $P(ND0,U,24)="E" S OLDORD=$P(ND0,U,25) I OLDORD S PKG=$S(OLDORD["V":"IV",OLDORD["U":5,OLDORD["P":"P",1:"")
|
---|
171 | . Q:($G(OLDORD)'["P")
|
---|
172 | . D PENDING(OLDORD) S OLDORD=""
|
---|
173 | I PKG="IV" S ND2=$G(^PS(55,PAT,PKG,ORD,2)) I $P(ND2,U,8)="E" S OLDORD=$P(ND2,U,5) S:OLDORD'["V" OLDORD="" I OLDORD D
|
---|
174 | .N ACTND S ACTND=0 F S ACTND=$O(^PS(55,PAT,"IV",ORD,"A",ACTND)) Q:'ACTND D
|
---|
175 | ..I $G(^PS(55,PAT,"IV",ORD,"A",ACTND,0))["IV LIMIT OVERRIDDEN" S OLDORD=""
|
---|
176 | I $G(P("LIMIT"))]"" S DUR=P("LIMIT"),IVLIMIT=1 I '$G(RAW) S DUR=$$FMTDUR(DUR) Q DUR
|
---|
177 | I PKG=5 S ND0=$G(^PS(55,PAT,PKG,ORD,0)) I $P(ND0,U,24)="E" S OLDORD=$P(ND0,U,25) S:OLDORD'["U" OLDORD=""
|
---|
178 | S F25="^PS(55,PAT,PKG,ORD,2.5)" I '$G(OLDORD) Q:'$D(@(F25)) DUR
|
---|
179 | S ND25=$G(@(F25)) S DUR=$P(ND25,U,2) I DUR="" S DUR=$P(ND25,U,4) I DUR]"" S IVLIMIT=1
|
---|
180 | I DUR="",$G(OLDORD) S ORD=+OLDORD Q:'$D(@(F25)) DUR D
|
---|
181 | . S ND25=$G(@(F25)) S DUR=$P(ND25,U,2) I DUR="" S DUR=$P(ND25,U,4) I DUR]"" S IVLIMIT=1
|
---|
182 | I '$G(RAW),DUR]"" S DUR=$$FMTDUR(DUR)
|
---|
183 | Q DUR
|
---|
184 | ;
|
---|
185 | PENDING(PNDON) ;
|
---|
186 | S ND=$G(^PS(53.1,+ORD,0))
|
---|
187 | I ND S ND25=$S(($P(ND,U,15)=PAT):$G(^PS(53.1,+ORD,2.5)),1:"")
|
---|
188 | S DUR=$P(ND25,U,4) I DUR]"" D Q
|
---|
189 | .S:($E(DUR)="s")!($E(DUR)="m")!($E(DUR)="l")!($E(DUR)="d")!($E(DUR)="h")!($E(DUR)="a") IVLIMIT=1 S DUR=$S($G(RAW):DUR,1:$$FMTDUR(DUR))
|
---|
190 | S DUR=$P(ND25,U,2) I DUR]"" S DUR=$S($G(RAW):DUR,1:$$FMTDUR(DUR))
|
---|
191 | Q
|
---|
192 | ;
|
---|
193 | FMTDUR(DURCODE) ;
|
---|
194 | N DUNIT,DNUM,BAD S BAD=0
|
---|
195 | ;PSJ*5*180 - Add PSJBADD variable
|
---|
196 | K PSJBADD S PSJBADD=0
|
---|
197 | S DUNIT=$E(DURCODE),DNUM=$P(DURCODE,DUNIT,2) I 'DNUM S BAD=1
|
---|
198 | I DUNIT'="",DUNIT'?1(1U,1L) S PSJBADD=1
|
---|
199 | S DUNIT=$S(DUNIT="D"!(DUNIT="d"):" day",DUNIT="H"!(DUNIT="h"):" hour",DUNIT="W":" week",DUNIT="L":" month",DUNIT="M":" minute",DUNIT="S":" second",DUNIT="m":" ml",DUNIT="l":" liter",DUNIT="a":" dose",1:"")
|
---|
200 | S:DUNIT="" BAD=1 I (DNUM'=1),(DUNIT'["ml") S DUNIT=DUNIT_"s"
|
---|
201 | I PSJBADD=1 S PSGACT=$TR($G(PSGACT),"F")
|
---|
202 | Q $S(PSJBADD=1:"*INVALID DURATION/LIMIT*",BAD:"",1:DNUM_DUNIT)
|
---|
203 | ;
|
---|
204 | DURMIN(DCOD) ;
|
---|
205 | N DUR,DMIN,CHR S DUR="" F I=1:1:$L(DCOD) S CHR=$E(DCOD,I) I CHR?1N S DUR=DUR_CHR
|
---|
206 | S DMIN=DUR*$S(DCOD["L":43200,DCOD["W":10080,DCOD["M":1,DCOD["S":(1/60),DCOD["D":1440,1:0) S DMIN=+$FN(DMIN,"",1)
|
---|
207 | Q DMIN
|
---|
208 | ;
|
---|
209 | DUR ;
|
---|
210 | N DUROUT,LABEL,IVLIMIT
|
---|
211 | Q:'$G(PSJORD) S PSJL=""
|
---|
212 | S DUROUT=$$GETDUR^PSJLIVMD(PSGP,+PSJORD,$S(PSJORD["P":"P",1:"IV"))
|
---|
213 | S LABEL=$S($G(IVLIMIT):"IV Limit: ",1:"Duration: ") K IVLIMIT
|
---|
214 | S PSJL=$$SETSTR^VALM1(LABEL,PSJL,12,10)
|
---|
215 | S PSJL=PSJL_DUROUT
|
---|
216 | Q
|
---|