SDAMA306 ;BPOIFO/ACS-Filter API Utilities ; 6/21/05 1:50pm
;;5.3;Scheduling;**301,347,508**;13 Aug 1993
;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")
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDAMA306 4335 printed Oct 16, 2024@18:47:56 Page 2
SDAMA306 ;BPOIFO/ACS-Filter API Utilities ; 6/21/05 1:50pm
+1 ;;5.3;Scheduling;**301,347,508**;13 Aug 1993
+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")
