source: WorldVistAEHR/trunk/r/CLINICAL_CASE_REGISTRIES-ROR/RORUTL08.m@ 789

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

initial load of WorldVistAEHR
File size: 5.6 KB
RevLine 
[613]1RORUTL08 ;HCIOFO/SG - REPORT PARAMETERS UTILITIES ; 11/21/05 5:08pm
2 ;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
3 ;
4 Q
5 ;
6 ;***** RETURNS CODE AND NAME OF THE REPORT PARAMETERS (#799.34)
7 ;
8 ; RPIEN IEN of the report parameters
9 ; [.NAME] Report name is returned via this parameter
10 ;
11 ; Return Values:
12 ; "" Code is not available
13 ; Code of the report
14 ;
15RPCODE(RPIEN,NAME) ;
16 S NAME="" Q:RPIEN'>0 ""
17 N BUF
18 S BUF=$G(^ROR(799.34,+RPIEN,0)) Q:BUF="" ""
19 S NAME=$P(BUF,U)
20 Q $P(BUF,U,4)
21 ;
22 ;***** RETURNS IEN AND NAME OF THE REPORT PARAMETERS (#799.34)
23 ;
24 ; CODE Code of the report
25 ; [.NAME] Report name is returned via this parameter
26 ;
27 ; Return Values:
28 ; <0 Error code
29 ; >0 IEN of the item
30 ;
31RPIEN(CODE,NAME) ;
32 N RC,RORBUF,RORMSG S NAME=""
33 D FIND^DIC(799.34,,"@;.01","QX",CODE,2,"KEY",,,"RORBUF","RORMSG")
34 Q:$G(DIERR) $$DBS^RORERR("RORMSG",-9,,,799.34)
35 S RC=+$G(RORBUF("DILIST",0))
36 S:RC=1 NAME=$G(RORBUF("DILIST","ID",1,.01))
37 Q $S(RC<1:-86,RC>1:-87,1:+RORBUF("DILIST",2,1))
38 ;
39 ;***** RETURNS REPORT PARAMETERS
40 ;
41 ; CODE Report code
42 ;
43 ; .INFO Reference to a local variable (output):
44 ;
45 ; INFO(
46 ; OFFSET+1) Report Name
47 ; OFFSET+2) Backgr. Processing (0/1)
48 ; OFFSET+3) reserved
49 ; OFFSET+4) Code of the report
50 ; OFFSET+5) Report Parameters IEN
51 ; OFFSET+6) Inactivation Date (FileMan)
52 ; OFFSET+7) National (0/1)
53 ; OFFSET+8) List of parameter panels
54 ; OFFSET+9) Report Builder ($$TAG^ROUTINE)
55 ; OFFSET+10) Default parameters (XML)
56 ; OFFSET+11) Default sorting modes (XML)
57 ; OFFSET+12) Shared Templates (0/1)
58 ;
59 ; [FLAGS] Characters controlling behavior of the function
60 ; (they can be combined):
61 ; E Return external values also (when applicable)
62 ;
63 ; [OFFSET] A number that is added to all subscripts in the
64 ; destination array (by default, it is zero).
65 ;
66 ; Return Values:
67 ; <0 Error code
68 ; 0 Ok
69 ;
70RPINFO(CODE,INFO,FLAGS,OFFSET) ;
71 N BUF,I,IEN,IENS,RC,RORBUF,RORMSG,TMP
72 S FLAGS=$$UP^XLFSTR($G(FLAGS))
73 S OFFSET=$S($G(OFFSET)>0:+OFFSET,1:0)
74 ;--- Clear the output array
75 K:'OFFSET INFO S TMP=$$RPN
76 F I=1:1:TMP S INFO(OFFSET+I)=""
77 ;--- Get the record IEN
78 S IEN=$$RPIEN(CODE) Q:IEN<0 IEN
79 ;--- Load the parameters
80 S IENS=IEN_",",I=$S(FLAGS["E":"EIN",1:"IN")
81 S TMP=".01;.02;.03;.04;.05;.09;1;10.01;11;12"
82 D GETS^DIQ(799.34,IENS,TMP,I,"RORBUF","RORMSG")
83 I $G(DIERR) D Q RC
84 . S RC=$$DBS^RORERR("RORMSG",-9,,,799.34,IENS)
85 ;--- Name
86 S INFO(OFFSET+1)=$G(RORBUF(799.34,IENS,.01,"I"))
87 ;--- Background Processing
88 I $G(RORBUF(799.34,IENS,.02,"I"))'="" D
89 . S INFO(OFFSET+2)=RORBUF(799.34,IENS,.02,"I")
90 ;--- Code of the report
91 S INFO(OFFSET+4)=$G(RORBUF(799.34,IENS,.04,"I"))
92 ;--- Report Parameters IEN
93 S INFO(OFFSET+5)=IEN
94 ;--- Inactivation Date
95 I $G(RORBUF(799.34,IENS,.05,"I"))'="" D
96 . S INFO(OFFSET+6)=RORBUF(799.34,IENS,.05,"I")
97 ;--- National
98 I $G(RORBUF(799.34,IENS,.09,"I"))'="" D
99 . S INFO(OFFSET+7)=RORBUF(799.34,IENS,.09,"I")
100 ;--- List of parameter panels
101 S INFO(OFFSET+8)=$G(RORBUF(799.34,IENS,1,"I"))
102 ;--- Report Builder
103 S INFO(OFFSET+9)=$G(RORBUF(799.34,IENS,10.01,"I"))
104 ;--- Default parameters
105 S I=0,BUF=""
106 F S I=$O(RORBUF(799.34,IENS,11,I)) Q:I'>0 D
107 . S BUF=BUF_$$TRIM^XLFSTR(RORBUF(799.34,IENS,11,I))
108 S:BUF'="" INFO(OFFSET+10)="<PARAMS>"_BUF_"</PARAMS>"
109 ;--- Default sorting modes
110 S I=0,BUF=""
111 F S I=$O(RORBUF(799.34,IENS,12,I)) Q:I'>0 D
112 . S BUF=BUF_$$TRIM^XLFSTR(RORBUF(799.34,IENS,12,I))
113 S:BUF'="" INFO(OFFSET+11)="<SORT_MODES>"_BUF_"</SORT_MODES>"
114 ;--- Shared Templates
115 S INFO(OFFSET+12)=$G(RORBUF(799.34,IENS,.03,"I"))
116 Q 0
117 ;
118 ;***** RETURNS A LIST OF REPORTS AVAILABLE FOR THE REGISTRY
119 ;
120 ; .ROR8DST Reference to a local variable. Report parameters are
121 ; returned into this array in the following format:
122 ;
123 ; ROR8DST(ReportCode)=ReportIEN^ReportName
124 ;
125 ; [REGIEN] Registry IEN. If $G(REGIEN)>0, both the registry
126 ; specific (REGISTRY=REGIEN) and common (REGISTRY=0)
127 ; reports will be returned. Otherwise, only the common
128 ; ones will be returned.
129 ;
130 ; [CDT] "Current" Date/Time (NOW by default)
131 ;
132 ; If this date/time is equal or later that the
133 ; inactivation date from the record (only if there
134 ; is any) then the record is considered inactive
135 ; and will be skipped.
136 ;
137 ; To include both active and inactive reports in the
138 ; list, pass a negative number as the value of this
139 ; parameter.
140 ;
141 ; Return Values:
142 ; <0 Error code
143 ; 0 Ok
144 ;
145RPLIST(ROR8DST,REGIEN,CDT) ;
146 N CODE,I,IEN,IENS,NAME,INCTVDT,RC,RORMSG,RPLST
147 K ROR8DST S RC=0 S:'$G(CDT) CDT=$$NOW^XLFDT
148 ;--- Load the list of available reports (report codes)
149 S IENS=(+REGIEN)_","
150 S RPLST=$$GET1^DIQ(798.1,IENS,27,,,"RORMSG")
151 Q:$G(DIERR) $$DBS^RORERR("RORMSG",-9,,,798.1,IENS)
152 S RPLST=$TR(RPLST," ")
153 ;--- Load the report parameters
154 F I=1:1 S CODE=$P(RPLST,",",I) Q:CODE="" D Q:RC<0
155 . S IEN=$$RPIEN(CODE,.NAME) Q:IEN'>0
156 . S IENS=IEN_","
157 . ;--- Skip inactive report parameters
158 . S INCTVDT=$$GET1^DIQ(799.34,IENS,.05,"I",,"RORMSG")
159 . I $G(DIERR) D Q
160 . . S RC=$$DBS^RORERR("RORMSG",-9,,,799.34,IENS)
161 . I INCTVDT>0 Q:CDT'<INCTVDT
162 . ;--- Create a record in the destination array
163 . S ROR8DST(CODE)=IEN_U_NAME
164 Q $S(RC<0:RC,1:0)
165 ;
166 ;***** RETURNS NUMBER OF NODES IN THE PARAMETERS ARRAY
167RPN() Q 12
Note: See TracBrowser for help on using the repository browser.