VistA-WorldVistAEHR/r/OUTPATIENT_PHARMACY-PSO-APS.../PSOCMOPT.m

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