- QAMTIME0 ;HISC/DAD-CALCULATE TIME FRAME START-END FROM A DATE ;2/10/92 07:33
- ;;1.0;Clinical Monitoring System;;09/13/1993
- ; REQUIRES
- ; QAMD0 = MONITOR IEN QAMTODAY = DATE OF AUTO ENROLL RUN
- ; RETURNS
- ; QAMSTART & QAMEND = START & END DATES OF THE TIME FRAME
- EN ;
- 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
- K %Y,LEAPYEAR,QA,QAM,QAMDAYS,QAMONTH1,QAMONTH2,QAMONTHS,QAMPRG,QAMWEEK,X,X1,X2,Y
- Q
- EN1 ; *** DAILY
- S (QAMSTART,QAMEND)=QAMTODAY
- Q
- EN2 ; *** WEEKLY
- S QAMWEEK=$S($D(^QA(740,1,"QAM"))#2:+^("QAM"),1:0)
- 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
- Q
- EN3 ; *** MONTHLY
- S (QAMONTH1,QAMONTH2)=$E(QAMTODAY,4,5) D DAYS S QAMSTART=$E(QAMTODAY,1,5)_"01",QAMEND=$E(QAMTODAY,1,5)_QAMDAYS
- Q
- EN4 ; *** QUARTERLY
- S QAM=$E(QAMTODAY,4,5),QA=$E(QAMTODAY,1,3)
- I QAM'>3 S QAMSTART=QA_"0101",QAMEND=QA_"0331" Q
- I QAM'>6 S QAMSTART=QA_"0401",QAMEND=QA_"0630" Q
- I QAM'>9 S QAMSTART=QA_"0701",QAMEND=QA_"0930" Q
- S QAMSTART=QA_"1001",QAMEND=QA_"1231"
- Q
- EN5 ; *** SEMI-ANNUALLY
- S QAM=$E(QAMTODAY,4,5),QA=$E(QAMTODAY,1,3)
- I QAM'>6 S QAMSTART=QA_"0101",QAMEND=QA_"0630"
- E S QAMSTART=QA_"0701",QAMEND=QA_"1231"
- Q
- EN6 ; *** ANNUALLY
- S QAMSTART=$E(QAMTODAY,1,3)_"0101",QAMEND=$E(QAMTODAY,1,3)_"1231"
- Q
- EN7 ; *** FISCAL YEARLY
- S QAM=$E(QAMTODAY,4,5),QA=$E(QAMTODAY,1,3)
- I QAM'<10 S QAMSTART=QA_"1001",QAMEND=(QA+1)_"0930"
- E S QAMSTART=(QA-1)_"1001",QAMEND=QA_"0930"
- Q
- EN8 ; *** FISCAL SEMI-ANNUALLY
- S QAM=$E(QAMTODAY,4,5),QA=$E(QAMTODAY,1,3)
- I QAM'<10 S QAMSTART=QA_"1001",QAMEND=(QA+1)_"0331" Q
- I QAM'>3 S QAMSTART=(QA-1)_"1001",QAMEND=QA_"0331" Q
- I QAM'<4 S QAMSTART=(QA-1)_"0401",QAMEND=QA_"0930"
- Q
- DAYS ; *** DAYS IN MONTH(S)
- 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))
- F QAM=QAMONTH1:1:QAMONTH2 S QAMDAYS=QAMDAYS+$P(QAMONTHS,"^",QAM)+$S(QAM=2:LEAPYEAR,1:0)
- K LEAPYEAR,QAM,QAMONTH1,QAMONTH2,QAMONTHS,Y
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HQAMTIME0 2128 printed Jan 18, 2025@02:43:56 Page 2
- QAMTIME0 ;HISC/DAD-CALCULATE TIME FRAME START-END FROM A DATE ;2/10/92 07:33
- +1 ;;1.0;Clinical Monitoring System;;09/13/1993
- +2 ; REQUIRES
- +3 ; QAMD0 = MONITOR IEN QAMTODAY = DATE OF AUTO ENROLL RUN
- +4 ; RETURNS
- +5 ; QAMSTART & QAMEND = START & END DATES OF THE TIME FRAME
- EN ;
- +1 SET (QAMSTART,QAMEND)=0
- SET QA=$SELECT($DATA(^QA(743,QAMD0,1))#2:$PIECE(^(1),"^"),1:"")
- if QA'>0
- QUIT
- SET QAMPRG=$SELECT($DATA(^QA(743.92,QA,1))#2:^(1),1:"")
- if QAMPRG]""
- XECUTE QAMPRG
- +2 KILL %Y,LEAPYEAR,QA,QAM,QAMDAYS,QAMONTH1,QAMONTH2,QAMONTHS,QAMPRG,QAMWEEK,X,X1,X2,Y
- +3 QUIT
- EN1 ; *** DAILY
- +1 SET (QAMSTART,QAMEND)=QAMTODAY
- +2 QUIT
- EN2 ; *** WEEKLY
- +1 SET QAMWEEK=$SELECT($DATA(^QA(740,1,"QAM"))#2:+^("QAM"),1:0)
- +2 SET X=QAMTODAY
- DO H^%DTC
- SET X1=QAMTODAY
- SET X2=%Y-QAMWEEK
- if X2>0
- SET X2=-X2
- DO C^%DTC
- SET (QAMSTART,X1)=X
- SET X2=6
- DO C^%DTC
- SET QAMEND=X
- +3 QUIT
- EN3 ; *** MONTHLY
- +1 SET (QAMONTH1,QAMONTH2)=$EXTRACT(QAMTODAY,4,5)
- DO DAYS
- SET QAMSTART=$EXTRACT(QAMTODAY,1,5)_"01"
- SET QAMEND=$EXTRACT(QAMTODAY,1,5)_QAMDAYS
- +2 QUIT
- EN4 ; *** QUARTERLY
- +1 SET QAM=$EXTRACT(QAMTODAY,4,5)
- SET QA=$EXTRACT(QAMTODAY,1,3)
- +2 IF QAM'>3
- SET QAMSTART=QA_"0101"
- SET QAMEND=QA_"0331"
- QUIT
- +3 IF QAM'>6
- SET QAMSTART=QA_"0401"
- SET QAMEND=QA_"0630"
- QUIT
- +4 IF QAM'>9
- SET QAMSTART=QA_"0701"
- SET QAMEND=QA_"0930"
- QUIT
- +5 SET QAMSTART=QA_"1001"
- SET QAMEND=QA_"1231"
- +6 QUIT
- EN5 ; *** SEMI-ANNUALLY
- +1 SET QAM=$EXTRACT(QAMTODAY,4,5)
- SET QA=$EXTRACT(QAMTODAY,1,3)
- +2 IF QAM'>6
- SET QAMSTART=QA_"0101"
- SET QAMEND=QA_"0630"
- +3 IF '$TEST
- SET QAMSTART=QA_"0701"
- SET QAMEND=QA_"1231"
- +4 QUIT
- EN6 ; *** ANNUALLY
- +1 SET QAMSTART=$EXTRACT(QAMTODAY,1,3)_"0101"
- SET QAMEND=$EXTRACT(QAMTODAY,1,3)_"1231"
- +2 QUIT
- EN7 ; *** FISCAL YEARLY
- +1 SET QAM=$EXTRACT(QAMTODAY,4,5)
- SET QA=$EXTRACT(QAMTODAY,1,3)
- +2 IF QAM'<10
- SET QAMSTART=QA_"1001"
- SET QAMEND=(QA+1)_"0930"
- +3 IF '$TEST
- SET QAMSTART=(QA-1)_"1001"
- SET QAMEND=QA_"0930"
- +4 QUIT
- EN8 ; *** FISCAL SEMI-ANNUALLY
- +1 SET QAM=$EXTRACT(QAMTODAY,4,5)
- SET QA=$EXTRACT(QAMTODAY,1,3)
- +2 IF QAM'<10
- SET QAMSTART=QA_"1001"
- SET QAMEND=(QA+1)_"0331"
- QUIT
- +3 IF QAM'>3
- SET QAMSTART=(QA-1)_"1001"
- SET QAMEND=QA_"0331"
- QUIT
- +4 IF QAM'<4
- SET QAMSTART=(QA-1)_"0401"
- SET QAMEND=QA_"0930"
- +5 QUIT
- DAYS ; *** DAYS IN MONTH(S)
- +1 SET QAMONTHS="31^28^31^30^31^30^31^31^30^31^30^31"
- SET QAMDAYS=0
- SET Y=1700+$EXTRACT(QAMTODAY,1,3)
- SET LEAPYEAR=(Y#4=0)&((Y#100)!(Y#400=0))
- +2 FOR QAM=QAMONTH1:1:QAMONTH2
- SET QAMDAYS=QAMDAYS+$PIECE(QAMONTHS,"^",QAM)+$SELECT(QAM=2:LEAPYEAR,1:0)
- +3 KILL LEAPYEAR,QAM,QAMONTH1,QAMONTH2,QAMONTHS,Y
- +4 QUIT