source: WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SCRPBK3.m@ 1361

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

initial load of WorldVistAEHR
File size: 5.1 KB
RevLine 
[613]1SCRPBK3 ;MJK/ALB - RPC Broker Utilities ; 27 FEB 96
2 ;;5.3;Scheduling;**41**;AUG 13, 1993
3 ;
4PRINT(SCDATA,SCPTR,SCDATE,SCTIME,SCQDEF) ;
5 ; -- print pcmm report
6 ;
7 ; input: SCPTR -> printer name
8 ; SCDATE -> run date
9 ; SCTIME -> run time
10 ;
11 ;output:
12 ; SCDATA(0) -> TaskMan task number assicated with queued report
13 ;
14 ; --- OR if errors were found during validation ---
15 ;
16 ; SCDATA(0) -> 0 - meaning errors found ^ <number of errors>
17 ; SCDATA(1...n) -> error text
18 ;
19 ; -- SEE BOTTOM OF SCRPBK FOR MORE VARIABLE DEFINITIONS
20 ;
21 ; Related RPC: SCRP REPORT PRINT
22 ;
23 N SCQREC,SCRUNDT,SCPNTR,SCLOG,DIERR
24 ;
25 ; -- build query record
26 D PARSE^SCRPBK5(.SCQDEF,.SCQREC)
27 ;
28 ; -- do validation full check and report any errors
29 S SCLOG="SCDATA"
30 D VALCHK^SCRPBK4(SCLOG,.SCQREC,"FULL")
31 IF $G(DIERR) D G PRINTQ
32 . D HDREC^SCUTBK3(.SCDATA,DIERR,"Report Printing")
33 ;
34 ; -- process date/time and printer data and retuen in usable format
35 D INIT(SCDATE,SCTIME,SCPTR,.SCRUNDT,.SCPNTR)
36 IF SCQREC("REPORTID") D
37 . ; -- call appropriate report
38 . D @("RPT"_SCQREC("REPORTID")_"(.SCDATA,.SCQREC,.SCPNTR,.SCRUNDT)")
39 ELSE D
40 . S SCDATA(0)="0^NOT A VAILD REPORT REQUEST"
41PRINTQ Q
42 ;
43RPT1(SCDATA,SCQREC,SCPNTR,SCRUNDT) ; -- patient/team assignment
44 N VAUTD,VAUTT,VAUTR,VAUTP
45 D BUILD(.SCQREC,"DIVISION",.VAUTD)
46 D BUILD(.SCQREC,"TEAM",.VAUTT)
47 D BUILD(.SCQREC,"ROLE",.VAUTR)
48 S VAUTP="" D BUILD(.SCQREC,"PRACTITIONER",.VAUTP)
49 S SCDATA(0)=$$ENTRY2^SCRPTA(.VAUTD,.VAUTT,.VAUTR,.VAUTP,SCPNTR,SCRUNDT)
50 Q
51 ;
52RPT2(SCDATA,SCQREC,SCPNTR,SCRUNDT) ; -- detailed patient enrollments
53 N VAUTD,VAUTT,VAUTC,VAUTA
54 D BUILD(.SCQREC,"DIVISION",.VAUTD)
55 D BUILD(.SCQREC,"TEAM",.VAUTT)
56 D BUILD(.SCQREC,"CLINIC",.VAUTC)
57 S VAUTA=$$PASSIGN(.SCQREC,"radAssigned")
58 S SCDATA(0)=$$ENTRY2^SCRPEC(.VAUTD,.VAUTT,.VAUTC,VAUTA,SCPNTR,SCRUNDT)
59 Q
60 ;
61RPT3(SCDATA,SCQREC,SCPNTR,SCRUNDT) ; -- practitioner's demographics
62 N VAUTP
63 D BUILD(.SCQREC,"PRACTITIONER",.VAUTP)
64 S SCDATA(0)=$$ENTRY2^SCRPRAC(.VAUTP,SCPNTR,SCRUNDT)
65 Q
66 ;
67RPT4(SCDATA,SCQREC,SCPNTR,SCRUNDT) ; -- practitioner's pateints
68 N VAUTD,VAUTT,VAUTC,VAUTR,VAUTP,VAUTS,SCSORT
69 D BUILD(.SCQREC,"DIVISION",.VAUTD)
70 D BUILD(.SCQREC,"TEAM",.VAUTT)
71 D BUILD(.SCQREC,"ROLE",.VAUTR)
72 D BUILD(.SCQREC,"PRACTITIONER",.VAUTP)
73 S VAUTS=$$YESNO(.SCQREC,"chkSummary")
74 S SCSORT=$$FINDSORT(.SCQREC)
75 S SCDATA(0)=$$ENTRY2^SCRPPAT(.VAUTD,.VAUTT,.VAUTR,.VAUTP,VAUTS,SCSORT,SCPNTR,SCRUNDT)
76 Q
77 ;
78RPT5(SCDATA,SCQREC,SCPNTR,SCRUNDT) ; -- team profile
79 N VAUTD,VAUTT
80 D BUILD(.SCQREC,"DIVISION",.VAUTD)
81 D BUILD(.SCQREC,"TEAM",.VAUTT)
82 S SCDATA(0)=$$ENTRY2^SCRPITP(.VAUTD,.VAUTT,SCPNTR,SCRUNDT)
83 Q
84 ;
85RPT6(SCDATA,SCQREC,SCPNTR,SCRUNDT) ; -- summaru listing of Teams
86 N VAUTD,VAUTT,VAUTR
87 D BUILD(.SCQREC,"DIVISION",.VAUTD)
88 D BUILD(.SCQREC,"TEAM",.VAUTT)
89 D BUILD(.SCQREC,"ROLE",.VAUTR)
90 S SCDATA(0)=$$ENTRY2^SCRPSLT(.VAUTD,.VAUTT,.VAUTR,SCPNTR,SCRUNDT)
91 Q
92 ;
93RPT7(SCDATA,SCQREC,SCPNTR,SCRUNDT) ; -- team's patients
94 N VAUTD,VAUTT,VAUTR,VAUTPS,SCSORT
95 D BUILD(.SCQREC,"DIVISION",.VAUTD)
96 D BUILD(.SCQREC,"TEAM",.VAUTT)
97 D BUILD(.SCQREC,"ROLE",.VAUTR)
98 S VAUTPS=$$PSTATUS(.SCQREC,"radPatStatus")
99 S SCSORT=$$FINDSORT(.SCQREC)
100 S SCDATA(0)=$$ENTRY2^SCRPTP(.VAUTD,.VAUTT,.VAUTR,.VAUTPS,SCSORT,SCPNTR,SCRUNDT)
101 Q
102 ;
103RPT8(SCDATA,SCQREC,SCPNTR,SCRUNDT) ; -- team's members
104 N VAUTD,VAUTT,VAUTUC,VAUTR,SCRANG
105 D BUILD(.SCQREC,"DIVISION",.VAUTD)
106 D BUILD(.SCQREC,"TEAM",.VAUTT)
107 D BUILD(.SCQREC,"USERCLASS",.VAUTUC)
108 D BUILD(.SCQREC,"ROLE",.VAUTR)
109 S SCRANG=$$RANGE(.SCQREC)
110 S SCDATA(0)=$$ENTRY2^SCRPTM(.VAUTD,.VAUTT,.VAUTUC,.VAUTR,SCRANG,SCPNTR,SCRUNDT)
111 Q
112 ;
113INIT(SCDATE,SCTIME,SCPTR,SCRUNDT,SCPNTR) ; -- setup of general vars
114 N X
115 S SCPNTR="Q;"_SCPTR
116 S X=SCDATE_"."_$TR($TR(SCTIME,":")," ",0)
117 S SCRUNDT=+X
118 Q
119 ;
120BUILD(SCQREC,SCTYPE,VAUT) ; -- build selection array
121 ; is type active
122 IF '$$CHKTYPE^SCRPBK2(SCTYPE) G BUILDQ
123 N SCX
124 S SCX="",SCRT=$$ROOT(SCTYPE)
125 F S SCX=$O(SCQREC("SELECTIONS",SCTYPE,SCX)) Q:SCX="" D
126 . IF $D(@SCRT@(+SCX,0)) S VAUT(+SCX)=$P(^(0),U)
127 IF $O(VAUT(0)) S VAUT=0
128BUILDQ Q
129 ;
130ROOT(SCTYPE) ; -- determine global root for file type
131 N Y
132 IF SCTYPE="DIVISION" S Y="^DIC(4)" G ROOTQ
133 IF SCTYPE="TEAM" S Y="^SCTM(404.51)" G ROOTQ
134 IF SCTYPE="PRACTITIONER" S Y="^VA(200)" G ROOTQ
135 IF SCTYPE="ROLE" S Y="^SD(403.46)" G ROOTQ
136 IF SCTYPE="CLINIC" S Y="^SC" G ROOTQ
137 IF SCTYPE="USERCLASS" S Y="^USR(8930)" G ROOTQ
138ROOTQ Q Y
139 ;
140 ;
141FINDSORT(SCQREC) ; -- find sort selected in report definition
142 N I,SCRPT,SCSORT,SCSORTID
143 S SCSORTID=1
144 S SCRPT=+$G(SCQREC("REPORTID"))
145 S SCSORT=$G(SCQREC("FIELDS","cboSort"))
146 S I=0
147 F S I=$O(^SD(404.92,SCRPT,"SORTS",I)) Q:'I IF $D(^(I,0)),$P(^(0),U)=SCSORT S SCSORTID=I Q
148 Q SCSORTID
149 ;
150YESNO(SCQREC,SCFLD) ; -- determine yes/no field value
151 Q ($G(SCQREC("FIELDS",SCFLD),"NO")="YES")
152 ;
153PSTATUS(SCQREC,SCFLD) ; -- determine pat status to show
154 N VALUE
155 S VALUE=$G(SCQREC("FIELDS",SCFLD))
156 S VALUE=$S(VALUE=""!(VALUE="ALL"):1,1:VALUE)
157 Q VALUE
158 ;
159PASSIGN(SCQREC,SCFLD) ; -- determine if assign patient's is requested
160 Q ($G(SCQREC("FIELDS",SCFLD))="Primary Care")
161 ;
162RANGE(SCQREC) ; -- deterime date range
163 Q $G(SCQREC("FIELDS","txtBeginDate"),DT)_U_$G(SCQREC("FIELDS","txtEndDate"),DT)
164 ;
Note: See TracBrowser for help on using the repository browser.