AWCMCPUR.m

AWCMCPUR        ;VISN 7/THM-Purge CPRS Monitor data file and ^XTMP("AWC" global ; 09 Jan 2004  3:43 PM

 ;;7.3;TOOLKIT;**84**;Jan 9, 2004

 ;

EN D DT^DICRW

 ; number of days to keep data in param file

 S AWCPDAYS=$P(^AWC(177100.12,1,0),U,14)

 I +AWCPDAYS=0 S AWCPDAYS=30 ;if no limit set, keep minimum of 30 days

 S X1=DT,X2=-AWCPDAYS D C^%DTC S AWCEND=X+.2359,AWCDTX=""

 F  S AWCDTX=$O(^AWC(177100.13,"C",AWCDTX)) Q:(AWCDTX>AWCEND)!(AWCDTX="")  DO

 .F DA=0:0 S DA=$O(^AWC(177100.13,"C",AWCDTX,DA)) Q:DA=""  DO

 ..S DIK="^AWC(177100.13," D ^DIK

 ;

 ; now purge the XTMP global

PGXTMP S AWCDTX="" F  S AWCDTX=$O(^XTMP("AWCCPRS",AWCDTX)) Q:(AWCDTX>AWCEND)!(AWCDTX="")  DO

 .F DA=0:0 S DA=$O(^XTMP("AWCCPRS",AWCDTX,DA)) Q:DA=""  K ^XTMP("AWCCPRS",AWCDTX,DA,0)

 ; reset zero node purge date

 S X="T+10",%DT="" D ^%DT Q:Y<0  S AWCPGDT=Y

 S $P(^XTMP("AWCCPRS",0),U)=AWCPGDT

 K DIK,DA,AWCEND,AWCPGDT,AWCDTX,AWCPDAYS,X1,X2,X,%,%H,%T,%DT,Y

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---AWCMCPUR   952     printed  Apr 09, 2024@21:43:12                                                                                                                                                                                                     Page 2

AWCMCPUR  ;VISN 7/THM-Purge CPRS Monitor data file and ^XTMP("AWC" global ; 09 Jan 2004  3:43 PM

 +1       ;;7.3;TOOLKIT;**84**;Jan 9, 2004

 +2       ;

EN         DO DT^DICRW

 +1       ; number of days to keep data in param file

 +2        SET AWCPDAYS=$PIECE(^AWC(177100.12,1,0),U,14)

 +3       ;if no limit set, keep minimum of 30 days

           IF +AWCPDAYS=0

               SET AWCPDAYS=30

 +4        SET X1=DT

           SET X2=-AWCPDAYS

           DO C^%DTC

           SET AWCEND=X+.2359

           SET AWCDTX=""

 +5        FOR 

               SET AWCDTX=$ORDER(^AWC(177100.13,"C",AWCDTX))

               if (AWCDTX>AWCEND)!(AWCDTX="")

                   QUIT 

               Begin DoDot:1

 +6                FOR DA=0:0

                       SET DA=$ORDER(^AWC(177100.13,"C",AWCDTX,DA))

                       if DA=""

                           QUIT 

                       Begin DoDot:2

 +7                        SET DIK="^AWC(177100.13,"

                           DO ^DIK

                       End DoDot:2

               End DoDot:1

 +8       ;

 +9       ; now purge the XTMP global

PGXTMP     SET AWCDTX=""

           FOR 

               SET AWCDTX=$ORDER(^XTMP("AWCCPRS",AWCDTX))

               if (AWCDTX>AWCEND)!(AWCDTX="")

                   QUIT 

               Begin DoDot:1

 +1                FOR DA=0:0

                       SET DA=$ORDER(^XTMP("AWCCPRS",AWCDTX,DA))

                       if DA=""

                           QUIT 

                       KILL ^XTMP("AWCCPRS",AWCDTX,DA,0)

               End DoDot:1

 +2       ; reset zero node purge date

 +3        SET X="T+10"

           SET %DT=""

           DO ^%DT

           if Y<0

               QUIT 

           SET AWCPGDT=Y

 +4        SET $PIECE(^XTMP("AWCCPRS",0),U)=AWCPGDT

 +5        KILL DIK,DA,AWCEND,AWCPGDT,AWCDTX,AWCPDAYS,X1,X2,X,%,%H,%T,%DT,Y

 +6        QUIT