source: FOIAVistA/tag/r/SCHEDULING-SD-SC/SDAMA306.m@ 1018

Last change on this file since 1018 was 628, checked in by George Lilly, 16 years ago

initial load of FOIAVistA 6/30/08 version
File size: 4.1 KB
Line 
1SDAMA306 ;BPOIFO/ACS-Filter API Utilities ; 6/21/05 1:50pm
2 ;;5.3;Scheduling;**301,347,508**;13 Aug 1993
3 ;PER VHA DIRECTIVE 2004-038, DO NOT MODIFY THIS ROUTINE
4 ;
5 ;
6 ;*****************************************************************
7 ; CHANGE LOG
8 ;
9 ; DATE PATCH DESCRIPTION
10 ;-------- ---------- -----------------------------------------
11 ;12/04/03 SD*5.3*301 ROUTINE COMPLETED
12 ;08/06/04 SD*5.3*347 ADDITION OF A NEW FILTER - DATE APPOINTMENT
13 ; MADE (FIELD #16) AND 2 NEW FIELDS TO RETURN:
14 ; 1) AUTO-REBOOKED APPT DATE/TIME (FIELD #24)
15 ; 2) NO-SHOW/CANCEL APPT DATE/TIME (FIELD #25)
16 ;02/22/07 SD*5.3*508 SEE SDAMA301 FOR CHANGE LIST
17 ;*****************************************************************
18 ;*****************************************************************
19 ;
20 ;INPUT
21 ; SDARRAY Appointment Filter array (by reference)
22 ;
23 ;*****************************************************************
24INITAE(SDARRAY) ;Initialize Array Entries as needed
25 ;Initialize Appointment "From" and "To" dates if null
26 N SDI
27 F SDI=1,16 D INITDTS(SDI)
28 ;
29 ;Initialize Fields Array if ALL Fields Requested
30 D:($$UPCASE(SDARRAY("FLDS"))="ALL") INITFLDS(.SDARRAY)
31 ;
32 ;Remove leading and trailing semi-colons from filter lists if present
33 N SDNODE
34 F SDNODE=2,3,4,13,"FLDS" D
35 . I $L($G(SDARRAY(SDNODE)))>0 D
36 .. I $E(SDARRAY(SDNODE),$L(SDARRAY(SDNODE)))=";" D
37 ... S SDARRAY(SDNODE)=$E(SDARRAY(SDNODE),1,($L(SDARRAY(SDNODE))-1))
38 .. I $E(SDARRAY(SDNODE),1)=";" D
39 ... S SDARRAY(SDNODE)=$E(SDARRAY(SDNODE),2,$L(SDARRAY(SDNODE)))
40 ;
41 ;If the patient list is in a global, add comma at end if needed
42 S SDARRAY("PATGBL")=0
43 I $G(SDARRAY(4))["(" D
44 . ;flag as patient global input
45 . S SDARRAY("PATGBL")=1
46 . ;add comma to end of global root if needed
47 . N SDLCHAR S SDLCHAR=$E(SDARRAY(4),$L(SDARRAY(4)))
48 . I SDLCHAR="," Q
49 . E I SDLCHAR'="(" S SDARRAY(4)=SDARRAY(4)_","
50 ;
51 ;If the clinic list is in a global, add comma at end if needed
52 S SDARRAY("CLNGBL")=0
53 I $G(SDARRAY(2))["(" D
54 . ;flag as clinic global input
55 . S SDARRAY("CLNGBL")=1
56 . ;add comma to end of global root if needed
57 . N SDLCHAR S SDLCHAR=$E(SDARRAY(2),$L(SDARRAY(2)))
58 . I SDLCHAR="," Q
59 . E I SDLCHAR'="(" S SDARRAY(2)=SDARRAY(2)_","
60 ;Initialize Encounter Filter
61 S SDARRAY("ENCTR")=$$UPCASE($G(SDARRAY(12)))
62 Q
63 ;
64 ;***************************************************
65 ;INPUT
66 ; SDFLTR Filter to initialize
67 ;***************************************************
68INITDTS(SDFLTR) ;initialize Appt Date/Time and Date Appt Made
69 N SDFROM,SDTO,SDYR,SDDAY,SDMNTH,SDTIME,SDVAR
70 ;initialize variables to passed in values
71 S SDFROM=$P($G(SDARRAY(SDFLTR)),";",1)
72 S SDTO=$P($G(SDARRAY(SDFLTR)),";",2)
73 ;replace day and month to Jan 01 (0101) if 0s or "" are passed
74 ;replace time with 2359 if time is greater than 2359
75 F SDVAR="SDFROM","SDTO" D
76 .I @SDVAR'="" D
77 ..S SDYR=$E(@SDVAR,1,3),SDMNTH=$E(@SDVAR,4,5),SDDAY=$E(@SDVAR,6,7)
78 ..S SDTIME=$P(@SDVAR,".",2) S:(SDTIME'="") SDTIME="."_SDTIME
79 ..S:(+SDDAY'>0) SDDAY="01"
80 ..S:(+SDMNTH'>0) SDMNTH="01"
81 ..S:((+SDTIME'=0)&(+SDTIME>.2359)) SDTIME=.2359
82 ..S @SDVAR=SDYR_SDMNTH_SDDAY
83 ..S:(SDTIME'="") @SDVAR=@SDVAR_SDTIME
84 ;initialize SDTO to default if null
85 I $G(SDTO)="" D
86 .S:SDFLTR=1 SDTO="9999999.9999"
87 .S:SDFLTR=16 SDTO="9999999"
88 ;if date passed in without time for Appt Date/Time filter add time
89 I SDFLTR=1,SDTO'["." S SDTO=SDTO_".2359"
90 ;create new variables to reference Date(/Time)s
91 I SDFLTR=1 D
92 .S SDARRAY("FR")=$G(SDFROM)
93 .S SDARRAY("TO")=$G(SDTO)
94 I SDFLTR=16 D
95 .S SDARRAY("DAMFR")=$G(SDFROM)
96 .S SDARRAY("DAMTO")=$G(SDTO)
97 Q
98 ;
99 ;*****************************************************************
100 ;INPUT
101 ; SDARRAY Appointment Filter array (by reference)
102 ;*****************************************************************
103INITFLDS(SDARRAY) ;initialize Fields Requested
104 N SDFLD
105 S SDARRAY("FLDS")="" ;Reset Field Array
106 ;add all available fields to Field Request
107 F SDFLD=1:1:26,28:1:SDARRAY("FC") S SDARRAY("FLDS")=SDARRAY("FLDS")_SDFLD_";"
108 Q
109UPCASE(SDDATA) ;ensure RSA text is upper case
110 Q $TR(SDDATA,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
Note: See TracBrowser for help on using the repository browser.