Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: SDAMA307

SDAMA307.m

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