source: WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SCRPBK4.m@ 1578

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

initial load of WorldVistAEHR
File size: 4.7 KB
RevLine 
[613]1SCRPBK4 ;MJK/ALB - RPC Broker Utilities ; 27 FEB 96
2 ;;5.3;Scheduling;**41**;AUG 13, 1993
3 ;
4VALID(SCDATA,SCVM,SCQDEF) ; -- query definition validation
5 ;
6 ; input: SCVM -> validation mode (FULL or SELECTIONS only)
7 ;
8 ;output:
9 ; SCDATA(0) -> 1 - meaning validation checks found no errors
10 ;
11 ; --- OR ---
12 ;
13 ; SCDATA(0) -> 0 - meaning errors found ^ <number of errors>
14 ;SCDATA(1...n) -> error text
15 ;
16 ; -- SEE BOTTOM OF SCRPBK FOR MORW VARIABLE DEFINITIONS
17 ;
18 ; Related RPC: SCRP QUERY VALIDATE
19 ;
20 N SCQREC,SCTYPE,SCLOG,DIERR,SCER
21 S SCLOG="SCDATA"
22 ; -- build query record
23 D PARSE^SCRPBK5(.SCQDEF,.SCQREC)
24 ; -- validate query record
25 D VALCHK(SCLOG,.SCQREC,SCVM)
26 ; -- report back any erros found(if any) or 1 for success
27 D HDREC^SCUTBK3(.SCDATA,$G(DIERR),"Template Validation ("_SCVM_")")
28 Q
29 ;
30VALCHK(SCLOG,SCQREC,SCVM) ; -- determine validation mode and do appropriate checks
31 IF SCVM="FULL" D VALFLDS(SCLOG,.SCQREC)
32 IF SCVM="FULL"!(SCVM="SELECTIONS") D VALSELS(SCLOG,.SCQREC)
33 Q
34 ;
35VALFLDS(SCLOG,SCQREC) ; -- validate field data
36 N X,SCAN,SCFLD
37 ;
38 ; -- required single fields
39 D GETFLDS^SCRPBK2(+SCQREC("REPORTID"),.SCAN)
40 S SCFLD=""
41 F S SCFLD=$O(SCAN(SCFLD)) Q:SCFLD="" S X=SCAN(SCFLD) D
42 . IF $P(X,U,2),'$D(SCQREC("FIELDS",SCFLD)) D
43 . . D SETFLD(SCLOG,$P($G(^SD(404.93,+X,0),"UNKNOWN"),U))
44 Q
45 ;
46VALSELS(SCLOG,SCQREC) ; -- validate file entry selections
47 N SCTYPE,SCAN
48 ;
49 ; -- have all required selections been made?
50 K SCAN
51 D GETYPE^SCRPBK2(+SCQREC("REPORTID"),.SCAN)
52 S SCTYPE=""
53 F S SCTYPE=$O(SCAN(SCTYPE)) Q:SCTYPE="" S X=SCAN(SCTYPE) D
54 . IF $P(X,U,2),'$D(SCQREC("SELECTIONS",SCTYPE)) D
55 . . D SETFLD(SCLOG,SCTYPE)
56 ;
57 ; -- are selections consistent?
58 S SCTYPE=""
59 F S SCTYPE=$O(SCQREC("SELECTIONS",SCTYPE)) Q:SCTYPE="" IF $D(SCAN(SCTYPE)) D
60 . IF SCTYPE="DIVISION" D DIV(SCLOG,.SCQREC,SCTYPE)
61 . IF SCTYPE="TEAM" D TEAM(SCLOG,.SCQREC,SCTYPE)
62 . IF SCTYPE="PRACTITIONER" D PRAC(SCLOG,.SCQREC,SCTYPE)
63 . IF SCTYPE="ROLE" D ROLE(SCLOG,.SCQREC,SCTYPE)
64 . IF SCTYPE="CLINIC" D CLIN(SCLOG,.SCQREC,SCTYPE)
65 . IF SCTYPE="USERCLASS" D USER(SCLOG,.SCQREC,SCTYPE)
66 Q
67 ;
68DIV(SCLOG,SCQREC,SCTYPE) ; -- validate division selections
69 N SCSEL,Y,SC0
70 S SCSEL=""
71 F S SCSEL=$O(SCQREC("SELECTIONS",SCTYPE,SCSEL)) Q:SCSEL="" D
72 . S Y=SCSEL,SC0=$G(^DIC(4,+SCSEL,0))
73 . IF $D(^SCTM(404.51,"AINST",+Y)) D
74 . . Q
75 . ELSE D
76 . . D SETSEL(SCLOG,SCTYPE,"NO TEAMS FOR DIVISION",SC0)
77 Q
78 ;
79TEAM(SCLOG,SCQREC,SCTYPE) ; -- validate team selections
80 N SCSEL,Y,SC0,VAUTD
81 S SCSEL=""
82 D BUILD^SCRPBK3(.SCQREC,"DIVISION",.VAUTD)
83 F S SCSEL=$O(SCQREC("SELECTIONS",SCTYPE,SCSEL)) Q:SCSEL="" D
84 . S Y=+SCSEL,SC0=$G(^SCTM(404.51,+SCSEL,0))
85 . IF $D(VAUTD(+$P(SC0,U,7))) D
86 . . Q
87 . ELSE D
88 . . D SETSEL(SCLOG,SCTYPE,"DIVISION",SC0)
89 Q
90 ;
91PRAC(SCLOG,SCQREC,SCTYPE) ; -- validate practitioner selections
92 N SCSEL,Y,SC0,VAUTT
93 S SCSEL=""
94 IF SCQREC("REPORTID")=3 D
95 . S VAUTT=1
96 ELSE D
97 . D BUILD^SCRPBK3(.SCQREC,"TEAM",.VAUTT)
98 F S SCSEL=$O(SCQREC("SELECTIONS",SCTYPE,SCSEL)) Q:SCSEL="" D
99 . S Y=+SCSEL,SC0=$G(^VA(200,Y,0))
100 . IF $D(VAUTT),$$PRACS^SCRPU1() D
101 . . Q
102 . ELSE D
103 . . D SETSEL(SCLOG,SCTYPE,"TEAM",SC0)
104 Q
105 ;
106ROLE(SCLOG,SCQREC,SCTYPE) ; -- validate role selections
107 N SCSEL,Y,SC0,VAUTT
108 S SCSEL=""
109 D BUILD^SCRPBK3(.SCQREC,"TEAM",.VAUTT)
110 F S SCSEL=$O(SCQREC("SELECTIONS",SCTYPE,SCSEL)) Q:SCSEL="" D
111 . S Y=+SCSEL,SC0=$G(^SD(403.46,Y,0))
112 . IF $D(VAUTT),$$RL^SCRPU1() D
113 . . Q
114 . ELSE D
115 . . D SETSEL(SCLOG,SCTYPE,"TEAM",SC0)
116 Q
117 ;
118CLIN(SCLOG,SCQREC,SCTYPE) ; -- validate clinic selections
119 N SCSEL,Y,SC0,SCRPTID,VAUTD,VAUTT
120 S SCSEL="",SCRPTID=SCQREC("REPORTID")
121 IF SCRPTID=2 D
122 . D BUILD^SCRPBK3(.SCQREC,"DIVISION",.VAUTD)
123 ELSE D
124 . D BUILD^SCRPBK3(.SCQREC,"TEAM",.VAUTT)
125 ;
126 F S SCSEL=$O(SCQREC("SELECTIONS",SCTYPE,SCSEL)) Q:SCSEL="" D
127 . S Y=+SCSEL,SC0=$G(^SC(Y,0))
128 . IF SCRPTID=2,$D(VAUTD),$$CLSC2^SCRPU1() D Q
129 . . Q
130 . ELSE D Q
131 . . D SETSEL(SCLOG,SCTYPE,"DIVISION",SC0)
132 . IF SCRPTID'=2,$D(VAUTT),$$CLSC^SCRPU1() D
133 . . Q
134 . ELSE D
135 . . D SETSEL(SCLOG,SCTYPE,"TEAM",SC0)
136 Q
137 ;
138USER(SCLOG,SCQREC,SCTYPE) ; -- validate user selections
139 N SCSEL,Y,SC0,VAUTT
140 S SCSEL=""
141 D BUILD^SCRPBK3(.SCQREC,"TEAM",.VAUTT)
142 F S SCSEL=$O(SCQREC("SELECTIONS",SCTYPE,SCSEL)) Q:SCSEL="" D
143 . S Y=+SCSEL,SC0=$G(^USR(8930,+SCSEL,0))
144 . IF $D(VAUTT),$$USRCL^SCRPU1() D
145 . . Q
146 . ELSE D
147 . . D SETSEL(SCLOG,SCTYPE,"TEAM",SC0)
148 Q
149 ;
150SETFLD(SCLOG,SCFLD) ; -- set field error in error log
151 N SCPARM
152 S SCPARM("FIELD")=SCFLD
153 D BLD^DIALOG(4035001.001,.SCPARM,"",SCLOG,"S")
154 Q
155 ;
156SETSEL(SCLOG,SCTYPE,SCDTYPE,SC0) ; -- set file entry error in error log
157 N SCPARM
158 S SCPARM("TYPE")=SCTYPE
159 S SCPARM("SELECTION")=$P(SC0,U)
160 S SCPARM("DEPENDENT")=SCDTYPE
161 D BLD^DIALOG(4035001.002,.SCPARM,"",SCLOG,"S")
162 Q
163 ;
Note: See TracBrowser for help on using the repository browser.