source: FOIAVistA/trunk/r/CLINICAL_CASE_REGISTRIES-ROR/RORX005C.m@ 1611

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

initial load of FOIAVistA 6/30/08 version
File size: 5.6 KB
Line 
1RORX005C ;HCIOFO/BH,SG - INPATIENT UTILIZATION (STORE) ; 9/14/05 9:17am
2 ;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
3 ;
4 Q
5 ;
6 ;***** HIGHEST UTILIZATION
7 ;
8 ; PRNTELMT IEN of the parent element
9 ;
10 ; RORNODE Closed root of the section in the temporary global
11 ;
12 ; Return Values:
13 ; <0 Error code
14 ; 0 Ok
15 ;
16HIGHUTIL(PRNTELMT,RORNODE) ;
17 N RC,RORMAXUT,RORTCNT,SECTION,TMP
18 S RORMAXUT=$$PARAM^RORTSK01("MAXUTNUM")
19 Q:RORMAXUT'>0 0
20 S SECTION=$$ADDVAL^RORTSK11(RORTSK,"HIGHUTIL",,PRNTELMT)
21 Q:SECTION<0 SECTION
22 S (RC,RORTCNT)=0
23 ;--- Stays
24 S RC=$$HIGHUTSD(SECTION,"IPS","HU_STAYS") Q:RC<0 RC
25 ;--- Days
26 S RC=$$HIGHUTSD(SECTION,"IPD","HU_DAYS") Q:RC<0 RC
27 ;--- Disable the empty section
28 D:RORTCNT'>0 UPDVAL^RORTSK11(RORTSK,SECTION,"",,1)
29 Q 0
30 ;
31 ;*****
32 ;
33 ; SECTION IEN of the parent element
34 ;
35 ; SUBS Utilization subscript in the temporary global
36 ;
37 ; TBLNAME Name of the table element
38 ;
39 ; Return Values:
40 ; <0 Error code
41 ; 0 Ok
42 ;
43HIGHUTSD(SECTION,SUBS,TBLNAME) ;
44 Q:$D(@RORNODE@(SUBS))<10 0
45 N COUNT,DFN,ITEM,NAME,NUM,RC,TABLE,TMP
46 S TABLE=$$ADDVAL^RORTSK11(RORTSK,TBLNAME,,SECTION)
47 Q:TABLE<0 TABLE
48 D ADDATTR^RORTSK11(RORTSK,TABLE,"TABLE",TBLNAME)
49 S RORTCNT=RORTCNT+1
50 ;---
51 S NUM="",(COUNT,RC)=0
52 F S NUM=$O(@RORNODE@(SUBS,NUM),-1) Q:NUM="" D Q:RC
53 . S NAME=""
54 . F S NAME=$O(@RORNODE@(SUBS,NUM,NAME)) Q:NAME="" D Q:RC
55 . . S DFN=""
56 . . F S DFN=$O(@RORNODE@(SUBS,NUM,NAME,DFN)) Q:DFN="" D Q:RC
57 . . . S COUNT=COUNT+1 I COUNT>RORMAXUT S RC=1 Q
58 . . . S ITEM=$$ADDVAL^RORTSK11(RORTSK,"PATIENT",,TABLE)
59 . . . D ADDVAL^RORTSK11(RORTSK,"NAME",NAME,ITEM,1)
60 . . . S TMP=$G(@RORNODE@("IP",DFN))
61 . . . D ADDVAL^RORTSK11(RORTSK,"LAST4",$P(TMP,U),ITEM,2)
62 . . . S TMP=+$G(@RORNODE@("IP",DFN,"S"))
63 . . . D ADDVAL^RORTSK11(RORTSK,"NST",TMP,ITEM,3)
64 . . . S TMP=+$G(@RORNODE@("IP",DFN,"D"))
65 . . . D ADDVAL^RORTSK11(RORTSK,"ND",TMP,ITEM,3)
66 . . . S TMP=$G(@RORNODE@("IP",DFN,"V"))
67 . . . D ADDVAL^RORTSK11(RORTSK,"NSS",TMP,ITEM,3)
68 Q 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,TMP
83 S NODE=$NA(^TMP("RORX005",$J))
84 Q:$D(@NODE)<10 0
85 S RORSONLY=$$SMRYONLY^RORXU006(),(ECNT,RC)=0
86 ;--- Inpatients
87 S RC=$$LOOP^RORTSK01(0) Q:RC<0 RC
88 S RC=$$STOREIP(REPORT,NODE)
89 I RC Q:RC<0 RC S ECNT=ECNT+1
90 ;--- Highest utilization
91 S RC=$$LOOP^RORTSK01(0.5) Q:RC<0 RC
92 S RC=$$HIGHUTIL(REPORT,NODE)
93 I RC Q:RC<0 RC S ECNT=ECNT+1
94 ;---
95 Q ECNT
96 ;
97 ;***** INPATIENT DATA
98 ;
99 ; PRNTELMT IEN of the parent element
100 ;
101 ; NODE Closed root of the category section
102 ; in the temporary global
103 ;
104 ; Return Values:
105 ; <0 Error code
106 ; 0 Ok
107 ;
108STOREIP(PRNTELMT,NODE) ;
109 Q:$D(@NODE@("IP"))<10 0
110 N BSID,DATE,ITEM,NAME,NS,PATIEN,PTF,RC,SECTION,TABLE,TMP
111 S SECTION=$$ADDVAL^RORTSK11(RORTSK,"INPATIENTS",,PRNTELMT)
112 Q:SECTION<0 SECTION
113 S RC=0
114 ;--- Stays
115 I $D(@NODE@("IPS"))>1 D Q:RC<0 RC
116 . S TABLE=$$ADDVAL^RORTSK11(RORTSK,"STAYS",,SECTION)
117 . I TABLE<0 S RC=TABLE Q
118 . D ADDATTR^RORTSK11(RORTSK,TABLE,"TABLE","STAYS")
119 . S NS=""
120 . F S NS=$O(@NODE@("IPS",NS)) Q:NS="" D
121 . . S ITEM=$$ADDVAL^RORTSK11(RORTSK,"ITEM",,TABLE)
122 . . D ADDVAL^RORTSK11(RORTSK,"NP",$P(@NODE@("IPS",NS),U),ITEM,3)
123 . . D ADDVAL^RORTSK11(RORTSK,"NST",NS,ITEM,3)
124 ;--- Bed sections (clinics)
125 I $D(@NODE@("IPB"))>1 D Q:RC<0 RC
126 . S TABLE=$$ADDVAL^RORTSK11(RORTSK,"BEDSECTIONS",,SECTION)
127 . I TABLE<0 S RC=TABLE Q
128 . D ADDATTR^RORTSK11(RORTSK,TABLE,"TABLE","BEDSECTIONS")
129 . S NAME=""
130 . F S NAME=$O(@NODE@("IPB","B",NAME)) Q:NAME="" D
131 . . S BSID=""
132 . . F S BSID=$O(@NODE@("IPB","B",NAME,BSID)) Q:BSID="" D:BSID>0
133 . . . S ITEM=$$ADDVAL^RORTSK11(RORTSK,"BEDSECTION",,TABLE)
134 . . . D ADDVAL^RORTSK11(RORTSK,"NAME",NAME,ITEM,1)
135 . . . S TMP=+$G(@NODE@("IPB",BSID,"P"))
136 . . . D ADDVAL^RORTSK11(RORTSK,"NP",TMP,ITEM,3)
137 . . . S TMP=+$G(@NODE@("IPB",BSID,"S"))
138 . . . D ADDVAL^RORTSK11(RORTSK,"NST",TMP,ITEM,3)
139 . . . S TMP=+$G(@NODE@("IPB",BSID,"D"))
140 . . . D ADDVAL^RORTSK11(RORTSK,"ND",TMP,ITEM,3)
141 . . . S TMP=+$G(@NODE@("IPMLOS",BSID))
142 . . . D ADDVAL^RORTSK11(RORTSK,"MLOS",$J(TMP,0,1),ITEM,3)
143 . . . S TMP=$G(@NODE@("IPB",BSID,"V"))
144 . . . D ADDVAL^RORTSK11(RORTSK,"NSS",TMP,ITEM,3)
145 ;--- No bed section
146 I 'RORSONLY,$D(@NODE@("IPNOBS"))>1 D Q:RC<0 RC
147 . S TABLE=$$ADDVAL^RORTSK11(RORTSK,"NOBS",,SECTION)
148 . I TABLE<0 S RC=TABLE Q
149 . D ADDATTR^RORTSK11(RORTSK,TABLE,"TABLE","NOBS")
150 . S NAME=""
151 . F S NAME=$O(@NODE@("IPNOBS",NAME)) Q:NAME="" D
152 . . S DATE=""
153 . . F S DATE=$O(@NODE@("IPNOBS",NAME,DATE)) Q:DATE="" D
154 . . . S PTF=""
155 . . . F S PTF=$O(@NODE@("IPNOBS",NAME,DATE,PTF)) Q:PTF="" D
156 . . . . S DFN=""
157 . . . . F S DFN=$O(@NODE@("IPNOBS",NAME,DATE,PTF,DFN)) Q:DFN="" D
158 . . . . . S ITEM=$$ADDVAL^RORTSK11(RORTSK,"PATIENT",,TABLE)
159 . . . . . D ADDVAL^RORTSK11(RORTSK,"NAME",NAME,ITEM,1)
160 . . . . . S TMP=$P($G(@NODE@("IP",DFN)),U)
161 . . . . . D ADDVAL^RORTSK11(RORTSK,"LAST4",TMP,ITEM,2)
162 . . . . . D ADDVAL^RORTSK11(RORTSK,"DATE",DATE,ITEM,3)
163 . . . . . D ADDVAL^RORTSK11(RORTSK,"PTF",PTF,ITEM,1)
164 ;--- Summary
165 D ADDVAL^RORTSK11(RORTSK,"NP",+$G(@NODE@("IP")),SECTION)
166 D ADDVAL^RORTSK11(RORTSK,"NST",+$G(@NODE@("IPS")),SECTION)
167 D ADDVAL^RORTSK11(RORTSK,"ND",+$G(@NODE@("IPD")),SECTION)
168 D ADDVAL^RORTSK11(RORTSK,"NSS",+$G(@NODE@("IPV")),SECTION)
169 S TMP=$G(@NODE@("IPMLOS",0))
170 D ADDVAL^RORTSK11(RORTSK,"MLOS",$J(TMP,0,1),SECTION)
171 I $G(@NODE@("IPS"))>0 D
172 . S TMP=$G(@NODE@("IPD"))/@NODE@("IPS")
173 E S TMP=0
174 D ADDVAL^RORTSK11(RORTSK,"ALOS",$J(TMP,0,1),SECTION)
175 Q 0
Note: See TracBrowser for help on using the repository browser.