PSO52CLR ;BIR/DB - Encapsulation Routine ; 27 Feb 2008
;;7.0;OUTPATIENT PHARMACY;**299**;DEC 1997;Build 5
STAT(PSO) ;Return Status(#100) external format from Prescription (#52) file
N PSOSTAT I $G(PSO)="" Q "UNKNOWN"
S PSOSTAT=$$EXTERNAL^DILFD(52,100,,PSO)
I $G(PSOSTAT)="" S PSOSTAT="UNKNOWN"
Q PSOSTAT
;
NEPSRX() ;Return number of entries in PSRX
N DA,DA1,DATE,DSUP,DFN,DRUG,NE,RDATE,TEMP
S (DA,NE)=0
F S DA=+$O(^PSRX(DA)) Q:DA=0 D
. S TEMP=$G(^PSRX(DA,0))
. S DFN=$P(TEMP,U,2)
. I DFN="" Q
. S DRUG=$P(TEMP,U,6)
. I DRUG="" Q
. S DSUP=$P(TEMP,U,8)
. I DSUP="" Q
. S RDATE=+$P($G(^PSRX(DA,2)),U,13)
. I RDATE>0 S NE=NE+1
.;Process the refill mutiple.
. S DA1=0
. F S DA1=+$O(^PSRX(DA,1,DA1)) Q:DA1=0 D
.. S TEMP=$G(^PSRX(DA,1,DA1,0))
.. S DSUP=+$P(TEMP,U,10)
.. I DSUP="" Q
.. S RDATE=+$P(TEMP,U,18)
.. I RDATE>0 S NE=NE+1
.;Process the partial fill multiple.
. S DA1=0
. F S DA1=+$O(^PSRX(DA,"P",DA1)) Q:DA1=0 D
.. S TEMP=$G(^PSRX(DA,"P",DA1,0))
.. S DSUP=+$P(TEMP,U,10)
.. I DSUP="" Q
.. S RDATE=+$P(TEMP,U,19)
.. I RDATE>0 S NE=NE+1
K DA,DA1,DATE,DSUP,DFN,DRUG,RDATE,TEMP
Q NE
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSO52CLR 1163 printed Dec 13, 2024@02:23:10 Page 2
PSO52CLR ;BIR/DB - Encapsulation Routine ; 27 Feb 2008
+1 ;;7.0;OUTPATIENT PHARMACY;**299**;DEC 1997;Build 5
STAT(PSO) ;Return Status(#100) external format from Prescription (#52) file
+1 NEW PSOSTAT
IF $GET(PSO)=""
QUIT "UNKNOWN"
+2 SET PSOSTAT=$$EXTERNAL^DILFD(52,100,,PSO)
+3 IF $GET(PSOSTAT)=""
SET PSOSTAT="UNKNOWN"
+4 QUIT PSOSTAT
+5 ;
NEPSRX() ;Return number of entries in PSRX
+1 NEW DA,DA1,DATE,DSUP,DFN,DRUG,NE,RDATE,TEMP
+2 SET (DA,NE)=0
+3 FOR
SET DA=+$ORDER(^PSRX(DA))
if DA=0
QUIT
Begin DoDot:1
+4 SET TEMP=$GET(^PSRX(DA,0))
+5 SET DFN=$PIECE(TEMP,U,2)
+6 IF DFN=""
QUIT
+7 SET DRUG=$PIECE(TEMP,U,6)
+8 IF DRUG=""
QUIT
+9 SET DSUP=$PIECE(TEMP,U,8)
+10 IF DSUP=""
QUIT
+11 SET RDATE=+$PIECE($GET(^PSRX(DA,2)),U,13)
+12 IF RDATE>0
SET NE=NE+1
+13 ;Process the refill mutiple.
+14 SET DA1=0
+15 FOR
SET DA1=+$ORDER(^PSRX(DA,1,DA1))
if DA1=0
QUIT
Begin DoDot:2
+16 SET TEMP=$GET(^PSRX(DA,1,DA1,0))
+17 SET DSUP=+$PIECE(TEMP,U,10)
+18 IF DSUP=""
QUIT
+19 SET RDATE=+$PIECE(TEMP,U,18)
+20 IF RDATE>0
SET NE=NE+1
End DoDot:2
+21 ;Process the partial fill multiple.
+22 SET DA1=0
+23 FOR
SET DA1=+$ORDER(^PSRX(DA,"P",DA1))
if DA1=0
QUIT
Begin DoDot:2
+24 SET TEMP=$GET(^PSRX(DA,"P",DA1,0))
+25 SET DSUP=+$PIECE(TEMP,U,10)
+26 IF DSUP=""
QUIT
+27 SET RDATE=+$PIECE(TEMP,U,19)
+28 IF RDATE>0
SET NE=NE+1
End DoDot:2
End DoDot:1
+29 KILL DA,DA1,DATE,DSUP,DFN,DRUG,RDATE,TEMP
+30 QUIT NE
