- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/INPATIENT_MEDICATIONS-PSJ-PSIV-PSG--PSGW/PSJHL4.m
r613 r623 1 PSJHL4 ;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,134**;16 DEC 97;Build 124 3 ; Reference to $$EN^PSOHLNEW is supported by DBIA# 2188. 4 ; Reference to ^PS(50.7 is supported by DBIA 2180. 5 ; Reference to ^PS(51.2 is supported by DBIA 2178. 6 ; Reference to ^PS(55 is supported by DBIA 2191. 7 ; Reference to ^PS(59.7 supported by DBIA 2181. 8 ; Reference to ^ORHLESC is supported by DBIA 4922. 9 ; 10 EN(PSJMSG) ; Start 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,IVCAT,INTRMT 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") 20 END ; 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 DECODE ; Parse into fields 27 K FIELD 28 N PSJCTR1 S PSJCTR1="" 29 S SEGMENT=$G(PSJMSG(II)) 30 I $D(PSJMSG(II,1)),$P(SEGMENT,"|",1)="ORC" F S PSJCTR1=$O(PSJMSG(II,PSJCTR1)) Q:PSJCTR1="" D 31 . S SEGMENT=SEGMENT_PSJMSG(II,PSJCTR1) ;Handle CPRS "overflow" ORC nodes 32 S J=0 33 F Q:$G(SEGMENT)="" D 34 .I SEGMENT["|" S FIELD(J)=$P(SEGMENT,"|"),SEGMENT=$E(SEGMENT,$L(FIELD(J))+2,$L(SEGMENT)),J=J+1 Q 35 .I SEGMENT'["|" S FIELD(J)=SEGMENT,SEGMENT="" Q 36 K PSJCTR1 37 Q 38 NOTIFY(ORDER,PSJHLDFN,PRIO,PSJSCHED) ; Send msg 39 N NTFYREAS,WARD,MGROUP,NTFSTAT,DRUG,DRIEN,PNAME,ORDATE,DO,PSG,XMY,VADPT,LASTFOUR,PSJSOK 40 Q:($G(PRIO)=""&($G(PSJSCHED)="")) 41 S DFN=PSJHLDFN D DEM^VADPT S LASTFOUR=$P($P(VADM(2),"^",2),"-",3) 42 S NTFYREAS=$S((",S,A,")[(","_PRIO_","):1,($G(PSJSCHED)="NOW"):2,($G(PSJSCHED)="STAT"):3,1:0) Q:'NTFYREAS 43 S PSJSOK=1 44 I ORDER["P" D PND 45 I ORDER["U" D UD 46 I ORDER["V" D IV 47 Q:PSJSOK=1 48 D XMD^PSJHL4A 49 Q 50 PND ; Pending 51 N WARD,WDPARM,MGRP 52 Q:'$D(^PS(53.1,+ORDER,0)) 53 S WARD=$G(^DPT(PSJHLDFN,.1)) I WARD]"" D 54 .N DIC,X,Y S DIC="^DIC(42,",DIC(0)="BOXZ",X=WARD D ^DIC S WARD=+Y Q:WARD=0 55 .S WARD=$O(^PS(59.6,"B",WARD,0)) Q:+WARD=0 56 .Q:$$SNDTSTW^PSJHL4A(PRIO,PSJSCHED,WARD) 57 .S WDPARM=$G(^PS(59.6,+WARD,0)),MGRP=$P(WDPARM,"^",30) Q:+MGRP=0 58 .S MGRP=$$GET1^DIQ(3.8,MGRP,.01) I MGRP]"" S XMY("G."_MGRP_"@"_$G(^XMB("NETNAME")))="",PSJSOK=0 59 S:'$$SNDTSTP^PSJHL4A(PRIO,PSJSCHED) MGROUP="G.PSJ STAT NOW PENDING ORDER@"_$G(^XMB("NETNAME")),XMY(MGROUP)="",PSJSOK=0 60 S NTFSTAT="PENDING" 61 N NDP2,ND0 S NDP2=$G(^PS(53.1,+ORDER,.2)),ND0=$G(^PS(53.1,+ORDER,0)) 62 S DRIEN=+$P(NDP2,"^"),DO=$P(NDP2,"^",2),RTE=$P(ND0,"^",3),ORDATE=$P(ND0,"^",14) 63 S SCHED=$P($G(^PS(53.1,+ORDER,2)),"^") 64 Q 65 UD ; UD 66 N WARD,WDPARM,MGRP 67 Q:'$D(^PS(55,PSJHLDFN,5,+ORDER,0)) 68 S WARD=$P($G(^PS(55,PSJHLDFN,5,+ORDER,0)),"^",23) I +WARD D 69 .S WARD=$O(^PS(59.6,"B",WARD,0)) Q:+WARD=0 70 .Q:$$SNDTSTW^PSJHL4A(PRIO,PSJSCHED,WARD) 71 .S WDPARM=$G(^PS(59.6,+WARD,0)),MGRP=$P(WDPARM,"^",30) Q:+MGRP=0 72 .S MGRP=$$GET1^DIQ(3.8,MGRP,.01) I MGRP]"" S XMY("G."_MGRP_"@"_$G(^XMB("NETNAME")))="",PSJSOK=0 73 S:'$$SNDTSTA^PSJHL4A(PRIO,PSJSCHED) MGROUP="G.PSJ STAT NOW ACTIVE ORDER@"_$G(^XMB("NETNAME")),XMY(MGROUP)="",PSJSOK=0 74 S NTFSTAT="ACTIVE" 75 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)) 76 S DRIEN=+$P(NDP2,"^"),DO=$P(NDP2,"^",2),RTE=$P(ND0,"^",3),ORDATE=$P(ND0,"^",14) 77 S SCHED=$P(ND2,"^") 78 Q 79 IV ; IV 80 N WARD,WDPARM,MGRP 81 Q:'$D(^PS(55,PSJHLDFN,"IV",+ORDER,0)) 82 S WARD=$P($G(^PS(55,PSJHLDFN,"IV",+ORDER,0)),"^",22) I +WARD D 83 .S WARD=$O(^PS(59.6,"B",WARD,0)) Q:+WARD=0 84 .Q:$$SNDTSTW^PSJHL4A(PRIO,PSJSCHED,WARD) 85 .S WDPARM=$G(^PS(59.6,+WARD,0)),MGRP=$P(WDPARM,"^",30) Q:+MGRP=0 86 .S MGRP=$$GET1^DIQ(3.8,MGRP,.01) I MGRP]"" S XMY("G."_MGRP_"@"_$G(^XMB("NETNAME")))="",PSJSOK=0 87 S:'$$SNDTSTA^PSJHL4A(PRIO,PSJSCHED) MGROUP="G.PSJ STAT NOW ACTIVE ORDER@"_$G(^XMB("NETNAME")),XMY(MGROUP)="",PSJSOK=0 88 S NTFSTAT="ACTIVE" 89 N ND2,NDP2,ND0 S ND0=$G(^PS(55,PSJHLDFN,"IV",+ORDER,0)),ND2=$G(^PS(55,PSJHLDFN,"IV",+ORDER,2)) 90 S NDP2=$G(^PS(55,PSJHLDFN,"IV",+ORDER,.2)) 91 S DRIEN=$P(NDP2,"^"),DO=$P(NDP2,"^",2),RTE=$P(NDP2,"^",3) 92 S ORDATE=$P(ND2,"^"),SCHED=$P(ND0,"^",9) 93 Q 94 MSH ; Header 95 S PSOC=FIELD(8) 96 Q 97 PID ; ID 98 S PSJHLDFN=$$UNESC^ORHLESC(FIELD(3)) 99 Q 100 PV1 ; Visit 101 N A 102 S CLASS=FIELD(2),LOC=$P(FIELD(3),"^"),APPT="" I $G(FIELD(44))]"" S APPT=+$$HL7TFM^XLFDT(FIELD(44)) 103 I "IO"'[CLASS S PSREASON="Invalid patient class" Q 104 N QQ K PSJNVA S QQ=II F S QQ=$O(PSJMSG(QQ)) Q:'QQ D Q:$G(PSJNVA) 105 .S X=$G(PSJMSG(QQ)) 106 .I $P(X,"|")="ZRN" S PSJNVA=1,CLASS="O" D EN^PSOHLNEW(.PSJMSG) 107 I $G(PSJNVA) K PSJNVA Q 108 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" 109 .S RXON=$P(PSJMSG(QQ),"|",4) I RXON]"" S RXON=$P(RXON,"^") I "ABNPUV"[$E(RXON,$L(RXON)) S CLASS="I" 110 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" 111 .S RXON=$P(PSJMSG(QQ),"|",4) I RXON]"" S RXON=$P(RXON,"^") I "ABNPUV"[$E(RXON,$L(RXON)) S CLASS="I" 112 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" 113 .S CHK=$P(PSJMSG(QQ),"|",2),CHK=$S($P(CHK,"^",5)="IV":"IV",1:$P(CHK,"^",4)) 114 .I CHK="IV" S CLASS="I" Q 115 .I 'CHK S PSREASON="Missing or Invalid Orderable Item",CLASS="I" Q 116 .I $P($G(^PS(50.7,CHK,0)),"^",3)=1 S CLASS="I" Q 117 D:CLASS="O" EN^PSOHLNEW(.PSJMSG) 118 Q 119 ORC ; Order 120 S TMPAT="" 121 S PSOC=FIELD(1) 122 S ORDER=FIELD(2) 123 I $G(PSREASON)]"" D ERROR^PSJHL9 Q 124 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_",") 125 I PSOC="NA" D ASSIGN^PSJHL5 Q 126 S CLERK=+$G(FIELD(10)) 127 S PROVIDER=+$G(FIELD(12)) D:PSOC="NW" 128 .I PROVIDER=0 S PSREASON="Invalid Provider" D ERROR^PSJHL9 Q 129 .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 130 S UNITS=$P(FIELD(7),"^"),INSTR=$$UNESC^ORHLESC($P(FIELD(7),"^",8)) 131 S:UNITS["&" DOSE=$P(UNITS,"&"),UNIT=$P(UNITS,"&",2),UNITS=$P(UNITS,"&",3) S:UNITS]"" UNITS=$$UNESC^ORHLESC(UNITS) S:$G(DOSE)]"" DOSE=$$UNESC^ORHLESC(DOSE) 132 S SCHEDULE=$P(FIELD(7),"^",2),PRIORITY=$P(FIELD(7),"^",6) S:SCHEDULE["PRN" SCHTYP="P" 133 I SCHEDULE["&" S ADMINS=$P(SCHEDULE,"&",2),SCHEDULE=$P(SCHEDULE,"&") S ADMINS=$TR(ADMINS," ","") S ADMINS=$S(ADMINS:ADMINS,1:"") 134 S SCHEDULE=$$UNESC^ORHLESC(SCHEDULE) 135 I SCHEDULE["@" S TMPAT=$$TMPAT^PSJHL4A(SCHEDULE) 136 I $G(TMPAT) S $P(SCHEDULE,"@",2)=TMPAT,ADMINS=TMPAT 137 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) 138 S PRIORITY=$S($G(PRIORITY)]"":PRIORITY,1:"R") 139 I $E(SCHEDULE,1)=" " S:$TR(SCHEDULE," ")="PRN" SCHEDULE="PRN" I '(SCHEDULE="PRN") S PSREASON="Invalid Schedule" D ERROR^PSJHL9 Q 140 S SCHTYP=$P(FIELD(7),"^",7) 141 I $G(SCHTYP)="D" S SCHTYP="C" ;Makes CPRS Day of Week consistent in behavior with backdoor order of Day of Week 142 S PRNTON=$P(FIELD(8),"^") 143 S NURSEACK=$G(FIELD(11)) 144 S LOGIN=$G(FIELD(15)) S:LOGIN'="" LOGIN=+$E(+$$HL7TFM^XLFDT(FIELD(15)),1,12) S LOGIN=$$DATE2^PSJUTL2(LOGIN) 145 S:$G(NURSEACK)]"" ACKDATE=LOGIN 146 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) 147 I (PSOC="CA")!(PSOC="DC") D CANCEL^PSJHL6 Q 148 I PSOC="HD" D HOLD^PSJHL6 Q 149 I PSOC="RL" D UNHOLD^PSJHL6 Q 150 I PSOC="ZV" D NURSEACK^PSJHL5 Q 151 I PSOC="SS" D STATUS^PSJHL5 Q 152 I PSOC="Z@" N X S X="PSJHL8" X ^%ZOSF("TEST") I D PURGE^PSJHL8 Q 153 I PSOC="DE" S QFLG=1 Q 154 Q 155 OBR ; Flagging from CPRS. 156 S ORDER=FIELD(2) 157 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_",") 158 S PSJFLAG=FIELD(4) 159 S FLDATE=$G(FIELD(7)) S:FLDATE'="" FLDATE=+$E(+$$HL7TFM^XLFDT(FIELD(7)),1,12) S FLDATE=$$DATE2^PSJUTL2(FLDATE) 160 S CLERK=+$G(FIELD(16)) 161 S PSJYN=$G(FIELD(24)) 162 S FLCMNT=$$UNESC^ORHLESC($G(FIELD(13))) 163 I PSOC="ORU" D FLAG^PSJHL5 164 Q 165 RXC ; IV 166 D RXC^PSJHL4A 167 Q 168 RXO ; OP 169 D RXO^PSJHL4A 170 Q 171 RXR ; Route 172 S ROUTE=$P(FIELD(1),"^",4) 173 Q 174 OBX ; Obs. 175 D OBX^PSJHL4A 176 Q 177 NTE ; Note 178 D NTE^PSJHL4A 179 Q 180 ZRX ; Custom 181 D ZRX^PSJHL4A 182 Q 183 ZSC ;Service Connected - Not Used 184 Q 185 ZRN ;Non-VA Med (Herbal/OTC) 186 S CLASS="O" D EN^PSOHLNEW(.PSJMSG) 187 Q 188 DG1 ;Billing Awareness - Not used 189 Q 1 PSJHL4 ;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 ; 10 EN(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") 20 END ; 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 ; 27 DECODE ;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 ; 37 NOTIFY(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 ; 61 PND ; 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 ; 77 UD ; 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 ; 92 IV ; 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 ; 108 MSH ; 109 S PSOC=FIELD(8) 110 Q 111 ; 112 PID ; 113 S PSJHLDFN=FIELD(3) 114 Q 115 ; 116 PV1 ; 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 ; 139 ORC ; 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 168 OBR ; 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 178 RXC ; IV order 179 D RXC^PSJHL4A 180 Q 181 ; 182 RXO ; 183 D RXO^PSJHL4A 184 Q 185 ; 186 RXR ; 187 S ROUTE=$P(FIELD(1),"^",4) 188 Q 189 ; 190 OBX ; 191 D OBX^PSJHL4A 192 Q 193 ; 194 NTE ; 195 D NTE^PSJHL4A 196 Q 197 ; 198 ZRX ; 199 D ZRX^PSJHL4A 200 Q 201 ; 202 ZSC ;Service Connected - Not Used by Inpatient 203 Q 204 ; 205 ZRN ;Non-VA Med (Herbal/OTC) 206 S CLASS="O" D EN^PSOHLNEW(.PSJMSG) 207 Q 208 DG1 ;Billing Awareness - Not used by Inpatient 209 Q
Note:
See TracChangeset
for help on using the changeset viewer.
