source: WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SCRPBK2.m@ 1270

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

initial load of WorldVistAEHR
File size: 6.9 KB
Line 
1SCRPBK2 ;MJK/ALB - RPC Broker Utilities ; 27 FEB 96
2 ;;5.3;Scheduling;**41**;AUG 13, 1993
3 ;
4SAVE(SCDATA,SCQDEF) ; -- save query definition
5 ;
6 ; -- SCDATA(0) -> <1 - success> ^ <new query ien> ^ <reload client>
7 ; -> <0 - errors found> ^ <number of errors>
8 ; (1...n) -> error text
9 ;
10 ; -- SEE BOTTOM OF SCRPBK FOR VARIABLE DEFINITIONS
11 ;
12 ; Related RPC: SCRP QUERY SAVE
13 ;
14 N SCQREC,SCERR,SCIENS,SCSTAT,SCVM,SCLOG,SCERS,DIERR,SCPROC
15 S SCPROC="Save Template"
16 D PARSE^SCRPBK5(.SCQDEF,.SCQREC)
17 ;
18 ; -- do full validation mode(SCVM) check
19 S SCVM="FULL",SCLOG="SCDATA"
20 D VALCHK^SCRPBK4(SCLOG,.SCQREC,SCVM)
21 IF $G(DIERR) D G SAVEQ
22 . D HDREC^SCUTBK3(.SCDATA,DIERR,"Save Template Validation Check")
23 ;
24 ; -- try to save record and get status of save
25 S SCSTAT=$$SAVEREC(.SCQREC,.SCIENS,.SCERR)
26 IF SCSTAT D
27 . S SCDATA(0)=1_U_$S(SCQREC("QUERYID")="+1":+$G(SCIENS(1)),1:"")_U_$P(SCSTAT,U,2)
28 ELSE D
29 . D ERRCHK^SCUTBK3(.SCDATA,.SCERR,SCPROC)
30SAVEQ Q
31 ;
32SAVEREC(SCQREC,SCIENS,SCERR) ; -- actual save process
33 N SCFILE,SCFDA,SCDFDA,SCQRY,SCNEW,SCMOD
34 S SCFILE=404.95
35 S SCFDA="SCFDA",SCDFDA="SCDFDA",SCERR="SCERR",SCIENS="SCIENS"
36 S SCQRY=SCQREC("QUERYID")
37 ;
38 ; -- strip out data not needed
39 ; SCMOD = 1 means some stripping occurred and query needs to reload
40 S SCMOD=$$STRIP(.SCQREC)
41 ;
42 D FDA^DILF(SCFILE,SCQRY_",",.01,"",SCQREC("NAME"),SCFDA,SCERR)
43 D FDA^DILF(SCFILE,SCQRY_",",.02,"",SCQREC("CREATORID"),SCFDA,SCERR)
44 D FDA^DILF(SCFILE,SCQRY_",",.03,"",SCQREC("ACCESSID"),SCFDA,SCERR)
45 D FDA^DILF(SCFILE,SCQRY_",",.04,"",SCQREC("REPORTID"),SCFDA,SCERR)
46 D FDA^DILF(SCFILE,SCQRY_",",.05,"",$$NOW^XLFDT(),SCFDA,SCERR)
47 IF $D(SCQREC("DESCRIPTION")) D
48 . D FDA^DILF(SCFILE,SCQRY_",",10,"",$NA(SCQREC("DESCRIPTION")),SCFDA,SCERR)
49 ; -- is this a new record?
50 S SCNEW=$S(SCQRY="+1":1,1:0)
51 D SAVFLD(.SCQREC,.SCFDA,.SCDFDA,.SCERR,.SCNEW)
52 D SAVSEL(.SCQREC,.SCFDA,.SCDFDA,.SCERR,.SCNEW)
53 ;
54 ; -- process any deletions (SCDFDA array holds deletion FDA)
55 IF $D(SCDFDA)>10 D
56 . D FILE^DIE("K",SCDFDA,SCERR)
57 ;
58 ; -- process new items and changes
59 IF SCNEW D
60 . D UPDATE^DIE("",SCFDA,SCIENS,SCERR)
61 ELSE D
62 . D FILE^DIE("K",SCFDA,SCERR)
63 ;
64 ; -- ret := <success 0/1> ^ <unneeded data automatically stripped out>
65SAVERECQ Q '$G(SCERR("DIERR"))_U_SCMOD
66 ;
67SAVFLD(SCQREC,SCFDA,SCDFDA,SCERR,SCNEW) ;
68 ; -- determine which fields were changed or deleted
69 ;
70 N SCUR,SCAN,SCQRY,SCI,SCFLD
71 S SCQRY=SCQREC("QUERYID")
72 ;
73 ; -- scan fields multiple and build array
74 S SCI=0
75 F S SCI=$O(^SD(404.95,SCQRY,"FIELDS",SCI)) Q:'SCI S X=$G(^(SCI,0)) D
76 . IF $D(^SD(404.93,+X,0)) S SCAN($P(^(0),U,2))=SCI_U_$P(X,U,2)
77 ;
78 ; -- delete fields not passed down and set delete fda
79 S SCFLD=""
80 F S SCFLD=$O(SCAN(SCFLD)) Q:SCFLD="" IF '$D(SCQREC("FIELDS",SCFLD)) D
81 . D FDA^DILF(404.9502,+SCAN(SCFLD)_","_SCQRY_",",.01,"","@",SCDFDA,SCERR)
82 ;
83 ; -- set fda for changes
84 S SCFLD=""
85 F S SCFLD=$O(SCQREC("FIELDS",SCFLD)) Q:SCFLD="" D
86 . N SCVAL,SCFLDI,SCIEN,SCUR
87 . S SCVAL=SCQREC("FIELDS",SCFLD)
88 . S SCFLDI=+$O(^SD(404.93,"C",SCFLD,0))
89 . S SCUR=$G(SCAN(SCFLD))
90 . S SCIEN=+SCUR IF 'SCIEN S SCNEW=SCNEW+1,SCIEN="+"_SCNEW
91 . IF SCIEN="+1"!($P(SCUR,U,2)'=SCVAL) D
92 . . D FDA^DILF(404.9502,SCIEN_","_SCQRY_",",.01,"",SCFLDI,SCFDA,SCERR)
93 . . D FDA^DILF(404.9502,SCIEN_","_SCQRY_",",.02,"",SCVAL,SCFDA,SCERR)
94 Q
95 ;
96SAVSEL(SCQREC,SCFDA,SCDFDA,SCERR,SCNEW) ;
97 ; -- determine which file selections were changed or deleted
98 ;
99 N SCUR,SCAN,SCQRY,SCI,SCSEL,SCTYPE,SCHIT
100 S SCQRY=SCQREC("QUERYID")
101 ; -- scan fields and build array
102 S SCI=0
103 F S SCI=$O(^SD(404.95,SCQRY,"FILES",SCI)) Q:'SCI S X=$G(^(SCI,0)) D
104 . S SCAN($P(^(0),U))=SCI
105 ;
106 ; -- delete fields not passed down
107 S SCSEL=""
108 F S SCSEL=$O(SCAN(SCSEL)) Q:SCSEL="" D
109 . S SCTYPE="",SCHIT=0
110 . F S SCTYPE=$O(SCQREC("SELECTIONS",SCTYPE)) Q:SCTYPE="" IF $D(SCQREC("SELECTIONS",SCTYPE,SCSEL)) S SCHIT=1 Q
111 . D:'SCHIT FDA^DILF(404.9503,+SCAN(SCSEL)_","_SCQRY_",",.01,"","@",SCDFDA,SCERR)
112 ;
113 ; -- set fda
114 S SCTYPE=""
115 F S SCTYPE=$O(SCQREC("SELECTIONS",SCTYPE)) Q:SCTYPE="" D
116 . S SCSEL=""
117 . F S SCSEL=$O(SCQREC("SELECTIONS",SCTYPE,SCSEL)) Q:SCSEL="" IF '$D(SCAN(SCSEL)) D
118 . . S SCNEW=SCNEW+1,SCIEN="+"_SCNEW
119 . . D FDA^DILF(404.9503,SCIEN_","_SCQRY_",",.01,"",SCSEL,SCFDA,SCERR)
120 Q
121 ;
122DELETE(SCDATA,SCQDEF) ; -- delete a query record
123 ;
124 ; -- SCDATA(0) -> <1 - success> ^
125 ; -> <0 - errors found> ^ <number of errors>
126 ; (1...n) -> error text
127 ;
128 ; -- SEE BOTTOM OF SCRPBK FOR VARIABLE DEFINITIONS
129 ;
130 ; Related RPC: SCRP QUERY DELETE
131 ;
132 N SCQREC,DIERR,SCLOG
133 S SCLOG="SCDATA"
134 D PARSE^SCRPBK5(.SCQDEF,.SCQREC)
135 D DELCHK(SCLOG,.SCQREC)
136 D HDREC^SCUTBK3(.SCDATA,$G(DIERR),"Template Deletion")
137 IF SCDATA(0) D DELREC(.SCQREC)
138 Q
139 ;
140DELCHK(SCLOG,SCQREC) ; -- check to see if query can be deleted
141 ; -- is the query being used as a default by any user?
142 ;
143 N SCQRY,PARAM
144 S SCQRY=SCQREC("QUERYID")
145 IF SCQRY=+SCQRY,'$D(^SCRS(403.35,"AC",SCQRY)) D G DELCHKQ
146 . Q
147 ELSE D
148 . S SCPARM("QUERY NAME")=SCQREC("NAME")
149 . D BLD^DIALOG(4035002.001,.SCPARM,"",SCLOG,"S")
150DELCHKQ Q
151 ;
152DELREC(SCQREC) ; -- actually delete query record
153 N DIK,DA,X
154 S DIK="^SD(404.95,",DA=SCQREC("QUERYID") D ^DIK
155 Q
156 ;
157NAME(SCDATA,SCQNAME,SCUSER) ;
158 ; -- check to see if user has a query with same name
159 ;
160 ; input: SCQNAME -> query name
161 ; SCUSER -> user id (DUZ)
162 ;output: SCDATA(1) -> 0 means no query with that name found
163 ; -> <n> means query with that name found has this ien
164 ; -- SEE BOTTOM OF SCRPBK FOR VARIABLE DEFINITIONS
165 ;
166 ; Related RPC: SCRP QUERY CHECK NAME
167 ;
168 N SCERR,SCDUP
169 IF $$NAMECHK(.SCQNAME,.SCUSER,.SCERR,.SCDUP) D
170 . S SCDATA(1)=0
171 ELSE D
172 . S SCDATA(1)=SCDUP
173 Q
174 ;
175NAMECHK(SCQNAME,SCUSER,SCERR,SCDUP) ; -- actuallt scan xref for query name
176 N SCOK,SDI
177 S SCOK=1,SCI=0
178 F S SCI=$O(^SD(404.95,"AC",SCUSER,SCI)) Q:'SCI D Q:'SCOK
179 . IF SCQNAME=$P($G(^SD(404.95,SCI,0)),U) S SCOK=0,SCDUP=SCI
180 Q SCOK
181 ;
182STRIP(SCQREC) ; -- strip out inappropriate data for report type
183 N I,X,SCAN,SCFLD,SCMOD
184 S SCMOD=0
185 D GETFLDS(+SCQREC("REPORTID"),.SCAN)
186 S SCFLD=""
187 F S SCFLD=$O(SCQREC("FIELDS",SCFLD)) Q:SCFLD="" D
188 . IF '$D(SCAN(SCFLD)) K SCQREC("FIELDS",SCFLD) S SCMOD=1
189 ;
190 K SCAN
191 D GETYPE(+SCQREC("REPORTID"),.SCAN)
192 S SCTYPE=""
193 F S SCTYPE=$O(SCQREC("SELECTIONS",SCTYPE)) Q:SCTYPE="" D
194 . IF '$D(SCAN(SCTYPE)) K SCQREC("SELECTIONS",SCTYPE) S SCMOD=1
195 Q SCMOD
196 ;
197GETFLDS(RPTID,SCAN) ; -- build array of fields used/needed by report
198 N SCI,SCX
199 S SCI=0
200 F S SCI=$O(^SD(404.92,RPTID,"FIELDS",SCI)) Q:'SCI S SCX=$G(^(SCI,0)) D
201 . IF $D(^SD(404.93,+SCX,0)) S SCAN($P(^(0),U,2))=SCX
202 Q
203 ;
204GETYPE(RPTID,SCAN) ; -- build array of files used/needed by report
205 N SCI,SCX
206 S SCI=0
207 F S SCI=$O(^SD(404.92,RPTID,"FILES",SCI)) Q:'SCI S SCX=$G(^(SCI,0)) D
208 . S SCTYPE=$$TYPE^SCRPBK(+SCX)
209 . IF $$CHKTYPE(SCTYPE) S SCAN(SCTYPE)=SCX
210 Q
211 ;
212CHKTYPE(SCTYPE) ; -- special checks to see if file type is ok to use
213 N SCOK S SCOK=1
214 IF SCTYPE="" S SCOK=0
215 ;
216 ; -- is site using user class relationship in PCMM?
217 IF SCTYPE="USERCLASS",'$P($G(^SD(404.91,1,"PCMM")),U) S SCOK=0
218 Q SCOK
219 ;
Note: See TracBrowser for help on using the repository browser.