- 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/PSOHLSN.m
r613 r623 1 PSOHLSN ;BIR/RTR-Send order information to OERR from file 52.41 ;10/10/94 2 ;;7.0;OUTPATIENT PHARMACY;**1,7,15,24,27,30,55,46,98,88,121,292**;DEC 1997;Build 1 3 ;Externel reference EN^ORERR supported by DBIA 2187 4 ; 5 ; PS EVSEND OR PROTOCOL MUST BE OUR DRIVER RTN, (52 OR 52.41 INDICATOR 6 ; IS SENT THERE, THEN IT ROUTES, (NO NEED TO SEND FILE NUMBER HERE) 7 EN(PLACER,STAT,COMM,PSNOO) ; 8 N DA,FIELD,J,JJ,MSG,LIMIT,NULLFLDS,PSIEN,PSOHINST,PSZERO,SEGMENT,NAME,DFN,COUNT,GG,CC,CT,MM,PVAR,PVAR1,PLIM,SEG1,SUBCOUNT,PSOPSTRT,PSOPSTOP,PSODFN,EDUZ,PSNOOTX,PSOHSTAT,PSOPSIEN 9 S (PSIEN,PSOPSIEN)=$O(^PS(52.41,"B",PLACER,0)) 10 S COUNT=0 11 ;I '$G(PSIEN) W !!,?5,"PROBLEM WITH ENTRY IN PENDING FILE!",! Q 12 I '$G(PSIEN) Q 13 I $G(STAT)="OC"!($G(STAT)="OD")!($G(STAT)="CR")!($G(STAT)="DR") D 14 .D CHKOLDRX 15 .I $D(^PS(52.41,PSIEN,0)) K ^PS(52.41,"AD",$P(^PS(52.41,PSIEN,0),"^",12),+$P($G(^("INI")),"^"),PSIEN),^PS(52.41,"ACL",+$P(^PS(52.41,PSIEN,0),"^",13),+$P(^(0),"^",12),PSIEN),^PS(52.41,"AQ",+$P($G(^PS(52.41,PSIEN,0)),"^",21),PSIEN) 16 S PSZERO=$G(^PS(52.41,PSIEN,0)),PSOHSTAT=$G(STAT) 17 S NULLFLDS="F JJ=0:1:LIMIT S FIELD(JJ)=""""" 18 D INIT 19 I $G(STAT)="Z@" S COUNT=1 D PID,PV1,ORC,SEND Q 20 S COUNT=1 D PID,PV1,ORC,RXE,ZRX,SEND,REN Q 21 INIT K ^UTILITY("DIQ1",$J),DIQ S DA=$P($$SITE^VASITE(),"^") I $G(DA) S DIC=4,DIQ(0)="I",DR="99" D EN^DIQ1 S PSOHINST=$G(^UTILITY("DIQ1",$J,4,DA,99,"I")) K ^UTILITY("DIQ1",$J),DA,DR,DIQ,DIC 22 S MSG(1)="MSH|^~\&|PHARMACY|"_$G(PSOHINST)_"|||||"_$S($G(PSOMSORR):"ORR",1:"ORM") 23 Q 24 PID S LIMIT=5 X NULLFLDS 25 S FIELD(0)="PID" 26 S DFN=+$P(PSZERO,"^",2) D DEM^VADPT S NAME=$G(VADM(1)) K VADM 27 S FIELD(3)=DFN 28 S FIELD(5)=NAME 29 D SEG Q 30 PV1 S LIMIT=19 X NULLFLDS 31 S FIELD(0)="PV1" 32 S FIELD(2)="O" 33 S:$P($G(^PS(52.41,PSIEN,0)),"^",13) FIELD(3)=$P(^(0),"^",13) 34 D SEG Q 35 ORC S LIMIT=15 X NULLFLDS 36 S FIELD(0)="ORC" 37 S FIELD(1)=STAT 38 S FIELD(2)=PLACER_$S($G(PLACERXX):";"_PLACERXX,1:"")_"^OR" 39 S FIELD(3)=PSIEN_"S"_"^PS" 40 I $G(FIELD(5))="" I $G(STAT)="OR"!($G(STAT)="OE") S FIELD(5)="IP" 41 S:$G(COMM)="IP" FIELD(5)="IP" 42 I $G(STAT)="SC" S FIELD(5)=$S($G(COMM)="IP":"IP",$G(COMM)="HD":"HD",$G(COMM)="DC":"DC",1:"") 43 I $G(PSORPV),$G(STAT)="OC" S FIELD(5)="RP" 44 ;S (PSOPSTRT,PSOPSTOP)="" S X=$P($G(^PS(52.41,PSIEN,0)),"^",6) I X S PSOPSTRT=$$FMTHL7^XLFDT(X) 45 ;I $G(STAT)="CR"!($G(STAT)="OC") D:'$G(DT) S X=DT S PSOPSTOP=$$FMTHL7^XLFDT(X) 46 ;.S DT=$$DT^XLFDT 47 ;K X S FIELD(7)="^^^"_$G(PSOPSTRT)_"^"_$G(PSOPSTOP) 48 S EDUZ=$P($G(^PS(52.41,PSIEN,0)),"^",4) I EDUZ D USER^PSOORFI2(EDUZ) S FIELD(10)=EDUZ_"^"_USER1 K USER1 49 I $G(PSOCANRC),$G(PSOCANRN)'="" I $G(STAT)="OC"!($G(STAT)="OD") S FIELD(12)=$G(PSOCANRC)_"^"_$G(PSOCANRN) 50 I '$G(FIELD(12)) D USER^PSOORFI2($P(^PS(52.41,PSIEN,0),"^",5)) 51 I '$G(FIELD(12)) S FIELD(12)=$P(^PS(52.41,PSIEN,0),"^",5)_"^"_USER1 K USER1 52 S FIELD(15)=$G(PSOPSTRT) 53 D SEG 54 I $G(COMM)'=""!($G(PSNOO)'="") D 55 .I $G(PSNOO)="" I $G(COMM)="IP"!($G(COMM)="HD")!($G(COMM)="DC") Q 56 .I $G(PSNOO)'="" D NOO^PSOHLSN1 57 .I '$D(COMM) S COMM="" 58 .I $L($G(COMM))+($L(MSG(COUNT)))+($L($G(PSNOOTX)))+($S($G(PSNOO)'="":11,1:5))<245 S MSG(COUNT)=MSG(COUNT)_"|"_$G(PSNOO)_"^"_$G(PSNOOTX)_"^"_$S($G(PSNOO)'="":"99ORN",1:"")_"^^"_$S(COMM="IP"!(COMM="DC")!(COMM="HD"):"",1:$G(COMM))_"^" Q 59 .S MSG(COUNT,1)="|"_$G(PSNOO)_"^"_$G(PSNOOTX)_"^"_$S($G(PSNOO)'="":"99ORN",1:"")_"^^"_$S(COMM="IP"!(COMM="DC")!(COMM="HD"):"",1:$G(COMM))_"^" Q 60 Q 61 RXE S LIMIT=1 X NULLFLDS 62 S FIELD(0)="RXE" 63 S (PSOPSTRT,PSOPSTOP)="" S X=$P($G(^PS(52.41,PSIEN,0)),"^",6) I X S PSOPSTRT=$$FMTHL7^XLFDT(X) 64 I $G(STAT)="CR"!($G(STAT)="OC") D:'$G(DT) S X=DT S PSOPSTOP=$$FMTHL7^XLFDT(X) 65 .S DT=$$DT^XLFDT 66 K X S FIELD(1)="^^^"_$G(PSOPSTRT)_"^"_$G(PSOPSTOP) 67 D SEG Q 68 ; 69 ZRX ; 70 ;Only send if DC is from an external system 71 I $G(STAT)'="OC",$G(STAT)'="OD" Q 72 I '$G(PSOHUIOR)!('$G(PSOCANRC)) Q 73 I $P($G(^PS(52.41,PSIEN,"EXT")),"^")="" Q 74 S LIMIT=5 X NULLFLDS 75 S FIELD(0)="ZRX" 76 S FIELD(5)=PSOCANRC_"^"_$P($G(^VA(200,PSOCANRC,0)),"^")_"^"_"99NP" 77 D SEG 78 Q 79 ; 80 SEG S SEGMENT="" F J=0:1:LIMIT S SEGMENT=$S(SEGMENT="":FIELD(J),1:SEGMENT_"|"_FIELD(J)) 81 S COUNT=COUNT+1,MSG(COUNT)=SEGMENT 82 Q 83 SEND D MSG^XQOR("PS EVSEND OR",.MSG) 84 Q 85 ; 86 SEGPAR ;Parse out fields for sending segments to OERR that can be >245 87 K PSOFIELD 88 S COUNT=COUNT+1,CT=1,(PVAR,PVAR1)="" 89 F MM=0:1:LIMIT S FIELD(MM)=$S(FIELD(MM)="":"|",1:FIELD(MM)_"|") 90 I $L(FIELD(LIMIT))>1 S FIELD(LIMIT)=$E(FIELD(LIMIT),1,($L(FIELD(LIMIT))-1)) 91 F MM=0:1:LIMIT S SEG1=FIELD(MM) F CC=1:1:$L(SEG1) D I $L(PVAR)=245 S PSOFIELD(CT)=PVAR,CT=CT+1,PVAR="" 92 .S PVAR1=$E(SEG1,CC) 93 .S PLIM=PVAR 94 .S PVAR=$S(PVAR="":PVAR1,1:PVAR_PVAR1) 95 I $G(PVAR)'="" S PSOFIELD(CT)=PVAR 96 S MSG(COUNT)=PSOFIELD(1),SUBCOUNT=1 F GG=2:1 Q:'$D(PSOFIELD(GG)) S MSG(COUNT,SUBCOUNT)=PSOFIELD(GG),SUBCOUNT=SUBCOUNT+1 97 K PSOFIELD 98 Q 99 ERROR ;Builds error message from PSOHLNEW, usually means we can't find order 100 D EN^ORERR(COMM,.MSG) 101 N MSG,PSOHINST 102 S PSOMSORR=1 D INIT 103 S MSG(2)=$G(PSERRPID) 104 S MSG(3)=$G(PSERRPV1) 105 S MSG(4)="ORC|"_$S($G(STAT)'="":$G(STAT),1:"DE")_"|"_PLACER_$S($G(PLACERXX):";"_PLACERXX,1:"")_"^OR"_"|"_$S($P($G(PSERRORC),"|",4)'="":$P(PSERRORC,"|",4),1:"") 106 F EER=11,13 I $P($G(PSERRORC),"|",EER)'="" S $P(MSG(4),"|",EER)=$P($G(PSERRORC),"|",EER) 107 I $G(COMM)'="" S $P(MSG(4),"|",17)="^^^^"_$G(COMM) 108 D SEND K PSOMSORR Q 109 ; 110 RERROR ; 111 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) 112 N MSG 113 S PSOMSORR=1 D INIT 114 S MSG(2)=$G(PSERRPID),MSG(3)=$G(PSERRPV1) 115 S MSG(4)="ORC|"_$S($G(XOFLAGZ):"UX",1:"UA")_"|"_$G(PLACER)_$S($G(PLACERXX):";"_PLACERXX,1:"")_"^OR"_"|"_$S($P($G(PSERRORC),"|",4)'="":$P(PSERRORC,"|",4),1:"") 116 F EER=11,13 I $P($G(PSERRORC),"|",EER)'="" S $P(MSG(4),"|",EER)=$P($G(PSERRORC),"|",EER) 117 S $P(MSG(4),"|",17)="D^Duplicate^99ORN^^"_$S($G(XOFLAGZ):"Patient mismatch on previous order.",$G(NWFLAG):"Patient Mismatch on new CPRS order",$G(PSOXRP):"Patient mismatch on Renewal.",1:"Duplicate Renewal Request. Order rejected by Pharmacy.") 118 I $G(PSOCVI) S $P(MSG(4),"|",17)="D^Duplicate^99ORN^^Order mismatch on Renewal." 119 D SEND K PSOMSORR Q 120 ; 121 DCP ; 122 K ^PS(52.41,"AOR",+$G(DFN),+$P($G(^PS(52.41,+$G(PREV),"INI")),"^"),+$G(PREV)) S $P(^PS(52.41,+$G(PREV),0),"^",3)="DE" 123 S PSORPV=1 N PSOMSORR 124 D EN^PSOHLSN(+$P($G(^PS(52.41,+$G(PREV),0)),"^"),"OC","","A") 125 K PSORPV 126 Q 127 REN ;Update previous Rx on Cancel/Discontinue 128 N RPREV,RENOC,RENOCP,RENSTA,PSOMSORR 129 I $G(PSOHSTAT)'="OC",$G(PSOHSTAT)'="CR",$G(PSOHSTAT)'="DR",$G(PSOHSTAT)'="OD" Q 130 Q:'$D(^PS(52.41,+$G(PSOPSIEN),0)) 131 S RPREV=$P($G(^PS(52.41,+$G(PSOPSIEN),0)),"^",21) Q:'$G(RPREV)!('$D(^PSRX(+$G(RPREV),0))) 132 S RENSTA=$P($G(^PSRX(+$G(RPREV),"STA")),"^") Q:$G(RENSTA)="" 133 S RENOC="SC",RENOCP=$S(RENSTA=0:"CM",(RENSTA=1!(RENSTA=4)):"IP",(RENSTA=3!(RENSTA=16)):"HD",RENSTA=5:"ZS",RENSTA=11:"ZE",RENSTA=15:"RP",1:"DC") 134 D EN^PSOHLSN1(RPREV,RENOC,RENOCP,"","") 135 Q 136 ; 137 DELP ;Delete refill requests 138 I $G(PSODEATH) Q 139 N DA,PENDDA 140 S PENDDA=$P($G(^PSRX(+$G(PSRXIEN),"OR1")),"^",2) I 'PENDDA Q 141 S DA=$O(^PS(52.41,"B",PENDDA,0)) I '$G(DA) Q 142 I $P($G(^PS(52.41,DA,0)),"^",3)="RF" S DIK="^PS(52.41," D ^DIK K DIK 143 Q 144 SEGPARX ; 145 N PSOFIELD 146 S COUNT=COUNT+1,CT=1,(PVAR,PVAR1)="" 147 F MM=0:1:LIMIT I MM'=1 S FIELD(MM)=$S(FIELD(MM)="":"|",1:FIELD(MM)_"|") 148 F MM=0:0 S MM=$O(FIELD(1,MM)) I '$O(FIELD(1,MM)) S FIELD(1,MM)=$S(FIELD(1,MM)="":"|",1:FIELD(1,MM)_"|") Q 149 I $L(FIELD(LIMIT))>1 S FIELD(LIMIT)=$E(FIELD(LIMIT),1,($L(FIELD(LIMIT))-1)) 150 F MM=0:1:LIMIT S SEG1=FIELD(MM) D:MM=1 SEGXX I MM'=1 F CC=1:1:$L(SEG1) D I $L(PVAR)=245 S PSOFIELD(CT)=PVAR,CT=CT+1,PVAR="" 151 .S PVAR1=$E(SEG1,CC) 152 .S PLIM=PVAR 153 .S PVAR=$S(PVAR="":PVAR1,1:PVAR_PVAR1) 154 I $G(PVAR)'="" S PSOFIELD(CT)=PVAR 155 S MSG(COUNT)=PSOFIELD(1),SUBCOUNT=1 F GG=2:1 Q:'$D(PSOFIELD(GG)) S MSG(COUNT,SUBCOUNT)=PSOFIELD(GG),SUBCOUNT=SUBCOUNT+1 156 Q 157 SEGXX ; 158 N MMZ F MMZ=0:0 S MMZ=$O(FIELD(MM,MMZ)) Q:'MMZ S SEG1=FIELD(MM,MMZ) F CC=1:1:$L(SEG1) D I $L(PVAR)=245 S PSOFIELD(CT)=PVAR,CT=CT+1,PVAR="" 159 .S PVAR1=$E(SEG1,CC) 160 .S PLIM=PVAR 161 .S PVAR=$S(PVAR="":PVAR1,1:PVAR_PVAR1) 162 Q 163 CHKOLDRX ; when dc a pending renewal - if prior Rx is expired, set piece 19 to 1 so will update CPRS from 'renewed' to 'expired' in PSOHLSN1 164 N PSOOLD 165 S PSOOLD=$P($G(^PS(52.41,PSIEN,0)),"^",21) 166 I PSOOLD'="",$P($G(^PSRX(PSOOLD,"STA")),"^")=11 S $P(^PSRX(PSOOLD,0),"^",19)=1 167 Q 1 PSOHLSN ;BIR/RTR-Send order information to OERR from file 52.41 ;10/10/94 2 ;;7.0;OUTPATIENT PHARMACY;**1,7,15,24,27,30,55,46,98,88,121**;DEC 1997 3 ;Externel reference EN^ORERR supported by DBIA 2187 4 ; 5 ; PS EVSEND OR PROTOCOL MUST BE OUR DRIVER RTN, (52 OR 52.41 INDICATOR 6 ; IS SENT THERE, THEN IT ROUTES, (NO NEED TO SEND FILE NUMBER HERE) 7 EN(PLACER,STAT,COMM,PSNOO) ; 8 N DA,FIELD,J,JJ,MSG,LIMIT,NULLFLDS,PSIEN,PSOHINST,PSZERO,SEGMENT,NAME,DFN,COUNT,GG,CC,CT,MM,PVAR,PVAR1,PLIM,SEG1,SUBCOUNT,PSOPSTRT,PSOPSTOP,PSODFN,EDUZ,PSNOOTX,PSOHSTAT,PSOPSIEN 9 S (PSIEN,PSOPSIEN)=$O(^PS(52.41,"B",PLACER,0)) 10 S COUNT=0 11 ;I '$G(PSIEN) W !!,?5,"PROBLEM WITH ENTRY IN PENDING FILE!",! Q 12 I '$G(PSIEN) Q 13 I $G(STAT)="OC"!($G(STAT)="OD")!($G(STAT)="CR")!($G(STAT)="DR") D 14 .I $D(^PS(52.41,PSIEN,0)) K ^PS(52.41,"AD",$P(^PS(52.41,PSIEN,0),"^",12),+$P($G(^("INI")),"^"),PSIEN),^PS(52.41,"ACL",+$P(^PS(52.41,PSIEN,0),"^",13),+$P(^(0),"^",12),PSIEN),^PS(52.41,"AQ",+$P($G(^PS(52.41,PSIEN,0)),"^",21),PSIEN) 15 S PSZERO=$G(^PS(52.41,PSIEN,0)),PSOHSTAT=$G(STAT) 16 S NULLFLDS="F JJ=0:1:LIMIT S FIELD(JJ)=""""" 17 D INIT 18 I $G(STAT)="Z@" S COUNT=1 D PID,PV1,ORC,SEND Q 19 S COUNT=1 D PID,PV1,ORC,RXE,ZRX,SEND,REN Q 20 INIT K ^UTILITY("DIQ1",$J),DIQ S DA=$P($$SITE^VASITE(),"^") I $G(DA) S DIC=4,DIQ(0)="I",DR="99" D EN^DIQ1 S PSOHINST=$G(^UTILITY("DIQ1",$J,4,DA,99,"I")) K ^UTILITY("DIQ1",$J),DA,DR,DIQ,DIC 21 S MSG(1)="MSH|^~\&|PHARMACY|"_$G(PSOHINST)_"|||||"_$S($G(PSOMSORR):"ORR",1:"ORM") 22 Q 23 PID S LIMIT=5 X NULLFLDS 24 S FIELD(0)="PID" 25 S DFN=+$P(PSZERO,"^",2) D DEM^VADPT S NAME=$G(VADM(1)) K VADM 26 S FIELD(3)=DFN 27 S FIELD(5)=NAME 28 D SEG Q 29 PV1 S LIMIT=19 X NULLFLDS 30 S FIELD(0)="PV1" 31 S FIELD(2)="O" 32 S:$P($G(^PS(52.41,PSIEN,0)),"^",13) FIELD(3)=$P(^(0),"^",13) 33 D SEG Q 34 ORC S LIMIT=15 X NULLFLDS 35 S FIELD(0)="ORC" 36 S FIELD(1)=STAT 37 S FIELD(2)=PLACER_$S($G(PLACERXX):";"_PLACERXX,1:"")_"^OR" 38 S FIELD(3)=PSIEN_"S"_"^PS" 39 I $G(FIELD(5))="" I $G(STAT)="OR"!($G(STAT)="OE") S FIELD(5)="IP" 40 S:$G(COMM)="IP" FIELD(5)="IP" 41 I $G(STAT)="SC" S FIELD(5)=$S($G(COMM)="IP":"IP",$G(COMM)="HD":"HD",$G(COMM)="DC":"DC",1:"") 42 I $G(PSORPV),$G(STAT)="OC" S FIELD(5)="RP" 43 ;S (PSOPSTRT,PSOPSTOP)="" S X=$P($G(^PS(52.41,PSIEN,0)),"^",6) I X S PSOPSTRT=$$FMTHL7^XLFDT(X) 44 ;I $G(STAT)="CR"!($G(STAT)="OC") D:'$G(DT) S X=DT S PSOPSTOP=$$FMTHL7^XLFDT(X) 45 ;.S DT=$$DT^XLFDT 46 ;K X S FIELD(7)="^^^"_$G(PSOPSTRT)_"^"_$G(PSOPSTOP) 47 S EDUZ=$P($G(^PS(52.41,PSIEN,0)),"^",4) I EDUZ D USER^PSOORFI2(EDUZ) S FIELD(10)=EDUZ_"^"_USER1 K USER1 48 I $G(PSOCANRC),$G(PSOCANRN)'="" I $G(STAT)="OC"!($G(STAT)="OD") S FIELD(12)=$G(PSOCANRC)_"^"_$G(PSOCANRN) 49 I '$G(FIELD(12)) D USER^PSOORFI2($P(^PS(52.41,PSIEN,0),"^",5)) 50 I '$G(FIELD(12)) S FIELD(12)=$P(^PS(52.41,PSIEN,0),"^",5)_"^"_USER1 K USER1 51 S FIELD(15)=$G(PSOPSTRT) 52 D SEG 53 I $G(COMM)'=""!($G(PSNOO)'="") D 54 .I $G(PSNOO)="" I $G(COMM)="IP"!($G(COMM)="HD")!($G(COMM)="DC") Q 55 .I $G(PSNOO)'="" D NOO^PSOHLSN1 56 .I '$D(COMM) S COMM="" 57 .I $L($G(COMM))+($L(MSG(COUNT)))+($L($G(PSNOOTX)))+($S($G(PSNOO)'="":11,1:5))<245 S MSG(COUNT)=MSG(COUNT)_"|"_$G(PSNOO)_"^"_$G(PSNOOTX)_"^"_$S($G(PSNOO)'="":"99ORN",1:"")_"^^"_$S(COMM="IP"!(COMM="DC")!(COMM="HD"):"",1:$G(COMM))_"^" Q 58 .S MSG(COUNT,1)="|"_$G(PSNOO)_"^"_$G(PSNOOTX)_"^"_$S($G(PSNOO)'="":"99ORN",1:"")_"^^"_$S(COMM="IP"!(COMM="DC")!(COMM="HD"):"",1:$G(COMM))_"^" Q 59 Q 60 RXE S LIMIT=1 X NULLFLDS 61 S FIELD(0)="RXE" 62 S (PSOPSTRT,PSOPSTOP)="" S X=$P($G(^PS(52.41,PSIEN,0)),"^",6) I X S PSOPSTRT=$$FMTHL7^XLFDT(X) 63 I $G(STAT)="CR"!($G(STAT)="OC") D:'$G(DT) S X=DT S PSOPSTOP=$$FMTHL7^XLFDT(X) 64 .S DT=$$DT^XLFDT 65 K X S FIELD(1)="^^^"_$G(PSOPSTRT)_"^"_$G(PSOPSTOP) 66 D SEG Q 67 ; 68 ZRX ; 69 ;Only send if DC is from an external system 70 I $G(STAT)'="OC",$G(STAT)'="OD" Q 71 I '$G(PSOHUIOR)!('$G(PSOCANRC)) Q 72 I $P($G(^PS(52.41,PSIEN,"EXT")),"^")="" Q 73 S LIMIT=5 X NULLFLDS 74 S FIELD(0)="ZRX" 75 S FIELD(5)=PSOCANRC_"^"_$P($G(^VA(200,PSOCANRC,0)),"^")_"^"_"99NP" 76 D SEG 77 Q 78 ; 79 SEG S SEGMENT="" F J=0:1:LIMIT S SEGMENT=$S(SEGMENT="":FIELD(J),1:SEGMENT_"|"_FIELD(J)) 80 S COUNT=COUNT+1,MSG(COUNT)=SEGMENT 81 Q 82 SEND D MSG^XQOR("PS EVSEND OR",.MSG) 83 Q 84 ; 85 SEGPAR ;Parse out fields for sending segments to OERR that can be >245 86 K PSOFIELD 87 S COUNT=COUNT+1,CT=1,(PVAR,PVAR1)="" 88 F MM=0:1:LIMIT S FIELD(MM)=$S(FIELD(MM)="":"|",1:FIELD(MM)_"|") 89 I $L(FIELD(LIMIT))>1 S FIELD(LIMIT)=$E(FIELD(LIMIT),1,($L(FIELD(LIMIT))-1)) 90 F MM=0:1:LIMIT S SEG1=FIELD(MM) F CC=1:1:$L(SEG1) D I $L(PVAR)=245 S PSOFIELD(CT)=PVAR,CT=CT+1,PVAR="" 91 .S PVAR1=$E(SEG1,CC) 92 .S PLIM=PVAR 93 .S PVAR=$S(PVAR="":PVAR1,1:PVAR_PVAR1) 94 I $G(PVAR)'="" S PSOFIELD(CT)=PVAR 95 S MSG(COUNT)=PSOFIELD(1),SUBCOUNT=1 F GG=2:1 Q:'$D(PSOFIELD(GG)) S MSG(COUNT,SUBCOUNT)=PSOFIELD(GG),SUBCOUNT=SUBCOUNT+1 96 K PSOFIELD 97 Q 98 ERROR ;Builds error message from PSOHLNEW, usually means we can't find order 99 D EN^ORERR(COMM,.MSG) 100 N MSG,PSOHINST 101 S PSOMSORR=1 D INIT 102 S MSG(2)=$G(PSERRPID) 103 S MSG(3)=$G(PSERRPV1) 104 S MSG(4)="ORC|"_$S($G(STAT)'="":$G(STAT),1:"DE")_"|"_PLACER_$S($G(PLACERXX):";"_PLACERXX,1:"")_"^OR"_"|"_$S($P($G(PSERRORC),"|",4)'="":$P(PSERRORC,"|",4),1:"") 105 F EER=11,13 I $P($G(PSERRORC),"|",EER)'="" S $P(MSG(4),"|",EER)=$P($G(PSERRORC),"|",EER) 106 I $G(COMM)'="" S $P(MSG(4),"|",17)="^^^^"_$G(COMM) 107 D SEND K PSOMSORR Q 108 ; 109 RERROR ; 110 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) 111 N MSG 112 S PSOMSORR=1 D INIT 113 S MSG(2)=$G(PSERRPID),MSG(3)=$G(PSERRPV1) 114 S MSG(4)="ORC|"_$S($G(XOFLAGZ):"UX",1:"UA")_"|"_$G(PLACER)_$S($G(PLACERXX):";"_PLACERXX,1:"")_"^OR"_"|"_$S($P($G(PSERRORC),"|",4)'="":$P(PSERRORC,"|",4),1:"") 115 F EER=11,13 I $P($G(PSERRORC),"|",EER)'="" S $P(MSG(4),"|",EER)=$P($G(PSERRORC),"|",EER) 116 S $P(MSG(4),"|",17)="D^Duplicate^99ORN^^"_$S($G(XOFLAGZ):"Patient mismatch on previous order.",$G(NWFLAG):"Patient Mismatch on new CPRS order",$G(PSOXRP):"Patient mismatch on Renewal.",1:"Duplicate Renewal Request. Order rejected by Pharmacy.") 117 I $G(PSOCVI) S $P(MSG(4),"|",17)="D^Duplicate^99ORN^^Order mismatch on Renewal." 118 D SEND K PSOMSORR Q 119 ; 120 DCP ; 121 K ^PS(52.41,"AOR",+$G(DFN),+$P($G(^PS(52.41,+$G(PREV),"INI")),"^"),+$G(PREV)) S $P(^PS(52.41,+$G(PREV),0),"^",3)="DE" 122 S PSORPV=1 N PSOMSORR 123 D EN^PSOHLSN(+$P($G(^PS(52.41,+$G(PREV),0)),"^"),"OC","","A") 124 K PSORPV 125 Q 126 REN ;Update previous Rx on Cancel/Discontinue 127 N RPREV,RENOC,RENOCP,RENSTA,PSOMSORR 128 I $G(PSOHSTAT)'="OC",$G(PSOHSTAT)'="CR",$G(PSOHSTAT)'="DR",$G(PSOHSTAT)'="OD" Q 129 Q:'$D(^PS(52.41,+$G(PSOPSIEN),0)) 130 S RPREV=$P($G(^PS(52.41,+$G(PSOPSIEN),0)),"^",21) Q:'$G(RPREV)!('$D(^PSRX(+$G(RPREV),0))) 131 S RENSTA=$P($G(^PSRX(+$G(RPREV),"STA")),"^") Q:$G(RENSTA)="" 132 S RENOC="SC",RENOCP=$S(RENSTA=0:"CM",(RENSTA=1!(RENSTA=4)):"IP",(RENSTA=3!(RENSTA=16)):"HD",RENSTA=5:"ZS",RENSTA=11:"ZE",RENSTA=15:"RP",1:"DC") 133 D EN^PSOHLSN1(RPREV,RENOC,RENOCP,"","") 134 Q 135 ; 136 DELP ;Delete refill requests 137 I $G(PSODEATH) Q 138 N DA,PENDDA 139 S PENDDA=$P($G(^PSRX(+$G(PSRXIEN),"OR1")),"^",2) I 'PENDDA Q 140 S DA=$O(^PS(52.41,"B",PENDDA,0)) I '$G(DA) Q 141 I $P($G(^PS(52.41,DA,0)),"^",3)="RF" S DIK="^PS(52.41," D ^DIK K DIK 142 Q 143 SEGPARX ; 144 N PSOFIELD 145 S COUNT=COUNT+1,CT=1,(PVAR,PVAR1)="" 146 F MM=0:1:LIMIT I MM'=1 S FIELD(MM)=$S(FIELD(MM)="":"|",1:FIELD(MM)_"|") 147 F MM=0:0 S MM=$O(FIELD(1,MM)) I '$O(FIELD(1,MM)) S FIELD(1,MM)=$S(FIELD(1,MM)="":"|",1:FIELD(1,MM)_"|") Q 148 I $L(FIELD(LIMIT))>1 S FIELD(LIMIT)=$E(FIELD(LIMIT),1,($L(FIELD(LIMIT))-1)) 149 F MM=0:1:LIMIT S SEG1=FIELD(MM) D:MM=1 SEGXX I MM'=1 F CC=1:1:$L(SEG1) D I $L(PVAR)=245 S PSOFIELD(CT)=PVAR,CT=CT+1,PVAR="" 150 .S PVAR1=$E(SEG1,CC) 151 .S PLIM=PVAR 152 .S PVAR=$S(PVAR="":PVAR1,1:PVAR_PVAR1) 153 I $G(PVAR)'="" S PSOFIELD(CT)=PVAR 154 S MSG(COUNT)=PSOFIELD(1),SUBCOUNT=1 F GG=2:1 Q:'$D(PSOFIELD(GG)) S MSG(COUNT,SUBCOUNT)=PSOFIELD(GG),SUBCOUNT=SUBCOUNT+1 155 Q 156 SEGXX ; 157 N MMZ F MMZ=0:0 S MMZ=$O(FIELD(MM,MMZ)) Q:'MMZ S SEG1=FIELD(MM,MMZ) F CC=1:1:$L(SEG1) D I $L(PVAR)=245 S PSOFIELD(CT)=PVAR,CT=CT+1,PVAR="" 158 .S PVAR1=$E(SEG1,CC) 159 .S PLIM=PVAR 160 .S PVAR=$S(PVAR="":PVAR1,1:PVAR_PVAR1) 161 Q
Note:
See TracChangeset
for help on using the changeset viewer.
