SDAMA303 ;BPOIFO/ACS-Filter API By Patient ; 9/14/05 12:45pm
;;5.3;Scheduling;**301,347,508**;13 Aug 1993
;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 CHANGE CALL TO ^SDAMA305 TO SETARRAY
;02/22/07 SD*5.3*508 SEE SDAMA301 FOR CHANGE LIST
;*****************************************************************
;
;*****************************************************************
;
; GET APPOINTMENT DATA BY PATIENT
;
;INPUT
; SDARRAY Appointment Filter array
; SDDV Appointment Data Values array
; SDFLTR Filter Flags array
;
;*****************************************************************
PAT(SDARRAY,SDDV,SDFLTR) ;
N SDCOUNT,SDX,SDQUIT,SDPATIEN,SDSTART,SDEND,SDGBL
S (SDCOUNT,SDQUIT)=0
;Set up start and end date/times for search criteria
I $G(SDARRAY("MAX"))'<0 D
.S SDSTART=$S(SDARRAY("FR")'="":(SDARRAY("FR")-.000001),1:0)
.S SDEND=(SDARRAY("TO"))
I $G(SDARRAY("MAX"))<0 D
.S SDSTART=$S($G(SDARRAY("FR"))'="":SDARRAY("FR"),1:0)
.S SDEND=(SDARRAY("TO")+.000001)
;
;if patient is not in global, get patient from filter list
I SDARRAY("PATGBL")=0 D
. S SDCOUNT=$L(SDARRAY(4),";")
. ;for each patient in the filter:
. F SDX=1:1:SDCOUNT D
.. S SDPATIEN=$P(SDARRAY(4),";",SDX)
.. D GETAPPT(SDPATIEN,SDSTART,SDEND,.SDARRAY)
;if patient is in global, get patient from global
I SDARRAY("PATGBL")=1 D
. S SDGBL=SDARRAY(4),SDPATIEN=0
. ;for each patient in the global:
. F S SDPATIEN=$O(@(SDGBL_"SDPATIEN)")) Q:+$G(SDPATIEN)=0 D
.. D GETAPPT(SDPATIEN,SDSTART,SDEND,.SDARRAY)
Q
;
GETAPPT(SDPATIEN,SDSTART,SDEND,SDARRAY) ;
;if the patient has no appointments on ^DPT, get next patient
Q:'$D(^DPT(SDPATIEN,"S"))
;since "by patient", 1st sort is patient
S (SDARRAY("SORT1"),SDARRAY("PAT"))=SDPATIEN
N SDAPPTDT
;
;get first "N" appointments
I $G(SDARRAY("MAX"))'<0 D
.S SDAPPTDT=SDSTART
.;Spin through each appointment on DPT for current patient
.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
.. D GETINFO(SDPATIEN,SDAPPTDT,.SDARRAY)
;
;get last "N" appointments
I $G(SDARRAY("MAX"))<0 D
.S SDAPPTDT=SDEND
.;spin through each appointment on DPT for current patient (REVERSE Order)
.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
.. D GETINFO(SDPATIEN,SDAPPTDT,.SDARRAY)
Q
;
GETINFO(SDPATIEN,SDAPPTDT,SDARRAY) ;
N SDMATCH,SDCLINIC,SDA,SDQUIT
S SDQUIT=0
; initialize array to hold data values
S SDARRAY("DPT0")=$G(^DPT(SDPATIEN,"S",SDAPPTDT,0))
S SDARRAY("DPT1")=$G(^DPT(SDPATIEN,"S",SDAPPTDT,1))
S SDARRAY("DATE")=SDAPPTDT
;appointment must match the "patient" filter values
I $$MATCH^SDAMA304("P",.SDARRAY,.SDFLTR,.SDDV) D
. ;set clinic appointment data to null and get clinic
. S (SDARRAY("SC0"),SDARRAY("SCC"),SDARRAY("SCOB"),SDARRAY("SCONS"))=""
. S SDCLINIC=+$G(SDARRAY("DPT0"))
. ;quit if clinic is null(0)
. Q:SDCLINIC=0
. ;since "by patient", 2nd sort is clinic
. S SDARRAY("SORT2")=SDCLINIC
. ;quit if this is a migrated appointment
. Q:'($$CLMIG^SDAMA307(SDCLINIC,.SDARRAY))
. S SDMATCH=1
. ;if appointment is not cancelled on ^DPT and the PURGED parameter
. ;is not set, then find the corresponding appt on ^SC and get data
. I ('+$G(SDARRAY("PURGED"))&(";C;CA;PC;PCA;"'[(";"_$P($G(SDARRAY("DPT0")),"^",2)_";"))) D
.. N SDCANCEL
.. S SDQUIT=0,SDA=0,SDMATCH=0
.. ;for current clinic and appt d/t, find matching appt on ^SC
.. F S SDA=$O(^SC(SDCLINIC,"S",SDAPPTDT,1,SDA)) Q:(($G(SDA)="")!(SDQUIT=1)) D
... S SDCANCEL=0
... ;get next appt if patient doesn't match
... Q:(+$G(^SC(SDCLINIC,"S",SDAPPTDT,1,SDA,0))'=SDPATIEN)
... ;get appointment data on ^SC
... S SDARRAY("SC0")=$G(^SC(SDCLINIC,"S",SDAPPTDT,1,SDA,0))
... ;get next appt if cancelled on SC
... S SDCANCEL=$P($G(SDARRAY("SC0")),"^",9)
... Q:($G(SDCANCEL)="C")
... ;get appointment "C" node on ^SC
... S SDARRAY("SCC")=$G(^SC(SDCLINIC,"S",SDAPPTDT,1,SDA,"C"))
... ;get appointment "OB" node on ^SC
... S SDARRAY("SCOB")=$G(^SC(SDCLINIC,"S",SDAPPTDT,1,SDA,"OB"))
... ;get appointment "CONS" node on ^SC
... S SDARRAY("SCONS")=$G(^SC(SDCLINIC,"S",SDAPPTDT,1,SDA,"CONS"))
... ;Corresponding appointment found on ^SC
... S SDQUIT=1,SDMATCH=1
. ;if appointment matches the clinic filters, put appointment data into output array
. I SDMATCH D
.. I $$MATCH^SDAMA304("C",.SDARRAY,.SDFLTR,.SDDV) D SETARRAY^SDAMA305(.SDARRAY)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDAMA303 4901 printed Dec 13, 2024@02:47:18 Page 2
SDAMA303 ;BPOIFO/ACS-Filter API By Patient ; 9/14/05 12:45pm
+1 ;;5.3;Scheduling;**301,347,508**;13 Aug 1993
+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 CHANGE CALL TO ^SDAMA305 TO SETARRAY
+11 ;02/22/07 SD*5.3*508 SEE SDAMA301 FOR CHANGE LIST
+12 ;*****************************************************************
+13 ;
+14 ;*****************************************************************
+15 ;
+16 ; GET APPOINTMENT DATA BY PATIENT
+17 ;
+18 ;INPUT
+19 ; SDARRAY Appointment Filter array
+20 ; SDDV Appointment Data Values array
+21 ; SDFLTR Filter Flags array
+22 ;
+23 ;*****************************************************************
PAT(SDARRAY,SDDV,SDFLTR) ;
+1 NEW SDCOUNT,SDX,SDQUIT,SDPATIEN,SDSTART,SDEND,SDGBL
+2 SET (SDCOUNT,SDQUIT)=0
+3 ;Set up start and end date/times for search criteria
+4 IF $GET(SDARRAY("MAX"))'<0
Begin DoDot:1
+5 SET SDSTART=$SELECT(SDARRAY("FR")'="":(SDARRAY("FR")-.000001),1:0)
+6 SET SDEND=(SDARRAY("TO"))
End DoDot:1
+7 IF $GET(SDARRAY("MAX"))<0
Begin DoDot:1
+8 SET SDSTART=$SELECT($GET(SDARRAY("FR"))'="":SDARRAY("FR"),1:0)
+9 SET SDEND=(SDARRAY("TO")+.000001)
End DoDot:1
+10 ;
+11 ;if patient is not in global, get patient from filter list
+12 IF SDARRAY("PATGBL")=0
Begin DoDot:1
+13 SET SDCOUNT=$LENGTH(SDARRAY(4),";")
+14 ;for each patient in the filter:
+15 FOR SDX=1:1:SDCOUNT
Begin DoDot:2
+16 SET SDPATIEN=$PIECE(SDARRAY(4),";",SDX)
+17 DO GETAPPT(SDPATIEN,SDSTART,SDEND,.SDARRAY)
End DoDot:2
End DoDot:1
+18 ;if patient is in global, get patient from global
+19 IF SDARRAY("PATGBL")=1
Begin DoDot:1
+20 SET SDGBL=SDARRAY(4)
SET SDPATIEN=0
+21 ;for each patient in the global:
+22 FOR
SET SDPATIEN=$ORDER(@(SDGBL_"SDPATIEN)"))
if +$GET(SDPATIEN)=0
QUIT
Begin DoDot:2
+23 DO GETAPPT(SDPATIEN,SDSTART,SDEND,.SDARRAY)
End DoDot:2
End DoDot:1
+24 QUIT
+25 ;
GETAPPT(SDPATIEN,SDSTART,SDEND,SDARRAY) ;
+1 ;if the patient has no appointments on ^DPT, get next patient
+2 if '$DATA(^DPT(SDPATIEN,"S"))
QUIT
+3 ;since "by patient", 1st sort is patient
+4 SET (SDARRAY("SORT1"),SDARRAY("PAT"))=SDPATIEN
+5 NEW SDAPPTDT
+6 ;
+7 ;get first "N" appointments
+8 IF $GET(SDARRAY("MAX"))'<0
Begin DoDot:1
+9 SET SDAPPTDT=SDSTART
+10 ;Spin through each appointment on DPT for current patient
+11 FOR
SET SDAPPTDT=$ORDER(^DPT(SDPATIEN,"S",SDAPPTDT))
if $SELECT(+$GET(SDAPPTDT)=0
QUIT
Begin DoDot:2
+12 DO GETINFO(SDPATIEN,SDAPPTDT,.SDARRAY)
End DoDot:2
End DoDot:1
+13 ;
+14 ;get last "N" appointments
+15 IF $GET(SDARRAY("MAX"))<0
Begin DoDot:1
+16 SET SDAPPTDT=SDEND
+17 ;spin through each appointment on DPT for current patient (REVERSE Order)
+18 FOR
SET SDAPPTDT=$ORDER(^DPT(SDPATIEN,"S",SDAPPTDT),-1)
if $SELECT(+$GET(SDAPPTDT)=0
QUIT
Begin DoDot:2
+19 DO GETINFO(SDPATIEN,SDAPPTDT,.SDARRAY)
End DoDot:2
End DoDot:1
+20 QUIT
+21 ;
GETINFO(SDPATIEN,SDAPPTDT,SDARRAY) ;
+1 NEW SDMATCH,SDCLINIC,SDA,SDQUIT
+2 SET SDQUIT=0
+3 ; initialize array to hold data values
+4 SET SDARRAY("DPT0")=$GET(^DPT(SDPATIEN,"S",SDAPPTDT,0))
+5 SET SDARRAY("DPT1")=$GET(^DPT(SDPATIEN,"S",SDAPPTDT,1))
+6 SET SDARRAY("DATE")=SDAPPTDT
+7 ;appointment must match the "patient" filter values
+8 IF $$MATCH^SDAMA304("P",.SDARRAY,.SDFLTR,.SDDV)
Begin DoDot:1
+9 ;set clinic appointment data to null and get clinic
+10 SET (SDARRAY("SC0"),SDARRAY("SCC"),SDARRAY("SCOB"),SDARRAY("SCONS"))=""
+11 SET SDCLINIC=+$GET(SDARRAY("DPT0"))
+12 ;quit if clinic is null(0)
+13 if SDCLINIC=0
QUIT
+14 ;since "by patient", 2nd sort is clinic
+15 SET SDARRAY("SORT2")=SDCLINIC
+16 ;quit if this is a migrated appointment
+17 if '($$CLMIG^SDAMA307(SDCLINIC,.SDARRAY))
QUIT
+18 SET SDMATCH=1
+19 ;if appointment is not cancelled on ^DPT and the PURGED parameter
+20 ;is not set, then find the corresponding appt on ^SC and get data
+21 IF ('+$GET(SDARRAY("PURGED"))&(";C;CA;PC;PCA;"'[(";"_$PIECE($GET(SDARRAY("DPT0")),"^",2)_";")))
Begin DoDot:2
+22 NEW SDCANCEL
+23 SET SDQUIT=0
SET SDA=0
SET SDMATCH=0
+24 ;for current clinic and appt d/t, find matching appt on ^SC
+25 FOR
SET SDA=$ORDER(^SC(SDCLINIC,"S",SDAPPTDT,1,SDA))
if (($GET(SDA)="")!(SDQUIT=1))
QUIT
Begin DoDot:3
+26 SET SDCANCEL=0
+27 ;get next appt if patient doesn't match
+28 if (+$GET(^SC(SDCLINIC,"S",SDAPPTDT,1,SDA,0))'=SDPATIEN)
QUIT
+29 ;get appointment data on ^SC
+30 SET SDARRAY("SC0")=$GET(^SC(SDCLINIC,"S",SDAPPTDT,1,SDA,0))
+31 ;get next appt if cancelled on SC
+32 SET SDCANCEL=$PIECE($GET(SDARRAY("SC0")),"^",9)
+33 if ($GET(SDCANCEL)="C")
QUIT
+34 ;get appointment "C" node on ^SC
+35 SET SDARRAY("SCC")=$GET(^SC(SDCLINIC,"S",SDAPPTDT,1,SDA,"C"))
+36 ;get appointment "OB" node on ^SC
+37 SET SDARRAY("SCOB")=$GET(^SC(SDCLINIC,"S",SDAPPTDT,1,SDA,"OB"))
+38 ;get appointment "CONS" node on ^SC
+39 SET SDARRAY("SCONS")=$GET(^SC(SDCLINIC,"S",SDAPPTDT,1,SDA,"CONS"))
+40 ;Corresponding appointment found on ^SC
+41 SET SDQUIT=1
SET SDMATCH=1
End DoDot:3
End DoDot:2
+42 ;if appointment matches the clinic filters, put appointment data into output array
+43 IF SDMATCH
Begin DoDot:2
+44 IF $$MATCH^SDAMA304("C",.SDARRAY,.SDFLTR,.SDDV)
DO SETARRAY^SDAMA305(.SDARRAY)
End DoDot:2
End DoDot:1
+45 QUIT
