- 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 Jan 18, 2025@03:39:34 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