source: WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SDAMA303.m@ 1147

Last change on this file since 1147 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 4.7 KB
Line 
1SDAMA303 ;BPOIFO/ACS-Filter API By Patient ; 9/14/05 12:45pm
2 ;;5.3;Scheduling;**301,347,508**;13 Aug 1993
3 ;PER VHA DIRECTIVE 2004-038, DO NOT MODIFY THIS ROUTINE
4 ;
5 ;*****************************************************************
6 ; CHANGE LOG
7 ;
8 ; DATE PATCH DESCRIPTION
9 ;-------- ---------- -----------------------------------------
10 ;12/04/03 SD*5.3*301 ROUTINE COMPLETED
11 ;08/06/04 SD*5.3*347 CHANGE CALL TO ^SDAMA305 TO SETARRAY
12 ;02/22/07 SD*5.3*508 SEE SDAMA301 FOR CHANGE LIST
13 ;*****************************************************************
14 ;
15 ;*****************************************************************
16 ;
17 ; GET APPOINTMENT DATA BY PATIENT
18 ;
19 ;INPUT
20 ; SDARRAY Appointment Filter array
21 ; SDDV Appointment Data Values array
22 ; SDFLTR Filter Flags array
23 ;
24 ;*****************************************************************
25PAT(SDARRAY,SDDV,SDFLTR) ;
26 N SDCOUNT,SDX,SDQUIT,SDPATIEN,SDSTART,SDEND,SDGBL
27 S (SDCOUNT,SDQUIT)=0
28 ;Set up start and end date/times for search criteria
29 I $G(SDARRAY("MAX"))'<0 D
30 .S SDSTART=$S(SDARRAY("FR")'="":(SDARRAY("FR")-.000001),1:0)
31 .S SDEND=(SDARRAY("TO"))
32 I $G(SDARRAY("MAX"))<0 D
33 .S SDSTART=$S($G(SDARRAY("FR"))'="":SDARRAY("FR"),1:0)
34 .S SDEND=(SDARRAY("TO")+.000001)
35 ;
36 ;if patient is not in global, get patient from filter list
37 I SDARRAY("PATGBL")=0 D
38 . S SDCOUNT=$L(SDARRAY(4),";")
39 . ;for each patient in the filter:
40 . F SDX=1:1:SDCOUNT D
41 .. S SDPATIEN=$P(SDARRAY(4),";",SDX)
42 .. D GETAPPT(SDPATIEN,SDSTART,SDEND,.SDARRAY)
43 ;if patient is in global, get patient from global
44 I SDARRAY("PATGBL")=1 D
45 . S SDGBL=SDARRAY(4),SDPATIEN=0
46 . ;for each patient in the global:
47 . F S SDPATIEN=$O(@(SDGBL_"SDPATIEN)")) Q:+$G(SDPATIEN)=0 D
48 .. D GETAPPT(SDPATIEN,SDSTART,SDEND,.SDARRAY)
49 Q
50 ;
51GETAPPT(SDPATIEN,SDSTART,SDEND,SDARRAY) ;
52 ;if the patient has no appointments on ^DPT, get next patient
53 Q:'$D(^DPT(SDPATIEN,"S"))
54 ;since "by patient", 1st sort is patient
55 S (SDARRAY("SORT1"),SDARRAY("PAT"))=SDPATIEN
56 N SDAPPTDT
57 ;
58 ;get first "N" appointments
59 I $G(SDARRAY("MAX"))'<0 D
60 .S SDAPPTDT=SDSTART
61 .;Spin through each appointment on DPT for current patient
62 .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
63 .. D GETINFO(SDPATIEN,SDAPPTDT,.SDARRAY)
64 ;
65 ;get last "N" appointments
66 I $G(SDARRAY("MAX"))<0 D
67 .S SDAPPTDT=SDEND
68 .;spin through each appointment on DPT for current patient (REVERSE Order)
69 .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
70 .. D GETINFO(SDPATIEN,SDAPPTDT,.SDARRAY)
71 Q
72 ;
73GETINFO(SDPATIEN,SDAPPTDT,SDARRAY) ;
74 N SDMATCH,SDCLINIC,SDA,SDQUIT
75 S SDQUIT=0
76 ; initialize array to hold data values
77 S SDARRAY("DPT0")=$G(^DPT(SDPATIEN,"S",SDAPPTDT,0))
78 S SDARRAY("DPT1")=$G(^DPT(SDPATIEN,"S",SDAPPTDT,1))
79 S SDARRAY("DATE")=SDAPPTDT
80 ;appointment must match the "patient" filter values
81 I $$MATCH^SDAMA304("P",.SDARRAY,.SDFLTR,.SDDV) D
82 . ;set clinic appointment data to null and get clinic
83 . S (SDARRAY("SC0"),SDARRAY("SCC"),SDARRAY("SCOB"),SDARRAY("SCONS"))=""
84 . S SDCLINIC=+$G(SDARRAY("DPT0"))
85 . ;quit if clinic is null(0)
86 . Q:SDCLINIC=0
87 . ;since "by patient", 2nd sort is clinic
88 . S SDARRAY("SORT2")=SDCLINIC
89 . ;quit if this is a migrated appointment
90 . Q:'($$CLMIG^SDAMA307(SDCLINIC,.SDARRAY))
91 . S SDMATCH=1
92 . ;if appointment is not cancelled on ^DPT and the PURGED parameter
93 . ;is not set, then find the corresponding appt on ^SC and get data
94 . I ('+$G(SDARRAY("PURGED"))&(";C;CA;PC;PCA;"'[(";"_$P($G(SDARRAY("DPT0")),"^",2)_";"))) D
95 .. N SDCANCEL
96 .. S SDQUIT=0,SDA=0,SDMATCH=0
97 .. ;for current clinic and appt d/t, find matching appt on ^SC
98 .. F S SDA=$O(^SC(SDCLINIC,"S",SDAPPTDT,1,SDA)) Q:(($G(SDA)="")!(SDQUIT=1)) D
99 ... S SDCANCEL=0
100 ... ;get next appt if patient doesn't match
101 ... Q:(+$G(^SC(SDCLINIC,"S",SDAPPTDT,1,SDA,0))'=SDPATIEN)
102 ... ;get appointment data on ^SC
103 ... S SDARRAY("SC0")=$G(^SC(SDCLINIC,"S",SDAPPTDT,1,SDA,0))
104 ... ;get next appt if cancelled on SC
105 ... S SDCANCEL=$P($G(SDARRAY("SC0")),"^",9)
106 ... Q:($G(SDCANCEL)="C")
107 ... ;get appointment "C" node on ^SC
108 ... S SDARRAY("SCC")=$G(^SC(SDCLINIC,"S",SDAPPTDT,1,SDA,"C"))
109 ... ;get appointment "OB" node on ^SC
110 ... S SDARRAY("SCOB")=$G(^SC(SDCLINIC,"S",SDAPPTDT,1,SDA,"OB"))
111 ... ;get appointment "CONS" node on ^SC
112 ... S SDARRAY("SCONS")=$G(^SC(SDCLINIC,"S",SDAPPTDT,1,SDA,"CONS"))
113 ... ;Corresponding appointment found on ^SC
114 ... S SDQUIT=1,SDMATCH=1
115 . ;if appointment matches the clinic filters, put appointment data into output array
116 . I SDMATCH D
117 .. I $$MATCH^SDAMA304("C",.SDARRAY,.SDFLTR,.SDDV) D SETARRAY^SDAMA305(.SDARRAY)
118 Q
Note: See TracBrowser for help on using the repository browser.