SDAMA300.m

SDAMA300 ;BPOIFO/ACS-Filter API Validate Filters ; 9/14/05 7:49am

 ;;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

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

 ;

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

 ;

 ;              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

SDAMA300  ;BPOIFO/ACS-Filter API Validate Filters ; 9/14/05 7:49am

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