- Timestamp:
- Dec 4, 2009, 12:11:15 AM (15 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/INPATIENT_MEDICATIONS-PSJ-PSIV-PSG--PSGW/PSJHL4A.m
r613 r623 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 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**;16 DEC 97;Build 15 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 ; 9 RXC ; IV order 10 N IVFL 11 S APPL=FIELD(1) 12 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 13 .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 14 ..S ^TMP("PSJNVO",$J,"SOL",0)=SOLCNT 15 ..S ^TMP("PSJNVO",$J,"SOL",SOLCNT,0)=SOLUTION_"^"_VOLUME,TVOLUME=TVOLUME+(+VOLUME) 16 I $G(INFRT)]"" S X=INFRT D ENI^PSJHLU S INFRT=$G(X) 17 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 18 .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 19 ..I $G(PSITEM)="" S PSITEM=PTR 20 ..S ^TMP("PSJNVO",$J,"AD",0)=ADCNT 21 ..S ^TMP("PSJNVO",$J,"AD",ADCNT,0)=ADDITIVE_"^"_STRENGTH 22 Q 23 ; 24 RXO ; 25 I $O(PSJMSG(II,0)) D 26 .K SEGMENT 27 .N KK,JJ,XX 28 .S SEGMENT(1)=$G(PSJMSG(II)) 29 .S KK=1,JJ="" F S JJ=$O(PSJMSG(II,JJ)) Q:'JJ S KK=KK+1,SEGMENT(KK)=$G(PSJMSG(II,JJ)) 30 .S KK=1,JJ=0 31 .F Q:'$D(SEGMENT(KK)) D 32 ..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 33 ..I SEGMENT(KK)'["|" S FIELD(JJ)=SEGMENT(KK),KK=KK+1 Q:'$D(SEGMENT(KK)) D 34 ...S XX=$P(SEGMENT(KK),"|"),SEGMENT(KK)=$E(SEGMENT(KK),$L(X)+2,$L(SEGMENT(KK))),FIELD(JJ)=FIELD(JJ)_XX,JJ=JJ+1 35 S APPL="",PSITEM=$S($P(FIELD(1),"^",5)="IV":"",1:$P(FIELD(1),"^",4)) 36 S:$P(FIELD(1),"^",6)="ORD" PSITEM="" 37 S:$P(FIELD(1),"^",5)="IV" IVTYP="A",SCHTYP="C",INFRT=$G(FIELD(2)) 38 S DISPENSE=$P($G(FIELD(10)),"^",4) 39 S IVLIMIT=$P($G(PSJMSG(II)),"^",3) 40 Q 41 ; 42 OBX ; 43 S OBXFL=1,OCNARR=FIELD(5),OCPROV=CLERK,OCCNT=OCCNT+1 44 S ^TMP("PSJNVO",$J,10,0)=OCCNT 45 S ^TMP("PSJNVO",$J,10,OCCNT,0)=OCNARR 46 S ^TMP("PSJNVO",$J,10,OCCNT,1)=$P($G(^VA(200,+OCPROV,0)),"^") 47 Q 48 ; 49 NTE ; 50 S TEXT=$S((FIELD(1)=6)&('OBXFL):"PROCOM",(FIELD(1)=7)&('OBXFL):"ADMINSTR",1:"OCRSN") 51 S @TEXT@(1)=$G(FIELD(3)) 52 S K=1,J="" F S J=$O(PSJMSG(II,J)) Q:'J S K=K+1,@TEXT@(K)=$G(PSJMSG(II,J)) 53 D:$D(OCRSN) 54 .S QQ=0 F S QQ=$O(OCRSN(QQ)) Q:'QQ S ^TMP("PSJNVO",$J,10,OCCNT,2,QQ,0)=OCRSN(QQ) 55 S OBXFL=0 56 Q 57 ; 58 ZRX ; 59 N ND,ND2,CHK,FOLOR,STDT 60 S PREON=$G(FIELD(1)),ROC=$G(FIELD(3)) 61 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))) 62 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))) 63 I 'ND I ROC'="N" S PSREASON="Invalid Pharmacy order number" D ERROR^PSJHL9 Q 64 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 65 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 66 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 67 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 68 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 69 D:ROC'="R" VALID^PSJHL9 Q:QFLG 70 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) 71 I PRIORITY="ZD" D VALID^PSJHL10 S QFLG=1 Q 72 I (PREON]"")&(ROC="E") D EDITCK^PSJHL5 Q:QFLG 73 D NVO^PSJHL9 74 I (PREON]"")&(ROC="R") D RENEW^PSJHL7 Q 75 I (PREON]"")&(ROC="E") D EDIT^PSJHL5 76 Q 77 ; 78 SOLSRCH ;Find solution 79 N SSSS,SEG,ON,ROC,SOL,SOL2 80 F SSSS=II:0 S SSSS=$O(PSJMSG(SSSS)) Q:'SSSS I $P(PSJMSG(SSSS),"|")="ZRX" D Q 81 .S SEG=$G(PSJMSG(SSSS)),ON=$P(SEG,"|",2),ROC=$P(SEG,"|",4) 82 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 83 I 'SOLUTION S SOLUTION=$O(^PS(52.7,"AOI",PTR,SOLUTION)) D SET 84 Q 85 SET ;Set solution tmp nodes 86 Q:'+SOLUTION 87 S ^TMP("PSJNVO",$J,"SOL",0)=SOLCNT 88 S ^TMP("PSJNVO",$J,"SOL",SOLCNT,0)=SOLUTION_"^"_VOLUME,TVOLUME=TVOLUME+(+VOLUME) 89 Q 90 ; 91 SNDTSTW(PRIO,PSJSCHED,WARD) ; Test to determine if mail message should be sent. 92 N SNPRIO,SNSCHD,SNOPT 93 S SNPRIO=$S(PRIO="S":"S",PRIO="A":"A",1:"R") 94 S SNSCHD=$S(PSJSCHED="STAT":"S",PSJSCHED="NOW":"N",1:"R") 95 S SNOPT=$P($G(^PS(59.6,WARD,0)),"^",32) 96 S:SNOPT="" SNOPT=$P($G(^PS(59.7,1,27)),"^",1) 97 Q:SNOPT="" 0 98 Q:SNOPT[SNPRIO 0 99 Q:SNOPT[SNSCHD 0 100 Q 1 101 ; 102 SNDTSTP(PRIO,PSJSCHED) ; Test to determine if mail message should be sent. 103 N SNPRIO,SNSCHD,SNOPT 104 S SNPRIO=$S(PRIO="S":"S",PRIO="A":"A",1:"R") 105 S SNSCHD=$S(PSJSCHED="STAT":"S",PSJSCHED="NOW":"N",1:"R") 106 S SNOPT=$P($G(^PS(59.7,1,27)),"^",1) 107 Q:SNOPT="" 1 108 Q:SNOPT[SNPRIO 0 109 Q:SNOPT[SNSCHD 0 110 Q 1 111 ; 112 SNDTSTA(PRIO,PSJSCHED) ; Test to determine if mail message should be sent. 113 N SNPRIO,SNSCHD,SNOPT 114 S SNPRIO=$S(PRIO="S":"S",PRIO="A":"A",1:"R") 115 S SNSCHD=$S(PSJSCHED="STAT":"S",PSJSCHED="NOW":"N",1:"R") 116 S SNOPT=$P($G(^PS(59.7,1,27)),"^",2) 117 S:SNOPT="" SNOPT=$P($G(^PS(59.7,1,27)),"^",1) 118 Q:SNOPT="" 1 119 Q:SNOPT[SNPRIO 0 120 Q:SNOPT[SNSCHD 0 121 Q 1
Note:
See TracChangeset
for help on using the changeset viewer.
