SDAMA302 ;BPOIFO/ACS-Filter API By Clinic ; 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 CLINIC
;
;INPUT
; SDARRAY Appointment Filter array
; SDDV Appointment Data Values array
; SDFLTR Filter Flags array
;
;*****************************************************************
CLIN(SDARRAY,SDDV,SDFLTR) ;
N SDCOUNT,SDX,SDQUIT,SDCLIEN,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 clinic filter is populated
I $L($G(SDARRAY(2)))>0 D
. ;if clinic is in a list:
. I SDARRAY("CLNGBL")=0 D
.. S SDCOUNT=$L(SDARRAY(2),";")
.. ;For each clinic in the filter:
.. F SDX=1:1:SDCOUNT D
... S SDCLIEN=$P(SDARRAY(2),";",SDX)
... ;call VistA for appointment information
... D CALLVSTA(SDCLIEN,SDSTART,SDEND,.SDARRAY)
. ;if clinic is in array, get IENs
. I SDARRAY("CLNGBL")=1 D
.. S SDGBL=SDARRAY(2),SDCLIEN=0
.. ;for each clinic in the global:
.. F S SDCLIEN=$O(@(SDGBL_"SDCLIEN)")) Q:$G(SDCLIEN)="" D
... ;call VistA for appointment information
... D CALLVSTA(SDCLIEN,SDSTART,SDEND,.SDARRAY)
;
;If clinic filter is not populated
I $L(SDARRAY(2))'>0 D
. ;for each clinic on ^SC
. S SDCLIEN=0 F S SDCLIEN=$O(^SC(SDCLIEN)) Q:(+$G(SDCLIEN)=0) D
.. ;call VistA for appointment information
.. D CALLVSTA(SDCLIEN,SDSTART,SDEND,.SDARRAY)
Q
;
CALLVSTA(SDCLIEN,SDSTART,SDEND,SDARRAY) ;
;retrieve appointment information from VistA
I $$CLMIG^SDAMA307(SDCLIEN,.SDARRAY) D
. ;adjust end time if clinic has completed migration
. ;(Only Non-migrated appointments returned from VistA)
. I $G(SDARRAY("MIG"))]"" D
.. S SDEND=+$G(SDARRAY("MIG"))
.. ;increment SDEND to capture all appointments when ordering
.. S:$G(SDARRAY("MAX"))<0 SDEND=(SDEND+.000001)
. D GETAPPT(SDCLIEN,SDSTART,SDEND,.SDARRAY)
Q
;
GETAPPT(SDCLIEN,SDSTART,SDEND,SDARRAY) ;
;since "by clinic", 1st sort is clinic
S SDARRAY("SORT1")=SDCLIEN
N SDAPPTDT,SDA
;if the current clinic has no appointments on ^SC, get next clinic
Q:'$D(^SC(SDCLIEN,"S"))
;
;get first "N" appointments
I $G(SDARRAY("MAX"))'<0 D
.S SDAPPTDT=SDSTART
.;spin through each date/time for current clinic
.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
.. ;spin through each appointment for that date/time
.. 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
... D GETINFO(SDCLIEN,SDAPPTDT,SDA,.SDARRAY)
;
;get last "N" appointments
I $G(SDARRAY("MAX"))<0 D
.S SDAPPTDT=SDEND
.;spin through each date/time for current clinic (REVERSE Order)
.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
.. ;spin through each appointment for that date/time (REVERSE Order)
.. 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
... D GETINFO(SDCLIEN,SDAPPTDT,SDA,.SDARRAY)
Q
;
GETINFO(SDCLIEN,SDAPPTDT,SDA,SDARRAY) ;
N SDPATIEN,SDCAN,SDQUIT
S SDQUIT=0
;get appointment data on ^SC
S SDARRAY("SC0")=$G(^SC(SDCLIEN,"S",SDAPPTDT,1,SDA,0))
S SDARRAY("SCC")=$G(^SC(SDCLIEN,"S",SDAPPTDT,1,SDA,"C"))
S SDARRAY("SCOB")=$G(^SC(SDCLIEN,"S",SDAPPTDT,1,SDA,"OB"))
S SDARRAY("SCONS")=$G(^SC(SDCLIEN,"S",SDAPPTDT,1,SDA,"CONS"))
S SDARRAY("DATE")=SDAPPTDT
;exclude cancelled appts
S SDCAN=$P($G(SDARRAY("SC0")),"^",9)
Q:$G(SDCAN)="C"
;initialize patient appointment data to null and get patient DFN
S (SDARRAY("DPT0"),SDARRAY("DPT1"))=""
S (SDPATIEN,SDARRAY("PAT"))=+SDARRAY("SC0")
;quit if patient is null on ^SC
Q:SDPATIEN=0
;since "by clinic", 2nd sort is patient
S SDARRAY("SORT2")=SDPATIEN
;get corresponding appt zero node on ^DPT
S SDARRAY("DPT0")=$G(^DPT(SDPATIEN,"S",SDAPPTDT,0))
;skip if appointment is cancelled on DPT
Q:($P($G(SDARRAY("DPT0")),"^",2)["C")
;skip if appointment on DPT is for different clinic
Q:(+$G(SDARRAY("DPT0"))'=SDCLIEN)
;get appointment 1 node on ^DPT
S SDARRAY("DPT1")=$G(^DPT(SDPATIEN,"S",SDAPPTDT,1))
;appointment must match the "clinic" filter values
I $$MATCH^SDAMA304("C",.SDARRAY,.SDFLTR,.SDDV) D
. ;if appointment matches the "patient" filter values, put appointment data into output array
. I $$MATCH^SDAMA304("P",.SDARRAY,.SDFLTR,.SDDV) D SETARRAY^SDAMA305(.SDARRAY)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDAMA302 5355 printed Apr 09, 2024@21:49:29 Page 2
SDAMA302 ;BPOIFO/ACS-Filter API By Clinic ; 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 CLINIC
+17 ;
+18 ;INPUT
+19 ; SDARRAY Appointment Filter array
+20 ; SDDV Appointment Data Values array
+21 ; SDFLTR Filter Flags array
+22 ;
+23 ;*****************************************************************
CLIN(SDARRAY,SDDV,SDFLTR) ;
+1 NEW SDCOUNT,SDX,SDQUIT,SDCLIEN,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 clinic filter is populated
+12 IF $LENGTH($GET(SDARRAY(2)))>0
Begin DoDot:1
+13 ;if clinic is in a list:
+14 IF SDARRAY("CLNGBL")=0
Begin DoDot:2
+15 SET SDCOUNT=$LENGTH(SDARRAY(2),";")
+16 ;For each clinic in the filter:
+17 FOR SDX=1:1:SDCOUNT
Begin DoDot:3
+18 SET SDCLIEN=$PIECE(SDARRAY(2),";",SDX)
+19 ;call VistA for appointment information
+20 DO CALLVSTA(SDCLIEN,SDSTART,SDEND,.SDARRAY)
End DoDot:3
End DoDot:2
+21 ;if clinic is in array, get IENs
+22 IF SDARRAY("CLNGBL")=1
Begin DoDot:2
+23 SET SDGBL=SDARRAY(2)
SET SDCLIEN=0
+24 ;for each clinic in the global:
+25 FOR
SET SDCLIEN=$ORDER(@(SDGBL_"SDCLIEN)"))
if $GET(SDCLIEN)=""
QUIT
Begin DoDot:3
+26 ;call VistA for appointment information
+27 DO CALLVSTA(SDCLIEN,SDSTART,SDEND,.SDARRAY)
End DoDot:3
End DoDot:2
End DoDot:1
+28 ;
+29 ;If clinic filter is not populated
+30 IF $LENGTH(SDARRAY(2))'>0
Begin DoDot:1
+31 ;for each clinic on ^SC
+32 SET SDCLIEN=0
FOR
SET SDCLIEN=$ORDER(^SC(SDCLIEN))
if (+$GET(SDCLIEN)=0)
QUIT
Begin DoDot:2
+33 ;call VistA for appointment information
+34 DO CALLVSTA(SDCLIEN,SDSTART,SDEND,.SDARRAY)
End DoDot:2
End DoDot:1
+35 QUIT
+36 ;
CALLVSTA(SDCLIEN,SDSTART,SDEND,SDARRAY) ;
+1 ;retrieve appointment information from VistA
+2 IF $$CLMIG^SDAMA307(SDCLIEN,.SDARRAY)
Begin DoDot:1
+3 ;adjust end time if clinic has completed migration
+4 ;(Only Non-migrated appointments returned from VistA)
+5 IF $GET(SDARRAY("MIG"))]""
Begin DoDot:2
+6 SET SDEND=+$GET(SDARRAY("MIG"))
+7 ;increment SDEND to capture all appointments when ordering
+8 if $GET(SDARRAY("MAX"))<0
SET SDEND=(SDEND+.000001)
End DoDot:2
+9 DO GETAPPT(SDCLIEN,SDSTART,SDEND,.SDARRAY)
End DoDot:1
+10 QUIT
+11 ;
GETAPPT(SDCLIEN,SDSTART,SDEND,SDARRAY) ;
+1 ;since "by clinic", 1st sort is clinic
+2 SET SDARRAY("SORT1")=SDCLIEN
+3 NEW SDAPPTDT,SDA
+4 ;if the current clinic has no appointments on ^SC, get next clinic
+5 if '$DATA(^SC(SDCLIEN,"S"))
QUIT
+6 ;
+7 ;get first "N" appointments
+8 IF $GET(SDARRAY("MAX"))'<0
Begin DoDot:1
+9 SET SDAPPTDT=SDSTART
+10 ;spin through each date/time for current clinic
+11 FOR
SET SDAPPTDT=$ORDER(^SC(SDCLIEN,"S",SDAPPTDT))
if $SELECT(+$GET(SDAPPTDT)=0
QUIT
Begin DoDot:2
+12 ;spin through each appointment for that date/time
+13 SET SDA=0
FOR
SET SDA=$ORDER(^SC(SDCLIEN,"S",SDAPPTDT,1,SDA))
if $SELECT(+$GET(SDA)=0
QUIT
Begin DoDot:3
+14 DO GETINFO(SDCLIEN,SDAPPTDT,SDA,.SDARRAY)
End DoDot:3
End DoDot:2
End DoDot:1
+15 ;
+16 ;get last "N" appointments
+17 IF $GET(SDARRAY("MAX"))<0
Begin DoDot:1
+18 SET SDAPPTDT=SDEND
+19 ;spin through each date/time for current clinic (REVERSE Order)
+20 FOR
SET SDAPPTDT=$ORDER(^SC(SDCLIEN,"S",SDAPPTDT),-1)
if $SELECT(+$GET(SDAPPTDT)=0
QUIT
Begin DoDot:2
+21 ;spin through each appointment for that date/time (REVERSE Order)
+22 SET SDA=""
FOR
SET SDA=$ORDER(^SC(SDCLIEN,"S",SDAPPTDT,1,SDA),-1)
if $SELECT(+$GET(SDA)=0
QUIT
Begin DoDot:3
+23 DO GETINFO(SDCLIEN,SDAPPTDT,SDA,.SDARRAY)
End DoDot:3
End DoDot:2
End DoDot:1
+24 QUIT
+25 ;
GETINFO(SDCLIEN,SDAPPTDT,SDA,SDARRAY) ;
+1 NEW SDPATIEN,SDCAN,SDQUIT
+2 SET SDQUIT=0
+3 ;get appointment data on ^SC
+4 SET SDARRAY("SC0")=$GET(^SC(SDCLIEN,"S",SDAPPTDT,1,SDA,0))
+5 SET SDARRAY("SCC")=$GET(^SC(SDCLIEN,"S",SDAPPTDT,1,SDA,"C"))
+6 SET SDARRAY("SCOB")=$GET(^SC(SDCLIEN,"S",SDAPPTDT,1,SDA,"OB"))
+7 SET SDARRAY("SCONS")=$GET(^SC(SDCLIEN,"S",SDAPPTDT,1,SDA,"CONS"))
+8 SET SDARRAY("DATE")=SDAPPTDT
+9 ;exclude cancelled appts
+10 SET SDCAN=$PIECE($GET(SDARRAY("SC0")),"^",9)
+11 if $GET(SDCAN)="C"
QUIT
+12 ;initialize patient appointment data to null and get patient DFN
+13 SET (SDARRAY("DPT0"),SDARRAY("DPT1"))=""
+14 SET (SDPATIEN,SDARRAY("PAT"))=+SDARRAY("SC0")
+15 ;quit if patient is null on ^SC
+16 if SDPATIEN=0
QUIT
+17 ;since "by clinic", 2nd sort is patient
+18 SET SDARRAY("SORT2")=SDPATIEN
+19 ;get corresponding appt zero node on ^DPT
+20 SET SDARRAY("DPT0")=$GET(^DPT(SDPATIEN,"S",SDAPPTDT,0))
+21 ;skip if appointment is cancelled on DPT
+22 if ($PIECE($GET(SDARRAY("DPT0")),"^",2)["C")
QUIT
+23 ;skip if appointment on DPT is for different clinic
+24 if (+$GET(SDARRAY("DPT0"))'=SDCLIEN)
QUIT
+25 ;get appointment 1 node on ^DPT
+26 SET SDARRAY("DPT1")=$GET(^DPT(SDPATIEN,"S",SDAPPTDT,1))
+27 ;appointment must match the "clinic" filter values
+28 IF $$MATCH^SDAMA304("C",.SDARRAY,.SDFLTR,.SDDV)
Begin DoDot:1
+29 ;if appointment matches the "patient" filter values, put appointment data into output array
+30 IF $$MATCH^SDAMA304("P",.SDARRAY,.SDFLTR,.SDDV)
DO SETARRAY^SDAMA305(.SDARRAY)
End DoDot:1
+31 QUIT
