SDAMA300 ;BPOIFO/ACS-Filter API Validate Filters ; 9/14/05 7:49am
;;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
;*****************************************************************
;
;*****************************************************************
;
; VALIDATE FILTER ARRAY CONTENTS
;INPUT
; SDARRAY Appointment filters
; SDFLTR Filter Flag array
;
;OUTPUT
; -1 if error
; 1 if no errors
;
;*****************************************************************
VALARR(SDARRAY,SDFLTR) ;
;Initialize local variables
N SDI,SDX,SDQUIT,SDDATA,SDCOUNT,SDERR
S SDQUIT=0,SDERR=115
;
;Set filter flags and validate input array entries
F SDI="MAX","FLDS","FLTRS","SORT","VSTAPPTS","PURGED" Q:SDQUIT D @SDI
Q:(SDARRAY("CNT")=-1) -1
;filters allowed on these fields
F SDI=1:1:4,13,16 Q:SDQUIT D
. I $G(SDARRAY(SDI))']"" S SDFLTR(SDI)=0
. E S SDFLTR(SDI)=1 D
.. S SDCOUNT=$L(SDARRAY(SDI),";")
.. S SDQUIT=0
.. D @SDI
;
I SDQUIT=0 D
. ;filters not allowed on these fields
. F SDI=5:1:12,14,15,17:1:26,28:1:SDARRAY("FC") Q:SDQUIT D NOFIL
Q SDARRAY("CNT")
;
;*****************************************************************
;
1 ;SDARRAY(1): Appt dates
;validate from/to date(/time)s
D CHKDTES($G(SDARRAY("FR")),$G(SDARRAY("TO")))
Q:SDQUIT
;allow seconds in date/time filter!
I $L(SDARRAY("FR"))>14 D ERROR(SDERR)
Q:SDQUIT
I $L(SDARRAY("TO"))>14 D ERROR(SDERR)
Q
2 ;SDARRAY(2): Clinic IEN
;Clinic must be on ^SC
;Clinic list is not in global
I SDARRAY("CLNGBL")'=1 D
. ; get each clinic IEN in the string and validate
. F SDX=1:1:SDCOUNT Q:SDQUIT D
.. S SDDATA=$P(SDARRAY(2),";",SDX)
.. I ($G(SDDATA)=""!'$D(^SC(SDDATA,0))) D ERROR(SDERR) Q
.. D:$$CHKRSACL(SDDATA) ERROR(SDERR) ;validate RSA Clinic (Type R)
;Clinic list is in global or local array
I SDARRAY("CLNGBL")=1 D
. Q:SDARRAY(2)="^SC(" ; no validation required if clinic global
. S SDX=SDARRAY(2)
. ;check for existence of IENs
. N SDIEN S SDIEN=$O(@(SDX_"0)")) I +$G(SDIEN)=0 D ERROR(SDERR)
. Q:SDQUIT
. S SDDATA=0
. ; get each IEN in the array and validate
. F S SDDATA=$O(@(SDX_"SDDATA)")) Q:(($G(SDDATA)="")!(SDQUIT)) D
.. I '$D(^SC(SDDATA,0)) D ERROR(SDERR) Q
.. D:$$CHKRSACL(SDDATA) ERROR(SDERR) ;validate RSA Clinic (Type R)
Q
3 ;SDARRAY(3): Appointment Status Code
F SDX=1:1:SDCOUNT Q:SDQUIT D
. S SDDATA=";"_$P(SDARRAY(3),";",SDX)_";"
. I ";I;R;NT;NS;NSR;CC;CCR;CP;CPR;"'[(SDDATA) D ERROR(SDERR)
Q
4 ;SDARRAY(4): Patient DFN
;patient must be on ^DPT
;DFN list is not in global
I SDARRAY("PATGBL")'=1 D
. ; get each DFN in the string and validate
. F SDX=1:1:SDCOUNT Q:SDQUIT D
.. S SDDATA=$P(SDARRAY(4),";",SDX)
.. I $G(SDDATA)="" D ERROR(SDERR)
.. Q:SDQUIT
.. I '$D(^DPT(SDDATA)) D ERROR(SDERR)
.. Q:SDQUIT
;DFN list is in global or local array
I SDARRAY("PATGBL")=1 D
. Q:SDARRAY(4)="^DPT("
. S SDX=SDARRAY(4)
. ;check for existence of DFNs
. N SDDFN S SDDFN=$O(@(SDX_"0)")) I +$G(SDDFN)=0 D ERROR(SDERR)
. Q:SDQUIT
. S SDDATA=0
. ; get each DFN in the array and validate
. F S SDDATA=$O(@(SDX_"SDDATA)")) Q:(($G(SDDATA)="")!(SDQUIT)) D
.. I '$D(^DPT(SDDATA)) D ERROR(SDERR)
.. Q:SDQUIT
Q
12 ;SDARRAY(12): Encounter Exists
;Unpublished and should not be used by other applications
;validate value
;S SDQUIT=$S(SDARRAY("ENCTR")="":0,SDARRAY("ENCTR")="Y":0,SDARRAY("ENCTR")="N":0,1:1)
;D:SDQUIT ERROR(SDERR)
Q
13 ;SDARRAY(13): Primary Stop Code
;primary stop code must exist on ^DIC(40.7,"C"
F SDX=1:1:SDCOUNT Q:SDQUIT D
. S SDDATA=$P(SDARRAY(13),";",SDX)
. I '+SDDATA D ERROR(SDERR) Q
. I '$D(^DIC(40.7,"C",SDDATA)) D ERROR(SDERR) Q
Q
16 ;SDARRAY(16): Date Appointment Made
;validate from/to date(s)
D CHKDTES($G(SDARRAY("DAMFR")),$G(SDARRAY("DAMTO")))
Q:SDQUIT
;ensure time not entered
I $L(SDARRAY("DAMFR"))>7 D ERROR(SDERR)
Q:SDQUIT
I $L(SDARRAY("DAMTO"))>7 D ERROR(SDERR)
Q
CHKRSACL(SDCL) ;validate RSA clinics
;
;Input SDCL - IEN of the clinic
;Output 0 - Clinic OK
; 1 - Clinic Error (Missing either Local Appointment
; purpose Id or Resource Id entry)
;
;initialize variables
N SDRSA,SDRNODE,SDERR
S SDERR=0
;quit if clinic is not of type "C" (Clinic)
; - RSA Clinic that has not completed migration
Q:($P($G(^SC(SDCL,0)),"^",3)'="C") SDERR
;determine clinic (RSA or VistA)
S SDRSA=$$RSACLNC^SDAMA307(SDCL)
Q:SDRSA SDERR ;valid RSA clinic (has both Resource/LAP Ids)
;check to ensure valid VistA clinic
S SDRNODE=$G(^SC(SDCL,"RSA"))
;error if either resource or lap defined
S SDERR=$S((($P(SDRNODE,"^",4)="")&($P(SDRNODE,"^",5)="")):0,1:1)
Q SDERR
VSTAPPTS ;validate parameter for retrieving only VistA Appointments
;This flag supports the RPC View for RSA - unpublished feature
Q:($G(SDARRAY("VSTAPPTS"))="")
D:($G(SDARRAY("VSTAPPTS"))'=1) ERROR(SDERR)
Q
PURGED ;validate parameter for retrieving PURGED VistA appts
Q:($G(SDARRAY("PURGED"))="") ;parameter not set/used
D:($G(SDARRAY("PURGED"))'=1) ERROR(SDERR)
Q:(SDQUIT) ;quit if parameter not set correctly
;throw error if patient filter not defined or invalid field requested
D:($G(SDARRAY(4))']"") ERROR(SDERR)
Q:(SDQUIT)
N SDI F SDI=5:1:9,11,22,28,30,31,33 Q:(SDQUIT) D
.D:((";"_$G(SDARRAY("FLDS"))_";")[(";"_SDI_";")) ERROR(SDERR)
Q
NOFIL ;No filter allowed
I $G(SDARRAY(SDI))]"" D ERROR(SDERR)
Q
FMDATE(SDDATE,SDERR) ;
;dates must be valid internal FileMan format
N X,Y,%H,%T,%Y
S Y=SDDATE D DD^%DT I Y=-1 D ERROR(SDERR)
Q:SDQUIT
;dates cannot be imprecise
S X=SDDATE D H^%DTC I %H=0 D ERROR(SDERR)
Q
CHKDTES(SDFROM,SDTO) ;validate date(/time)s
N SDI,X,Y,%DT
S %DT="STX"
F SDI=SDFROM,SDTO Q:SDQUIT D
.;valid fileman format
.I $G(SDI)'="" D
..D FMDATE(SDI,SDERR)
..Q:SDQUIT
..;check for valid dates / leap yr dates
..I SDI'[9999999 D
...S X=$$FMTE^XLFDT(SDI)
...D ^%DT
...I Y<0 D ERROR(SDERR)
.Q:SDQUIT
Q:SDQUIT
;from date(/time) can't be after to date(/time)
I SDFROM>SDTO D ERROR(SDERR)
Q
MAX ;Maximum number of appointments requested
;max can't be 0
N SDMAXAPT,SDPCOUNT,SDCCOUNT
S SDMAXAPT=$G(SDARRAY("MAX"))
S (SDPCOUNT,SDCCOUNT)=0
I $G(SDMAXAPT)]"" D
. ;Check Max Entry
. I +SDMAXAPT'=SDMAXAPT S SDQUIT=1 Q
. I SDMAXAPT=0 S SDQUIT=1 Q
. I SDMAXAPT["." S SDQUIT=1 Q
. ;Verify a SINGLE valid PATIENT &/OR CLINIC Entry
. ;Get Number of Patients passed in
. I SDARRAY("PATGBL")=1 S SDPCOUNT=$$CHKGBL(SDARRAY(4))
. I SDARRAY("PATGBL")=0 S SDPCOUNT=$L(SDARRAY(4),";")
. ;Get Number of Clinics passed in
. I SDARRAY("CLNGBL")=1 S SDCCOUNT=$$CHKGBL(SDARRAY(2))
. I SDARRAY("CLNGBL")=0 S SDCCOUNT=$L(SDARRAY(2),";")
. I (SDPCOUNT>1)!(SDCCOUNT>1) S SDQUIT=1 Q
. I SDPCOUNT=0,SDCCOUNT=0 S SDQUIT=1
I SDQUIT D ERROR(SDERR)
Q
;
FLDS ;Quit if field list is null
N SDFIELDS,SDFIELD
I $G(SDARRAY("FLDS"))="" D ERROR(SDERR)
Q:SDQUIT
S SDFIELDS=SDARRAY("FLDS")
S SDCOUNT=$L(SDFIELDS,";")
F SDI=1:1:SDCOUNT Q:SDQUIT D
. S SDFIELD=$P(SDFIELDS,";",SDI)
. I (($G(SDFIELD)'?.N)!($G(SDFIELD)<1)!($G(SDFIELD)=27)!($G(SDFIELD)>SDARRAY("FC"))) D ERROR(SDERR) S SDQUIT=1
Q
;
FLTRS ;Quit if max filters exceeded
N SDFCNT S SDFCNT=0
F SDI=1:1:SDARRAY("FC") D
. I $G(SDARRAY(SDI))]"" S SDFCNT=SDFCNT+1
I SDFCNT>SDARRAY("MF") D ERROR(SDERR) S SDQUIT=1
Q
;
SORT ;Quit if SORT Filter is a value other than P or null
N SDSORT
S SDSORT=$G(SDARRAY("SORT"))
I $G(SDSORT)="" Q
I '($G(SDSORT)="P") D ERROR(SDERR)
Q
;
ERROR(SDERRNUM) ;Generate Error and put in ^TMP global
S SDARRAY("CNT")=-1,SDQUIT=1
S $P(^TMP($J,"SDAMA301",SDERRNUM),"^",1)=$P($T(@SDERRNUM),";;",2)
Q
;
101 ;;DATABASE IS UNAVAILABLE
115 ;;INVALID INPUT ARRAY ENTRY
116 ;;DATA MISMATCH
117 ;;Fatal RSA error. See SDAM RSA ERROR LOG file.
;
CHKGBL(SDGBL) ;Check Global for number of entries
N SDIEN,SDCOUNT
S (SDIEN,SDCOUNT)=0
F S SDIEN=$O(@(SDGBL_"SDIEN)")) Q:(+$G(SDIEN)=0)!(SDCOUNT>2) D
.S SDCOUNT=SDCOUNT+1
Q SDCOUNT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDAMA300 8793 printed Dec 13, 2024@02:47:15 Page 2
SDAMA300 ;BPOIFO/ACS-Filter API Validate Filters ; 9/14/05 7:49am
+1 ;;5.3;Scheduling;**301,347,508**;13 Aug 1993
+2 ;PER VHA DIRECTIVE 2004-038, DO NOT MODIFY THIS ROUTINE
+3 ;
+4 ;*****************************************************************
+5 ; CHANGE LOG
+6 ;
+7 ; DATE PATCH DESCRIPTION
+8 ;-------- ---------- -----------------------------------------
+9 ;12/04/03 SD*5.3*301 ROUTINE COMPLETED
+10 ;08/06/04 SD*5.3*347 ADDITION OF A NEW FILTER - DATE APPOINTMENT
+11 ; MADE (FIELD #16) AND 2 NEW FIELDS TO RETURN:
+12 ; 1) AUTO-REBOOKED APPT DATE/TIME (FIELD #24)
+13 ; 2) NO-SHOW/CANCEL APPT DATE/TIME (FIELD #25)
+14 ;02/22/07 SD*5.3*508 SEE SDAMA301 FOR CHANGE LIST
+15 ;*****************************************************************
+16 ;
+17 ;*****************************************************************
+18 ;
+19 ; VALIDATE FILTER ARRAY CONTENTS
+20 ;INPUT
+21 ; SDARRAY Appointment filters
+22 ; SDFLTR Filter Flag array
+23 ;
+24 ;OUTPUT
+25 ; -1 if error
+26 ; 1 if no errors
+27 ;
+28 ;*****************************************************************
VALARR(SDARRAY,SDFLTR) ;
+1 ;Initialize local variables
+2 NEW SDI,SDX,SDQUIT,SDDATA,SDCOUNT,SDERR
+3 SET SDQUIT=0
SET SDERR=115
+4 ;
+5 ;Set filter flags and validate input array entries
+6 FOR SDI="MAX","FLDS","FLTRS","SORT","VSTAPPTS","PURGED"
if SDQUIT
QUIT
DO @SDI
+7 if (SDARRAY("CNT")=-1)
QUIT -1
+8 ;filters allowed on these fields
+9 FOR SDI=1:1:4,13,16
if SDQUIT
QUIT
Begin DoDot:1
+10 IF $GET(SDARRAY(SDI))']""
SET SDFLTR(SDI)=0
+11 IF '$TEST
SET SDFLTR(SDI)=1
Begin DoDot:2
+12 SET SDCOUNT=$LENGTH(SDARRAY(SDI),";")
+13 SET SDQUIT=0
+14 DO @SDI
End DoDot:2
End DoDot:1
+15 ;
+16 IF SDQUIT=0
Begin DoDot:1
+17 ;filters not allowed on these fields
+18 FOR SDI=5:1:12,14,15,17:1:26,28:1:SDARRAY("FC")
if SDQUIT
QUIT
DO NOFIL
End DoDot:1
+19 QUIT SDARRAY("CNT")
+20 ;
+21 ;*****************************************************************
+22 ;
1 ;SDARRAY(1): Appt dates
+1 ;validate from/to date(/time)s
+2 DO CHKDTES($GET(SDARRAY("FR")),$GET(SDARRAY("TO")))
+3 if SDQUIT
QUIT
+4 ;allow seconds in date/time filter!
+5 IF $LENGTH(SDARRAY("FR"))>14
DO ERROR(SDERR)
+6 if SDQUIT
QUIT
+7 IF $LENGTH(SDARRAY("TO"))>14
DO ERROR(SDERR)
+8 QUIT
2 ;SDARRAY(2): Clinic IEN
+1 ;Clinic must be on ^SC
+2 ;Clinic list is not in global
+3 IF SDARRAY("CLNGBL")'=1
Begin DoDot:1
+4 ; get each clinic IEN in the string and validate
+5 FOR SDX=1:1:SDCOUNT
if SDQUIT
QUIT
Begin DoDot:2
+6 SET SDDATA=$PIECE(SDARRAY(2),";",SDX)
+7 IF ($GET(SDDATA)=""!'$DATA(^SC(SDDATA,0)))
DO ERROR(SDERR)
QUIT
+8 ;validate RSA Clinic (Type R)
if $$CHKRSACL(SDDATA)
DO ERROR(SDERR)
End DoDot:2
End DoDot:1
+9 ;Clinic list is in global or local array
+10 IF SDARRAY("CLNGBL")=1
Begin DoDot:1
+11 ; no validation required if clinic global
if SDARRAY(2)="^SC("
QUIT
+12 SET SDX=SDARRAY(2)
+13 ;check for existence of IENs
+14 NEW SDIEN
SET SDIEN=$ORDER(@(SDX_"0)"))
IF +$GET(SDIEN)=0
DO ERROR(SDERR)
+15 if SDQUIT
QUIT
+16 SET SDDATA=0
+17 ; get each IEN in the array and validate
+18 FOR
SET SDDATA=$ORDER(@(SDX_"SDDATA)"))
if (($GET(SDDATA)="")!(SDQUIT))
QUIT
Begin DoDot:2
+19 IF '$DATA(^SC(SDDATA,0))
DO ERROR(SDERR)
QUIT
+20 ;validate RSA Clinic (Type R)
if $$CHKRSACL(SDDATA)
DO ERROR(SDERR)
End DoDot:2
End DoDot:1
+21 QUIT
3 ;SDARRAY(3): Appointment Status Code
+1 FOR SDX=1:1:SDCOUNT
if SDQUIT
QUIT
Begin DoDot:1
+2 SET SDDATA=";"_$PIECE(SDARRAY(3),";",SDX)_";"
+3 IF ";I;R;NT;NS;NSR;CC;CCR;CP;CPR;"'[(SDDATA)
DO ERROR(SDERR)
End DoDot:1
+4 QUIT
4 ;SDARRAY(4): Patient DFN
+1 ;patient must be on ^DPT
+2 ;DFN list is not in global
+3 IF SDARRAY("PATGBL")'=1
Begin DoDot:1
+4 ; get each DFN in the string and validate
+5 FOR SDX=1:1:SDCOUNT
if SDQUIT
QUIT
Begin DoDot:2
+6 SET SDDATA=$PIECE(SDARRAY(4),";",SDX)
+7 IF $GET(SDDATA)=""
DO ERROR(SDERR)
+8 if SDQUIT
QUIT
+9 IF '$DATA(^DPT(SDDATA))
DO ERROR(SDERR)
+10 if SDQUIT
QUIT
End DoDot:2
End DoDot:1
+11 ;DFN list is in global or local array
+12 IF SDARRAY("PATGBL")=1
Begin DoDot:1
+13 if SDARRAY(4)="^DPT("
QUIT
+14 SET SDX=SDARRAY(4)
+15 ;check for existence of DFNs
+16 NEW SDDFN
SET SDDFN=$ORDER(@(SDX_"0)"))
IF +$GET(SDDFN)=0
DO ERROR(SDERR)
+17 if SDQUIT
QUIT
+18 SET SDDATA=0
+19 ; get each DFN in the array and validate
+20 FOR
SET SDDATA=$ORDER(@(SDX_"SDDATA)"))
if (($GET(SDDATA)="")!(SDQUIT))
QUIT
Begin DoDot:2
+21 IF '$DATA(^DPT(SDDATA))
DO ERROR(SDERR)
+22 if SDQUIT
QUIT
End DoDot:2
End DoDot:1
+23 QUIT
12 ;SDARRAY(12): Encounter Exists
+1 ;Unpublished and should not be used by other applications
+2 ;validate value
+3 ;S SDQUIT=$S(SDARRAY("ENCTR")="":0,SDARRAY("ENCTR")="Y":0,SDARRAY("ENCTR")="N":0,1:1)
+4 ;D:SDQUIT ERROR(SDERR)
+5 QUIT
13 ;SDARRAY(13): Primary Stop Code
+1 ;primary stop code must exist on ^DIC(40.7,"C"
+2 FOR SDX=1:1:SDCOUNT
if SDQUIT
QUIT
Begin DoDot:1
+3 SET SDDATA=$PIECE(SDARRAY(13),";",SDX)
+4 IF '+SDDATA
DO ERROR(SDERR)
QUIT
+5 IF '$DATA(^DIC(40.7,"C",SDDATA))
DO ERROR(SDERR)
QUIT
End DoDot:1
+6 QUIT
16 ;SDARRAY(16): Date Appointment Made
+1 ;validate from/to date(s)
+2 DO CHKDTES($GET(SDARRAY("DAMFR")),$GET(SDARRAY("DAMTO")))
+3 if SDQUIT
QUIT
+4 ;ensure time not entered
+5 IF $LENGTH(SDARRAY("DAMFR"))>7
DO ERROR(SDERR)
+6 if SDQUIT
QUIT
+7 IF $LENGTH(SDARRAY("DAMTO"))>7
DO ERROR(SDERR)
+8 QUIT
CHKRSACL(SDCL) ;validate RSA clinics
+1 ;
+2 ;Input SDCL - IEN of the clinic
+3 ;Output 0 - Clinic OK
+4 ; 1 - Clinic Error (Missing either Local Appointment
+5 ; purpose Id or Resource Id entry)
+6 ;
+7 ;initialize variables
+8 NEW SDRSA,SDRNODE,SDERR
+9 SET SDERR=0
+10 ;quit if clinic is not of type "C" (Clinic)
+11 ; - RSA Clinic that has not completed migration
+12 if ($PIECE($GET(^SC(SDCL,0)),"^",3)'="C")
QUIT SDERR
+13 ;determine clinic (RSA or VistA)
+14 SET SDRSA=$$RSACLNC^SDAMA307(SDCL)
+15 ;valid RSA clinic (has both Resource/LAP Ids)
if SDRSA
QUIT SDERR
+16 ;check to ensure valid VistA clinic
+17 SET SDRNODE=$GET(^SC(SDCL,"RSA"))
+18 ;error if either resource or lap defined
+19 SET SDERR=$SELECT((($PIECE(SDRNODE,"^",4)="")&($PIECE(SDRNODE,"^",5)="")):0,1:1)
+20 QUIT SDERR
VSTAPPTS ;validate parameter for retrieving only VistA Appointments
+1 ;This flag supports the RPC View for RSA - unpublished feature
+2 if ($GET(SDARRAY("VSTAPPTS"))="")
QUIT
+3 if ($GET(SDARRAY("VSTAPPTS"))'=1)
DO ERROR(SDERR)
+4 QUIT
PURGED ;validate parameter for retrieving PURGED VistA appts
+1 ;parameter not set/used
if ($GET(SDARRAY("PURGED"))="")
QUIT
+2 if ($GET(SDARRAY("PURGED"))'=1)
DO ERROR(SDERR)
+3 ;quit if parameter not set correctly
if (SDQUIT)
QUIT
+4 ;throw error if patient filter not defined or invalid field requested
+5 if ($GET(SDARRAY(4))']"")
DO ERROR(SDERR)
+6 if (SDQUIT)
QUIT
+7 NEW SDI
FOR SDI=5:1:9,11,22,28,30,31,33
if (SDQUIT)
QUIT
Begin DoDot:1
+8 if ((";"_$GET(SDARRAY("FLDS"))_";")[(";"_SDI_";"))
DO ERROR(SDERR)
End DoDot:1
+9 QUIT
NOFIL ;No filter allowed
+1 IF $GET(SDARRAY(SDI))]""
DO ERROR(SDERR)
+2 QUIT
FMDATE(SDDATE,SDERR) ;
+1 ;dates must be valid internal FileMan format
+2 NEW X,Y,%H,%T,%Y
+3 SET Y=SDDATE
DO DD^%DT
IF Y=-1
DO ERROR(SDERR)
+4 if SDQUIT
QUIT
+5 ;dates cannot be imprecise
+6 SET X=SDDATE
DO H^%DTC
IF %H=0
DO ERROR(SDERR)
+7 QUIT
CHKDTES(SDFROM,SDTO) ;validate date(/time)s
+1 NEW SDI,X,Y,%DT
+2 SET %DT="STX"
+3 FOR SDI=SDFROM,SDTO
if SDQUIT
QUIT
Begin DoDot:1
+4 ;valid fileman format
+5 IF $GET(SDI)'=""
Begin DoDot:2
+6 DO FMDATE(SDI,SDERR)
+7 if SDQUIT
QUIT
+8 ;check for valid dates / leap yr dates
+9 IF SDI'[9999999
Begin DoDot:3
+10 SET X=$$FMTE^XLFDT(SDI)
+11 DO ^%DT
+12 IF Y<0
DO ERROR(SDERR)
End DoDot:3
End DoDot:2
+13 if SDQUIT
QUIT
End DoDot:1
+14 if SDQUIT
QUIT
+15 ;from date(/time) can't be after to date(/time)
+16 IF SDFROM>SDTO
DO ERROR(SDERR)
+17 QUIT
MAX ;Maximum number of appointments requested
+1 ;max can't be 0
+2 NEW SDMAXAPT,SDPCOUNT,SDCCOUNT
+3 SET SDMAXAPT=$GET(SDARRAY("MAX"))
+4 SET (SDPCOUNT,SDCCOUNT)=0
+5 IF $GET(SDMAXAPT)]""
Begin DoDot:1
+6 ;Check Max Entry
+7 IF +SDMAXAPT'=SDMAXAPT
SET SDQUIT=1
QUIT
+8 IF SDMAXAPT=0
SET SDQUIT=1
QUIT
+9 IF SDMAXAPT["."
SET SDQUIT=1
QUIT
+10 ;Verify a SINGLE valid PATIENT &/OR CLINIC Entry
+11 ;Get Number of Patients passed in
+12 IF SDARRAY("PATGBL")=1
SET SDPCOUNT=$$CHKGBL(SDARRAY(4))
+13 IF SDARRAY("PATGBL")=0
SET SDPCOUNT=$LENGTH(SDARRAY(4),";")
+14 ;Get Number of Clinics passed in
+15 IF SDARRAY("CLNGBL")=1
SET SDCCOUNT=$$CHKGBL(SDARRAY(2))
+16 IF SDARRAY("CLNGBL")=0
SET SDCCOUNT=$LENGTH(SDARRAY(2),";")
+17 IF (SDPCOUNT>1)!(SDCCOUNT>1)
SET SDQUIT=1
QUIT
+18 IF SDPCOUNT=0
IF SDCCOUNT=0
SET SDQUIT=1
End DoDot:1
+19 IF SDQUIT
DO ERROR(SDERR)
+20 QUIT
+21 ;
FLDS ;Quit if field list is null
+1 NEW SDFIELDS,SDFIELD
+2 IF $GET(SDARRAY("FLDS"))=""
DO ERROR(SDERR)
+3 if SDQUIT
QUIT
+4 SET SDFIELDS=SDARRAY("FLDS")
+5 SET SDCOUNT=$LENGTH(SDFIELDS,";")
+6 FOR SDI=1:1:SDCOUNT
if SDQUIT
QUIT
Begin DoDot:1
+7 SET SDFIELD=$PIECE(SDFIELDS,";",SDI)
+8 IF (($GET(SDFIELD)'?.N)!($GET(SDFIELD)<1)!($GET(SDFIELD)=27)!($GET(SDFIELD)>SDARRAY("FC")))
DO ERROR(SDERR)
SET SDQUIT=1
End DoDot:1
+9 QUIT
+10 ;
FLTRS ;Quit if max filters exceeded
+1 NEW SDFCNT
SET SDFCNT=0
+2 FOR SDI=1:1:SDARRAY("FC")
Begin DoDot:1
+3 IF $GET(SDARRAY(SDI))]""
SET SDFCNT=SDFCNT+1
End DoDot:1
+4 IF SDFCNT>SDARRAY("MF")
DO ERROR(SDERR)
SET SDQUIT=1
+5 QUIT
+6 ;
SORT ;Quit if SORT Filter is a value other than P or null
+1 NEW SDSORT
+2 SET SDSORT=$GET(SDARRAY("SORT"))
+3 IF $GET(SDSORT)=""
QUIT
+4 IF '($GET(SDSORT)="P")
DO ERROR(SDERR)
+5 QUIT
+6 ;
ERROR(SDERRNUM) ;Generate Error and put in ^TMP global
+1 SET SDARRAY("CNT")=-1
SET SDQUIT=1
+2 SET $PIECE(^TMP($JOB,"SDAMA301",SDERRNUM),"^",1)=$PIECE($TEXT(@SDERRNUM),";;",2)
+3 QUIT
+4 ;
101 ;;DATABASE IS UNAVAILABLE
115 ;;INVALID INPUT ARRAY ENTRY
116 ;;DATA MISMATCH
117 ;;Fatal RSA error. See SDAM RSA ERROR LOG file.
+1 ;
CHKGBL(SDGBL) ;Check Global for number of entries
+1 NEW SDIEN,SDCOUNT
+2 SET (SDIEN,SDCOUNT)=0
+3 FOR
SET SDIEN=$ORDER(@(SDGBL_"SDIEN)"))
if (+$GET(SDIEN)=0)!(SDCOUNT>2)
QUIT
Begin DoDot:1
+4 SET SDCOUNT=SDCOUNT+1
End DoDot:1
+5 QUIT SDCOUNT
