[613] | 1 | PSJHL4A ;BIR/RLW-CONTINUE DECODE HL7 /MESSSAGE FROM OE/RR ;16 Mar 99 / 4:55 PM
|
---|
| 2 | ;;5.0; INPATIENT MEDICATIONS ;**105,111,154,170,159,134**;16 DEC 97;Build 124
|
---|
| 3 | ;
|
---|
| 4 | ; Reference to ^PS(52.6 is supported by DBIA# 1231.
|
---|
| 5 | ; Reference to ^PS(52.7 is supported by DBIA# 2173.
|
---|
| 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 | ; Reference to ^SC( is supported by DBIA# 10040.
|
---|
| 10 | ; Reference to ^PS(51.1 is supported by DBIA# 2177.
|
---|
| 11 | ; Reference to ^PS(50.7 is supported by DBIA #2180.
|
---|
| 12 | ; Reference to ^PS(51.2 is supported by DBIA 2178.
|
---|
| 13 | ;
|
---|
| 14 | RXC ; IV order
|
---|
| 15 | N IVFL
|
---|
| 16 | S APPL=FIELD(1)
|
---|
| 17 | I APPL["B" S SOLCNT=SOLCNT+1,PTR=$P(FIELD(2),"^",4) Q:'PTR S VOLUME=+FIELD(3)_" ML" D I '$D(^TMP("PSJNVO",$J,"SOL",SOLCNT,0)) D SOLSRCH
|
---|
| 18 | .S SOLUTION="" F S SOLUTION=$O(^PS(52.7,"AOI",PTR,SOLUTION)) Q:'SOLUTION S INACT=$G(^PS(52.7,SOLUTION,"I")) I 'INACT!(INACT>DT) I VOLUME=$P(^PS(52.7,SOLUTION,0),U,3) D
|
---|
| 19 | ..S ^TMP("PSJNVO",$J,"SOL",0)=SOLCNT
|
---|
| 20 | ..S ^TMP("PSJNVO",$J,"SOL",SOLCNT,0)=SOLUTION_"^"_VOLUME,TVOLUME=TVOLUME+(+VOLUME)
|
---|
| 21 | I $G(INFRT)]"" S X=INFRT D ENI^PSJHLU S INFRT=$G(X)
|
---|
| 22 | I APPL="A" S ADCNT=ADCNT+1,PTR=$P(FIELD(2),"^",4) Q:'PTR S STRENGTH=$G(FIELD(3))_" "_$P($G(FIELD(4)),"^",5) D I '$D(^TMP("PSJNVO",$J,"AD",ADCNT,0)) S PSREASON="Can't find matching additive" D ERROR^PSJHL9 Q
|
---|
| 23 | .S ADDITIVE="" F S ADDITIVE=$O(^PS(52.6,"AOI",PTR,ADDITIVE)) Q:'ADDITIVE S INACT=$G(^PS(52.6,ADDITIVE,"I")),IVFL=$P($G(^(0)),"^",13) I 'INACT!(INACT>DT),IVFL'=0 Q:$G(^PS(52.6,ADDITIVE,0))']"" D Q:ADDITIVE
|
---|
| 24 | ..I $G(PSITEM)="" S PSITEM=PTR
|
---|
| 25 | ..S ^TMP("PSJNVO",$J,"AD",0)=ADCNT
|
---|
| 26 | ..S ^TMP("PSJNVO",$J,"AD",ADCNT,0)=ADDITIVE_"^"_STRENGTH
|
---|
| 27 | Q
|
---|
| 28 | ;
|
---|
| 29 | RXO ;
|
---|
| 30 | I $O(PSJMSG(II,0)) D
|
---|
| 31 | .K SEGMENT
|
---|
| 32 | .N KK,JJ,XX
|
---|
| 33 | .S SEGMENT(1)=$G(PSJMSG(II))
|
---|
| 34 | .S KK=1,JJ="" F S JJ=$O(PSJMSG(II,JJ)) Q:'JJ S KK=KK+1,SEGMENT(KK)=$G(PSJMSG(II,JJ))
|
---|
| 35 | .S KK=1,JJ=0
|
---|
| 36 | .F Q:'$D(SEGMENT(KK)) D
|
---|
| 37 | ..I SEGMENT(KK)["|" S FIELD(JJ)=$P(SEGMENT(KK),"|"),SEGMENT(KK)=$E(SEGMENT(KK),$L(FIELD(JJ))+2,$L(SEGMENT(KK))),JJ=JJ+1 Q
|
---|
| 38 | ..I SEGMENT(KK)'["|" S FIELD(JJ)=SEGMENT(KK),KK=KK+1 Q:'$D(SEGMENT(KK)) D
|
---|
| 39 | ...S XX=$P(SEGMENT(KK),"|"),SEGMENT(KK)=$E(SEGMENT(KK),$L(X)+2,$L(SEGMENT(KK))),FIELD(JJ)=FIELD(JJ)_XX,JJ=JJ+1
|
---|
| 40 | S APPL="",PSITEM=$S($P(FIELD(1),"^",5)="IV":"",1:$P(FIELD(1),"^",4))
|
---|
| 41 | S:$P(FIELD(1),"^",6)="ORD" PSITEM=""
|
---|
| 42 | S:$P(FIELD(1),"^",5)="IV" IVTYP="A",SCHTYP="C",INFRT=$G(FIELD(2))
|
---|
| 43 | S DISPENSE=$P($G(FIELD(10)),"^",4)
|
---|
| 44 | S IVLIMIT=$P($G(PSJMSG(II)),"^",3)
|
---|
| 45 | S:IVLIMIT["doses" IVLIMIT=$TR(IVLIMIT,"doses","a")
|
---|
| 46 | Q
|
---|
| 47 | ;
|
---|
| 48 | OBX ;
|
---|
| 49 | S OBXFL=1,OCNARR=FIELD(5),OCPROV=CLERK,OCCNT=OCCNT+1
|
---|
| 50 | S ^TMP("PSJNVO",$J,10,0)=OCCNT
|
---|
| 51 | S ^TMP("PSJNVO",$J,10,OCCNT,0)=OCNARR
|
---|
| 52 | S ^TMP("PSJNVO",$J,10,OCCNT,1)=$$UNESC^ORHLESC($P($G(^VA(200,+OCPROV,0)),"^"))
|
---|
| 53 | Q
|
---|
| 54 | ;
|
---|
| 55 | NTE ;
|
---|
| 56 | S TEXT=$S((FIELD(1)=6)&('OBXFL):"PROCOM",(FIELD(1)=7)&('OBXFL):"ADMINSTR",1:"OCRSN")
|
---|
| 57 | S @TEXT@(1)=$$UNESC^ORHLESC($G(FIELD(3)))
|
---|
| 58 | S K=1,J="" F S J=$O(PSJMSG(II,J)) Q:'J S K=K+1,@TEXT@(K)=$G(PSJMSG(II,J))
|
---|
| 59 | D:$D(OCRSN)
|
---|
| 60 | .S QQ=0 F S QQ=$O(OCRSN(QQ)) Q:'QQ S ^TMP("PSJNVO",$J,10,OCCNT,2,QQ,0)=OCRSN(QQ)
|
---|
| 61 | S OBXFL=0
|
---|
| 62 | Q
|
---|
| 63 | ;
|
---|
| 64 | ZRX ;
|
---|
| 65 | N ND,ND2,CHK,FOLOR,STDT
|
---|
| 66 | S PREON=$G(FIELD(1)),ROC=$G(FIELD(3)),IVCAT=$G(FIELD(6))
|
---|
| 67 | S IVCAT=$S(",I,C,"[(","_IVCAT_","):IVCAT,1:"") I 'PREON S IVTYP=$S($G(PSGS0XT):"P",1:"A") S IVTYP=$S(IVCAT="I":"P",IVCAT="C":"A",1:$G(IVTYP))
|
---|
| 68 | S ND=$S((PREON["N")!(PREON["P"):$G(^PS(53.1,+PREON,0)),PREON["V":$G(^PS(55,PSJHLDFN,"IV",+PREON,0)),1:$G(^PS(55,PSJHLDFN,5,+PREON,0)))
|
---|
| 69 | S ND2=$S((PREON["N")!(PREON["P"):$G(^PS(53.1,+PREON,2)),PREON["V":$G(^PS(55,PSJHLDFN,"IV",+PREON,2)),1:$G(^PS(55,PSJHLDFN,5,+PREON,2)))
|
---|
| 70 | I 'ND I ROC'="N" S PSREASON="Invalid Pharmacy order number" D ERROR^PSJHL9 Q
|
---|
| 71 | I ND I ROC="R" S FOLOR=$S(PREON["V":$P(ND2,U,6),1:$P(ND,U,26)) I FOLOR S PSREASON="Duplicate Renewal Request" D ERROR^PSJHL9 Q
|
---|
| 72 | I ND I ROC="R" S CHK=$S(PREON["V":$P(ND,U,17),1:$P(ND,U,9)) I "AE"'[CHK S PSREASON="Pharmacy orders with a status of "_CHK_" may not be renewed" D ERROR^PSJHL9 Q
|
---|
| 73 | I $G(CHK)="E" I PREON'["V" D NOW^%DTC S X1=+$E(%,1,12),X2=-4 D C^%DTC S STDT=$S(PREON["V":$P(ND,U,3),1:$P(ND2,U,4)) I STDT'>X S PSREASON="Pharmacy orders expired longer than 4 days may not be renewed" D ERROR^PSJHL9 Q
|
---|
| 74 | I ND I ROC="E" S FOLOR=$S(PREON["V":$P(ND2,U,6),1:$P(ND,U,26)) I FOLOR S PSREASON="Pharmacy orders may only be edited ONCE" D ERROR^PSJHL9 Q
|
---|
| 75 | I ND I ROC="E" S CHK=$S(PREON["V":$P(ND,U,17),1:$P(ND,U,9)) I "DEHO"[CHK N CHKRTN S CHKRTN=CHK_"^PSJHL6" D @CHKRTN S PSREASON=PSREASON_" orders may not be edited" D ERROR^PSJHL9 Q
|
---|
| 76 | D:ROC'="R" VALID^PSJHL9 Q:QFLG
|
---|
| 77 | I $G(PSITEM)="",$D(^TMP("PSJNVO",$J,"SOL",1,0)) S PSITEM=$P($G(^PS(52.7,+^TMP("PSJNVO",$J,"SOL",1,0),0)),"^",11)
|
---|
| 78 | I PRIORITY="ZD" D VALID^PSJHL10 S QFLG=1 Q
|
---|
| 79 | I (PREON]"")&(ROC="E") D EDITCK^PSJHL5 Q:QFLG
|
---|
| 80 | D NVO^PSJHL9
|
---|
| 81 | I (PREON]"")&(ROC="R") D RENEW^PSJHL7 Q
|
---|
| 82 | I (PREON]"")&(ROC="E") D EDIT^PSJHL5
|
---|
| 83 | Q
|
---|
| 84 | ;
|
---|
| 85 | SOLSRCH ;Find solution
|
---|
| 86 | N SSSS,SEG,ON,ROC,SOL,SOL2
|
---|
| 87 | F SSSS=II:0 S SSSS=$O(PSJMSG(SSSS)) Q:'SSSS I $P(PSJMSG(SSSS),"|")="ZRX" D Q
|
---|
| 88 | .S SEG=$G(PSJMSG(SSSS)),ON=$P(SEG,"|",2),ROC=$P(SEG,"|",4)
|
---|
| 89 | I $G(ROC)'="N" F SOL=0:0 S SOL=$O(^PS(55,PSJHLDFN,"IV",+ON,"SOL",SOL)) Q:'SOL S SOL2=$G(^PS(55,PSJHLDFN,"IV",+ON,"SOL",SOL,0)) I $D(^PS(52.7,"AOI",PTR,+SOL2))&($P(SOL2,U,2)=VOLUME) S SOLUTION=+SOL2 D SET Q
|
---|
| 90 | I 'SOLUTION S SOLUTION=$O(^PS(52.7,"AOI",PTR,SOLUTION)) D SET
|
---|
| 91 | Q
|
---|
| 92 | SET ;Set solution tmp nodes
|
---|
| 93 | Q:'+SOLUTION
|
---|
| 94 | S ^TMP("PSJNVO",$J,"SOL",0)=SOLCNT
|
---|
| 95 | S ^TMP("PSJNVO",$J,"SOL",SOLCNT,0)=SOLUTION_"^"_VOLUME,TVOLUME=TVOLUME+(+VOLUME)
|
---|
| 96 | Q
|
---|
| 97 | ;
|
---|
| 98 | SNDTSTW(PRIO,PSJSCHED,WARD) ; Test to determine if mail message should be sent.
|
---|
| 99 | N SNPRIO,SNSCHD,SNOPT
|
---|
| 100 | S SNPRIO=$S(PRIO="S":"S",PRIO="A":"A",1:"R")
|
---|
| 101 | S SNSCHD=$S(PSJSCHED="STAT":"S",PSJSCHED="NOW":"N",1:"R")
|
---|
| 102 | S SNOPT=$P($G(^PS(59.6,WARD,0)),"^",32)
|
---|
| 103 | S:SNOPT="" SNOPT=$P($G(^PS(59.7,1,27)),"^",1)
|
---|
| 104 | Q:SNOPT="" 0
|
---|
| 105 | Q:SNOPT[SNPRIO 0
|
---|
| 106 | Q:SNOPT[SNSCHD 0
|
---|
| 107 | Q 1
|
---|
| 108 | ;
|
---|
| 109 | SNDTSTP(PRIO,PSJSCHED) ; Test to determine if mail message should be sent.
|
---|
| 110 | N SNPRIO,SNSCHD,SNOPT
|
---|
| 111 | S SNPRIO=$S(PRIO="S":"S",PRIO="A":"A",1:"R")
|
---|
| 112 | S SNSCHD=$S(PSJSCHED="STAT":"S",PSJSCHED="NOW":"N",1:"R")
|
---|
| 113 | S SNOPT=$P($G(^PS(59.7,1,27)),"^",1)
|
---|
| 114 | Q:SNOPT="" 1
|
---|
| 115 | Q:SNOPT[SNPRIO 0
|
---|
| 116 | Q:SNOPT[SNSCHD 0
|
---|
| 117 | Q 1
|
---|
| 118 | ;
|
---|
| 119 | SNDTSTA(PRIO,PSJSCHED) ; Test to determine if mail message should be sent.
|
---|
| 120 | N SNPRIO,SNSCHD,SNOPT
|
---|
| 121 | S SNPRIO=$S(PRIO="S":"S",PRIO="A":"A",1:"R")
|
---|
| 122 | S SNSCHD=$S(PSJSCHED="STAT":"S",PSJSCHED="NOW":"N",1:"R")
|
---|
| 123 | S SNOPT=$P($G(^PS(59.7,1,27)),"^",2)
|
---|
| 124 | S:SNOPT="" SNOPT=$P($G(^PS(59.7,1,27)),"^",1)
|
---|
| 125 | Q:SNOPT="" 1
|
---|
| 126 | Q:SNOPT[SNPRIO 0
|
---|
| 127 | Q:SNOPT[SNSCHD 0
|
---|
| 128 | Q 1
|
---|
| 129 | ;
|
---|
| 130 | TMPAT(SCHEDULE) ; Extract admin times from schedule in format schedule@schedule
|
---|
| 131 | S TMPAT="" I SCHEDULE'["@" Q TMPAT
|
---|
| 132 | S TMPAT=$P(SCHEDULE,"@",2) I TMPAT]"" D
|
---|
| 133 | .N WARD S WARD=$G(^DPT(PSJHLDFN,.1)) I WARD]"" D
|
---|
| 134 | ..N DIC,X,Y S DIC="^DIC(42,",DIC(0)="BOXZ",X=WARD D ^DIC S WARD=+Y Q:WARD=0
|
---|
| 135 | ..S WARD=$O(^PS(59.6,"B",WARD,0))
|
---|
| 136 | .I '$D(^PS(51.1,"AC","PSJ",TMPAT)) S TMPAT="" Q
|
---|
| 137 | .N II I '$$DOW^PSIVUTL($P(SCHEDULE,"@")) S TMPAT="" Q
|
---|
| 138 | .N TMPIEN S TMPIEN=$O(^PS(51.1,"AC","PSJ",TMPAT,0)),TMPAT=$P($G(^PS(51.1,+TMPIEN,0)),"^",2) D
|
---|
| 139 | ..I $P($G(^PS(51.1,+TMPIEN,1,+$G(WARD),0)),"^",2) S TMPAT=$P($G(^(0)),"^",2)
|
---|
| 140 | Q TMPAT
|
---|
| 141 | ;
|
---|
| 142 | XMD ; Mailman call for NOTIFY^PSJHL4
|
---|
| 143 | ; Input - PNAME = Patient Name
|
---|
| 144 | ; RTE = Route
|
---|
| 145 | ; DRUG = Drug Name
|
---|
| 146 | ; WARD = Ward Name
|
---|
| 147 | ; PRIO = CPRS Order Priority
|
---|
| 148 | S PNAME=$P($G(^DPT(+PSJHLDFN,0)),"^") S:$G(RTE) RTE=$P(^PS(51.2,+RTE,0),"^",3)
|
---|
| 149 | S DRUG=$S(DRIEN:$P($G(^PS(50.7,+DRIEN,0)),"^"),1:""),WARD=$G(^DPT(PSJHLDFN,.1))
|
---|
| 150 | S XMDUZ="MEDICATIONS,INPATIENT",XMSUB=$G(WARD)
|
---|
| 151 | S XMSUB=XMSUB_"-"_NTFSTAT_" "_$S($G(PRIO)="A":"ASAP",$G(PRIO)="S":"STAT",$G(NTFYREAS)=2:"NOW",$G(NTFYREAS)=3:"STAT",1:"")_"-"
|
---|
| 152 | S XMSUB=XMSUB_$E(PNAME,1,65-$L(XMSUB))
|
---|
| 153 | S XMTEXT="PSG("
|
---|
| 154 | 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_")"
|
---|
| 155 | S PSG(2,0)=""
|
---|
| 156 | S PSG(3,0)=" Patient: "_PNAME I $G(LASTFOUR) S PSG(3,0)=PSG(3,0)_" ("_LASTFOUR_")"
|
---|
| 157 | S PSG(4,0)="Order Information: "_DRUG_" "_DO_" "_RTE_" "_$G(PSJSCHED)
|
---|
| 158 | S PSG(5,0)=" Order Date: "_$$ENDTC^PSGMI(ORDATE)
|
---|
| 159 | D ^XMD
|
---|
| 160 | Q
|
---|