PSUCP3.m

PSUCP3 ;BIR/REG - PBM UTILITY TO PURGE ^XTMP and ^XTMP ;25 AUG 1998 

 ;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005

EN ;

 N PSUI,PSUPDT,PSUCDT,PSUI1,PSUI2

 D NOW^%DTC

 S PSUCDT=X

 S PSUI="PSU"

 F  S PSUI=$O(^XTMP(PSUI)) Q:$E(PSUI,1,3)'="PSU"  D

 .K ^XTMP(PSUI) Q

 .S PSUPDT=$P($G(^XTMP(PSUI,0)),"^",1)

 .I PSUPDT="" K ^XTMP(PSUI) Q

 .I PSUPDT<PSUCDT K ^XTMP(PSUI) Q

 ;

 Q   ;ALL PURGED

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PSUCP3   402     printed  Apr 09, 2024@21:30:12                                                                                                                                                                                                       Page 2

PSUCP3    ;BIR/REG - PBM UTILITY TO PURGE ^XTMP and ^XTMP ;25 AUG 1998 

 +1       ;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005

EN        ;

 +1        NEW PSUI,PSUPDT,PSUCDT,PSUI1,PSUI2

 +2        DO NOW^%DTC

 +3        SET PSUCDT=X

 +4        SET PSUI="PSU"

 +5        FOR 

               SET PSUI=$ORDER(^XTMP(PSUI))

               if $EXTRACT(PSUI,1,3)'="PSU"

                   QUIT 

               Begin DoDot:1

 +6                KILL ^XTMP(PSUI)

                   QUIT 

 +7                SET PSUPDT=$PIECE($GET(^XTMP(PSUI,0)),"^",1)

 +8                IF PSUPDT=""

                       KILL ^XTMP(PSUI)

                       QUIT 

 +9                IF PSUPDT<PSUCDT

                       KILL ^XTMP(PSUI)

                       QUIT 

               End DoDot:1

 +10      ;

 +11      ;ALL PURGED

           QUIT