SDAMA307 ;BPOIFO/ACS-Filter API Call RSA ; 9/14/05 12:45pm
;;5.3;Scheduling;**301,508,1015**;13 Aug 1993;Build 21
;PER VHA DIRECTIVE 2004-038, DO NOT MODIFY THIS ROUTINE
;
;** GET APPOINTMENT DATA FROM RSA **
;
;***************************************************************
; CHANGE LOG
;
; DATE PATCH DESCRIPTION
;-------- ---------- ---------------------------------------
;12/04/03 SD*5.3*301 ROUTINE COMPLETED
;09/14/05 SD*5.3*372 Phase II Apptmts on Multiple Databases
;02/22/07 SD*5.3*508 SEE SDAMA301 FOR CHANGE LIST
;***************************************************************
;
;***************************************************************
;INPUT
; SDARRAY APPOINTMENT FILTER ARRAY (by reference)
; SDVRFR OVERLOAD PARAMETER FOR VERIFIER [optional]
; (Returns Screened RSA Appts (Migrating))
;***************************************************************
DATA(SDARRAY,SDVRFR) ;Get RSA appointment data (Phase II)
;Initialize variables
N SDRESP,SDCOUNT,SDDFN,SDX,SDGBL
S SDX=0
;if patient filter defined ensure that at least 1 patient has
;an ICN. if no patient in the list or global has an icn then RSA
;does not need to be called (No Appointments will exist.)
I (($G(SDARRAY(4))]"")&($G(SDARRAY(4))'="^DPT(")) D Q:'SDX
.;patients in global
.I SDARRAY("PATGBL")=1 D
..S SDGBL=SDARRAY(4),SDDFN=0
..F S SDDFN=$O(@(SDGBL_"SDDFN)")) Q:((+$G(SDDFN)=0)!SDX) D
...S:(+$$GETICN^MPIF001(SDDFN)>0) SDX=1
.;patients in list
.I SDARRAY("PATGBL")=0 D
..S SDCOUNT=$L(SDARRAY(4),";")
..F SDDFN=1:1:SDCOUNT Q:SDX D
...S:(+$$GETICN^MPIF001($P(SDARRAY(4),";",SDDFN))>0) SDX=1
;if patient filter is not defined ensure that if the status
;filter is defined that it has more than cancelled appt statuses
;(Cancelled Appts not returned if Patient filter not defined)
I (($G(SDARRAY(4))']"")&($G(SDARRAY(3))]"")) D Q:'SDX
.N SDSTAT,SDI S SDSTAT="",SDX=0
.F SDI=1:1:$L(SDARRAY(3),";") Q:SDX D
..S:($P(SDARRAY(3),";",SDI)'["C") SDX=1
;Call RSA Business Delegate
;S SDRESP=$$XMLDLGT^SDAMA309(.SDARRAY,$G(SDVRFR))
;error occurred creating appt records
I SDRESP<0 S SDARRAY("CNT")=-1
;no errors/update total appt counter/adjust appts to max filter
;as RSA appts were appended to output and may exceed the MAX
I '(SDRESP<0) D
.S SDARRAY("CNT")=SDARRAY("CNT")+SDRESP
.;adjust total number of appointments
.D MAXAPPTS(.SDARRAY)
Q
;
;***************************************************************
;OUTPUT
; If RSA Implemented, return 1,10 or 11 if Appt Entry Exists
; If RSA NOT Implemented, return 0
;***************************************************************
IMP() ;RSA Implemented
Q $D(^XOB(18.08,"B",$$GETSRVNM))
;
;***************************************************************
;OUTPUT
; Returns RSA Application Server Name
;***************************************************************
GETSRVNM() ;return the VL 2.0 application server name
Q "SDAM-RSA"
;
;***************************************************************
;INPUT
; SDCLIEN Clinic's Internal Entry Number (Required)
; SDARRAY APPOINTMENT FILTER ARRAY (by reference)
;OUTPUT
; 1 Return a Patients or Clinics VistA Appointments
; 0 Exclude a Patients or Clinics VistA Appointments
;
; SDARRAY("RSA")=1 will exist if RSA has to be Called
; SDARRAY("MIG") will exist for VistA Clinics that have an
; earliest migrated date/time and has
; completed migration.
; ***************************************************************
CLMIG(SDCLIEN,SDARRAY) ;clinic status switch
;initialize variables
N SDRSA
S SDARRAY("CLIN")=SDCLIEN,SDARRAY("MIG")=""
;quit if clinic is not of type "C" (Clinic)
Q:($P($G(^SC(SDCLIEN,0)),"^",3)'="C") 0
;determine if RSA Clinic,
;if RSA Clinic Quit VistA doesnt need to be called
S SDRSA=$$RSACLNC(SDCLIEN)
;
;RSA CLINIC (Check-In Point) Logic
;Call RSA for Future Migrated/New appointments
I SDRSA S SDARRAY("RSA")=1 Q 0
;
;VISTA CLINIC Logic
;return all VistA appointments (Migration not completed)
Q:($P($G(^SC(SDCLIEN,"RSA")),"^",6)']"") 1
;retrieve earliest migrated date/time
S SDARRAY("MIG")=+$P($G(^SC(SDCLIEN,"RSA")),"^",3)
;return non-migrated VistA appointments
Q:(SDARRAY("MIG")>+$G(SDARRAY("DATE"))) 1
;migrated VistA appointments not returned
Q 0
;
;***************************************************************
;INPUT
; SDCLNC - Clinic IEN
;OUTPUT
; 1 - Is an RSA Clinic
; 0 - Is not an RSA Clinic
;***************************************************************
RSACLNC(SDCLNC) ;determine if Clinic is an RSA Clinic
;RSA Clinic if Resource Id (#44.203) and
; Appt Purpose ID (#44.204) exist
;initialize variables
N SDRID,SDLAPID
;get resource id
S SDRID=$P($G(^SC(SDCLNC,"RSA")),"^",4)
;get local appt purpose id
S SDLAPID=$P($G(^SC(SDCLNC,"RSA")),"^",5)
Q $S(((SDRID'="")&(SDLAPID'="")):1,1:0)
;
;***************************************************************
;OUTPUT
; Returns the Sites VistA Instance Number
;***************************************************************
VI() ;Get VistA Instance
N SDVI
S SDVI=$$SITE^VASITE
Q +$P(SDVI,"^",3)
;
;******************************************************************
;INPUT
; SDARRAY APPOINTMENT FILTER ARRAY (by reference)
;******************************************************************
MAXAPPTS(SDARRAY) ;Adjust combined appointments (VistA/RSA) to MAX
N SDDIFF,SDDIR,SDREF,SDMAX,SDI,SDDTM,SDSORT1,SDSORT2
S SDMAX=$S(SDARRAY("MAX")<0:SDARRAY("MAX")*-1,1:SDARRAY("MAX"))
S SDDIR=1,SDREF="^TMP($J,""SDRSRT"")"
;quit if max filter not defined / max equals appt count / or
;appt count is less than max
Q:($S(SDARRAY("MAX")="":1,SDMAX=SDARRAY("CNT"):1,SDARRAY("CNT")<SDMAX:1,1:0))
;determine how many appts to kill and QUERY direction
I SDARRAY("MAX")>0 D
.S SDDIFF=SDARRAY("CNT")-SDARRAY("MAX"),SDDIR=-1
.I $G(SDARRAY("SORT"))="P" S SDREF="^TMP($J,""SDRSRT"",""A"",""A"")"
.E S SDREF="^TMP($J,""SDRSRT"",""A"",""A"",""A"")"
S:SDARRAY("MAX")<0 SDDIFF=SDARRAY("CNT")+SDARRAY("MAX")
;create temporary resorted output global by Date/Time
;D MAXRESRT^SDAMA309(.SDARRAY)
;
;loop through appt set and kill the excess appts
F Q:'SDDIFF D
.S SDREF=$Q(@SDREF,SDDIR)
.;retrieve subscribpt to delete from output global
.S SDDTM=$P(SDREF,",",3),SDSORT1=+$P(SDREF,",",4),SDSORT2=+$P(SDREF,",",5)
.K:($G(SDARRAY("SORT"))="P") ^TMP($J,"SDAMA301",SDSORT1,SDDTM)
.K:($G(SDARRAY("SORT"))'="P") ^TMP($J,"SDAMA301",SDSORT1,SDSORT2,SDDTM)
.K @SDREF ;delete resorted temp output copy
.S SDDIFF=SDDIFF-1
;reset total appt count to max
S SDARRAY("CNT")=$S(SDARRAY("MAX")>0:SDARRAY("MAX"),1:(SDARRAY("MAX")*(-1)))
K ^TMP($J,"SDRSRT")
Q
;
;Both Patient and Clinic Filter Defined, Determine if RSA should be
;called, by evaluating the Clinic Filter List. Patient may have no
;appointments in VistA, so Clinic Filter has to be evaluated.
;******************************************************************
;INPUT
; SDARRAY APPOINTMENT FILTER ARRAY (by reference)
;******************************************************************
CALLRSA(SDARRAY) ;
;initialize variables
N SDCOUNT,SDX,SDCLIEN,SDQUIT,SDGBL,SDRSLT
S (SDCOUNT,SDQUIT)=0
;if clinic is in a list:
I SDARRAY("CLNGBL")=0 D
. S SDCOUNT=$L(SDARRAY(2),";")
. ;For each clinic in the filter (LIST):
. F SDX=1:1:SDCOUNT Q:SDQUIT D
.. S SDCLIEN=$P(SDARRAY(2),";",SDX)
.. ;determine if clinic has migrated (Call RSA)
.. S SDRSLT='$$CLMIG(SDCLIEN,.SDARRAY)
.. S SDQUIT=+$G(SDARRAY("RSA"))
;if clinic is in array, get IENs
I SDARRAY("CLNGBL")=1 D
. S SDGBL=SDARRAY(2),SDCLIEN=0
. ;for each clinic in the filter (GLOBAL):
. F S SDCLIEN=$O(@(SDGBL_"SDCLIEN)")) Q:(($G(SDCLIEN)="")!(SDQUIT)) D
.. ;determine if clinic has migrated (Call RSA)
.. S SDRSLT='$$CLMIG(SDCLIEN,.SDARRAY)
.. S SDQUIT=+$G(SDARRAY("RSA"))
Q
;
;****************************************************************
;INPUT
; SDERRNUM Appropriate error diagnosing problem (REQUIRED)
; 101 Database Unavailable
; 115 Invalid Input Array Entry
; 116 Data Mismatch
; 117 SDAPI Error (Other Error)
; SDVLRHNL Request Handle (optional)
;
;Output
; N/A
;****************************************************************
ERROR(SDERRNUM,SDVLRHNL) ;error handling
;clean up locations
;D:$G(SDVLRHNL)'="" CLEAN^XOBVJLIB(SDVLRHNL)
;kill existing global entries
K ^TMP($J,"SDAMA301")
;create error entry in global
D ERROR^SDAMA300(SDERRNUM)
Q
;
;****************************************************************
;INPUT
; SDVLRHNL VistALink Request Handle (REQUIRED)
; SDVRFR OVERLOAD PARAMETER FOR VERIFIER [optional]
; (Creates Error Info in Output Global - 101 Returned)
;****************************************************************
VLERR(SDVLRHNL,SDVRFR) ;write vistalink errors to err log
N SDERR ;initialize variables
;setup err log variables and call err log handler
S SDERR(1)="SDAMA301"
;S SDERR(5)="VistALink returned ERROR Code: "_$$GETFLTCD^XOBVJRQ(SDVLRHNL)_" ERROR Message: "_$$GETFLTMS^XOBVJRQ(SDVLRHNL)
S SDERR(6)="SDRSA101"
;remove special characters from VL calls
S SDERR(5)=$E(SDERR(5),1,$L(SDERR(5))-1)
;D LOGERR^SDAMA314(.SDERR)
D:($G(SDVRFR)) ERROR(101,SDVLRHNL) ;write error to output global
Q
SDAMA307 ;BPOIFO/ACS-Filter API Call RSA ; 9/14/05 12:45pm
+1 ;;5.3;Scheduling;**301,508,1015**;13 Aug 1993;Build 21
+2 ;PER VHA DIRECTIVE 2004-038, DO NOT MODIFY THIS ROUTINE
+3 ;
+4 ;** GET APPOINTMENT DATA FROM RSA **
+5 ;
+6 ;***************************************************************
+7 ; CHANGE LOG
+8 ;
+9 ; DATE PATCH DESCRIPTION
+10 ;-------- ---------- ---------------------------------------
+11 ;12/04/03 SD*5.3*301 ROUTINE COMPLETED
+12 ;09/14/05 SD*5.3*372 Phase II Apptmts on Multiple Databases
+13 ;02/22/07 SD*5.3*508 SEE SDAMA301 FOR CHANGE LIST
+14 ;***************************************************************
+15 ;
+16 ;***************************************************************
+17 ;INPUT
+18 ; SDARRAY APPOINTMENT FILTER ARRAY (by reference)
+19 ; SDVRFR OVERLOAD PARAMETER FOR VERIFIER [optional]
+20 ; (Returns Screened RSA Appts (Migrating))
+21 ;***************************************************************
DATA(SDARRAY,SDVRFR) ;Get RSA appointment data (Phase II)
+1 ;Initialize variables
+2 NEW SDRESP,SDCOUNT,SDDFN,SDX,SDGBL
+3 SET SDX=0
+4 ;if patient filter defined ensure that at least 1 patient has
+5 ;an ICN. if no patient in the list or global has an icn then RSA
+6 ;does not need to be called (No Appointments will exist.)
+7 IF (($GET(SDARRAY(4))]"")&($GET(SDARRAY(4))'="^DPT("))
Begin DoDot:1
+8 ;patients in global
+9 IF SDARRAY("PATGBL")=1
Begin DoDot:2
+10 SET SDGBL=SDARRAY(4)
SET SDDFN=0
+11 FOR
SET SDDFN=$ORDER(@(SDGBL_"SDDFN)"))
IF ((+$GET(SDDFN)=0)!SDX)
QUIT
Begin DoDot:3
+12 IF (+$$GETICN^MPIF001(SDDFN)>0)
SET SDX=1
End DoDot:3
End DoDot:2
+13 ;patients in list
+14 IF SDARRAY("PATGBL")=0
Begin DoDot:2
+15 SET SDCOUNT=$LENGTH(SDARRAY(4),";")
+16 FOR SDDFN=1:1:SDCOUNT
IF SDX
QUIT
Begin DoDot:3
+17 IF (+$$GETICN^MPIF001($PIECE(SDARRAY(4),";",SDDFN))>0)
SET SDX=1
End DoDot:3
End DoDot:2
End DoDot:1
IF 'SDX
QUIT
+18 ;if patient filter is not defined ensure that if the status
+19 ;filter is defined that it has more than cancelled appt statuses
+20 ;(Cancelled Appts not returned if Patient filter not defined)
+21 IF (($GET(SDARRAY(4))']"")&($GET(SDARRAY(3))]""))
Begin DoDot:1
+22 NEW SDSTAT,SDI
SET SDSTAT=""
SET SDX=0
+23 FOR SDI=1:1:$LENGTH(SDARRAY(3),";")
IF SDX
QUIT
Begin DoDot:2
+24 IF ($PIECE(SDARRAY(3),";",SDI)'["C")
SET SDX=1
End DoDot:2
End DoDot:1
IF 'SDX
QUIT
+25 ;Call RSA Business Delegate
+26 ;S SDRESP=$$XMLDLGT^SDAMA309(.SDARRAY,$G(SDVRFR))
+27 ;error occurred creating appt records
+28 IF SDRESP<0
SET SDARRAY("CNT")=-1
+29 ;no errors/update total appt counter/adjust appts to max filter
+30 ;as RSA appts were appended to output and may exceed the MAX
+31 IF '(SDRESP<0)
Begin DoDot:1
+32 SET SDARRAY("CNT")=SDARRAY("CNT")+SDRESP
+33 ;adjust total number of appointments
+34 DO MAXAPPTS(.SDARRAY)
End DoDot:1
+35 QUIT
+36 ;
+37 ;***************************************************************
+38 ;OUTPUT
+39 ; If RSA Implemented, return 1,10 or 11 if Appt Entry Exists
+40 ; If RSA NOT Implemented, return 0
+41 ;***************************************************************
IMP() ;RSA Implemented
+1 QUIT $DATA(^XOB(18.08,"B",$$GETSRVNM))
+2 ;
+3 ;***************************************************************
+4 ;OUTPUT
+5 ; Returns RSA Application Server Name
+6 ;***************************************************************
GETSRVNM() ;return the VL 2.0 application server name
+1 QUIT "SDAM-RSA"
+2 ;
+3 ;***************************************************************
+4 ;INPUT
+5 ; SDCLIEN Clinic's Internal Entry Number (Required)
+6 ; SDARRAY APPOINTMENT FILTER ARRAY (by reference)
+7 ;OUTPUT
+8 ; 1 Return a Patients or Clinics VistA Appointments
+9 ; 0 Exclude a Patients or Clinics VistA Appointments
+10 ;
+11 ; SDARRAY("RSA")=1 will exist if RSA has to be Called
+12 ; SDARRAY("MIG") will exist for VistA Clinics that have an
+13 ; earliest migrated date/time and has
+14 ; completed migration.
+15 ; ***************************************************************
CLMIG(SDCLIEN,SDARRAY) ;clinic status switch
+1 ;initialize variables
+2 NEW SDRSA
+3 SET SDARRAY("CLIN")=SDCLIEN
SET SDARRAY("MIG")=""
+4 ;quit if clinic is not of type "C" (Clinic)
+5 IF ($PIECE($GET(^SC(SDCLIEN,0)),"^",3)'="C")
QUIT 0
+6 ;determine if RSA Clinic,
+7 ;if RSA Clinic Quit VistA doesnt need to be called
+8 SET SDRSA=$$RSACLNC(SDCLIEN)
+9 ;
+10 ;RSA CLINIC (Check-In Point) Logic
+11 ;Call RSA for Future Migrated/New appointments
+12 IF SDRSA
SET SDARRAY("RSA")=1
QUIT 0
+13 ;
+14 ;VISTA CLINIC Logic
+15 ;return all VistA appointments (Migration not completed)
+16 IF ($PIECE($GET(^SC(SDCLIEN,"RSA")),"^",6)']"")
QUIT 1
+17 ;retrieve earliest migrated date/time
+18 SET SDARRAY("MIG")=+$PIECE($GET(^SC(SDCLIEN,"RSA")),"^",3)
+19 ;return non-migrated VistA appointments
+20 IF (SDARRAY("MIG")>+$GET(SDARRAY("DATE")))
QUIT 1
+21 ;migrated VistA appointments not returned
+22 QUIT 0
+23 ;
+24 ;***************************************************************
+25 ;INPUT
+26 ; SDCLNC - Clinic IEN
+27 ;OUTPUT
+28 ; 1 - Is an RSA Clinic
+29 ; 0 - Is not an RSA Clinic
+30 ;***************************************************************
RSACLNC(SDCLNC) ;determine if Clinic is an RSA Clinic
+1 ;RSA Clinic if Resource Id (#44.203) and
+2 ; Appt Purpose ID (#44.204) exist
+3 ;initialize variables
+4 NEW SDRID,SDLAPID
+5 ;get resource id
+6 SET SDRID=$PIECE($GET(^SC(SDCLNC,"RSA")),"^",4)
+7 ;get local appt purpose id
+8 SET SDLAPID=$PIECE($GET(^SC(SDCLNC,"RSA")),"^",5)
+9 QUIT $SELECT(((SDRID'="")&(SDLAPID'="")):1,1:0)
+10 ;
+11 ;***************************************************************
+12 ;OUTPUT
+13 ; Returns the Sites VistA Instance Number
+14 ;***************************************************************
VI() ;Get VistA Instance
+1 NEW SDVI
+2 SET SDVI=$$SITE^VASITE
+3 QUIT +$PIECE(SDVI,"^",3)
+4 ;
+5 ;******************************************************************
+6 ;INPUT
+7 ; SDARRAY APPOINTMENT FILTER ARRAY (by reference)
+8 ;******************************************************************
MAXAPPTS(SDARRAY) ;Adjust combined appointments (VistA/RSA) to MAX
+1 NEW SDDIFF,SDDIR,SDREF,SDMAX,SDI,SDDTM,SDSORT1,SDSORT2
+2 SET SDMAX=$SELECT(SDARRAY("MAX")<0:SDARRAY("MAX")*-1,1:SDARRAY("MAX"))
+3 SET SDDIR=1
SET SDREF="^TMP($J,""SDRSRT"")"
+4 ;quit if max filter not defined / max equals appt count / or
+5 ;appt count is less than max
+6 IF ($SELECT(SDARRAY("MAX")=""
QUIT
+7 ;determine how many appts to kill and QUERY direction
+8 IF SDARRAY("MAX")>0
Begin DoDot:1
+9 SET SDDIFF=SDARRAY("CNT")-SDARRAY("MAX")
SET SDDIR=-1
+10 IF $GET(SDARRAY("SORT"))="P"
SET SDREF="^TMP($J,""SDRSRT"",""A"",""A"")"
+11 IF '$TEST
SET SDREF="^TMP($J,""SDRSRT"",""A"",""A"",""A"")"
End DoDot:1
+12 IF SDARRAY("MAX")<0
SET SDDIFF=SDARRAY("CNT")+SDARRAY("MAX")
+13 ;create temporary resorted output global by Date/Time
+14 ;D MAXRESRT^SDAMA309(.SDARRAY)
+15 ;
+16 ;loop through appt set and kill the excess appts
+17 FOR
IF 'SDDIFF
QUIT
Begin DoDot:1
+18 SET SDREF=$QUERY(@SDREF,SDDIR)
+19 ;retrieve subscribpt to delete from output global
+20 SET SDDTM=$PIECE(SDREF,",",3)
SET SDSORT1=+$PIECE(SDREF,",",4)
SET SDSORT2=+$PIECE(SDREF,",",5)
+21 IF ($GET(SDARRAY("SORT"))="P")
KILL ^TMP($JOB,"SDAMA301",SDSORT1,SDDTM)
+22 IF ($GET(SDARRAY("SORT"))'="P")
KILL ^TMP($JOB,"SDAMA301",SDSORT1,SDSORT2,SDDTM)
+23 ;delete resorted temp output copy
KILL @SDREF
+24 SET SDDIFF=SDDIFF-1
End DoDot:1
+25 ;reset total appt count to max
+26 SET SDARRAY("CNT")=$SELECT(SDARRAY("MAX")>0:SDARRAY("MAX"),1:(SDARRAY("MAX")*(-1)))
+27 KILL ^TMP($JOB,"SDRSRT")
+28 QUIT
+29 ;
+30 ;Both Patient and Clinic Filter Defined, Determine if RSA should be
+31 ;called, by evaluating the Clinic Filter List. Patient may have no
+32 ;appointments in VistA, so Clinic Filter has to be evaluated.
+33 ;******************************************************************
+34 ;INPUT
+35 ; SDARRAY APPOINTMENT FILTER ARRAY (by reference)
+36 ;******************************************************************
CALLRSA(SDARRAY) ;
+1 ;initialize variables
+2 NEW SDCOUNT,SDX,SDCLIEN,SDQUIT,SDGBL,SDRSLT
+3 SET (SDCOUNT,SDQUIT)=0
+4 ;if clinic is in a list:
+5 IF SDARRAY("CLNGBL")=0
Begin DoDot:1
+6 SET SDCOUNT=$LENGTH(SDARRAY(2),";")
+7 ;For each clinic in the filter (LIST):
+8 FOR SDX=1:1:SDCOUNT
IF SDQUIT
QUIT
Begin DoDot:2
+9 SET SDCLIEN=$PIECE(SDARRAY(2),";",SDX)
+10 ;determine if clinic has migrated (Call RSA)
+11 SET SDRSLT='$$CLMIG(SDCLIEN,.SDARRAY)
+12 SET SDQUIT=+$GET(SDARRAY("RSA"))
End DoDot:2
End DoDot:1
+13 ;if clinic is in array, get IENs
+14 IF SDARRAY("CLNGBL")=1
Begin DoDot:1
+15 SET SDGBL=SDARRAY(2)
SET SDCLIEN=0
+16 ;for each clinic in the filter (GLOBAL):
+17 FOR
SET SDCLIEN=$ORDER(@(SDGBL_"SDCLIEN)"))
IF (($GET(SDCLIEN)="")!(SDQUIT))
QUIT
Begin DoDot:2
+18 ;determine if clinic has migrated (Call RSA)
+19 SET SDRSLT='$$CLMIG(SDCLIEN,.SDARRAY)
+20 SET SDQUIT=+$GET(SDARRAY("RSA"))
End DoDot:2
End DoDot:1
+21 QUIT
+22 ;
+23 ;****************************************************************
+24 ;INPUT
+25 ; SDERRNUM Appropriate error diagnosing problem (REQUIRED)
+26 ; 101 Database Unavailable
+27 ; 115 Invalid Input Array Entry
+28 ; 116 Data Mismatch
+29 ; 117 SDAPI Error (Other Error)
+30 ; SDVLRHNL Request Handle (optional)
+31 ;
+32 ;Output
+33 ; N/A
+34 ;****************************************************************
ERROR(SDERRNUM,SDVLRHNL) ;error handling
+1 ;clean up locations
+2 ;D:$G(SDVLRHNL)'="" CLEAN^XOBVJLIB(SDVLRHNL)
+3 ;kill existing global entries
+4 KILL ^TMP($JOB,"SDAMA301")
+5 ;create error entry in global
+6 DO ERROR^SDAMA300(SDERRNUM)
+7 QUIT
+8 ;
+9 ;****************************************************************
+10 ;INPUT
+11 ; SDVLRHNL VistALink Request Handle (REQUIRED)
+12 ; SDVRFR OVERLOAD PARAMETER FOR VERIFIER [optional]
+13 ; (Creates Error Info in Output Global - 101 Returned)
+14 ;****************************************************************
VLERR(SDVLRHNL,SDVRFR) ;write vistalink errors to err log
+1 ;initialize variables
NEW SDERR
+2 ;setup err log variables and call err log handler
+3 SET SDERR(1)="SDAMA301"
+4 ;S SDERR(5)="VistALink returned ERROR Code: "_$$GETFLTCD^XOBVJRQ(SDVLRHNL)_" ERROR Message: "_$$GETFLTMS^XOBVJRQ(SDVLRHNL)
+5 SET SDERR(6)="SDRSA101"
+6 ;remove special characters from VL calls
+7 SET SDERR(5)=$EXTRACT(SDERR(5),1,$LENGTH(SDERR(5))-1)
+8 ;D LOGERR^SDAMA314(.SDERR)
+9 ;write error to output global
IF ($GET(SDVRFR))
DO ERROR(101,SDVLRHNL)
+10 QUIT
