PSOQ0076.m

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 ---PSOQ0076   844     printed  Apr 09, 2024@21:38:05                                                                                                                                                                                                     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