source: WorldVistAEHR/trunk/r/HEALTH_LEVEL_SEVEN-HL/HLEMEP.m@ 862

Last change on this file since 862 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.9 KB
Line 
1HLEMEP ;ALB/CJM-HL7 - Purge Monitor Events ;02/04/2004
2 ;;1.6;HEALTH LEVEL SEVEN;**109**;Oct 13, 1995
3 ;
4PURGE ;
5 N NOW,WHEN,EVENT,ERROR
6 S NOW=$$NOW^XLFDT
7 S WHEN=0
8 D START^HLEVAPI(.VAR)
9 ;
10 ;delete the old events
11 F S WHEN=$O(^HLEV(776.4,"AJ",WHEN)) Q:'WHEN Q:WHEN>NOW D
12 .S EVENT=0
13 .F S EVENT=$O(^HLEV(776.4,"AJ",WHEN,EVENT)) Q:'EVENT D
14 ..I '$$DELETE^HLEMU(776.4,EVENT,.ERROR),'$D(^HLEV(776.4,EVENT,0)) K ^HLEV(776.4,"AJ",WHEN,EVENT)
15 ;
16 ;delete the old statistics
17 N STATS,SITE,TYPE,YEAR,MONTH,DAY,CUTMONTH,CUTDAY,CUTHOUR
18 S STATS="^HLEV(776.4,""AF"")"
19 S SITE=0
20 ;
21 ;these determine the timeframes within which to delete the old statistics
22 S CUTMONTH=$E($$FMADD^XLFDT(DT,-65),1,5)
23 S CUTDAY=$P($$FMADD^XLFDT(DT,-8),".")
24 S CUTHOUR=$$FMADD^XLFDT(NOW,-2)
25 ;
26 F S SITE=$O(@STATS@(SITE)) Q:'SITE D
27 .S TYPE=0
28 .F S TYPE=$O(@STATS@(SITE,TYPE)) Q:'TYPE D
29 ..S YEAR=""
30 ..F S YEAR=$O(@STATS@(SITE,TYPE,"RECEIVED","YEAR",YEAR)) Q:'YEAR D
31 ...S MONTH=""
32 ...F S MONTH=$O(@STATS@(SITE,TYPE,"RECEIVED","YEAR",YEAR,"MONTH",MONTH)) Q:(MONTH="") D
33 ....I ((YEAR-1700)_$$PAD2(MONTH))<CUTMONTH D
34 .....K @STATS@(SITE,TYPE,"RECEIVED","YEAR",YEAR,"MONTH",MONTH)
35 ....E D
36 .....S DAY=""
37 .....F S DAY=$O(@STATS@(SITE,TYPE,"RECEIVED","YEAR",YEAR,"MONTH",MONTH,"DAY",DAY)) Q:(DAY="") D
38 ......I ((YEAR-1700)_$$PAD2(MONTH)_$$PAD2(DAY))<CUTDAY D
39 .......K @STATS@(SITE,TYPE,"RECEIVED","YEAR",YEAR,"MONTH",MONTH,"DAY",DAY)
40 ......E D
41 .......S HOUR=0
42 .......F S HOUR=$O(@STATS@(SITE,TYPE,"RECEIVED","YEAR",YEAR,"MONTH",MONTH,"DAY",DAY,"HOUR",HOUR)) Q:(HOUR="") Q:((YEAR-1700)_$$PAD2(MONTH)_$$PAD2(DAY)_"."_$$PAD2(HOUR))>CUTHOUR D
43 ........K @STATS@(SITE,TYPE,"RECEIVED","YEAR",YEAR,"MONTH",MONTH,"DAY",DAY,"HOUR",HOUR)
44 ;
45 ;
46 D CHECKOUT^HLEVAPI
47 K ^TMP("HLEVFLAG",$J)
48 Q
49 ;
50INPERSON ;entry point for running in the foreground
51 S ^TMP("HLEVFLAG",$J)="STOP"
52 D PURGE
53 Q
54PAD2(STRING) ;
55 ; pads a number on the left with '0', to a length of 2
56 Q $$RJ^XLFSTR(STRING,2,"0")
57 ;
Note: See TracBrowser for help on using the repository browser.