- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSOHLNE1.m
r613 r623 1 PSOHLNE1 ;BIR/RTR-Parsing out segments from OERR ;01/20/95 2 ;;7.0;OUTPATIENT PHARMACY;**1,9,46,71,98,111,117,131,157,181,143,235,239,225**;DEC 1997;Build 29 3 ;External reference to EN^ORERR supported by DBIA 2187 4 ;External reference to PS(50.607 supported by DBIA 2221 5 ;External reference to OR(100 supported by DBIA 2219 6 ;External reference to PSDRUG( supported by DBIA 221 7 ;External reference VADPT supported by DBIA 10061 8 ; 9 EN ;ORC segment 10 N Q1,Q2,Q3,Q4,Q5,Q6,Q7,PSOPOSSD 11 K PSOLQ1I,PSOLQ1II,PSOLQ1IX 12 I '$O(MSG(ZZ,0)) D 13 .S PSOOC="NW",PLACER=+$P(PSOSEG,"|",2),PLACERXX=+$P($P(PSOSEG,"|",2),";",2),ENTERED=$P(PSOSEG,"|",10),PROV=$P(PSOSEG,"|",12) 14 .S X=$P(PSOSEG,"|",15) S EFFECT=$$HL7TFM^XLFDT(X) K X 15 .D NOW^%DTC S PSOLOG=% K % 16 .;S RSN=$P(PSOSEG,"|",16) 17 .S ORCSEG=$P(PSOSEG,"|",7),QCOUNT=1 Q:$G(ORCSEG)'["~" 18 .F JJ=1:1:$L(ORCSEG) S:$E(ORCSEG,JJ)="~" QCOUNT=QCOUNT+1 19 I '$O(MSG(ZZ,0)) D Q 20 .F JJJ=1:1:QCOUNT S QQQ=$P(ORCSEG,"~",JJJ) D:QQQ'="" 21 ..S PSOPOSSD=$S($P($P(QQQ,"^"),"&"):1,1:0) ;PSOPOSSD=1 if possible dose 22 ..S Q1I(JJJ)=$S(PSOPOSSD:$P(QQQ,"^"),1:$P(QQQ,"^",8)),PSOLQ1IX(JJJ)=$P($P(QQQ,"^"),"&",5) S PSOLQ1I(JJJ)=$P(QQQ,"^",8),PSOLQ1II(JJJ)=PSOPOSSD ;ORC piece 1 if Possible Dosage, ORC piece 8 if Local Possible Dosage 23 ..S Q1(JJJ)=$P(QQQ,"^",2) ;schedule 24 ..S Q2(JJJ)=$P(QQQ,"^",3) ;duration 25 ..S Q3(JJJ)=$P(QQQ,"^",4) I Q3(JJJ) S X=Q3(JJJ) S Q3(JJJ)=$$HL7TFM^XLFDT(X) K X ;start date 26 ..S Q4(JJJ)=$P(QQQ,"^",5) ;end date 27 ..S:$G(PRIOR)="" PRIOR=$P(QQQ,"^",6) 28 ..S Q6(JJJ)=$P(QQQ,"^",9) ;conjunction 29 ..S Q7(JJJ)=$P(QQQ,"^",10) ;sequencing 30 ..S QTARRAY(JJJ)=Q1(JJJ)_"^"_Q2(JJJ)_"^"_Q3(JJJ)_"^"_Q4(JJJ)_"^^"_Q6(JJJ)_"^"_Q7(JJJ) 31 ..S QTARRAY2(JJJ)=$S(PSOPOSSD:$P(Q1I(JJJ),"&"),1:Q1I(JJJ))_"^"_$S(PSOPOSSD:$P(Q1I(JJJ),"&",3),1:"") 32 ..I PSOPOSSD S $P(QTARRAY(JJJ),"^",5)=$P(Q1I(JJJ),"&",4) 33 ..I PSOPOSSD S PSOUNN=$P(Q1I(JJJ),"&",2) I PSOUNN'="" S PSOUNN=$O(^PS(50.607,"B",PSOUNN,0)) S $P(QTARRAY(JJJ),"^",9)=$G(PSOUNN) 34 ..K PSOUNN 35 ;For multiple ORC subscripts 36 S (POVAR,POVAR1)="",(NNCK,NNN,NNNN)=0,PSOIII=1,MSG(ZZ,0)=$E(MSG(ZZ),5,$L(MSG(ZZ))) 37 S AAA="" F S AAA=$O(MSG(ZZ,AAA)) Q:AAA="" S NNN=0 F OOO=1:1:$L(MSG(ZZ,AAA)) S NNN=NNN+1 D D:$G(POVAR1)="~"&(NNNN=6) PARSE D:$G(POVAR1)="|" PARSE 38 .I $E(MSG(ZZ,AAA),OOO)="|" S NNNN=NNNN+1 39 .S POVAR1=$E(MSG(ZZ,AAA),OOO) 40 .S POLIM=POVAR 41 .S POVAR=$S(POVAR="":POVAR1,1:POVAR_POVAR1) 42 .;I NNNN=6 I $G(POVAR1)="~"!($G(POVAR1)="|") 43 END ;16 OF ORC? 44 ;I $G(POVAR)'="" I NNNN=14!(NNNN=15) S EFFECT=$G(POVAR) 45 S QCOUNT=0 F JJJ=0:0 S JJJ=$O(QTVAR(JJJ)) Q:'JJJ I $L($G(QTVAR(JJJ))) S QCOUNT=QCOUNT+1 D 46 .S PSOPOSSD=$S($P($P(QTVAR(JJJ),"^"),"&"):1,1:0) ;PSOPOSSD =1 if possible dose 47 .S Q1I(JJJ)=$S(PSOPOSSD:$P(QTVAR(JJJ),"^"),1:$P(QTVAR(JJJ),"^",8)),PSOLQ1IX(JJJ)=$P($P(QTVAR(JJJ),"^"),"&",5) S PSOLQ1I(JJJ)=$P(QTVAR(JJJ),"^",8),PSOLQ1II(JJJ)=PSOPOSSD ;piece 1 if possible dose, piece 8 if not 48 .S Q1(JJJ)=$P(QTVAR(JJJ),"^",2) 49 .S Q2(JJJ)=$P(QTVAR(JJJ),"^",3) 50 .;S Q2(JJJ)=$S($E($P(QTVAR(JJJ),"^",3)):"D"_$P(QTVAR(JJJ),"^",3),$E($P(QTVAR(JJJ),"^",3))=0:"D"_$P(QTVAR(JJJ),"^",3),1:$P(QTVAR(JJJ),"^",3)) 51 .S Q3(JJJ)=$P(QTVAR(JJJ),"^",4) I Q3(JJJ) S X=Q3(JJJ) S Q3(JJJ)=$$HL7TFM^XLFDT(X) K X 52 .S Q4(JJJ)=$P(QTVAR(JJJ),"^",5) 53 .S:$G(PRIOR)="" PRIOR=$P(QTVAR(JJJ),"^",6) 54 .S Q6(JJJ)=$P(QTVAR(JJJ),"^",9) 55 .S Q7(JJJ)=$P(QTVAR(JJJ),"^",10) 56 .S QTARRAY(JJJ)=Q1(JJJ)_"^"_Q2(JJJ)_"^"_Q3(JJJ)_"^"_Q4(JJJ)_"^^"_Q6(JJJ)_"^"_Q7(JJJ) 57 .S QTARRAY2(JJJ)=$S(PSOPOSSD:$P(Q1I(JJJ),"&"),1:Q1I(JJJ))_"^"_$S(PSOPOSSD:$P(Q1I(JJJ),"&",3),1:"") 58 .I PSOPOSSD S $P(QTARRAY(JJJ),"^",5)=$P(Q1I(JJJ),"&",4) 59 .I PSOPOSSD S PSOUNN=$P(Q1I(JJJ),"&",2) I PSOUNN'="" S PSOUNN=$O(^PS(50.607,"B",PSOUNN,0)) S $P(QTARRAY(JJJ),"^",9)=$G(PSOUNN) 60 .K PSOUNN 61 I $G(EFFECT) S X=EFFECT S EFFECT=$$HL7TFM^XLFDT(X) K X 62 D NOW^%DTC S PSOLOG=% S:'$G(EFFECT) EFFECT=% K % 63 K MSG(ZZ,0) 64 Q 65 PARSE I NNNN=1 S PSOOC="NW" G SET 66 I NNNN=2 S PLACER=+$G(POLIM),PLACERXX=+$P($G(POLIM),";",2) G SET 67 I NNNN=3!(NNNN=4)!(NNNN=5) G SET 68 I NNNN=6,$G(POVAR1)="~" S NNCK=NNCK+1,QTVAR(NNCK)=$G(POLIM) G SET 69 I NNNN=7 S NNCK=NNCK+1 S QTVAR(NNCK)=$G(POLIM) G SET 70 I NNNN=8!(NNNN=9) G SET 71 I NNNN=10 S ENTERED=$G(POLIM) G SET 72 I NNNN=11 G SET 73 I NNNN=12 S PROV=$G(POLIM) G SET 74 I NNNN=13!(NNNN=14) G SET 75 I NNNN=15 S EFFECT=$G(POLIM) 76 SET S (POVAR,POLIM)="" Q 77 ; 78 EXP ; 79 ;Q:'$G(OR("PLACE")) 80 Q:'$G(PSOFILNM) 81 S PSOMSORR=1 82 N PSOSSMES S PSOSSMES="CPRSUP" 83 I $G(PSOFILNM),$G(PSOFILNM)["S" S LL=+$G(PSOFILNM) I $D(^PS(52.41,LL,0)),$P($G(^(0)),"^",3)'="RF" G EXPEN 84 S LL=$G(PSOFILNM) I 'LL!('$D(^PSRX(+$G(LL),0))) S COMM="Order was not located by Pharmacy" D EN^ORERR(COMM,.MSG) D G EXPQ 85 .F EER=0:0 S EER=$O(MSG(EER)) Q:'EER S:$P(MSG(EER),"|")="PV1" PSERRPV1=MSG(EER) S:$P(MSG(EER),"|")="PID" PSERRPID=MSG(EER) S:$P(MSG(EER),"|")="ORC"&($G(PSERRORC)="") PSERRORC=MSG(EER) 86 .N MSG,PSOHINST D INIT^PSOHLSN S MSG(2)=$G(PSERRPID),MSG(3)=$G(PSERRPV1),MSG(4)="ORC|DE|"_$G(OR("PLACE"))_$S($G(PLACERXX):";"_PLACERXX,1:"")_"^OR"_"|"_$S($P($G(PSERRORC),"|",4)'="":$P(PSERRORC,"|",4),1:"") S:$G(COMM)'="" MSG(5)="NTE|16||"_COMM 87 .D SEND^PSOHLSN 88 Q:'$D(^PSRX(LL,0)) 89 I +$P($G(^PSRX(LL,2)),"^",6)<DT D 90 .;Reset PSOSSMES if status changes, so HDR gets updated in PSOHLSN1 91 .I +$P($G(^PSRX(LL,"STA")),"^")<12!($P($G(^("STA")),"^")=16) S $P(^PSRX(LL,"STA"),"^")=11 D ECAN^PSOUTL(LL) S PSOSSMES="CPRSVDEF" 92 S GG=+$P($G(^PSRX(LL,"STA")),"^") 93 ;S AA=$S(GG=3:"OH",GG=12:"OD",GG=13:"OC",GG=14:"OD",GG=15:"OD",GG=16:"OH",1:"SC"),AAA=$S(GG=0:"CM",GG=1:"IP",GG=4:"IP",GG=5:"ZS",GG=11:"ZE",1:"") 94 S AA="SC",AAA=$S(GG=0:"CM",GG=2:"CM",GG=1:"IP",GG=4:"IP",GG=5:"ZS",GG=3:"HD",GG=16:"HD",GG=11:"ZE",1:"DC") 95 D EN^PSOHLSN1(LL,AA,AAA,"") 96 K PSOSSMES 97 EXPQ K LL,GG,AA,AAA,PSOMSORR Q 98 EXPEN ;SS on Pending orders 99 S AA=$P($G(^PS(52.41,LL,0)),"^",3) 100 S AAA=$S(AA="DC"!(AA="DE"):"DC",AA="HD":"HD",1:"IP") 101 D EN^PSOHLSN(OR("PLACE"),"SC",AAA) 102 G EXPQ 103 ; 104 OID ;Check for 1 to 1 match from Dispense Drug to Orderable Item 105 N PSOCDD,PSOCDDI,PSOCDDIZ 106 Q:'$G(PSORDITE) 107 K PSOCDDIZ 108 S (PSOCDD,PSOCDDI)=0 109 F S PSOCDD=$O(^PSDRUG("ASP",PSORDITE,PSOCDD)) Q:'PSOCDD I $S('$P($G(^PSDRUG(PSOCDD,"I")),"^"):1,DT'>$P($G(^("I")),"^"):1,1:0),$P($G(^PSDRUG(PSOCDD,2)),"^",3)["O" S PSOCDDI=PSOCDDI+1,PSOCDDIZ=PSOCDD 110 I PSOCDDI'=1 Q 111 S PSOQWX=$G(PSOCDDIZ) 112 Q 113 CP ;ZSC segment (replaced by ZCL segment) 114 S SERV=$S($P(PSOSEG,"|")=1:"SC",$P(PSOSEG,"|")=0:"NSC",1:$P(PSOSEG,"|")) 115 S PSOIBY=$P(PSOSEG,"|",2)_"^"_$P(PSOSEG,"|",3)_"^"_$P(PSOSEG,"|",4)_"^"_$P(PSOSEG,"|",5)_"^"_$P(PSOSEG,"|",6)_"^"_$P(PSOSEG,"|",7)_"^"_$P(PSOSEG,"|",8) 116 Q 117 ; 118 ZCL ;ZCL segment - SC/EI related to ICDs 119 N SEQ,SEQ2,SEQ3 S SEQ3=$P(PSOSEG,"|",2),SEQ2=$P(PSOSEG,"|",1) 120 S:'$D(PSOICD(SEQ2)) PSOICD(SEQ2)="" 121 S $P(PSOICD(SEQ2),"^",(SEQ3+1))=$P(PSOSEG,"|",3) ;set sc/ei for ICD node 122 D SCP^PSORN52D K PSOSCA 123 S:'$D(PSOIBY) PSOIBY="" 124 I PSOSCP<50 D ;set IBQ node variables if <50% SC 125 . Q:$P(PSOIBY,U,$S(SEQ3=1:2,SEQ3=2:3,SEQ3=4:4,SEQ3=5:1,SEQ3=6:5,SEQ3=7:6,SEQ3=8:7,1:""))>0 126 . S:SEQ3=1 $P(PSOIBY,U,2)=$P(PSOSEG,"|",3) ;AO 127 . S:SEQ3=2 $P(PSOIBY,U,3)=$P(PSOSEG,"|",3) ;IR 128 . S:SEQ3=3 SERV=$S($P(PSOSEG,"|",3)=1:"SC",$P(PSOSEG,"|",3)=0:"NSC",1:$P(PSOSEG,"|",3)) ;SC 129 . S:SEQ3=4 $P(PSOIBY,U,4)=$P(PSOSEG,"|",3) ;EC 130 . S:SEQ3=5 $P(PSOIBY,U,1)=$P(PSOSEG,"|",3) ;MST 131 . S:SEQ3=6 $P(PSOIBY,U,5)=$P(PSOSEG,"|",3) ;HNC 132 . S:SEQ3=7 $P(PSOIBY,U,6)=$P(PSOSEG,"|",3) ;CV 133 . S:SEQ3=8 $P(PSOIBY,U,7)=$P(PSOSEG,"|",3) ;SHAD 134 Q 135 MISX ;Mismatch patient on CPRS New Order 136 S RCOMM="Patient mismatch on New Order from CPRS." D EN^ORERR(RCOMM,.MSG) S NWFLAG=1 D RERROR^PSOHLSN D KL^PSOHLSIH 137 Q 138 MISRN ;Mismatch on CPRS renewal 139 N PSOCINV 140 I $G(PDFN)'=$P($G(^PSRX(+$G(PREV),0)),"^",2) D S PSOMO=1 Q 141 .S RCOMM="Patient mismatch on CPRS Renewal." D EN^ORERR(RCOMM,.MSG) S PSOXRP=1 D RERROR^PSOHLSN D KL^PSOHLSIH 142 S PSOCINV=+$P($G(^OR(100,+$G(PLACER),3)),"^",5) 143 I PSOCINV'=$P($G(^PSRX(+$G(PREV),"OR1")),"^",2) D S PSOMO=1 Q 144 .S RCOMM="Order mismatch on CPRS Renewal." D EN^ORERR(RCOMM,.MSG) S PSOCVI=1 D RERROR^PSOHLSN D KL^PSOHLSIH 145 Q 146 ZRX ;Process ZRX segment 147 I $P(PSOSEG,"|",3)="R" S PSOOC="RNW",PSRNFLAG=1 148 S PREV=$S(+$P(PSOSEG,"|"):+$P(PSOSEG,"|"),1:"") 149 I $P(PSOSEG,"|")["P"!($P(PSOSEG,"|")["S") S PFLAG=1 150 S NATURE=$P(PSOSEG,"|",2) 151 S PSORSO=$P(PSOSEG,"|",3) 152 S ROUTING=$P(PSOSEG,"|",4) 153 I ROUTING="" S ROUTING="M" 154 I $P(PSOSEG,"|",7) S DSIG=1 155 Q 156 CHCS ;Replace CHCS number with CPRS number in .01 field 157 N PSOHTMP 158 I $G(PDFN),PDFN'=+$P($G(^PS(52.41,+$G(PSOCHFFL),0)),"^",2) S COMM="Patient does not match" D EN^ORERR(COMM,.MSG) K PSOPLC,PSOFFL,PSOSND Q 159 I '$D(^PS(52.41,+$G(PSOCHFFL),0)) S COMM="Order was not located by Pharmacy" D EN^ORERR(COMM,.MSG) K PSOPLC,PSOFFL,PSOSND Q 160 S PSOHTMP=$P($G(^PS(52.41,+$G(PSOCHFFL),0)),"^") 161 I PSOHTMP'="" K ^PS(52.41,"B",PSOHTMP,+$G(PSOCHFFL)) 162 S $P(^PS(52.41,+$G(PSOCHFFL),0),"^")=PSOPLC,^PS(52.41,"B",PSOPLC,+$G(PSOCHFFL))="" 163 S $P(^PS(52.41,+$G(PSOCHFFL),"EXT"),"^",2)=1 164 Q 165 CNT ; 166 S TAC=0 F TACA=0:0 S TACA=$O(^PSRX(PREV,"A",TACA)) Q:'TACA S TAC=TACA 167 S PAC=0 F PACA=0:0 S PACA=$O(^PSRX(PREV,1,PACA)) Q:'PACA S PAC=PACA 168 D NOW^%DTC S TAC=TAC+1,^PSRX(PREV,"A",0)="^52.3DA^"_TAC_"^"_TAC,^PSRX(PREV,"A",TAC,0)=%_"^"_"C"_"^"_$S(+$G(PROV):$G(PROV),1:+$G(ENTERED))_"^"_PAC_"^"_"Discontinued due to CPRS edit" 169 K TAC,PAC,TACA,PACA 170 Q 171 NTE ; 172 S WPCT=1,WORDP=$S($P(MSG(LL),"|",2):$P(MSG(LL),"|",2),1:$P(MSG(LL),"|",3)) S:$P(MSG(LL),"|",4)'="" WPARRAY(WORDP,WPCT)=$P(MSG(LL),"|",4) S:$P(MSG(LL),"|",4)'="" WPCT=WPCT+1 F LLL=0:0 S LLL=$O(MSG(LL,LLL)) Q:'LLL D 173 .I $G(MSG(LL,LLL))'="" S WPARRAY(WORDP,WPCT)=$G(MSG(LL,LLL)),WPCT=WPCT+1 174 Q 1 PSOHLNE1 ;BIR/RTR-Parsing out segments from OERR ;01/20/95 2 ;;7.0;OUTPATIENT PHARMACY;**1,9,46,71,98,111,117,131,157,181,143,235,239**;DEC 1997 3 ;External reference to EN^ORERR supported by DBIA 2187 4 ;External reference to PS(50.607 supported by DBIA 2221 5 ;External reference to OR(100 supported by DBIA 2219 6 ;External reference to PSDRUG( supported by DBIA 221 7 ;External reference VADPT supported by DBIA 10061 8 ; 9 EN ;ORC segment 10 N Q1,Q2,Q3,Q4,Q5,Q6,Q7,PSOPOSSD 11 K PSOLQ1I,PSOLQ1II,PSOLQ1IX 12 I '$O(MSG(ZZ,0)) D 13 .S PSOOC="NW",PLACER=+$P(PSOSEG,"|",2),PLACERXX=+$P($P(PSOSEG,"|",2),";",2),ENTERED=$P(PSOSEG,"|",10),PROV=$P(PSOSEG,"|",12) 14 .S X=$P(PSOSEG,"|",15) S EFFECT=$$HL7TFM^XLFDT(X) K X 15 .D NOW^%DTC S PSOLOG=% K % 16 .;S RSN=$P(PSOSEG,"|",16) 17 .S ORCSEG=$P(PSOSEG,"|",7),QCOUNT=1 Q:$G(ORCSEG)'["~" 18 .F JJ=1:1:$L(ORCSEG) S:$E(ORCSEG,JJ)="~" QCOUNT=QCOUNT+1 19 I '$O(MSG(ZZ,0)) D Q 20 .F JJJ=1:1:QCOUNT S QQQ=$P(ORCSEG,"~",JJJ) D:QQQ'="" 21 ..S PSOPOSSD=$S($P($P(QQQ,"^"),"&"):1,1:0) ;PSOPOSSD=1 if possible dose 22 ..S Q1I(JJJ)=$S(PSOPOSSD:$P(QQQ,"^"),1:$P(QQQ,"^",8)),PSOLQ1IX(JJJ)=$P($P(QQQ,"^"),"&",5) S PSOLQ1I(JJJ)=$P(QQQ,"^",8),PSOLQ1II(JJJ)=PSOPOSSD ;ORC piece 1 if Possible Dosage, ORC piece 8 if Local Possible Dosage 23 ..S Q1(JJJ)=$P(QQQ,"^",2) ;schedule 24 ..S Q2(JJJ)=$P(QQQ,"^",3) ;duration 25 ..S Q3(JJJ)=$P(QQQ,"^",4) I Q3(JJJ) S X=Q3(JJJ) S Q3(JJJ)=$$HL7TFM^XLFDT(X) K X ;start date 26 ..S Q4(JJJ)=$P(QQQ,"^",5) ;end date 27 ..S:$G(PRIOR)="" PRIOR=$P(QQQ,"^",6) 28 ..S Q6(JJJ)=$P(QQQ,"^",9) ;conjunction 29 ..S Q7(JJJ)=$P(QQQ,"^",10) ;sequencing 30 ..S QTARRAY(JJJ)=Q1(JJJ)_"^"_Q2(JJJ)_"^"_Q3(JJJ)_"^"_Q4(JJJ)_"^^"_Q6(JJJ)_"^"_Q7(JJJ) 31 ..S QTARRAY2(JJJ)=$S(PSOPOSSD:$P(Q1I(JJJ),"&"),1:Q1I(JJJ))_"^"_$S(PSOPOSSD:$P(Q1I(JJJ),"&",3),1:"") 32 ..I PSOPOSSD S $P(QTARRAY(JJJ),"^",5)=$P(Q1I(JJJ),"&",4) 33 ..I PSOPOSSD S PSOUNN=$P(Q1I(JJJ),"&",2) I PSOUNN'="" S PSOUNN=$O(^PS(50.607,"B",PSOUNN,0)) S $P(QTARRAY(JJJ),"^",9)=$G(PSOUNN) 34 ..K PSOUNN 35 ;For multiple ORC subscripts 36 S (POVAR,POVAR1)="",(NNCK,NNN,NNNN)=0,PSOIII=1,MSG(ZZ,0)=$E(MSG(ZZ),5,$L(MSG(ZZ))) 37 S AAA="" F S AAA=$O(MSG(ZZ,AAA)) Q:AAA="" S NNN=0 F OOO=1:1:$L(MSG(ZZ,AAA)) S NNN=NNN+1 D D:$G(POVAR1)="~"&(NNNN=6) PARSE D:$G(POVAR1)="|" PARSE 38 .I $E(MSG(ZZ,AAA),OOO)="|" S NNNN=NNNN+1 39 .S POVAR1=$E(MSG(ZZ,AAA),OOO) 40 .S POLIM=POVAR 41 .S POVAR=$S(POVAR="":POVAR1,1:POVAR_POVAR1) 42 .;I NNNN=6 I $G(POVAR1)="~"!($G(POVAR1)="|") 43 END ;16 OF ORC? 44 ;I $G(POVAR)'="" I NNNN=14!(NNNN=15) S EFFECT=$G(POVAR) 45 S QCOUNT=0 F JJJ=0:0 S JJJ=$O(QTVAR(JJJ)) Q:'JJJ I $L($G(QTVAR(JJJ))) S QCOUNT=QCOUNT+1 D 46 .S PSOPOSSD=$S($P($P(QTVAR(JJJ),"^"),"&"):1,1:0) ;PSOPOSSD =1 if possible dose 47 .S Q1I(JJJ)=$S(PSOPOSSD:$P(QTVAR(JJJ),"^"),1:$P(QTVAR(JJJ),"^",8)),PSOLQ1IX(JJJ)=$P($P(QTVAR(JJJ),"^"),"&",5) S PSOLQ1I(JJJ)=$P(QTVAR(JJJ),"^",8),PSOLQ1II(JJJ)=PSOPOSSD ;piece 1 if possible dose, piece 8 if not 48 .S Q1(JJJ)=$P(QTVAR(JJJ),"^",2) 49 .S Q2(JJJ)=$P(QTVAR(JJJ),"^",3) 50 .;S Q2(JJJ)=$S($E($P(QTVAR(JJJ),"^",3)):"D"_$P(QTVAR(JJJ),"^",3),$E($P(QTVAR(JJJ),"^",3))=0:"D"_$P(QTVAR(JJJ),"^",3),1:$P(QTVAR(JJJ),"^",3)) 51 .S Q3(JJJ)=$P(QTVAR(JJJ),"^",4) I Q3(JJJ) S X=Q3(JJJ) S Q3(JJJ)=$$HL7TFM^XLFDT(X) K X 52 .S Q4(JJJ)=$P(QTVAR(JJJ),"^",5) 53 .S:$G(PRIOR)="" PRIOR=$P(QTVAR(JJJ),"^",6) 54 .S Q6(JJJ)=$P(QTVAR(JJJ),"^",9) 55 .S Q7(JJJ)=$P(QTVAR(JJJ),"^",10) 56 .S QTARRAY(JJJ)=Q1(JJJ)_"^"_Q2(JJJ)_"^"_Q3(JJJ)_"^"_Q4(JJJ)_"^^"_Q6(JJJ)_"^"_Q7(JJJ) 57 .S QTARRAY2(JJJ)=$S(PSOPOSSD:$P(Q1I(JJJ),"&"),1:Q1I(JJJ))_"^"_$S(PSOPOSSD:$P(Q1I(JJJ),"&",3),1:"") 58 .I PSOPOSSD S $P(QTARRAY(JJJ),"^",5)=$P(Q1I(JJJ),"&",4) 59 .I PSOPOSSD S PSOUNN=$P(Q1I(JJJ),"&",2) I PSOUNN'="" S PSOUNN=$O(^PS(50.607,"B",PSOUNN,0)) S $P(QTARRAY(JJJ),"^",9)=$G(PSOUNN) 60 .K PSOUNN 61 I $G(EFFECT) S X=EFFECT S EFFECT=$$HL7TFM^XLFDT(X) K X 62 D NOW^%DTC S PSOLOG=% S:'$G(EFFECT) EFFECT=% K % 63 K MSG(ZZ,0) 64 Q 65 PARSE I NNNN=1 S PSOOC="NW" G SET 66 I NNNN=2 S PLACER=+$G(POLIM),PLACERXX=+$P($G(POLIM),";",2) G SET 67 I NNNN=3!(NNNN=4)!(NNNN=5) G SET 68 I NNNN=6,$G(POVAR1)="~" S NNCK=NNCK+1,QTVAR(NNCK)=$G(POLIM) G SET 69 I NNNN=7 S NNCK=NNCK+1 S QTVAR(NNCK)=$G(POLIM) G SET 70 I NNNN=8!(NNNN=9) G SET 71 I NNNN=10 S ENTERED=$G(POLIM) G SET 72 I NNNN=11 G SET 73 I NNNN=12 S PROV=$G(POLIM) G SET 74 I NNNN=13!(NNNN=14) G SET 75 I NNNN=15 S EFFECT=$G(POLIM) 76 SET S (POVAR,POLIM)="" Q 77 ; 78 EXP ; 79 ;Q:'$G(OR("PLACE")) 80 Q:'$G(PSOFILNM) 81 S PSOMSORR=1 82 N PSOSSMES S PSOSSMES="CPRSUP" 83 I $G(PSOFILNM),$G(PSOFILNM)["S" S LL=+$G(PSOFILNM) I $D(^PS(52.41,LL,0)),$P($G(^(0)),"^",3)'="RF" G EXPEN 84 S LL=$G(PSOFILNM) I 'LL!('$D(^PSRX(+$G(LL),0))) S COMM="Order was not located by Pharmacy" D EN^ORERR(COMM,.MSG) D G EXPQ 85 .F EER=0:0 S EER=$O(MSG(EER)) Q:'EER S:$P(MSG(EER),"|")="PV1" PSERRPV1=MSG(EER) S:$P(MSG(EER),"|")="PID" PSERRPID=MSG(EER) S:$P(MSG(EER),"|")="ORC"&($G(PSERRORC)="") PSERRORC=MSG(EER) 86 .N MSG,PSOHINST D INIT^PSOHLSN S MSG(2)=$G(PSERRPID),MSG(3)=$G(PSERRPV1),MSG(4)="ORC|DE|"_$G(OR("PLACE"))_$S($G(PLACERXX):";"_PLACERXX,1:"")_"^OR"_"|"_$S($P($G(PSERRORC),"|",4)'="":$P(PSERRORC,"|",4),1:"") S:$G(COMM)'="" MSG(5)="NTE|16||"_COMM 87 .D SEND^PSOHLSN 88 Q:'$D(^PSRX(LL,0)) 89 I +$P($G(^PSRX(LL,2)),"^",6)<DT D 90 .;Reset PSOSSMES if status changes, so HDR gets updated in PSOHLSN1 91 .I +$P($G(^PSRX(LL,"STA")),"^")<12!($P($G(^("STA")),"^")=16) S $P(^PSRX(LL,"STA"),"^")=11 D ECAN^PSOUTL(LL) S PSOSSMES="CPRSVDEF" 92 S GG=+$P($G(^PSRX(LL,"STA")),"^") 93 ;S AA=$S(GG=3:"OH",GG=12:"OD",GG=13:"OC",GG=14:"OD",GG=15:"OD",GG=16:"OH",1:"SC"),AAA=$S(GG=0:"CM",GG=1:"IP",GG=4:"IP",GG=5:"ZS",GG=11:"ZE",1:"") 94 S AA="SC",AAA=$S(GG=0:"CM",GG=2:"CM",GG=1:"IP",GG=4:"IP",GG=5:"ZS",GG=3:"HD",GG=16:"HD",GG=11:"ZE",1:"DC") 95 D EN^PSOHLSN1(LL,AA,AAA,"") 96 K PSOSSMES 97 EXPQ K LL,GG,AA,AAA,PSOMSORR Q 98 EXPEN ;SS on Pending orders 99 S AA=$P($G(^PS(52.41,LL,0)),"^",3) 100 S AAA=$S(AA="DC"!(AA="DE"):"DC",AA="HD":"HD",1:"IP") 101 D EN^PSOHLSN(OR("PLACE"),"SC",AAA) 102 G EXPQ 103 ; 104 OID ;Check for 1 to 1 match from Dispense Drug to Orderable Item 105 N PSOCDD,PSOCDDI,PSOCDDIZ 106 Q:'$G(PSORDITE) 107 K PSOCDDIZ 108 S (PSOCDD,PSOCDDI)=0 109 F S PSOCDD=$O(^PSDRUG("ASP",PSORDITE,PSOCDD)) Q:'PSOCDD I $S('$P($G(^PSDRUG(PSOCDD,"I")),"^"):1,DT'>$P($G(^("I")),"^"):1,1:0),$P($G(^PSDRUG(PSOCDD,2)),"^",3)["O" S PSOCDDI=PSOCDDI+1,PSOCDDIZ=PSOCDD 110 I PSOCDDI'=1 Q 111 S PSOQWX=$G(PSOCDDIZ) 112 Q 113 CP ;ZSC segment (replaced by ZCL segment) 114 S SERV=$S($P(PSOSEG,"|")=1:"SC",$P(PSOSEG,"|")=0:"NSC",1:$P(PSOSEG,"|")) 115 S PSOIBY=$P(PSOSEG,"|",2)_"^"_$P(PSOSEG,"|",3)_"^"_$P(PSOSEG,"|",4)_"^"_$P(PSOSEG,"|",5)_"^"_$P(PSOSEG,"|",6)_"^"_$P(PSOSEG,"|",7) 116 Q 117 ; 118 ZCL ;ZCL segment - SC/EI related to ICDs 119 N SEQ,SEQ2,SEQ3 S SEQ3=$P(PSOSEG,"|",2),SEQ2=$P(PSOSEG,"|",1) 120 S:'$D(PSOICD(SEQ2)) PSOICD(SEQ2)="" 121 S $P(PSOICD(SEQ2),"^",(SEQ3+1))=$P(PSOSEG,"|",3) ;set sc/ei for ICD node 122 D SCP^PSORN52D K PSOSCA 123 S:'$D(PSOIBY) PSOIBY="" 124 I PSOSCP<50 D ;set IBQ node variables if <50% SC 125 . Q:$P(PSOIBY,U,$S(SEQ3=1:2,SEQ3=2:3,SEQ3=4:4,SEQ3=5:1,SEQ3=6:5,SEQ3=7:6,1:""))>0 126 . S:SEQ3=1 $P(PSOIBY,U,2)=$P(PSOSEG,"|",3) ;AO 127 . S:SEQ3=2 $P(PSOIBY,U,3)=$P(PSOSEG,"|",3) ;IR 128 . S:SEQ3=3 SERV=$S($P(PSOSEG,"|",3)=1:"SC",$P(PSOSEG,"|",3)=0:"NSC",1:$P(PSOSEG,"|",3)) ;SC 129 . S:SEQ3=4 $P(PSOIBY,U,4)=$P(PSOSEG,"|",3) ;EC 130 . S:SEQ3=5 $P(PSOIBY,U,1)=$P(PSOSEG,"|",3) ;MST 131 . S:SEQ3=6 $P(PSOIBY,U,5)=$P(PSOSEG,"|",3) ;HNC 132 . S:SEQ3=7 $P(PSOIBY,U,6)=$P(PSOSEG,"|",3) ;CV 133 ;E D 134 ;. S PSOIBY="^^^^^^",SERV="" 135 Q 136 MISX ;Mismatch patient on CPRS New Order 137 S RCOMM="Patient mismatch on New Order from CPRS." D EN^ORERR(RCOMM,.MSG) S NWFLAG=1 D RERROR^PSOHLSN D KL^PSOHLSIH 138 Q 139 MISRN ;Mismatch on CPRS renewal 140 N PSOCINV 141 I $G(PDFN)'=$P($G(^PSRX(+$G(PREV),0)),"^",2) D S PSOMO=1 Q 142 .S RCOMM="Patient mismatch on CPRS Renewal." D EN^ORERR(RCOMM,.MSG) S PSOXRP=1 D RERROR^PSOHLSN D KL^PSOHLSIH 143 S PSOCINV=+$P($G(^OR(100,+$G(PLACER),3)),"^",5) 144 I PSOCINV'=$P($G(^PSRX(+$G(PREV),"OR1")),"^",2) D S PSOMO=1 Q 145 .S RCOMM="Order mismatch on CPRS Renewal." D EN^ORERR(RCOMM,.MSG) S PSOCVI=1 D RERROR^PSOHLSN D KL^PSOHLSIH 146 Q 147 ZRX ;Process ZRX segment 148 I $P(PSOSEG,"|",3)="R" S PSOOC="RNW",PSRNFLAG=1 149 S PREV=$S(+$P(PSOSEG,"|"):+$P(PSOSEG,"|"),1:"") 150 I $P(PSOSEG,"|")["P"!($P(PSOSEG,"|")["S") S PFLAG=1 151 S NATURE=$P(PSOSEG,"|",2) 152 S PSORSO=$P(PSOSEG,"|",3) 153 S ROUTING=$P(PSOSEG,"|",4) 154 I ROUTING="" S ROUTING="M" 155 I $P(PSOSEG,"|",7) S DSIG=1 156 Q 157 CHCS ;Replace CHCS number with CPRS number in .01 field 158 N PSOHTMP 159 I $G(PDFN),PDFN'=+$P($G(^PS(52.41,+$G(PSOCHFFL),0)),"^",2) S COMM="Patient does not match" D EN^ORERR(COMM,.MSG) K PSOPLC,PSOFFL,PSOSND Q 160 I '$D(^PS(52.41,+$G(PSOCHFFL),0)) S COMM="Order was not located by Pharmacy" D EN^ORERR(COMM,.MSG) K PSOPLC,PSOFFL,PSOSND Q 161 S PSOHTMP=$P($G(^PS(52.41,+$G(PSOCHFFL),0)),"^") 162 I PSOHTMP'="" K ^PS(52.41,"B",PSOHTMP,+$G(PSOCHFFL)) 163 S $P(^PS(52.41,+$G(PSOCHFFL),0),"^")=PSOPLC,^PS(52.41,"B",PSOPLC,+$G(PSOCHFFL))="" 164 S $P(^PS(52.41,+$G(PSOCHFFL),"EXT"),"^",2)=1 165 Q 166 CNT ; 167 S TAC=0 F TACA=0:0 S TACA=$O(^PSRX(PREV,"A",TACA)) Q:'TACA S TAC=TACA 168 S PAC=0 F PACA=0:0 S PACA=$O(^PSRX(PREV,1,PACA)) Q:'PACA S PAC=PACA 169 D NOW^%DTC S TAC=TAC+1,^PSRX(PREV,"A",0)="^52.3DA^"_TAC_"^"_TAC,^PSRX(PREV,"A",TAC,0)=%_"^"_"C"_"^"_$S(+$G(PROV):$G(PROV),1:+$G(ENTERED))_"^"_PAC_"^"_"Discontinued due to CPRS edit" 170 K TAC,PAC,TACA,PACA 171 Q 172 NTE ; 173 S WPCT=1,WORDP=$S($P(MSG(LL),"|",2):$P(MSG(LL),"|",2),1:$P(MSG(LL),"|",3)) S:$P(MSG(LL),"|",4)'="" WPARRAY(WORDP,WPCT)=$P(MSG(LL),"|",4) S:$P(MSG(LL),"|",4)'="" WPCT=WPCT+1 F LLL=0:0 S LLL=$O(MSG(LL,LLL)) Q:'LLL D 174 .I $G(MSG(LL,LLL))'="" S WPARRAY(WORDP,WPCT)=$G(MSG(LL,LLL)),WPCT=WPCT+1 175 Q
Note:
See TracChangeset
for help on using the changeset viewer.
