SCAPU1 ;ALB/REW,HPE/ART - TEAM API UTILITIES ; 9/17/09 4:30pm ;07/06/2017
;;5.3;Scheduling;**41,504,666**;AUG 13, 1993;Build 4
;;1.0
Q
;
DTCHK2(SCDATES,ACTDT,INACTDT) ;given scdates array was it active?
N SCBEGIN,SCEND,SCINCL
D INIT^SCAPMCU1(1) ;set default array
Q $$DTCHK(SCBEGIN,SCEND,SCINCL,ACTDT,.INACTDT)
;
DTCHK(BEGINDT,ENDDT,INCL,ACTDT,INACTDT) ; -- given activation/inactivation dates and begin & end dates and include flag was it active?
;Parameters:
; BEGINDT - begining date
; ENDDT - ending date
; INCL - 1= must be active for whole period to get a 'yes'/0 o/w
; ACTDT - activation date for record
; INACTDT - inactivation date for record
; returns: 1 = Active
; 0 = Inactive
; -1 = Error
;
N OK
S OK=-1
G DTCHKQ:'$G(BEGINDT)!('$G(ENDDT))!('$G(ACTDT))
S OK=0
;
;check date params for timestamp, strip time if all date params do not have a timestamp - 666
IF ($G(INACTDT)&$P(INACTDT,".",2)="")!($P(ACTDT,".",2)="")!($P(BEGINDT,".",2)="")!($P(ENDDT,".",2)="") DO
. S INACTDT=$P(INACTDT,".",1)
. S ACTDT=$P(ACTDT,".",1)
. S BEGINDT=$P(BEGINDT,".",1)
. S ENDDT=$P(ENDDT,".",1)
; begin is after inactivation
IF $G(INACTDT),BEGINDT>=INACTDT G DTCHKQ ;666
; end is before effective date
IF ENDDT<ACTDT G DTCHKQ
; inactivation exists & isn't after end
IF $G(INACTDT),INACTDT<=ENDDT G DTCHKQ ;666
; just need 1 day in range
IF $G(INCL)=0 S OK=1 G DTCHKQ
; begin is not before effective date
IF ACTDT>BEGINDT G DTCHKQ
; inactivation exists & isn't after end
IF $G(INACTDT),INACTDT<=ENDDT G DTCHKQ ;666
S OK=1
DTCHKQ Q OK
;
ERR(SEQ,ERNUM,PARMS,OUTPUT,SCER) ;-- process errors
;if no dialog entry 4040000 will be processed
S ERNUM=$G(ERNUM,4040000)
S:'$$GET1^DIQ(.84,$G(ERNUM)_",",.01) ERNUM=4040000
IF SCER]"" D
. S SEQ=SEQ+1
. S SCER(SEQ)=ERNUM
.D BLD^DIALOG(.ERNUM,.PARMS,.OUTPUT,.SCER)
Q
;
OKARRAY(ARRAY,CHECK) ; see if input array says 'check' should be used
; DOES NOT change any varriables - $$okarray(.xx,.yy) is safe...
; if array is null OR undefined it is ok
; if @array@(check) is defined it is ok
; if @array@('exclude') is defined results switch
; RETURNS: 1: Yes use/0: No don't
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
;
OKUSRCL(USRARRAY,CHECK) ; see if input user class array says 'check' is ok
N SCOK,SCU
S SCOK=0
IF '$L($G(CHECK))!('$L($G(USRARRAY))) S SCOK=1 G QTOKUSR
IF (USRARRAY'?1A1.7AN)&(USRARRAY'?1"^"1A.E) G QTOKUSR
S SCU=0
IF $D(@USRARRAY@("EXCLUDE"))#2 D
.S SCOK=1
.F S SCU=$O(@USRARRAY@(SCU)) Q:'SCU S:(CHECK=SCU)!($$SUBCLASS^USRLM(CHECK,SCU)) SCOK=0
ELSE D
.S SCOK=0
.F S SCU=$O(@USRARRAY@(SCU)) Q:'SCU S:(CHECK=SCU)!($$SUBCLASS^USRLM(CHECK,SCU)) SCOK=1
.
QTOKUSR Q SCOK
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSCAPU1 2912 printed Oct 16, 2024@18:39:03 Page 2
SCAPU1 ;ALB/REW,HPE/ART - TEAM API UTILITIES ; 9/17/09 4:30pm ;07/06/2017
+1 ;;5.3;Scheduling;**41,504,666**;AUG 13, 1993;Build 4
+2 ;;1.0
+3 QUIT
+4 ;
DTCHK2(SCDATES,ACTDT,INACTDT) ;given scdates array was it active?
+1 NEW SCBEGIN,SCEND,SCINCL
+2 ;set default array
DO INIT^SCAPMCU1(1)
+3 QUIT $$DTCHK(SCBEGIN,SCEND,SCINCL,ACTDT,.INACTDT)
+4 ;
DTCHK(BEGINDT,ENDDT,INCL,ACTDT,INACTDT) ; -- given activation/inactivation dates and begin & end dates and include flag was it active?
+1 ;Parameters:
+2 ; BEGINDT - begining date
+3 ; ENDDT - ending date
+4 ; INCL - 1= must be active for whole period to get a 'yes'/0 o/w
+5 ; ACTDT - activation date for record
+6 ; INACTDT - inactivation date for record
+7 ; returns: 1 = Active
+8 ; 0 = Inactive
+9 ; -1 = Error
+10 ;
+11 NEW OK
+12 SET OK=-1
+13 if '$GET(BEGINDT)!('$GET(ENDDT))!('$GET(ACTDT))
GOTO DTCHKQ
+14 SET OK=0
+15 ;
+16 ;check date params for timestamp, strip time if all date params do not have a timestamp - 666
+17 IF ($GET(INACTDT)&$PIECE(INACTDT,".",2)="")!($PIECE(ACTDT,".",2)="")!($PIECE(BEGINDT,".",2)="")!($PIECE(ENDDT,".",2)="")
Begin DoDot:1
+18 SET INACTDT=$PIECE(INACTDT,".",1)
+19 SET ACTDT=$PIECE(ACTDT,".",1)
+20 SET BEGINDT=$PIECE(BEGINDT,".",1)
+21 SET ENDDT=$PIECE(ENDDT,".",1)
End DoDot:1
+22 ; begin is after inactivation
+23 ;666
IF $GET(INACTDT)
IF BEGINDT>=INACTDT
GOTO DTCHKQ
+24 ; end is before effective date
+25 IF ENDDT<ACTDT
GOTO DTCHKQ
+26 ; inactivation exists & isn't after end
+27 ;666
IF $GET(INACTDT)
IF INACTDT<=ENDDT
GOTO DTCHKQ
+28 ; just need 1 day in range
+29 IF $GET(INCL)=0
SET OK=1
GOTO DTCHKQ
+30 ; begin is not before effective date
+31 IF ACTDT>BEGINDT
GOTO DTCHKQ
+32 ; inactivation exists & isn't after end
+33 ;666
IF $GET(INACTDT)
IF INACTDT<=ENDDT
GOTO DTCHKQ
+34 SET OK=1
DTCHKQ QUIT OK
+1 ;
ERR(SEQ,ERNUM,PARMS,OUTPUT,SCER) ;-- process errors
+1 ;if no dialog entry 4040000 will be processed
+2 SET ERNUM=$GET(ERNUM,4040000)
+3 if '$$GET1^DIQ(.84,$GET(ERNUM)_",",.01)
SET ERNUM=4040000
+4 IF SCER]""
Begin DoDot:1
+5 SET SEQ=SEQ+1
+6 SET SCER(SEQ)=ERNUM
+7 DO BLD^DIALOG(.ERNUM,.PARMS,.OUTPUT,.SCER)
End DoDot:1
+8 QUIT
+9 ;
OKARRAY(ARRAY,CHECK) ; see if input array says 'check' should be used
+1 ; DOES NOT change any varriables - $$okarray(.xx,.yy) is safe...
+2 ; if array is null OR undefined it is ok
+3 ; if @array@(check) is defined it is ok
+4 ; if @array@('exclude') is defined results switch
+5 ; RETURNS: 1: Yes use/0: No don't
+6 ;changed to quit if check is not defined
QUIT $SELECT('$LENGTH($GET(CHECK)):1,'$LENGTH($GET(ARRAY)):1,(ARRAY'?1A1.7AN):0,1:'(($DATA(@ARRAY@(CHECK))#2)=($DATA(@ARRAY@("EXCLUDE"))#2)))
+7 ;
OKUSRCL(USRARRAY,CHECK) ; see if input user class array says 'check' is ok
+1 NEW SCOK,SCU
+2 SET SCOK=0
+3 IF '$LENGTH($GET(CHECK))!('$LENGTH($GET(USRARRAY)))
SET SCOK=1
GOTO QTOKUSR
+4 IF (USRARRAY'?1A1.7AN)&(USRARRAY'?1"^"1A.E)
GOTO QTOKUSR
+5 SET SCU=0
+6 IF $DATA(@USRARRAY@("EXCLUDE"))#2
Begin DoDot:1
+7 SET SCOK=1
+8 FOR
SET SCU=$ORDER(@USRARRAY@(SCU))
if 'SCU
QUIT
if (CHECK=SCU)!($$SUBCLASS^USRLM(CHECK,SCU))
SET SCOK=0
End DoDot:1
+9 IF '$TEST
Begin DoDot:1
+10 SET SCOK=0
+11 FOR
SET SCU=$ORDER(@USRARRAY@(SCU))
if 'SCU
QUIT
if (CHECK=SCU)!($$SUBCLASS^USRLM(CHECK,SCU))
SET SCOK=1
+12 End DoDot:1
QTOKUSR QUIT SCOK
