source: WorldVistAEHR/trunk/r/OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSOCMOPT.m@ 1438

Last change on this file since 1438 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.4 KB
Line 
1PSOCMOPT ;BIR/RTR-Test for CMOP prescription ;12/02/99
2 ;;7.0;OUTPATIENT PHARMACY;**36**;DEC 1997
3 ;External reference to ^PS(55 supported by DBIA 2228
4 ;External reference to ^PSDRUG supported by DBIA 221
5 ;PTRX = INTERNAL NUMBER FROM 52
6 ;PSOXFLAG IS THE CMOP FLAG VARIABLE 0 FOR CMOP, 1 FOR NON-CMOP
7 N PXDFN,PSOXMDT,PSOXMC,PXCK,PXRFD,PX7,PXREL,PSOWFLAG
8 S PSOXFLAG=0
9 I '$G(PSXSYS) G END
10 S PXDFN=+$P($G(^PSRX(PTRX,0)),"^",2),PSOXMDT=$P($G(^PS(55,PXDFN,0)),"^",5),PSOXMC=$P($G(^PS(55,PXDFN,0)),"^",3)
11 I (PSOXMC>1&(PSOXMDT>DT))!(PSOXMC>1&(PSOXMDT<1)) G END
12 S PXCK=+$P($G(^PSRX(PTRX,0)),"^",6) I '$D(^PSDRUG("AQ",PXCK)) G END
13 I $P($G(^PSDRUG(PXCK,2)),"^",3)'["O" G END
14 I $G(RXPR(PTRX))!($G(RXRS(PTRX))) G END
15 I $G(RXRP(PTRX))&($P($G(RXRP(PTRX)),"^",4)'=1) G END
16 I $G(^PSRX(PTRX,"TN"))]"" G END
17 I $P($G(^PSRX(PTRX,"STA")),"^")>9!($P($G(^("STA")),"^")=4)!($P($G(^("STA")),"^")=3) G END
18 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
19 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
20 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
21 S PXREL=$S(PXRFD=0:$P($G(^PSRX(PTRX,2)),"^",13),1:$P($G(^PSRX(PTRX,1,PXRFD,0)),"^",18))
22 I $G(PXREL) G END
23 G ENDX
24END S PSOXFLAG=1
25ENDX K PTRX Q
Note: See TracBrowser for help on using the repository browser.