PSOCMOPT.m

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

PSOCMOPT  ;BIR/RTR-Test for CMOP prescription ;12/02/99

 +1       ;;7.0;OUTPATIENT PHARMACY;**36**;DEC 1997

 +2       ;External reference to ^PS(55 supported by DBIA 2228

 +3       ;External reference to ^PSDRUG supported by DBIA 221

 +4       ;PTRX = INTERNAL NUMBER FROM 52

 +5       ;PSOXFLAG IS THE CMOP FLAG VARIABLE  0 FOR CMOP, 1 FOR NON-CMOP

 +6        NEW PXDFN,PSOXMDT,PSOXMC,PXCK,PXRFD,PX7,PXREL,PSOWFLAG

 +7        SET PSOXFLAG=0

 +8        IF '$GET(PSXSYS)

               GOTO END

 +9        SET PXDFN=+$PIECE($GET(^PSRX(PTRX,0)),"^",2)

           SET PSOXMDT=$PIECE($GET(^PS(55,PXDFN,0)),"^",5)

           SET PSOXMC=$PIECE($GET(^PS(55,PXDFN,0)),"^",3)

 +10       IF (PSOXMC>1&(PSOXMDT>DT))!(PSOXMC>1&(PSOXMDT<1))

               GOTO END

 +11       SET PXCK=+$PIECE($GET(^PSRX(PTRX,0)),"^",6)

           IF '$DATA(^PSDRUG("AQ",PXCK))

               GOTO END

 +12       IF $PIECE($GET(^PSDRUG(PXCK,2)),"^",3)'["O"

               GOTO END

 +13       IF $GET(RXPR(PTRX))!($GET(RXRS(PTRX)))

               GOTO END

 +14       IF $GET(RXRP(PTRX))&($PIECE($GET(RXRP(PTRX)),"^",4)'=1)

               GOTO END

 +15       IF $GET(^PSRX(PTRX,"TN"))]""

               GOTO END

 +16       IF $PIECE($GET(^PSRX(PTRX,"STA")),"^")>9!($PIECE($GET(^("STA")),"^")=4)!($PIECE($GET(^("STA")),"^")=3)

               GOTO END

 +17       SET PXRFD=0

           FOR PX7=0:0

               SET PX7=$ORDER(^PSRX(PTRX,1,PX7))

               IF '$GET(PX7)

                   QUIT 

               IF $DATA(^PSRX(PTRX,1,PX7,0))

                   SET PXRFD=PX7

 +18       SET PSOWFLAG=0

           IF '$ORDER(^PSRX(PTRX,1,0))

               IF '$PIECE($GET(^PSRX(PTRX,2)),"^",13)

                   IF $PIECE($GET(^(0)),"^",11)="W"

                       IF $SELECT($PIECE($GET(^PSRX(PTRX,2)),"^",2):$PIECE($GET(^(2)),"^",2),1:+$GET(PSOX("FILL DATE")))>DT

                           SET PSOWFLAG=1

 +19       SET MW=$SELECT($GET(PXRFD)>0:$PIECE($GET(^PSRX(PTRX,1,PXRFD,0)),"^",2),1:$PIECE($GET(^PSRX(PTRX,0)),"^",11))

           IF $GET(MW)="W"

               IF '$GET(PSOWFLAG)

                   GOTO END

 +20       SET PXREL=$SELECT(PXRFD=0:$PIECE($GET(^PSRX(PTRX,2)),"^",13),1:$PIECE($GET(^PSRX(PTRX,1,PXRFD,0)),"^",18))

 +21       IF $GET(PXREL)

               GOTO END

 +22       GOTO ENDX

END        SET PSOXFLAG=1

ENDX       KILL PTRX

           QUIT