26 lines
1.4 KiB
Mathematica
26 lines
1.4 KiB
Mathematica
|
PSOCMOPT ;BIR/RTR-Test for CMOP prescription ;12/02/99
|
||
|
;;7.0;OUTPATIENT PHARMACY;**36**;DEC 1997
|
||
|
;External reference to ^PS(55 supported by DBIA 2228
|
||
|
;External reference to ^PSDRUG supported by DBIA 221
|
||
|
;PTRX = INTERNAL NUMBER FROM 52
|
||
|
;PSOXFLAG IS THE CMOP FLAG VARIABLE 0 FOR CMOP, 1 FOR NON-CMOP
|
||
|
N PXDFN,PSOXMDT,PSOXMC,PXCK,PXRFD,PX7,PXREL,PSOWFLAG
|
||
|
S PSOXFLAG=0
|
||
|
I '$G(PSXSYS) G END
|
||
|
S PXDFN=+$P($G(^PSRX(PTRX,0)),"^",2),PSOXMDT=$P($G(^PS(55,PXDFN,0)),"^",5),PSOXMC=$P($G(^PS(55,PXDFN,0)),"^",3)
|
||
|
I (PSOXMC>1&(PSOXMDT>DT))!(PSOXMC>1&(PSOXMDT<1)) G END
|
||
|
S PXCK=+$P($G(^PSRX(PTRX,0)),"^",6) I '$D(^PSDRUG("AQ",PXCK)) G END
|
||
|
I $P($G(^PSDRUG(PXCK,2)),"^",3)'["O" G END
|
||
|
I $G(RXPR(PTRX))!($G(RXRS(PTRX))) G END
|
||
|
I $G(RXRP(PTRX))&($P($G(RXRP(PTRX)),"^",4)'=1) G END
|
||
|
I $G(^PSRX(PTRX,"TN"))]"" G END
|
||
|
I $P($G(^PSRX(PTRX,"STA")),"^")>9!($P($G(^("STA")),"^")=4)!($P($G(^("STA")),"^")=3) G END
|
||
|
S PXRFD=0 F PX7=0:0 S PX7=$O(^PSRX(PTRX,1,PX7)) Q:'$G(PX7) S:$D(^PSRX(PTRX,1,PX7,0)) PXRFD=PX7
|
||
|
S PSOWFLAG=0 I '$O(^PSRX(PTRX,1,0)),'$P($G(^PSRX(PTRX,2)),"^",13),$P($G(^(0)),"^",11)="W",$S($P($G(^PSRX(PTRX,2)),"^",2):$P($G(^(2)),"^",2),1:+$G(PSOX("FILL DATE")))>DT S PSOWFLAG=1
|
||
|
S MW=$S($G(PXRFD)>0:$P($G(^PSRX(PTRX,1,PXRFD,0)),"^",2),1:$P($G(^PSRX(PTRX,0)),"^",11)) I $G(MW)="W",'$G(PSOWFLAG) G END
|
||
|
S PXREL=$S(PXRFD=0:$P($G(^PSRX(PTRX,2)),"^",13),1:$P($G(^PSRX(PTRX,1,PXRFD,0)),"^",18))
|
||
|
I $G(PXREL) G END
|
||
|
G ENDX
|
||
|
END S PSOXFLAG=1
|
||
|
ENDX K PTRX Q
|