PSSRXACT ;BIR/SAB- returns active Rx flag ; 09/04/03 10:30 am
;;1.0;PHARMACY DATA MANAGEMENT;**75**;9/30/97
;External reference to EN^PSOORDER supported by DBIA 1878
;
EN(DFN) ;
N FLAG,EXPD,RX,STAT S EXPD=DT-1
F S EXPD=$O(^PS(55,DFN,"P","A",EXPD)) Q:'EXPD!($G(FLAG)) F RX=0:0 S RX=$O(^PS(55,DFN,"P","A",EXPD,RX)) Q:'RX!($G(FLAG)) D
.D EN^PSOORDER(DFN,RX)
.I $G(^TMP("PSOR",$J,RX,0))']"" Q
.S STAT=$P($P(^TMP("PSOR",$J,RX,0),"^",4),";")
.S FLAG=$S(STAT="A":1,STAT="N":1,STAT="H":1,STAT="S":1,1:0)
.K ^TMP("PSOR",$J)
Q +$G(FLAG)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSSRXACT 554 printed Dec 13, 2024@02:34:20 Page 2
PSSRXACT ;BIR/SAB- returns active Rx flag ; 09/04/03 10:30 am
+1 ;;1.0;PHARMACY DATA MANAGEMENT;**75**;9/30/97
+2 ;External reference to EN^PSOORDER supported by DBIA 1878
+3 ;
EN(DFN) ;
+1 NEW FLAG,EXPD,RX,STAT
SET EXPD=DT-1
+2 FOR
SET EXPD=$ORDER(^PS(55,DFN,"P","A",EXPD))
if 'EXPD!($GET(FLAG))
QUIT
FOR RX=0:0
SET RX=$ORDER(^PS(55,DFN,"P","A",EXPD,RX))
if 'RX!($GET(FLAG))
QUIT
Begin DoDot:1
+3 DO EN^PSOORDER(DFN,RX)
+4 IF $GET(^TMP("PSOR",$JOB,RX,0))']""
QUIT
+5 SET STAT=$PIECE($PIECE(^TMP("PSOR",$JOB,RX,0),"^",4),";")
+6 SET FLAG=$SELECT(STAT="A":1,STAT="N":1,STAT="H":1,STAT="S":1,1:0)
+7 KILL ^TMP("PSOR",$JOB)
End DoDot:1
+8 QUIT +$GET(FLAG)
