PSOQ0076 ;HINES/RMS - PRESCRIPTION FUNCTION "LAST RELEASED" ; 30 Nov 2007 7:49 AM
;;7.0;OUTPATIENT PHARMACY;**294**;DEC 1997;Build 13
;
LRDFUNC(PSOQRX) ;LAST RELEASE DATE IN FILEMAN FORMAT
N PSOQRD,PSOQRFD,PSOQANS,PSOQ
S PSOQANS=""
S PSOQRD=$P($G(^PSRX(PSOQRX,2)),"^",13)
S PSOQANS=PSOQRD
S PSOQ=0 F S PSOQ=$O(^PSRX(PSOQRX,1,PSOQ)) Q:'+PSOQ D ;
. S PSOQRFD=$P($G(^PSRX(PSOQRX,1,PSOQ,0)),"^",18)
. I PSOQRFD>PSOQANS S PSOQANS=PSOQRFD
Q PSOQANS
DAYSSUPP(PSOQRX) ;DAYS SUPPLY INDICATOR
Q $P($G(^PSRX(PSOQRX,0)),"^",8)
EXPDATE(PSOQRX) ;EXPIRATION DATE OF A PRESCRIPTION
Q $P($G(^PSRX(PSOQRX,2)),"^",6)
REFILLS(PSOQRX) ;REFILLS REMAINING
N PSOQRCT K RFILLS
Q:'$D(^PSRX(PSOQRX,0)) ""
S RFILLS=$P(^PSRX(PSOQRX,0),"^",9),PSOQRCT=0 F S PSOQRCT=$O(^PSRX(PSOQRX,1,PSOQRCT)) Q:'PSOQRCT S RFILLS=RFILLS-1
Q RFILLS
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOQ0076 844 printed Oct 16, 2024@18:33:53 Page 2
PSOQ0076 ;HINES/RMS - PRESCRIPTION FUNCTION "LAST RELEASED" ; 30 Nov 2007 7:49 AM
+1 ;;7.0;OUTPATIENT PHARMACY;**294**;DEC 1997;Build 13
+2 ;
LRDFUNC(PSOQRX) ;LAST RELEASE DATE IN FILEMAN FORMAT
+1 NEW PSOQRD,PSOQRFD,PSOQANS,PSOQ
+2 SET PSOQANS=""
+3 SET PSOQRD=$PIECE($GET(^PSRX(PSOQRX,2)),"^",13)
+4 SET PSOQANS=PSOQRD
+5 ;
SET PSOQ=0
FOR
SET PSOQ=$ORDER(^PSRX(PSOQRX,1,PSOQ))
if '+PSOQ
QUIT
Begin DoDot:1
+6 SET PSOQRFD=$PIECE($GET(^PSRX(PSOQRX,1,PSOQ,0)),"^",18)
+7 IF PSOQRFD>PSOQANS
SET PSOQANS=PSOQRFD
End DoDot:1
+8 QUIT PSOQANS
DAYSSUPP(PSOQRX) ;DAYS SUPPLY INDICATOR
+1 QUIT $PIECE($GET(^PSRX(PSOQRX,0)),"^",8)
EXPDATE(PSOQRX) ;EXPIRATION DATE OF A PRESCRIPTION
+1 QUIT $PIECE($GET(^PSRX(PSOQRX,2)),"^",6)
REFILLS(PSOQRX) ;REFILLS REMAINING
+1 NEW PSOQRCT
KILL RFILLS
+2 if '$DATA(^PSRX(PSOQRX,0))
QUIT ""
+3 SET RFILLS=$PIECE(^PSRX(PSOQRX,0),"^",9)
SET PSOQRCT=0
FOR
SET PSOQRCT=$ORDER(^PSRX(PSOQRX,1,PSOQRCT))
if 'PSOQRCT
QUIT
SET RFILLS=RFILLS-1
+4 QUIT RFILLS
