source: FOIAVistA/trunk/r/INPATIENT_MEDICATIONS-PSJ-PSIV-PSG--PSGW/PSJHL4.m@ 1742

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

initial load of FOIAVistA 6/30/08 version
File size: 9.2 KB
Line 
1PSJHL4 ;BIR/RLW-DECODE HL7 /MESSSAGE FROM OE/RR ;16 Mar 99 / 4:55 PM
2 ;;5.0; INPATIENT MEDICATIONS ;**1,12,27,34,40,42,55,47,50,56,58,98,85,105,107,110,111,154**;16 DEC 97
3 ;
4 ; Reference to $$EN^PSOHLNEW is supported by DBIA# 2188.
5 ; Reference to ^PS(50.7 is supported by DBIA# 2180.
6 ; Reference to ^PS(51.2 is supported by DBIA# 2178.
7 ; Reference to ^PS(55 is supported by DBIA# 2191.
8 ; Reference to ^PS(59.7 supported by DBIA #2181.
9 ;
10EN(PSJMSG) ; start here
11 K ^TMP("PSJNVO",$J)
12 N ADCNT,SOLCNT,OCCNT
13 N ACKDATE,ADDITIVE,ADMINSTR,APPL,COMMENT,PSJHLDFN,DISPENSE,DOSE,DURATION,II,INSTR,J,JJ,JJJ,K,LOGIN,NEWORDER,NURSEACK,OBXFL,OCNARR,OCPROV,OCRSN,ORDER,PRIORITY,PSITEM,ORDCON,PROCOM,PSJORDER,PSREASON
14 N LOC,PROVIDER,PSPR,PSOC,PTR,QQ,REQST,ROUTE,RXON,RXORDER,SCHEDULE,SEGMENT,SOLUTION,STPDT,STRENGTH,TEXT,CLERK,INFRT,IVTYP,SCHTYP,PREON,NOO,ROC,FREQ,CLASS,PSJHLMTN,UNIT,UNITS,QFLG,VOLUME,TVOLUME,PSGP
15 N PSJASTP,FLDATE,FLCMNT,PSJFLAG,PSJYN,PRNTON,APPT,IVLIMIT
16 S (ADCNT,SOLCNT,OCCNT,II,TVOLUME)="",(OBXFL,QFLG)=0,PSJHLMTN="ORR" F S II=$O(PSJMSG(II)) Q:'II D DECODE Q:QFLG D @FIELD(0) Q:$G(CLASS)="O" Q:QFLG
17 I ($G(CLASS)'="I")!(QFLG) G END
18 I ($G(PSOC)="NW")!($G(PSOC)="XO") N DIK,DA S DIK="^PS(53.1,",DA=NEWORDER D EN1^DIK L -^PS(53.1,NEWORDER)
19 I ($G(PSOC)="NW")!($G(PSOC)="XO") D EN1^PSJHL2(PSJHLDFN,$S(PSOC="NW":"OK",1:"XR"),NEWORDER_"P")
20END ;
21 K ^TMP("PSJNVO",$J)
22 I (",S,A,")[(","_$G(PRIORITY)_",")!($G(SCHEDULE)="NOW")!($G(SCHEDULE)["STAT") D
23 . I $G(PRIORITY)="ZD",$G(PSGORD) D NOTIFY(PSGORD_$S(PSGORD["V":"V",PSGORD["U":"U",1:""),PSJHLDFN,$G(PRIORITY),$G(SCHEDULE))
24 . I $G(NEWORDER) D NOTIFY(NEWORDER_"P",PSJHLDFN,$G(PRIORITY),$G(SCHEDULE))
25 Q
26 ;
27DECODE ;break segment down into fields
28 K FIELD
29 S SEGMENT=$G(PSJMSG(II))
30 S J=0
31 F Q:$G(SEGMENT)="" D
32 .;get fields from segment
33 .I SEGMENT["|" S FIELD(J)=$P(SEGMENT,"|"),SEGMENT=$E(SEGMENT,$L(FIELD(J))+2,$L(SEGMENT)),J=J+1 Q
34 .I SEGMENT'["|" S FIELD(J)=SEGMENT,SEGMENT="" Q
35 Q
36 ;
37NOTIFY(ORDER,PSJHLDFN,PRIO,PSJSCHED) ;
38 N NTFYREAS,WARD,MGROUP,NTFSTAT,DRUG,DRIEN,PNAME,ORDATE,DO,PSG,XMY,VADPT,LASTFOUR,PSJSOK
39 Q:($G(PRIO)=""&($G(PSJSCHED)=""))
40 S DFN=PSJHLDFN D DEM^VADPT S LASTFOUR=$P($P(VADM(2),"^",2),"-",3)
41 S NTFYREAS=$S((",S,A,")[(","_PRIO_","):1,($G(PSJSCHED)="NOW"):2,($G(PSJSCHED)="STAT"):3,1:0) Q:'NTFYREAS
42 S PSJSOK=1
43 I ORDER["P" D PND
44 I ORDER["U" D UD
45 I ORDER["V" D IV
46 Q:PSJSOK=1
47 S PNAME=$P($G(^DPT(+PSJHLDFN,0)),"^") S:$G(RTE) RTE=$P(^PS(51.2,+RTE,0),"^",3)
48 S DRUG=$S(DRIEN:$P($G(^PS(50.7,+DRIEN,0)),"^"),1:""),WARD=$G(^DPT(PSJHLDFN,.1))
49 S XMDUZ="MEDICATIONS,INPATIENT",XMSUB=$G(WARD)
50 S XMSUB=XMSUB_"-"_NTFSTAT_" "_$S($G(PRIO)="A":"ASAP",$G(PRIO)="S":"STAT",$G(NTFYREAS)=2:"NOW",$G(NTFYREAS)=3:"STAT",1:"")_"-"
51 S XMSUB=XMSUB_$E(PNAME,1,65-$L(XMSUB))
52 S XMTEXT="PSG("
53 S PSG(1,0)="Inpatient Medications has received the following "_$S($G(PRIO)="A":"ASAP",$G(PRIO)="S":"STAT",$G(NTFYREAS)=2:"NOW",1:"")_" order ("_NTFSTAT_")"
54 S PSG(2,0)=""
55 S PSG(3,0)=" Patient: "_PNAME I $G(LASTFOUR) S PSG(3,0)=PSG(3,0)_" ("_LASTFOUR_")"
56 S PSG(4,0)="Order Information: "_DRUG_" "_DO_" "_RTE_" "_$G(PSJSCHED)
57 S PSG(5,0)=" Order Date: "_$$ENDTC^PSGMI(ORDATE)
58 D ^XMD
59 Q
60 ;
61PND ;
62 N WARD,WDPARM,MGRP
63 Q:'$D(^PS(53.1,+ORDER,0))
64 S WARD=$G(^DPT(PSJHLDFN,.1)) I WARD]"" D
65 .N DIC,X,Y S DIC="^DIC(42,",DIC(0)="BOXZ",X=WARD D ^DIC S WARD=+Y Q:WARD=0
66 .S WARD=$O(^PS(59.6,"B",WARD,0)) Q:+WARD=0
67 .Q:$$SNDTSTW^PSJHL4A(PRIO,PSJSCHED,WARD)
68 .S WDPARM=$G(^PS(59.6,+WARD,0)),MGRP=$P(WDPARM,"^",30) Q:+MGRP=0
69 .S MGRP=$$GET1^DIQ(3.8,MGRP,.01) I MGRP]"" S XMY("G."_MGRP_"@"_$G(^XMB("NETNAME")))="",PSJSOK=0
70 S:'$$SNDTSTP^PSJHL4A(PRIO,PSJSCHED) MGROUP="G.PSJ STAT NOW PENDING ORDER@"_$G(^XMB("NETNAME")),XMY(MGROUP)="",PSJSOK=0
71 S NTFSTAT="PENDING"
72 N NDP2,ND0 S NDP2=$G(^PS(53.1,+ORDER,.2)),ND0=$G(^PS(53.1,+ORDER,0))
73 S DRIEN=+$P(NDP2,"^"),DO=$P(NDP2,"^",2),RTE=$P(ND0,"^",3),ORDATE=$P(ND0,"^",14)
74 S SCHED=$P($G(^PS(53.1,+ORDER,2)),"^")
75 Q
76 ;
77UD ;
78 N WARD,WDPARM,MGRP
79 Q:'$D(^PS(55,PSJHLDFN,5,+ORDER,0))
80 S WARD=$P($G(^PS(55,PSJHLDFN,5,+ORDER,0)),"^",23) I +WARD D
81 .S WARD=$O(^PS(59.6,"B",WARD,0)) Q:+WARD=0
82 .Q:$$SNDTSTW^PSJHL4A(PRIO,PSJSCHED,WARD)
83 .S WDPARM=$G(^PS(59.6,+WARD,0)),MGRP=$P(WDPARM,"^",30) Q:+MGRP=0
84 .S MGRP=$$GET1^DIQ(3.8,MGRP,.01) I MGRP]"" S XMY("G."_MGRP_"@"_$G(^XMB("NETNAME")))="",PSJSOK=0
85 S:'$$SNDTSTA^PSJHL4A(PRIO,PSJSCHED) MGROUP="G.PSJ STAT NOW ACTIVE ORDER@"_$G(^XMB("NETNAME")),XMY(MGROUP)="",PSJSOK=0
86 S NTFSTAT="ACTIVE"
87 N ND2,ND0 S ND0=$G(^PS(55,PSJHLDFN,5,+ORDER,0)),ND2=$G(^PS(55,PSJHLDFN,5,+ORDER,2)),NDP2=$G(^PS(55,PSJHLDFN,5,+ORDER,.2))
88 S DRIEN=+$P(NDP2,"^"),DO=$P(NDP2,"^",2),RTE=$P(ND0,"^",3),ORDATE=$P(ND0,"^",14)
89 S SCHED=$P(ND2,"^")
90 Q
91 ;
92IV ;
93 N WARD,WDPARM,MGRP
94 Q:'$D(^PS(55,PSJHLDFN,"IV",+ORDER,0))
95 S WARD=$P($G(^PS(55,PSJHLDFN,"IV",+ORDER,0)),"^",22) I +WARD D
96 .S WARD=$O(^PS(59.6,"B",WARD,0)) Q:+WARD=0
97 .Q:$$SNDTSTW^PSJHL4A(PRIO,PSJSCHED,WARD)
98 .S WDPARM=$G(^PS(59.6,+WARD,0)),MGRP=$P(WDPARM,"^",30) Q:+MGRP=0
99 .S MGRP=$$GET1^DIQ(3.8,MGRP,.01) I MGRP]"" S XMY("G."_MGRP_"@"_$G(^XMB("NETNAME")))="",PSJSOK=0
100 S:'$$SNDTSTA^PSJHL4A(PRIO,PSJSCHED) MGROUP="G.PSJ STAT NOW ACTIVE ORDER@"_$G(^XMB("NETNAME")),XMY(MGROUP)="",PSJSOK=0
101 S NTFSTAT="ACTIVE"
102 N ND2,NDP2,ND0 S ND0=$G(^PS(55,PSJHLDFN,"IV",+ORDER,0)),ND2=$G(^PS(55,PSJHLDFN,"IV",+ORDER,2))
103 S NDP2=$G(^PS(55,PSJHLDFN,"IV",+ORDER,.2))
104 S DRIEN=$P(NDP2,"^"),DO=$P(NDP2,"^",2),RTE=$P(NDP2,"^",3)
105 S ORDATE=$P(ND2,"^"),SCHED=$P(ND0,"^",9)
106 Q
107 ;
108MSH ;
109 S PSOC=FIELD(8)
110 Q
111 ;
112PID ;
113 S PSJHLDFN=FIELD(3)
114 Q
115 ;
116PV1 ;
117 N A
118 S CLASS=FIELD(2),LOC=$P(FIELD(3),"^"),APPT="" I $G(FIELD(44))]"" S APPT=+$$HL7TFM^XLFDT(FIELD(44))
119 I "IO"'[CLASS S PSREASON="Invalid patient class" Q
120 ;N II K PSJNVA S II="" F S II=$O(PSJMSG(II)) Q:'II D Q:CLASS="O"
121 N QQ K PSJNVA S QQ=II F S QQ=$O(PSJMSG(QQ)) Q:'QQ D Q:$G(PSJNVA)
122 .S X=$G(PSJMSG(QQ))
123 .I $P(X,"|")="ZRN" S PSJNVA=1,CLASS="O" D EN^PSOHLNEW(.PSJMSG)
124 .;I $P(X,"|")="ZRN" S PSJNVA=1 D EN^PSOHLNEW(.PSJMSG)
125 ; OBR check - enable outpatient flagging from backdoor
126 I $G(PSJNVA) K PSJNVA Q
127 I CLASS="O" N QQ S QQ=II F S QQ=$O(PSJMSG(QQ)) Q:'QQ I $P(PSJMSG(QQ),"|")="OBR" D Q:$P(PSJMSG(QQ),"|")="OBR"
128 .S RXON=$P(PSJMSG(QQ),"|",4) I RXON]"" S RXON=$P(RXON,"^") I "ABNPUV"[$E(RXON,$L(RXON)) S CLASS="I"
129 I CLASS="O" N QQ S QQ=II F S QQ=$O(PSJMSG(QQ)) Q:'QQ I $P(PSJMSG(QQ),"|")="ORC" D Q:$P(PSJMSG(QQ),"|")="ORC"
130 .S RXON=$P(PSJMSG(QQ),"|",4) I RXON]"" S RXON=$P(RXON,"^") I "ABNPUV"[$E(RXON,$L(RXON)) S CLASS="I"
131 I CLASS="O" N CHK,QQ S QQ=II F S QQ=$O(PSJMSG(QQ)) Q:'QQ I $P(PSJMSG(QQ),"|")="RXO" D Q:$P(PSJMSG(QQ),"|")="RXO"
132 .S CHK=$P(PSJMSG(QQ),"|",2),CHK=$S($P(CHK,"^",5)="IV":"IV",1:$P(CHK,"^",4))
133 .I CHK="IV" S CLASS="I" Q
134 .I 'CHK S PSREASON="Missing or Invalid Orderable Item",CLASS="I" Q
135 .I $P($G(^PS(50.7,CHK,0)),"^",3)=1 S CLASS="I" Q
136 D:CLASS="O" EN^PSOHLNEW(.PSJMSG)
137 Q
138 ;
139ORC ;
140 S PSOC=FIELD(1)
141 S ORDER=FIELD(2)
142 I $G(PSREASON)]"" D ERROR^PSJHL9 Q
143 S PSJORDER=$P(FIELD(2),"^"),RXON=$P(FIELD(3),"^"),RXORDER=$S((RXON["N")!(RXON["P"):"^PS(53.1,"_+RXON_",",RXON["V":"^PS(55,"_PSJHLDFN_",""IV"","_+RXON_",",1:"^PS(55,"_PSJHLDFN_",5,"_+RXON_",")
144 I PSOC="NA" D ASSIGN^PSJHL5 Q
145 S CLERK=+$G(FIELD(10))
146 S PROVIDER=+$G(FIELD(12)) D:PSOC="NW"
147 .I PROVIDER=0 S PSREASON="Invalid Provider" D ERROR^PSJHL9 Q
148 .I PROVIDER>0 S PSPR=$G(^VA(200,+PROVIDER,"PS")) I '$D(PSPR)!'(PSPR)!$S($P(PSPR,"^",4)="":0,1:$P(PSPR,"^",4)'>DT) S PSREASON="Invalid Provider" D ERROR^PSJHL9 Q
149 S UNITS=$P(FIELD(7),"^"),INSTR=$P(FIELD(7),"^",8)
150 S:UNITS["&" DOSE=$P(UNITS,"&"),UNIT=$P(UNITS,"&",2),UNITS=$P(UNITS,"&",3)
151 S SCHEDULE=$P(FIELD(7),"^",2),PRIORITY=$P(FIELD(7),"^",6) S:SCHEDULE["PRN" SCHTYP="P"
152 S DURATION=$P(FIELD(7),"^",3),REQST=$P(FIELD(7),"^",4) S:REQST'="" REQST=+$E(+$$HL7TFM^XLFDT(REQST),1,12) S REQST=$$DATE2^PSJUTL2(REQST)
153 S PRIORITY=$S($G(PRIORITY)]"":PRIORITY,1:"R")
154 I $E(SCHEDULE,1)=" " S:$TR(SCHEDULE," ")="PRN" SCHEDULE="PRN" I '(SCHEDULE="PRN") S PSREASON="Invalid Schedule" D ERROR^PSJHL9 Q
155 S PRNTON=$P(FIELD(8),"^")
156 S NURSEACK=$G(FIELD(11))
157 S LOGIN=$G(FIELD(15)) S:LOGIN'="" LOGIN=+$E(+$$HL7TFM^XLFDT(FIELD(15)),1,12) S LOGIN=$$DATE2^PSJUTL2(LOGIN)
158 S:$G(NURSEACK)]"" ACKDATE=LOGIN
159 S ORDCON=$P($G(FIELD(16)),U) I ORDCON="A" S PSJASTP=$G(FIELD(9)) S:$G(PSJASTP)'="" PSJASTP=+$E(+$$HL7TFM^XLFDT(PSJASTP),1,12) S PSJASTP=$$DATE2^PSJUTL2(PSJASTP)
160 I (PSOC="CA")!(PSOC="DC") D CANCEL^PSJHL6 Q
161 I PSOC="HD" D HOLD^PSJHL6 Q
162 I PSOC="RL" D UNHOLD^PSJHL6 Q
163 I PSOC="ZV" D NURSEACK^PSJHL5 Q
164 I PSOC="SS" D STATUS^PSJHL5 Q
165 I PSOC="Z@" N X S X="PSJHL8" X ^%ZOSF("TEST") I D PURGE^PSJHL8 Q
166 I PSOC="DE" S QFLG=1 Q
167 Q
168OBR ; This segment is used to pass flagging information from CPRS.
169 S ORDER=FIELD(2)
170 S PSJORDER=$P(FIELD(2),"^"),RXON=$P(FIELD(3),"^"),RXORDER=$S((RXON["N")!(RXON["P"):"^PS(53.1,"_+RXON_",",RXON["V":"^PS(55,"_PSJHLDFN_",""IV"","_+RXON_",",1:"^PS(55,"_PSJHLDFN_",5,"_+RXON_",")
171 S PSJFLAG=FIELD(4)
172 S FLDATE=$G(FIELD(7)) S:FLDATE'="" FLDATE=+$E(+$$HL7TFM^XLFDT(FIELD(7)),1,12) S FLDATE=$$DATE2^PSJUTL2(FLDATE)
173 S CLERK=+$G(FIELD(16))
174 S PSJYN=$G(FIELD(24))
175 S FLCMNT=$G(FIELD(13))
176 I PSOC="ORU" D FLAG^PSJHL5
177 Q
178RXC ; IV order
179 D RXC^PSJHL4A
180 Q
181 ;
182RXO ;
183 D RXO^PSJHL4A
184 Q
185 ;
186RXR ;
187 S ROUTE=$P(FIELD(1),"^",4)
188 Q
189 ;
190OBX ;
191 D OBX^PSJHL4A
192 Q
193 ;
194NTE ;
195 D NTE^PSJHL4A
196 Q
197 ;
198ZRX ;
199 D ZRX^PSJHL4A
200 Q
201 ;
202ZSC ;Service Connected - Not Used by Inpatient
203 Q
204 ;
205ZRN ;Non-VA Med (Herbal/OTC)
206 S CLASS="O" D EN^PSOHLNEW(.PSJMSG)
207 Q
208DG1 ;Billing Awareness - Not used by Inpatient
209 Q
Note: See TracBrowser for help on using the repository browser.