source: FOIAVistA/trunk/r/CLINICAL_CASE_REGISTRIES-ROR/RORX006C.m@ 1504

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

initial load of FOIAVistA 6/30/08 version
File size: 4.2 KB
Line 
1RORX006C ;HCIOFO/BH,SG - LAB UTILIZATION (STORE) ; 9/19/05 9:39am
2 ;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
3 ;
4 Q
5 ;
6 ;***** PATIENTS WITH HIGHEST UTILIZATION
7 ;
8 ; PRNTELMT IEN of the parent element
9 ;
10 ; NODE Closed root of the category section
11 ; in the temporary global
12 ;
13 ; Return Values:
14 ; <0 Error code
15 ; 0 Ok
16 ;
17PATIENTS(PRNTELMT,NODE) ;
18 Q:$D(@NODE@("PAT"))<10 0
19 N COUNT,DFN,ITEM,MAXUTNUM,NAME,NUM,RC,TMP
20 S MAXUTNUM=$$PARAM^RORTSK01("MAXUTNUM")
21 Q:MAXUTNUM'>0 0
22 S TABLE=$$ADDVAL^RORTSK11(RORTSK,"PATIENTS",,PRNTELMT)
23 Q:TABLE<0 TABLE
24 D ADDATTR^RORTSK11(RORTSK,TABLE,"TABLE","PATIENTS")
25 ;---
26 S NUM="",(COUNT,RC)=0
27 F S NUM=$O(@NODE@("RES1",NUM),-1) Q:NUM="" D Q:RC
28 . S NAME=""
29 . F S NAME=$O(@NODE@("RES1",NUM,NAME)) Q:NAME="" D Q:RC
30 . . S DFN=""
31 . . F S DFN=$O(@NODE@("RES1",NUM,NAME,DFN)) Q:DFN="" D Q:RC
32 . . . S COUNT=COUNT+1 I COUNT>MAXUTNUM S RC=1 Q
33 . . . S ITEM=$$ADDVAL^RORTSK11(RORTSK,"PATIENT",,TABLE)
34 . . . D ADDVAL^RORTSK11(RORTSK,"NAME",NAME,ITEM,1)
35 . . . S TMP=$G(@NODE@("PAT",DFN))
36 . . . D ADDVAL^RORTSK11(RORTSK,"LAST4",$P(TMP,U),ITEM,2)
37 . . . D ADDVAL^RORTSK11(RORTSK,"DOD",$P(TMP,U,2),ITEM,1)
38 . . . S TMP=+$G(@NODE@("PAT",DFN,"O"))
39 . . . D ADDVAL^RORTSK11(RORTSK,"NO",TMP,ITEM,3)
40 . . . D ADDVAL^RORTSK11(RORTSK,"NR",NUM,ITEM,3)
41 . . . S TMP=+$P($G(@NODE@("PAT",DFN,"R")),U,2)
42 . . . D ADDVAL^RORTSK11(RORTSK,"NDT",TMP,ITEM,3)
43 Q $S(RC<0:RC,1:0)
44 ;
45 ;***** NUMBERS OF PATIENTS AND RESULTS
46 ;
47 ; PRNTELMT IEN of the parent element
48 ;
49 ; NODE Closed root of the category section
50 ; in the temporary global
51 ;
52 ; Return Values:
53 ; <0 Error code
54 ; 0 Ok
55 ;
56RESULTS(PRNTELMT,NODE) ;
57 Q:$D(@NODE@("RES1"))<10 0
58 N ITEM,NUM,RC,TABLE
59 S TABLE=$$ADDVAL^RORTSK11(RORTSK,"RESULTS",,PRNTELMT)
60 Q:TABLE<0 TABLE
61 D ADDATTR^RORTSK11(RORTSK,TABLE,"TABLE","RESULTS")
62 S NUM="",RC=0
63 F S NUM=$O(@NODE@("RES1",NUM),-1) Q:NUM="" D Q:RC
64 . S ITEM=$$ADDVAL^RORTSK11(RORTSK,"ITEM",,TABLE)
65 . S TMP=+$G(@NODE@("RES1",NUM))
66 . D ADDVAL^RORTSK11(RORTSK,"NP",TMP,ITEM,3)
67 . D ADDVAL^RORTSK11(RORTSK,"NR",NUM,ITEM,3)
68 Q $S(RC<0:RC,1:0)
69 ;
70 ;***** STORES THE REPORT DATA
71 ;
72 ; REPORT IEN of the REPORT element
73 ;
74 ; Return Values:
75 ; <0 Error code
76 ; 0 Ok
77 ; >0 Number of non-fatal errors
78 ;
79STORE(REPORT) ;
80 N RORSONLY ; Output summary only
81 ;
82 N ECNT,NODE,RC,RORI,SUBLST,TMP
83 S RORSONLY=$$SMRYONLY^RORXU006()
84 S (ECNT,RC)=0
85 ;---
86 S NODE=$NA(^TMP("RORX006",$J))
87 Q:$D(@NODE)<10 0
88 ;--- Tables
89 S RC=$$LOOP^RORTSK01(0) Q:RC<0 RC
90 S RC=$$RESULTS(REPORT,NODE)
91 I RC Q:RC<0 RC S ECNT=ECNT+RC
92 ;---
93 S RC=$$LOOP^RORTSK01(1/3) Q:RC<0 RC
94 S RC=$$TESTS(REPORT,NODE)
95 I RC Q:RC<0 RC S ECNT=ECNT+RC
96 ;---
97 S RC=$$LOOP^RORTSK01(2/3) Q:RC<0 RC
98 S RC=$$PATIENTS(REPORT,NODE)
99 I RC Q:RC<0 RC S ECNT=ECNT+RC
100 ;--- Summary
101 D ADDVAL^RORTSK11(RORTSK,"NO",+$G(@NODE@("ORD")),REPORT)
102 S TMP=$G(@NODE@("RES"))
103 D ADDVAL^RORTSK11(RORTSK,"NR",+$P(TMP,U),REPORT)
104 D ADDVAL^RORTSK11(RORTSK,"NDT",+$P(TMP,U,2),REPORT)
105 D ADDVAL^RORTSK11(RORTSK,"NP",+$G(@NODE@("PAT")),REPORT)
106 ;---
107 Q $S(RC<0:RC,1:ECNT)
108 ;
109 ;***** LAB TESTS
110 ;
111 ; PRNTELMT IEN of the parent element
112 ;
113 ; NODE Closed root of the category section
114 ; in the temporary global
115 ;
116 ; Return Values:
117 ; <0 Error code
118 ; 0 Ok
119 ;
120TESTS(PRNTELMT,NODE) ;
121 Q:$D(@NODE@("RES"))<10 0
122 N IEN,ITEM,MINRPNUM,NAME,NUM,RC,TMP
123 S MINRPNUM=$$PARAM^RORTSK01("MINRPNUM")
124 Q:MINRPNUM'>0 0
125 S TABLE=$$ADDVAL^RORTSK11(RORTSK,"LABTESTS",,PRNTELMT)
126 Q:TABLE<0 TABLE
127 D ADDATTR^RORTSK11(RORTSK,TABLE,"TABLE","LABTESTS")
128 ;---
129 S NUM="",RC=0
130 F S NUM=$O(@NODE@("RES","B",NUM),-1) Q:NUM<MINRPNUM D Q:RC
131 . S NAME=""
132 . F S NAME=$O(@NODE@("RES","B",NUM,NAME)) Q:NAME="" D Q:RC
133 . . S IEN=""
134 . . F S IEN=$O(@NODE@("RES","B",NUM,NAME,IEN)) Q:IEN="" D Q:RC
135 . . . S ITEM=$$ADDVAL^RORTSK11(RORTSK,"LT",,TABLE)
136 . . . D ADDVAL^RORTSK11(RORTSK,"NAME",NAME,ITEM,1)
137 . . . S TMP=+$G(@NODE@("RES",IEN,"P"))
138 . . . D ADDVAL^RORTSK11(RORTSK,"NP",TMP,ITEM,3)
139 . . . D ADDVAL^RORTSK11(RORTSK,"NR",NUM,ITEM,3)
140 . . . S TMP=$G(@NODE@("RES",IEN,"M"))
141 . . . D ADDVAL^RORTSK11(RORTSK,"MAXNRPP",+$P(TMP,U),ITEM,3)
142 . . . D ADDVAL^RORTSK11(RORTSK,"MAXNP",+$P(TMP,U,2),ITEM,3)
143 Q $S(RC<0:RC,1:0)
Note: See TracBrowser for help on using the repository browser.