- 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 ---[H[J[2J[HAWCMCPUR 952 printed Feb 19, 2025@00:05:18 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
