PSOCMOPT ;BIR/RTR-Test for CMOP prescription ;Mar 29, 2019@08:56:25
;;7.0;OUTPATIENT PHARMACY;**36,441,753**;DEC 1997;Build 53
;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 $$GET1^DIQ(52,PTRX,100.2,"I")]"" S PSOXMDT="",PSOXMC=$$GET1^DIQ(52,PTRX,100.2,"I") ;p753
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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOCMOPT 1632 printed Oct 16, 2024@18:26:15 Page 2
PSOCMOPT ;BIR/RTR-Test for CMOP prescription ;Mar 29, 2019@08:56:25
+1 ;;7.0;OUTPATIENT PHARMACY;**36,441,753**;DEC 1997;Build 53
+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 ;p753
IF $$GET1^DIQ(52,PTRX,100.2,"I")]""
SET PSOXMDT=""
SET PSOXMC=$$GET1^DIQ(52,PTRX,100.2,"I")
+11 IF (PSOXMC>1&(PSOXMDT>DT))!(PSOXMC>1&(PSOXMDT<1))
GOTO END
+12 SET PXCK=+$PIECE($GET(^PSRX(PTRX,0)),"^",6)
IF '$DATA(^PSDRUG("AQ",PXCK))
GOTO END
+13 IF $PIECE($GET(^PSDRUG(PXCK,2)),"^",3)'["O"
GOTO END
+14 IF $GET(RXPR(PTRX))!($GET(RXRS(PTRX)))
GOTO END
+15 IF $GET(RXRP(PTRX))&($PIECE($GET(RXRP(PTRX)),"^",4)'=1)
GOTO END
+16 IF $GET(^PSRX(PTRX,"TN"))]""
GOTO END
+17 IF $PIECE($GET(^PSRX(PTRX,"STA")),"^")>9!($PIECE($GET(^("STA")),"^")=4)!($PIECE($GET(^("STA")),"^")=3)
GOTO END
+18 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
+19 SET PSOWFLAG=0
IF '$ORDER(^PSRX(PTRX,1,0))
IF '$PIECE($GET(^PSRX(PTRX,2)),"^",13)
IF ($PIECE($GET(^(0)),"^",11)="W"!$PIECE($GET(^(0)),"^",11)="P")
IF $SELECT($PIECE($GET(^PSRX(PTRX,2)),"^",2):$PIECE($GET(^(2)),"^",2),1:+$GET(PSOX("FILL DATE")))>DT
SET PSOWFLAG=1
+20 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"!($GET(MW)="P"))
IF '$GET(PSOWFLAG)
GOTO END
+21 SET PXREL=$SELECT(PXRFD=0:$PIECE($GET(^PSRX(PTRX,2)),"^",13),1:$PIECE($GET(^PSRX(PTRX,1,PXRFD,0)),"^",18))
+22 IF $GET(PXREL)
GOTO END
+23 GOTO ENDX
END SET PSOXFLAG=1
ENDX KILL PTRX
QUIT
