SDAMA306.m

SDAMA306 ;BPOIFO/ACS-Filter API Utilities ; 6/21/05 1:50pm

 ;;5.3;Scheduling;**301,347,508,1015**;13 Aug 1993;Build 21

 ;PER VHA DIRECTIVE 2004-038, DO NOT MODIFY THIS ROUTINE

 ;

 ;

 ;*****************************************************************

 ;              CHANGE LOG

 ;

 ;  DATE      PATCH       DESCRIPTION

 ;--------  ----------    -----------------------------------------

 ;12/04/03  SD*5.3*301    ROUTINE COMPLETED

 ;08/06/04  SD*5.3*347    ADDITION OF A NEW FILTER - DATE APPOINTMENT

 ;                        MADE (FIELD #16) AND 2 NEW FIELDS TO RETURN:

 ;                        1) AUTO-REBOOKED APPT DATE/TIME (FIELD #24)

 ;                        2) NO-SHOW/CANCEL APPT DATE/TIME (FIELD #25)

 ;02/22/07  SD*5.3*508    SEE SDAMA301 FOR CHANGE LIST

 ;*****************************************************************

 ;*****************************************************************

 ;

 ;INPUT

 ;  SDARRAY   Appointment Filter array (by reference)

 ;  

 ;*****************************************************************

INITAE(SDARRAY) ;Initialize Array Entries as needed

 ;Initialize Appointment "From" and "To" dates if null

 N SDI

 F SDI=1,16  D INITDTS(SDI)

 ;

 ;Initialize Fields Array if ALL Fields Requested

 D:($$UPCASE(SDARRAY("FLDS"))="ALL") INITFLDS(.SDARRAY)

 ;

 ;Remove leading and trailing semi-colons from filter lists if present

 N SDNODE

 F SDNODE=2,3,4,13,"FLDS" D

 . I $L($G(SDARRAY(SDNODE)))>0 D

 .. I $E(SDARRAY(SDNODE),$L(SDARRAY(SDNODE)))=";" D

 ... S SDARRAY(SDNODE)=$E(SDARRAY(SDNODE),1,($L(SDARRAY(SDNODE))-1))

 .. I $E(SDARRAY(SDNODE),1)=";" D

 ... S SDARRAY(SDNODE)=$E(SDARRAY(SDNODE),2,$L(SDARRAY(SDNODE)))

 ;

 ;If the patient list is in a global, add comma at end if needed

 S SDARRAY("PATGBL")=0

 I $G(SDARRAY(4))["(" D

 . ;flag as patient global input

 . S SDARRAY("PATGBL")=1

 . ;add comma to end of global root if needed

 . N SDLCHAR S SDLCHAR=$E(SDARRAY(4),$L(SDARRAY(4)))

 . I SDLCHAR="," Q

 . E  I SDLCHAR'="(" S SDARRAY(4)=SDARRAY(4)_","

 ;

 ;If the clinic list is in a global, add comma at end if needed

 S SDARRAY("CLNGBL")=0

 I $G(SDARRAY(2))["(" D

 . ;flag as clinic global input

 . S SDARRAY("CLNGBL")=1

 . ;add comma to end of global root if needed

 . N SDLCHAR S SDLCHAR=$E(SDARRAY(2),$L(SDARRAY(2)))

 . I SDLCHAR="," Q

 . E  I SDLCHAR'="(" S SDARRAY(2)=SDARRAY(2)_","

 ;Initialize Encounter Filter

 S SDARRAY("ENCTR")=$$UPCASE($G(SDARRAY(12)))

 Q

 ;

 ;***************************************************

 ;INPUT

 ;      SDFLTR    Filter to initialize

 ;***************************************************

INITDTS(SDFLTR) ;initialize Appt Date/Time and Date Appt Made

 N SDFROM,SDTO,SDYR,SDDAY,SDMNTH,SDTIME,SDVAR

 ;initialize variables to passed in values

 S SDFROM=$P($G(SDARRAY(SDFLTR)),";",1)

 S SDTO=$P($G(SDARRAY(SDFLTR)),";",2)

 ;replace day and month to Jan 01 (0101) if 0s or "" are passed

 ;replace time with 2359 if time is greater than 2359

 F SDVAR="SDFROM","SDTO"  D

 .I @SDVAR'="" D

 ..S SDYR=$E(@SDVAR,1,3),SDMNTH=$E(@SDVAR,4,5),SDDAY=$E(@SDVAR,6,7)

 ..S SDTIME=$P(@SDVAR,".",2) S:(SDTIME'="") SDTIME="."_SDTIME

 ..S:(+SDDAY'>0) SDDAY="01"

 ..S:(+SDMNTH'>0) SDMNTH="01"

 ..S:((+SDTIME'=0)&(+SDTIME>.2359)) SDTIME=.2359

 ..S @SDVAR=SDYR_SDMNTH_SDDAY

 ..S:(SDTIME'="") @SDVAR=@SDVAR_SDTIME

 ;initialize SDTO to default if null

 I $G(SDTO)="" D

 .S:SDFLTR=1 SDTO="9999999.9999"

 .S:SDFLTR=16 SDTO="9999999"

 ;if date passed in without time for Appt Date/Time filter add time

 I SDFLTR=1,SDTO'["." S SDTO=SDTO_".2359"

 ;create new variables to reference Date(/Time)s

 I SDFLTR=1 D

 .S SDARRAY("FR")=$G(SDFROM)

 .S SDARRAY("TO")=$G(SDTO)

 I SDFLTR=16 D

 .S SDARRAY("DAMFR")=$G(SDFROM)

 .S SDARRAY("DAMTO")=$G(SDTO)

 Q

 ;

 ;*****************************************************************

 ;INPUT

 ;  SDARRAY   Appointment Filter array (by reference)

 ;*****************************************************************

INITFLDS(SDARRAY) ;initialize Fields Requested

 N SDFLD

 S SDARRAY("FLDS")=""  ;Reset Field Array

 ;add all available fields to Field Request

 F SDFLD=1:1:26,28:1:SDARRAY("FC") S SDARRAY("FLDS")=SDARRAY("FLDS")_SDFLD_";"

 Q

UPCASE(SDDATA) ;ensure RSA text is upper case

 Q $TR(SDDATA,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")

SDAMA306  ;BPOIFO/ACS-Filter API Utilities ; 6/21/05 1:50pm

 +1       ;;5.3;Scheduling;**301,347,508,1015**;13 Aug 1993;Build 21

 +2       ;PER VHA DIRECTIVE 2004-038, DO NOT MODIFY THIS ROUTINE

 +3       ;

 +4       ;

 +5       ;*****************************************************************

 +6       ;              CHANGE LOG

 +7       ;

 +8       ;  DATE      PATCH       DESCRIPTION

 +9       ;--------  ----------    -----------------------------------------

 +10      ;12/04/03  SD*5.3*301    ROUTINE COMPLETED

 +11      ;08/06/04  SD*5.3*347    ADDITION OF A NEW FILTER - DATE APPOINTMENT

 +12      ;                        MADE (FIELD #16) AND 2 NEW FIELDS TO RETURN:

 +13      ;                        1) AUTO-REBOOKED APPT DATE/TIME (FIELD #24)

 +14      ;                        2) NO-SHOW/CANCEL APPT DATE/TIME (FIELD #25)

 +15      ;02/22/07  SD*5.3*508    SEE SDAMA301 FOR CHANGE LIST

 +16      ;*****************************************************************

 +17      ;*****************************************************************

 +18      ;

 +19      ;INPUT

 +20      ;  SDARRAY   Appointment Filter array (by reference)

 +21      ;  

 +22      ;*****************************************************************

INITAE(SDARRAY) ;Initialize Array Entries as needed

 +1       ;Initialize Appointment "From" and "To" dates if null

 +2        NEW SDI

 +3        FOR SDI=1,16

               DO INITDTS(SDI)

 +4       ;

 +5       ;Initialize Fields Array if ALL Fields Requested

 +6        IF ($$UPCASE(SDARRAY("FLDS"))="ALL")

               DO INITFLDS(.SDARRAY)

 +7       ;

 +8       ;Remove leading and trailing semi-colons from filter lists if present

 +9        NEW SDNODE

 +10       FOR SDNODE=2,3,4,13,"FLDS"

               Begin DoDot:1

 +11               IF $LENGTH($GET(SDARRAY(SDNODE)))>0

                       Begin DoDot:2

 +12                       IF $EXTRACT(SDARRAY(SDNODE),$LENGTH(SDARRAY(SDNODE)))=";"

                               Begin DoDot:3

 +13                               SET SDARRAY(SDNODE)=$EXTRACT(SDARRAY(SDNODE),1,($LENGTH(SDARRAY(SDNODE))-1))

                               End DoDot:3

 +14                       IF $EXTRACT(SDARRAY(SDNODE),1)=";"

                               Begin DoDot:3

 +15                               SET SDARRAY(SDNODE)=$EXTRACT(SDARRAY(SDNODE),2,$LENGTH(SDARRAY(SDNODE)))

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +16      ;

 +17      ;If the patient list is in a global, add comma at end if needed

 +18       SET SDARRAY("PATGBL")=0

 +19       IF $GET(SDARRAY(4))["("

               Begin DoDot:1

 +20      ;flag as patient global input

 +21               SET SDARRAY("PATGBL")=1

 +22      ;add comma to end of global root if needed

 +23               NEW SDLCHAR

                   SET SDLCHAR=$EXTRACT(SDARRAY(4),$LENGTH(SDARRAY(4)))

 +24               IF SDLCHAR=","

                       QUIT 

 +25              IF '$TEST

                       IF SDLCHAR'="("

                           SET SDARRAY(4)=SDARRAY(4)_","

               End DoDot:1

 +26      ;

 +27      ;If the clinic list is in a global, add comma at end if needed

 +28       SET SDARRAY("CLNGBL")=0

 +29       IF $GET(SDARRAY(2))["("

               Begin DoDot:1

 +30      ;flag as clinic global input

 +31               SET SDARRAY("CLNGBL")=1

 +32      ;add comma to end of global root if needed

 +33               NEW SDLCHAR

                   SET SDLCHAR=$EXTRACT(SDARRAY(2),$LENGTH(SDARRAY(2)))

 +34               IF SDLCHAR=","

                       QUIT 

 +35              IF '$TEST

                       IF SDLCHAR'="("

                           SET SDARRAY(2)=SDARRAY(2)_","

               End DoDot:1

 +36      ;Initialize Encounter Filter

 +37       SET SDARRAY("ENCTR")=$$UPCASE($GET(SDARRAY(12)))

 +38       QUIT 

 +39      ;

 +40      ;***************************************************

 +41      ;INPUT

 +42      ;      SDFLTR    Filter to initialize

 +43      ;***************************************************

INITDTS(SDFLTR) ;initialize Appt Date/Time and Date Appt Made

 +1        NEW SDFROM,SDTO,SDYR,SDDAY,SDMNTH,SDTIME,SDVAR

 +2       ;initialize variables to passed in values

 +3        SET SDFROM=$PIECE($GET(SDARRAY(SDFLTR)),";",1)

 +4        SET SDTO=$PIECE($GET(SDARRAY(SDFLTR)),";",2)

 +5       ;replace day and month to Jan 01 (0101) if 0s or "" are passed

 +6       ;replace time with 2359 if time is greater than 2359

 +7        FOR SDVAR="SDFROM","SDTO"

               Begin DoDot:1

 +8                IF @SDVAR'=""

                       Begin DoDot:2

 +9                        SET SDYR=$EXTRACT(@SDVAR,1,3)

                           SET SDMNTH=$EXTRACT(@SDVAR,4,5)

                           SET SDDAY=$EXTRACT(@SDVAR,6,7)

 +10                       SET SDTIME=$PIECE(@SDVAR,".",2)

                           IF (SDTIME'="")

                               SET SDTIME="."_SDTIME

 +11                       IF (+SDDAY'>0)

                               SET SDDAY="01"

 +12                       IF (+SDMNTH'>0)

                               SET SDMNTH="01"

 +13                       IF ((+SDTIME'=0)&(+SDTIME>.2359))

                               SET SDTIME=.2359

 +14                       SET @SDVAR=SDYR_SDMNTH_SDDAY

 +15                       IF (SDTIME'="")

                               SET @SDVAR=@SDVAR_SDTIME

                       End DoDot:2

               End DoDot:1

 +16      ;initialize SDTO to default if null

 +17       IF $GET(SDTO)=""

               Begin DoDot:1

 +18               IF SDFLTR=1

                       SET SDTO="9999999.9999"

 +19               IF SDFLTR=16

                       SET SDTO="9999999"

               End DoDot:1

 +20      ;if date passed in without time for Appt Date/Time filter add time

 +21       IF SDFLTR=1

               IF SDTO'["."

                   SET SDTO=SDTO_".2359"

 +22      ;create new variables to reference Date(/Time)s

 +23       IF SDFLTR=1

               Begin DoDot:1

 +24               SET SDARRAY("FR")=$GET(SDFROM)

 +25               SET SDARRAY("TO")=$GET(SDTO)

               End DoDot:1

 +26       IF SDFLTR=16

               Begin DoDot:1

 +27               SET SDARRAY("DAMFR")=$GET(SDFROM)

 +28               SET SDARRAY("DAMTO")=$GET(SDTO)

               End DoDot:1

 +29       QUIT 

 +30      ;

 +31      ;*****************************************************************

 +32      ;INPUT

 +33      ;  SDARRAY   Appointment Filter array (by reference)

 +34      ;*****************************************************************

INITFLDS(SDARRAY) ;initialize Fields Requested

 +1        NEW SDFLD

 +2       ;Reset Field Array

           SET SDARRAY("FLDS")=""

 +3       ;add all available fields to Field Request

 +4        FOR SDFLD=1:1:26,28:1:SDARRAY("FC")

               SET SDARRAY("FLDS")=SDARRAY("FLDS")_SDFLD_";"

 +5        QUIT 

UPCASE(SDDATA) ;ensure RSA text is upper case

 +1        QUIT $TRANSLATE(SDDATA,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")