source: WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SDAMA302.m@ 1608

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

initial load of WorldVistAEHR
File size: 5.1 KB
RevLine 
[613]1SDAMA302 ;BPOIFO/ACS-Filter API By Clinic ; 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 CLINIC
18 ;
19 ;INPUT
20 ; SDARRAY Appointment Filter array
21 ; SDDV Appointment Data Values array
22 ; SDFLTR Filter Flags array
23 ;
24 ;*****************************************************************
25CLIN(SDARRAY,SDDV,SDFLTR) ;
26 N SDCOUNT,SDX,SDQUIT,SDCLIEN,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 clinic filter is populated
37 I $L($G(SDARRAY(2)))>0 D
38 . ;if clinic is in a list:
39 . I SDARRAY("CLNGBL")=0 D
40 .. S SDCOUNT=$L(SDARRAY(2),";")
41 .. ;For each clinic in the filter:
42 .. F SDX=1:1:SDCOUNT D
43 ... S SDCLIEN=$P(SDARRAY(2),";",SDX)
44 ... ;call VistA for appointment information
45 ... D CALLVSTA(SDCLIEN,SDSTART,SDEND,.SDARRAY)
46 . ;if clinic is in array, get IENs
47 . I SDARRAY("CLNGBL")=1 D
48 .. S SDGBL=SDARRAY(2),SDCLIEN=0
49 .. ;for each clinic in the global:
50 .. F S SDCLIEN=$O(@(SDGBL_"SDCLIEN)")) Q:$G(SDCLIEN)="" D
51 ... ;call VistA for appointment information
52 ... D CALLVSTA(SDCLIEN,SDSTART,SDEND,.SDARRAY)
53 ;
54 ;If clinic filter is not populated
55 I $L(SDARRAY(2))'>0 D
56 . ;for each clinic on ^SC
57 . S SDCLIEN=0 F S SDCLIEN=$O(^SC(SDCLIEN)) Q:(+$G(SDCLIEN)=0) D
58 .. ;call VistA for appointment information
59 .. D CALLVSTA(SDCLIEN,SDSTART,SDEND,.SDARRAY)
60 Q
61 ;
62CALLVSTA(SDCLIEN,SDSTART,SDEND,SDARRAY) ;
63 ;retrieve appointment information from VistA
64 I $$CLMIG^SDAMA307(SDCLIEN,.SDARRAY) D
65 . ;adjust end time if clinic has completed migration
66 . ;(Only Non-migrated appointments returned from VistA)
67 . I $G(SDARRAY("MIG"))]"" D
68 .. S SDEND=+$G(SDARRAY("MIG"))
69 .. ;increment SDEND to capture all appointments when ordering
70 .. S:$G(SDARRAY("MAX"))<0 SDEND=(SDEND+.000001)
71 . D GETAPPT(SDCLIEN,SDSTART,SDEND,.SDARRAY)
72 Q
73 ;
74GETAPPT(SDCLIEN,SDSTART,SDEND,SDARRAY) ;
75 ;since "by clinic", 1st sort is clinic
76 S SDARRAY("SORT1")=SDCLIEN
77 N SDAPPTDT,SDA
78 ;if the current clinic has no appointments on ^SC, get next clinic
79 Q:'$D(^SC(SDCLIEN,"S"))
80 ;
81 ;get first "N" appointments
82 I $G(SDARRAY("MAX"))'<0 D
83 .S SDAPPTDT=SDSTART
84 .;spin through each date/time for current clinic
85 .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
86 .. ;spin through each appointment for that date/time
87 .. 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
88 ... D GETINFO(SDCLIEN,SDAPPTDT,SDA,.SDARRAY)
89 ;
90 ;get last "N" appointments
91 I $G(SDARRAY("MAX"))<0 D
92 .S SDAPPTDT=SDEND
93 .;spin through each date/time for current clinic (REVERSE Order)
94 .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
95 .. ;spin through each appointment for that date/time (REVERSE Order)
96 .. 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
97 ... D GETINFO(SDCLIEN,SDAPPTDT,SDA,.SDARRAY)
98 Q
99 ;
100GETINFO(SDCLIEN,SDAPPTDT,SDA,SDARRAY) ;
101 N SDPATIEN,SDCAN,SDQUIT
102 S SDQUIT=0
103 ;get appointment data on ^SC
104 S SDARRAY("SC0")=$G(^SC(SDCLIEN,"S",SDAPPTDT,1,SDA,0))
105 S SDARRAY("SCC")=$G(^SC(SDCLIEN,"S",SDAPPTDT,1,SDA,"C"))
106 S SDARRAY("SCOB")=$G(^SC(SDCLIEN,"S",SDAPPTDT,1,SDA,"OB"))
107 S SDARRAY("SCONS")=$G(^SC(SDCLIEN,"S",SDAPPTDT,1,SDA,"CONS"))
108 S SDARRAY("DATE")=SDAPPTDT
109 ;exclude cancelled appts
110 S SDCAN=$P($G(SDARRAY("SC0")),"^",9)
111 Q:$G(SDCAN)="C"
112 ;initialize patient appointment data to null and get patient DFN
113 S (SDARRAY("DPT0"),SDARRAY("DPT1"))=""
114 S (SDPATIEN,SDARRAY("PAT"))=+SDARRAY("SC0")
115 ;quit if patient is null on ^SC
116 Q:SDPATIEN=0
117 ;since "by clinic", 2nd sort is patient
118 S SDARRAY("SORT2")=SDPATIEN
119 ;get corresponding appt zero node on ^DPT
120 S SDARRAY("DPT0")=$G(^DPT(SDPATIEN,"S",SDAPPTDT,0))
121 ;skip if appointment is cancelled on DPT
122 Q:($P($G(SDARRAY("DPT0")),"^",2)["C")
123 ;skip if appointment on DPT is for different clinic
124 Q:(+$G(SDARRAY("DPT0"))'=SDCLIEN)
125 ;get appointment 1 node on ^DPT
126 S SDARRAY("DPT1")=$G(^DPT(SDPATIEN,"S",SDAPPTDT,1))
127 ;appointment must match the "clinic" filter values
128 I $$MATCH^SDAMA304("C",.SDARRAY,.SDFLTR,.SDDV) D
129 . ;if appointment matches the "patient" filter values, put appointment data into output array
130 . I $$MATCH^SDAMA304("P",.SDARRAY,.SDFLTR,.SDDV) D SETARRAY^SDAMA305(.SDARRAY)
131 Q
Note: See TracBrowser for help on using the repository browser.