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

SDAMA303.m

Go to the documentation of this file. 
  1. SDAMA303 ;BPOIFO/ACS-Filter API By Patient ; 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 PATIENT
  1.  ;
  1.  ;INPUT
  1.  ;  SDARRAY   Appointment Filter array
  1.  ;  SDDV      Appointment Data Values array
  1.  ;  SDFLTR    Filter Flags array
  1.  ;  
  1.  ;*****************************************************************
  1. PAT(SDARRAY,SDDV,SDFLTR) ;
  1.  N SDCOUNT,SDX,SDQUIT,SDPATIEN,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 patient is not in global, get patient from filter list
  1.  I SDARRAY("PATGBL")=0 D
  1.  . S SDCOUNT=$L(SDARRAY(4),";")
  1.  . ;for each patient in the filter:
  1.  . F SDX=1:1:SDCOUNT D
  1.  .. S SDPATIEN=$P(SDARRAY(4),";",SDX)
  1.  .. D GETAPPT(SDPATIEN,SDSTART,SDEND,.SDARRAY)
  1.  ;if patient is in global, get patient from global
  1.  I SDARRAY("PATGBL")=1 D
  1.  . S SDGBL=SDARRAY(4),SDPATIEN=0
  1.  . ;for each patient in the global:
  1.  . F  S SDPATIEN=$O(@(SDGBL_"SDPATIEN)")) Q:+$G(SDPATIEN)=0  D
  1.  .. D GETAPPT(SDPATIEN,SDSTART,SDEND,.SDARRAY)
  1.  Q
  1.  ;
  1. GETAPPT(SDPATIEN,SDSTART,SDEND,SDARRAY) ;
  1.  ;if the patient has no appointments on ^DPT, get next patient
  1.  Q:'$D(^DPT(SDPATIEN,"S"))
  1.  ;since "by patient", 1st sort is patient
  1.  S (SDARRAY("SORT1"),SDARRAY("PAT"))=SDPATIEN
  1.  N SDAPPTDT
  1.  ;
  1.  ;get first "N" appointments
  1.  I $G(SDARRAY("MAX"))'<0  D
  1.  .S SDAPPTDT=SDSTART
  1.  .;Spin through each appointment on DPT for current patient
  1.  .F  S SDAPPTDT=$O(^DPT(SDPATIEN,"S",SDAPPTDT)) Q:$S(+$G(SDAPPTDT)=0:1,SDAPPTDT>SDEND:1,SDARRAY("CNT")=$G(SDARRAY("MAX")):1,1:0)  D
  1.  .. D GETINFO(SDPATIEN,SDAPPTDT,.SDARRAY)
  1.  ;
  1.  ;get last "N" appointments
  1.  I $G(SDARRAY("MAX"))<0  D
  1.  .S SDAPPTDT=SDEND
  1.  .;spin through each appointment on DPT for current patient (REVERSE Order)
  1.  .F  S SDAPPTDT=$O(^DPT(SDPATIEN,"S",SDAPPTDT),-1) Q:$S(+$G(SDAPPTDT)=0:1,SDAPPTDT<SDSTART:1,SDARRAY("CNT")=-$G(SDARRAY("MAX")):1,1:0)  D
  1.  .. D GETINFO(SDPATIEN,SDAPPTDT,.SDARRAY)
  1.  Q
  1.  ;
  1. GETINFO(SDPATIEN,SDAPPTDT,SDARRAY) ;
  1.  N SDMATCH,SDCLINIC,SDA,SDQUIT
  1.  S SDQUIT=0
  1.  ; initialize array to hold data values
  1.  S SDARRAY("DPT0")=$G(^DPT(SDPATIEN,"S",SDAPPTDT,0))
  1.  S SDARRAY("DPT1")=$G(^DPT(SDPATIEN,"S",SDAPPTDT,1))
  1.  S SDARRAY("DATE")=SDAPPTDT
  1.  ;appointment must match the "patient" filter values
  1.  I $$MATCH^SDAMA304("P",.SDARRAY,.SDFLTR,.SDDV) D
  1.  . ;set clinic appointment data to null and get clinic
  1.  . S (SDARRAY("SC0"),SDARRAY("SCC"),SDARRAY("SCOB"),SDARRAY("SCONS"))=""
  1.  . S SDCLINIC=+$G(SDARRAY("DPT0"))
  1.  . ;quit if clinic is null(0)
  1.  . Q:SDCLINIC=0
  1.  . ;since "by patient", 2nd sort is clinic
  1.  . S SDARRAY("SORT2")=SDCLINIC
  1.  . ;quit if this is a migrated appointment
  1.  . Q:'($$CLMIG^SDAMA307(SDCLINIC,.SDARRAY))
  1.  . S SDMATCH=1
  1.  . ;if appointment is not cancelled on ^DPT and the PURGED parameter 
  1.  . ;is not set, then find the corresponding appt on ^SC and get data
  1.  . I ('+$G(SDARRAY("PURGED"))&(";C;CA;PC;PCA;"'[(";"_$P($G(SDARRAY("DPT0")),"^",2)_";"))) D
  1.  .. N SDCANCEL
  1.  .. S SDQUIT=0,SDA=0,SDMATCH=0
  1.  .. ;for current clinic and appt d/t, find matching appt on ^SC
  1.  .. F  S SDA=$O(^SC(SDCLINIC,"S",SDAPPTDT,1,SDA)) Q:(($G(SDA)="")!(SDQUIT=1))  D
  1.  ... S SDCANCEL=0
  1.  ... ;get next appt if patient doesn't match
  1.  ... Q:(+$G(^SC(SDCLINIC,"S",SDAPPTDT,1,SDA,0))'=SDPATIEN)
  1.  ... ;get appointment data on ^SC
  1.  ... S SDARRAY("SC0")=$G(^SC(SDCLINIC,"S",SDAPPTDT,1,SDA,0))
  1.  ... ;get next appt if cancelled on SC
  1.  ... S SDCANCEL=$P($G(SDARRAY("SC0")),"^",9)
  1.  ... Q:($G(SDCANCEL)="C")
  1.  ... ;get appointment "C" node on ^SC
  1.  ... S SDARRAY("SCC")=$G(^SC(SDCLINIC,"S",SDAPPTDT,1,SDA,"C"))
  1.  ... ;get appointment "OB" node on ^SC
  1.  ... S SDARRAY("SCOB")=$G(^SC(SDCLINIC,"S",SDAPPTDT,1,SDA,"OB"))
  1.  ... ;get appointment "CONS" node on ^SC
  1.  ... S SDARRAY("SCONS")=$G(^SC(SDCLINIC,"S",SDAPPTDT,1,SDA,"CONS"))
  1.  ... ;Corresponding appointment found on ^SC
  1.  ... S SDQUIT=1,SDMATCH=1
  1.  . ;if appointment matches the clinic filters, put appointment data into output array
  1.  . I SDMATCH D
  1.  .. I $$MATCH^SDAMA304("C",.SDARRAY,.SDFLTR,.SDDV) D SETARRAY^SDAMA305(.SDARRAY)
  1.  Q