Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSOCMOPT

PSOCMOPT.m

Go to the documentation of this file.
PSOCMOPT ;BIR/RTR-Test for CMOP prescription ;Mar 29, 2019@08:56:25
 ;;7.0;OUTPATIENT PHARMACY;**36,441**;DEC 1997;Build 208
 ;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"!$P($G(^(0)),"^",11)="P"),$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(MW)="P")),'$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