source: FOIAVistA/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORWRP16.m@ 1607

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

initial load of FOIAVistA 6/30/08 version

File size: 5.6 KB
Line 
1ORWRP16 ; ALB/MJK Report Calls - 16bit ;5/22/97 19:13
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;;Dec 17, 1997
3 ;
4LIST(ROOT) ; -- return lists for list boxes
5 ; RPC: ORWRP REPORT LIST
6 ; See RPC definition for details on input and output parameters
7 ;
8 N EOF
9 S EOF="$$END",ROOT=$NA(^TMP($J,"ORPTLIST"))
10 K @ROOT
11 ;
12 ; -- get list of reports
13 D GETRPTS(.ROOT,.EOF)
14 ; -- get list of health summary types
15 D GETHS(.ROOT,.EOF)
16 ; -- get list of date ranges
17 D GETDT(.ROOT,.EOF)
18 ;
19 Q
20 ;
21GETRPTS(ROOT,EOF) ; -- get list of reports
22 N I,X
23 D SETITEM(.ROOT,"[REPORT LIST]")
24 F I=2:1 S X=$P($T(RPTLIST+I),";",3) D SETITEM(.ROOT,X) Q:X=EOF
25 Q
26 ;
27RPTLIST ; -- list of reports
28 ;<ID> ^ <report name> ^ <ask date range> ^ <ask health summary type> ^ <right margin>
29 ;;1^Health Summary^N^Y^80
30 ;;2^Blood Bank Report^N^N^80
31 ;;3^Anatomic Path Report^N^N^80
32 ;;4^Dietetics Profile^N^N^80
33 ;;5^Vitals Cumulative^Y^N^132
34 ;;6^Vitals SF511^Y^N^132
35 ;;$$END
36 ;
37GETHS(ROOT,EOF) ; --get list of health summary types
38 N I,HSPARM
39 D GETLST^XPAR(.HSPARM,"SYS","ORWRP HEALTH SUMMARY TYPE LIST","N")
40 ;
41 D SETITEM(.ROOT,"[HEALTH SUMMARY TYPES]")
42 S I=0 F S I=$O(HSPARM(I)) Q:'I D SETITEM(.ROOT,HSPARM(I))
43 D SETITEM(.ROOT,EOF)
44 Q
45 ;
46GETDT(ROOT,EOF) ; -- get date range choices
47 N I,X
48 D SETITEM(.ROOT,"[DATE RANGES]")
49 F I=2:1 S X=$P($T(DTLIST+I),";",3) D SETITEM(.ROOT,X) Q:X=EOF
50 Q
51 ;
52DTLIST ; -- list of date ranges
53 ;<number of days>^ <display text>
54 ;;0^Today
55 ;;7^One Week Back
56 ;;14^Two Weeks Back
57 ;;30^One Month Back
58 ;;180^Six Months Back
59 ;;365^One Year Back
60 ;;$$END
61 ;
62SETITEM(ROOT,X) ; -- set item in list
63 S @ROOT@($O(@ROOT@(9999),-1)+1)=X
64 Q
65 ;
66RPT(ROOT,DFN,RPTID,HSTYPE,DTRANGE,SECTION) ; -- return report text
67 ; RPC: ORWRP REPORT TEXT
68 ; See RPC definition for details on input and output parameters
69 ;
70 IF $G(SECTION),$D(^TMP("ORDATA",$J,SECTION)) D G RPTQ
71 . S ROOT=$NA(^TMP("ORDATA",$J,SECTION))
72 ;
73 ; -- init output global for close logic of WORKSTATION device
74 K ^TMP("ORDATA",$J)
75 S ROOT=$NA(^TMP("ORDATA",$J,1))
76 ;
77 ; -- get report text
78 IF RPTID=1 D HS(DFN,HSTYPE) G RPTQ
79 IF RPTID=2 D BL(DFN) G RPTQ
80 IF RPTID=3 D PATH(DFN) G RPTQ
81 IF RPTID=4 D DIET(.ROOT,DFN) G RPTQ
82 IF RPTID=5 D VITALS(DFN,DTRANGE,"VITCUM") G RPTQ
83 IF RPTID=6 D VITALS(DFN,DTRANGE,"VIT511") G RPTQ
84 ;
85 ; -- basic report if id not found above
86 D NOTYET(.ROOT)
87RPTQ Q
88 ;
89HS(ORDFN,ORHS) ; - get health summary report
90 N ZTQUEUED,ORRM,ORHFS,ORSUB,ORIO
91 S ORRM=80,ORHFS=$$HFS(),ORSUB="ORDATA"
92 D OPEN(.ORRM,.ORHFS,"W",.ORIO)
93 ;
94 D HSB(.ORDFN,.ORHS)
95 ;
96 D CLOSE(.ORRM,.ORHFS,.ORSUB,.ORIO)
97 Q
98 ;
99HSB(ORDFN,ORHS) ; - build health summary report
100 N ORVP,GMTYP,Y
101 S ORVP=ORDFN_";DPT("
102 S Y=$P($G(^GMT(142,+ORHS,0)),U)
103 S GMTYP(0)=1,GMTYP(1)=+ORHS_U_Y_U_Y_U_Y
104 D PQ^ORPRS13
105 Q
106 ;
107BL(ORDFN) ; -- get blood bank report
108 N ZTQUEUED,ORRM,ORHFS,ORSUB,ORIO
109 S ORRM=80,ORHFS=$$HFS(),ORSUB="ORDATA"
110 D OPEN(.ORRM,.ORHFS,"W",.ORIO)
111 ;
112 D BLB(.ORDFN)
113 ;
114 D CLOSE(.ORRM,.ORHFS,.ORSUB,.ORIO)
115 Q
116 ;
117BLB(ORDFN) ; -- build blood bank report
118 N DFN
119 ;
120 D SET^LRBLPD1
121 IF $G(OREND)'=1 D
122 . S DFN=ORDFN
123 . D OERR^LRBLPD1
124 . D CLEAN^LRBLPD1
125 Q
126 ;
127PATH(ORDFN) ; -- get anatomic path report
128 N ZTQUEUED,ORRM,ORHFS,ORSUB,ORIO
129 S ORRM=80,ORHFS=$$HFS(),ORSUB="ORDATA"
130 D OPEN(.ORRM,.ORHFS,"W",.ORIO)
131 ;
132 D PATHB(.ORDFN)
133 ;
134 D CLOSE(.ORRM,.ORHFS,.ORSUB,.ORIO)
135 Q
136 ;
137PATHB(ORDFN) ; -- build anatomic path report
138 N DFN
139 ;
140 D SET^LRAPS3
141 IF $G(OREND)'=1 D
142 . S DFN=ORDFN
143 . D OERR^LRAPS3
144 . D CLEAN^LRAPS3
145 Q
146 ;
147DIET(ROOT,DFN) ; -- get dietetics profile
148 D NOTYET(.ROOT)
149 Q
150 ;
151DIETB(DFN) ; -- get dietetics profile
152 W !!,"Dietetics Profile not yet available."
153 Q
154 ;
155VITALS(DFN,DTRANGE,ORTAG) ; -- get vitals report
156 N ZTQUEUED,ORRM,ORHFS,ORSUB,ORIO
157 S ORRM=132,ORHFS=$$HFS(),ORSUB="ORDATA"
158 D OPEN(.ORRM,.ORHFS,"W",.ORIO)
159 ;
160 D VITALSB(.DFN,.DTRANGE,.ORTAG)
161 ;
162 D CLOSE(.ORRM,.ORHFS,.ORSUB,.ORIO)
163 Q
164 ;
165VITALSB(DFN,DTRANGE,ORTAG) ; -- build vitals report
166 N ORVP,XQORNOD,ORSSTRT,ORSSTOP
167 ;
168 S ORVP=DFN_";DPT(",XQORNOD=1
169 S X1=DT
170 ; -- if TODAY then do not substract 1
171 S X2=-$S(DTRANGE:DTRANGE-1,1:0)
172 D C^%DTC
173 S ORSSTRT(XQORNOD)=X-.7641,ORSSTOP(XQORNOD)=DT+.2359
174 D @ORTAG^ORPRS14
175 Q
176 ;
177NOTYET(ROOT) ; -- standard not available display text
178 D SETITEM(.ROOT,"Report not available at this time.")
179 S @ROOT@(.1)="1^1"
180 Q
181 ;
182HFS() ; -- get hfs file name
183 ; -- need to define better unique algorithm
184 Q "ORU_"_$J_".DAT"
185 ;
186OPEN(ORRM,ORHFS,ORMODE,ORIO) ; -- open WORKSTATION device
187 ; ORRM: right margin
188 ; ORHFS: host file name
189 ; ORMODE: open file in 'R'ead or 'W'rite mode
190 S ZTQUEUED="" K IOPAR
191 S IOP="WORKSTATION;"_$G(ORRM,80)
192 S %ZIS("HFSMODE")=ORMODE,%ZIS("HFSNAME")=ORHFS
193 D ^%ZIS K IOP,%ZIS
194 U IO S ORIO=IO
195 Q
196 ;
197CLOSE(ORRM,ORHFS,ORSUB,ORIO) ; -- close WORKSTATION device
198 ; ORSUB: unique subscript name for output
199 IF IO=ORIO D ^%ZISC
200 U IO
201 D USEHFS
202 U IO
203 Q
204USEHFS ; -- use host file to build global array
205 N IO,OROK
206 ; D OPEN^%ZISH(ORSUB,"",ORHFS,"R") I POP Q
207 K ^TMP($J,"ORTMPLST")
208 S OROK=$$FTG^%ZISH(,ORHFS,$NA(^TMP($J,"ORTMPLST",1)),3)
209 D BUILD
210 K ^TMP($J,"ORTMPLST")
211 ; D CLOSE^%ZISH(ORSUB)
212 N ORARR S ORARR(ORHFS)=""
213 S OROK=$$DEL^%ZISH("",$NA(ORARR))
214 Q
215 ;
216BUILD ; -- build tmp global for report
217 N INC,CNT,MAX,SECTION,ROOT,STRIP,LN
218 S SECTION=0,MAX=20000,STRIP=$C(7,12)
219 D INIT
220 ; -- strip out ff's and quit on error
221 S LN=0 F S LN=$O(^TMP($J,"ORTMPLST",LN)) Q:'LN S X=^(LN) D
222 . ;F U IO R X:5 D Q:$$STATUS^%ZISH
223 . I (CNT+250)>MAX D INIT
224 . S X=$TR(X,STRIP,"")
225 . S INC=INC+1,@ROOT@(INC)=X
226 . S CNT=CNT+$L(X)
227 D FINAL
228 Q
229 ;
230INIT ; -- initialize counts and global section
231 S (INC,CNT)=0,SECTION=SECTION+1
232 S ROOT=$NA(^TMP(ORSUB,$J,SECTION))
233 K @ROOT
234 Q
235 ;
236FINAL ; -- set 'x of y' for each section
237 N I
238 F I=1:1:SECTION S ^TMP(ORSUB,$J,I,.1)=I_U_SECTION
239 Q
240 ;
Note: See TracBrowser for help on using the repository browser.