SCAPU1.m

SCAPU1 ;ALB/REW - TEAM API UTILITIES ; 9/17/09 4:30pm

 ;;5.3;PIMS;**41,1015,1016**;JUN 30, 2012;Build 20

 ;;1.0

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

 ; begin is after inactivation

 IF $G(INACTDT),BEGINDT'<INACTDT G DTCHKQ

 ; end is before effective date

 IF ENDDT<ACTDT G DTCHKQ

 ; 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

 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

SCAPU1    ;ALB/REW - TEAM API UTILITIES ; 9/17/09 4:30pm

 +1       ;;5.3;PIMS;**41,1015,1016**;JUN 30, 2012;Build 20

 +2       ;;1.0

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      ; begin is after inactivation

 +16       IF $GET(INACTDT)

               IF BEGINDT'<INACTDT

                   GOTO DTCHKQ

 +17      ; end is before effective date

 +18       IF ENDDT<ACTDT

               GOTO DTCHKQ

 +19      ; just need 1 day in range

 +20       IF $GET(INCL)=0

               SET OK=1

               GOTO DTCHKQ

 +21      ; begin is not before effective date

 +22       IF ACTDT>BEGINDT

               GOTO DTCHKQ

 +23      ; inactivation exists & isn't after end

 +24       IF $GET(INACTDT)

               IF INACTDT<ENDDT

                   GOTO DTCHKQ

 +25       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