source: WorldVistAEHR/trunk/r/CLINICAL_MONITORING_SYSTEM-QAM/QAMTIME0.m@ 808

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

initial load of WorldVistAEHR

File size: 2.0 KB
Line 
1QAMTIME0 ;HISC/DAD-CALCULATE TIME FRAME START-END FROM A DATE ;2/10/92 07:33
2 ;;1.0;Clinical Monitoring System;;09/13/1993
3 ; REQUIRES
4 ; QAMD0 = MONITOR IEN QAMTODAY = DATE OF AUTO ENROLL RUN
5 ; RETURNS
6 ; QAMSTART & QAMEND = START & END DATES OF THE TIME FRAME
7EN ;
8 S (QAMSTART,QAMEND)=0,QA=$S($D(^QA(743,QAMD0,1))#2:$P(^(1),"^"),1:"") Q:QA'>0 S QAMPRG=$S($D(^QA(743.92,QA,1))#2:^(1),1:"") X:QAMPRG]"" QAMPRG
9 K %Y,LEAPYEAR,QA,QAM,QAMDAYS,QAMONTH1,QAMONTH2,QAMONTHS,QAMPRG,QAMWEEK,X,X1,X2,Y
10 Q
11EN1 ; *** DAILY
12 S (QAMSTART,QAMEND)=QAMTODAY
13 Q
14EN2 ; *** WEEKLY
15 S QAMWEEK=$S($D(^QA(740,1,"QAM"))#2:+^("QAM"),1:0)
16 S X=QAMTODAY D H^%DTC S X1=QAMTODAY,X2=%Y-QAMWEEK S:X2>0 X2=-X2 D C^%DTC S (QAMSTART,X1)=X,X2=6 D C^%DTC S QAMEND=X
17 Q
18EN3 ; *** MONTHLY
19 S (QAMONTH1,QAMONTH2)=$E(QAMTODAY,4,5) D DAYS S QAMSTART=$E(QAMTODAY,1,5)_"01",QAMEND=$E(QAMTODAY,1,5)_QAMDAYS
20 Q
21EN4 ; *** QUARTERLY
22 S QAM=$E(QAMTODAY,4,5),QA=$E(QAMTODAY,1,3)
23 I QAM'>3 S QAMSTART=QA_"0101",QAMEND=QA_"0331" Q
24 I QAM'>6 S QAMSTART=QA_"0401",QAMEND=QA_"0630" Q
25 I QAM'>9 S QAMSTART=QA_"0701",QAMEND=QA_"0930" Q
26 S QAMSTART=QA_"1001",QAMEND=QA_"1231"
27 Q
28EN5 ; *** SEMI-ANNUALLY
29 S QAM=$E(QAMTODAY,4,5),QA=$E(QAMTODAY,1,3)
30 I QAM'>6 S QAMSTART=QA_"0101",QAMEND=QA_"0630"
31 E S QAMSTART=QA_"0701",QAMEND=QA_"1231"
32 Q
33EN6 ; *** ANNUALLY
34 S QAMSTART=$E(QAMTODAY,1,3)_"0101",QAMEND=$E(QAMTODAY,1,3)_"1231"
35 Q
36EN7 ; *** FISCAL YEARLY
37 S QAM=$E(QAMTODAY,4,5),QA=$E(QAMTODAY,1,3)
38 I QAM'<10 S QAMSTART=QA_"1001",QAMEND=(QA+1)_"0930"
39 E S QAMSTART=(QA-1)_"1001",QAMEND=QA_"0930"
40 Q
41EN8 ; *** FISCAL SEMI-ANNUALLY
42 S QAM=$E(QAMTODAY,4,5),QA=$E(QAMTODAY,1,3)
43 I QAM'<10 S QAMSTART=QA_"1001",QAMEND=(QA+1)_"0331" Q
44 I QAM'>3 S QAMSTART=(QA-1)_"1001",QAMEND=QA_"0331" Q
45 I QAM'<4 S QAMSTART=(QA-1)_"0401",QAMEND=QA_"0930"
46 Q
47DAYS ; *** DAYS IN MONTH(S)
48 S QAMONTHS="31^28^31^30^31^30^31^31^30^31^30^31",QAMDAYS=0,Y=1700+$E(QAMTODAY,1,3),LEAPYEAR=(Y#4=0)&((Y#100)!(Y#400=0))
49 F QAM=QAMONTH1:1:QAMONTH2 S QAMDAYS=QAMDAYS+$P(QAMONTHS,"^",QAM)+$S(QAM=2:LEAPYEAR,1:0)
50 K LEAPYEAR,QAM,QAMONTH1,QAMONTH2,QAMONTHS,Y
51 Q
Note: See TracBrowser for help on using the repository browser.