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

SDAMA302.m

Go to the documentation of this file. 
  1. SDAMA302 ;BPOIFO/ACS-Filter API By Clinic ; 9/14/05 12:45pm
  1.  ;;5.3;Scheduling;**301,347,508,1015**;13 Aug 1993;Build 21
  1.  ;PER VHA DIRECTIVE 2004-038, DO NOT MODIFY THIS ROUTINE
  1.  ;
  1.  ;*****************************************************************
  1.  ;              CHANGE LOG
  1.  ;
  1.  ;  DATE      PATCH       DESCRIPTION
  1.  ;--------  ----------    -----------------------------------------
  1.  ;12/04/03  SD*5.3*301    ROUTINE COMPLETED
  1.  ;08/06/04  SD*5.3*347    CHANGE CALL TO ^SDAMA305 TO SETARRAY
  1.  ;02/22/07  SD*5.3*508    SEE SDAMA301 FOR CHANGE LIST
  1.  ;*****************************************************************
  1.  ;
  1.  ;*****************************************************************
  1.  ;
  1.  ;               GET APPOINTMENT DATA BY CLINIC
  1.  ;
  1.  ;INPUT
  1.  ;  SDARRAY   Appointment Filter array
  1.  ;  SDDV      Appointment Data Values array
  1.  ;  SDFLTR    Filter Flags array
  1.  ;  
  1.  ;*****************************************************************
  1. CLIN(SDARRAY,SDDV,SDFLTR) ;
  1.  N SDCOUNT,SDX,SDQUIT,SDCLIEN,SDSTART,SDEND,SDGBL
  1.  S (SDCOUNT,SDQUIT)=0
  1.  ;Set up start and end date/times for search criteria
  1.  I $G(SDARRAY("MAX"))'<0  D
  1.  .S SDSTART=$S(SDARRAY("FR")'="":(SDARRAY("FR")-.000001),1:0)
  1.  .S SDEND=SDARRAY("TO")
  1.  I $G(SDARRAY("MAX"))<0  D
  1.  .S SDSTART=$S($G(SDARRAY("FR"))'="":SDARRAY("FR"),1:0)
  1.  .S SDEND=(SDARRAY("TO")+.000001)
  1.  ;
  1.  ;If clinic filter is populated
  1.  I $L($G(SDARRAY(2)))>0 D
  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:
  1.  .. F SDX=1:1:SDCOUNT D
  1.  ... S SDCLIEN=$P(SDARRAY(2),";",SDX)
  1.  ... ;call VistA for appointment information
  1.  ... D CALLVSTA(SDCLIEN,SDSTART,SDEND,.SDARRAY)
  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 global:
  1.  .. F  S SDCLIEN=$O(@(SDGBL_"SDCLIEN)")) Q:$G(SDCLIEN)=""  D
  1.  ... ;call VistA for appointment information
  1.  ... D CALLVSTA(SDCLIEN,SDSTART,SDEND,.SDARRAY)
  1.  ;
  1.  ;If clinic filter is not populated
  1.  I $L(SDARRAY(2))'>0 D
  1.  . ;for each clinic on ^SC
  1.  . S SDCLIEN=0 F  S SDCLIEN=$O(^SC(SDCLIEN)) Q:(+$G(SDCLIEN)=0)  D
  1.  .. ;call VistA for appointment information
  1.  .. D CALLVSTA(SDCLIEN,SDSTART,SDEND,.SDARRAY)
  1.  Q
  1.  ;
  1. CALLVSTA(SDCLIEN,SDSTART,SDEND,SDARRAY) ;
  1.  ;retrieve appointment information from VistA
  1.  I $$CLMIG^SDAMA307(SDCLIEN,.SDARRAY) D
  1.  . ;adjust end time if clinic has completed migration
  1.  . ;(Only Non-migrated appointments returned from VistA)
  1.  . I $G(SDARRAY("MIG"))]"" D
  1.  .. S SDEND=+$G(SDARRAY("MIG"))
  1.  .. ;increment SDEND to capture all appointments when ordering
  1.  .. S:$G(SDARRAY("MAX"))<0 SDEND=(SDEND+.000001)
  1.  . D GETAPPT(SDCLIEN,SDSTART,SDEND,.SDARRAY)
  1.  Q
  1.  ;
  1. GETAPPT(SDCLIEN,SDSTART,SDEND,SDARRAY) ;
  1.  ;since "by clinic", 1st sort is clinic
  1.  S SDARRAY("SORT1")=SDCLIEN
  1.  N SDAPPTDT,SDA
  1.  ;if the current clinic has no appointments on ^SC, get next clinic
  1.  Q:'$D(^SC(SDCLIEN,"S"))
  1.  ;
  1.  ;get first "N" appointments
  1.  I $G(SDARRAY("MAX"))'<0  D
  1.  .S SDAPPTDT=SDSTART
  1.  .;spin through each date/time for current clinic
  1.  .F  S SDAPPTDT=$O(^SC(SDCLIEN,"S",SDAPPTDT)) Q:$S(+$G(SDAPPTDT)=0:1,SDAPPTDT>SDEND:1,SDARRAY("CNT")=$G(SDARRAY("MAX")):1,1:0)  D
  1.  .. ;spin through each appointment for that date/time
  1.  .. S SDA=0 F  S SDA=$O(^SC(SDCLIEN,"S",SDAPPTDT,1,SDA)) Q:$S(+$G(SDA)=0:1,SDARRAY("CNT")=$G(SDARRAY("MAX")):1,1:0)  D
  1.  ... D GETINFO(SDCLIEN,SDAPPTDT,SDA,.SDARRAY)
  1.  ;
  1.  ;get last "N" appointments
  1.  I $G(SDARRAY("MAX"))<0  D
  1.  .S SDAPPTDT=SDEND
  1.  .;spin through each date/time for current clinic (REVERSE Order)
  1.  .F  S SDAPPTDT=$O(^SC(SDCLIEN,"S",SDAPPTDT),-1) Q:$S(+$G(SDAPPTDT)=0:1,SDAPPTDT<SDSTART:1,SDARRAY("CNT")=-$G(SDARRAY("MAX")):1,1:0)  D
  1.  .. ;spin through each appointment for that date/time (REVERSE Order)
  1.  .. S SDA="" F  S SDA=$O(^SC(SDCLIEN,"S",SDAPPTDT,1,SDA),-1) Q:$S(+$G(SDA)=0:1,SDARRAY("CNT")=-$G(SDARRAY("MAX")):1,1:0)  D
  1.  ... D GETINFO(SDCLIEN,SDAPPTDT,SDA,.SDARRAY)
  1.  Q
  1.  ;
  1. GETINFO(SDCLIEN,SDAPPTDT,SDA,SDARRAY) ;
  1.  N SDPATIEN,SDCAN,SDQUIT
  1.  S SDQUIT=0
  1.  ;get appointment data on ^SC
  1.  S SDARRAY("SC0")=$G(^SC(SDCLIEN,"S",SDAPPTDT,1,SDA,0))
  1.  S SDARRAY("SCC")=$G(^SC(SDCLIEN,"S",SDAPPTDT,1,SDA,"C"))
  1.  S SDARRAY("SCOB")=$G(^SC(SDCLIEN,"S",SDAPPTDT,1,SDA,"OB"))
  1.  S SDARRAY("SCONS")=$G(^SC(SDCLIEN,"S",SDAPPTDT,1,SDA,"CONS"))
  1.  S SDARRAY("DATE")=SDAPPTDT
  1.  ;exclude cancelled appts
  1.  S SDCAN=$P($G(SDARRAY("SC0")),"^",9)
  1.  Q:$G(SDCAN)="C"
  1.  ;initialize patient appointment data to null and get patient DFN
  1.  S (SDARRAY("DPT0"),SDARRAY("DPT1"))=""
  1.  S (SDPATIEN,SDARRAY("PAT"))=+SDARRAY("SC0")
  1.  ;quit if patient is null on ^SC
  1.  Q:SDPATIEN=0
  1.  ;since "by clinic", 2nd sort is patient
  1.  S SDARRAY("SORT2")=SDPATIEN
  1.  ;get corresponding appt zero node on ^DPT
  1.  S SDARRAY("DPT0")=$G(^DPT(SDPATIEN,"S",SDAPPTDT,0))
  1.  ;skip if appointment is cancelled on DPT
  1.  Q:($P($G(SDARRAY("DPT0")),"^",2)["C")
  1.  ;skip if appointment on DPT is for different clinic
  1.  Q:(+$G(SDARRAY("DPT0"))'=SDCLIEN)
  1.  ;get appointment 1 node on ^DPT
  1.  S SDARRAY("DPT1")=$G(^DPT(SDPATIEN,"S",SDAPPTDT,1))
  1.  ;appointment must match the "clinic" filter values
  1.  I $$MATCH^SDAMA304("C",.SDARRAY,.SDFLTR,.SDDV) D
  1.  . ;if appointment matches the "patient" filter values, put appointment data into output array
  1.  . I $$MATCH^SDAMA304("P",.SDARRAY,.SDFLTR,.SDDV) D SETARRAY^SDAMA305(.SDARRAY)
  1.  Q