| 1 | SCAPU1 ;ALB/REW - TEAM API UTILITIES ; 30 Jun 95
|
|---|
| 2 | ;;5.3;Scheduling;**41**;AUG 13, 1993
|
|---|
| 3 | ;;1.0
|
|---|
| 4 | DTCHK2(SCDATES,ACTDT,INACTDT) ;given scdates array was it active?
|
|---|
| 5 | N SCBEGIN,SCEND,SCINCL
|
|---|
| 6 | D INIT^SCAPMCU1(1) ;set default array
|
|---|
| 7 | Q $$DTCHK(SCBEGIN,SCEND,SCINCL,ACTDT,.INACTDT)
|
|---|
| 8 | ;
|
|---|
| 9 | DTCHK(BEGINDT,ENDDT,INCL,ACTDT,INACTDT) ; -- given activation/inactivation dates and begin & end dates and include flag was it active?
|
|---|
| 10 | ;Parameters:
|
|---|
| 11 | ; BEGINDT - begining date
|
|---|
| 12 | ; ENDDT - ending date
|
|---|
| 13 | ; INCL - 1= must be active for whole period to get a 'yes'/0 o/w
|
|---|
| 14 | ; ACTDT - activation date for record
|
|---|
| 15 | ; INACTDT - inactivation date for record
|
|---|
| 16 | ; returns: 1 = Active
|
|---|
| 17 | ; 0 = Inactive
|
|---|
| 18 | ; -1 = Error
|
|---|
| 19 | ;
|
|---|
| 20 | N OK
|
|---|
| 21 | S OK=-1
|
|---|
| 22 | G DTCHKQ:'$G(BEGINDT)!('$G(ENDDT))!('$G(ACTDT))
|
|---|
| 23 | S OK=0
|
|---|
| 24 | ; begin is after inactivation
|
|---|
| 25 | IF $G(INACTDT),BEGINDT>INACTDT G DTCHKQ
|
|---|
| 26 | ; end is before effective date
|
|---|
| 27 | IF ENDDT<ACTDT G DTCHKQ
|
|---|
| 28 | ; just need 1 day in range
|
|---|
| 29 | IF $G(INCL)=0 S OK=1 G DTCHKQ
|
|---|
| 30 | ; begin is not before effective date
|
|---|
| 31 | IF ACTDT>BEGINDT G DTCHKQ
|
|---|
| 32 | ; inactivation exists & isn't after end
|
|---|
| 33 | IF $G(INACTDT),INACTDT<ENDDT G DTCHKQ
|
|---|
| 34 | S OK=1
|
|---|
| 35 | DTCHKQ Q OK
|
|---|
| 36 | ;
|
|---|
| 37 | ERR(SEQ,ERNUM,PARMS,OUTPUT,SCER) ;-- process errors
|
|---|
| 38 | ;if no dialog entry 4040000 will be processed
|
|---|
| 39 | S ERNUM=$G(ERNUM,4040000)
|
|---|
| 40 | S:'$$GET1^DIQ(.84,$G(ERNUM)_",",.01) ERNUM=4040000
|
|---|
| 41 | IF SCER]"" D
|
|---|
| 42 | . S SEQ=SEQ+1
|
|---|
| 43 | . S SCER(SEQ)=ERNUM
|
|---|
| 44 | .D BLD^DIALOG(.ERNUM,.PARMS,.OUTPUT,.SCER)
|
|---|
| 45 | Q
|
|---|
| 46 | ;
|
|---|
| 47 | OKARRAY(ARRAY,CHECK) ; see if input array says 'check' should be used
|
|---|
| 48 | ; DOES NOT change any varriables - $$okarray(.xx,.yy) is safe...
|
|---|
| 49 | ; if array is null OR undefined it is ok
|
|---|
| 50 | ; if @array@(check) is defined it is ok
|
|---|
| 51 | ; if @array@('exclude') is defined results switch
|
|---|
| 52 | ; RETURNS: 1: Yes use/0: No don't
|
|---|
| 53 | Q $S('$L($G(CHECK)):1,'$L($G(ARRAY)):1,(ARRAY'?1A1.7AN):0,1:'(($D(@ARRAY@(CHECK))#2)=($D(@ARRAY@("EXCLUDE"))#2))) ;changed to quit if check is not defined
|
|---|
| 54 | ;
|
|---|
| 55 | OKUSRCL(USRARRAY,CHECK) ; see if input user class array says 'check' is ok
|
|---|
| 56 | N SCOK,SCU
|
|---|
| 57 | S SCOK=0
|
|---|
| 58 | IF '$L($G(CHECK))!('$L($G(USRARRAY))) S SCOK=1 G QTOKUSR
|
|---|
| 59 | IF (USRARRAY'?1A1.7AN)&(USRARRAY'?1"^"1A.E) G QTOKUSR
|
|---|
| 60 | S SCU=0
|
|---|
| 61 | IF $D(@USRARRAY@("EXCLUDE"))#2 D
|
|---|
| 62 | .S SCOK=1
|
|---|
| 63 | .F S SCU=$O(@USRARRAY@(SCU)) Q:'SCU S:(CHECK=SCU)!($$SUBCLASS^USRLM(CHECK,SCU)) SCOK=0
|
|---|
| 64 | ELSE D
|
|---|
| 65 | .S SCOK=0
|
|---|
| 66 | .F S SCU=$O(@USRARRAY@(SCU)) Q:'SCU S:(CHECK=SCU)!($$SUBCLASS^USRLM(CHECK,SCU)) SCOK=1
|
|---|
| 67 | .
|
|---|
| 68 | QTOKUSR Q SCOK
|
|---|
