source: FOIAVistA/tag/r/CLINICAL_CASE_REGISTRIES-ROR/RORX005.m@ 628

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

initial load of FOIAVistA 6/30/08 version
File size: 3.7 KB
Line 
1RORX005 ;HCIOFO/BH,SG - INPATIENT UTILIZATION ; 10/14/05 1:53pm
2 ;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
3 ;
4 Q
5 ;
6 ;***** OUTPUTS THE REPORT HEADER
7 ;
8 ; PARTAG Reference (IEN) to the parent tag
9 ;
10 ; Return Values:
11 ; <0 Error code
12 ; >0 IEN of the HEADER element
13 ;
14HEADER(PARTAG) ;
15 ;;HU_DAYS(#,NAME,LAST4,NST,ND,NSS)
16 ;;HU_STAYS(#,NAME,LAST4,NST,ND,NSS)
17 ;;BEDSECTIONS(#,NAME,NP,NST,ND,MLOS,NSS)
18 ;;NOBS(#,NAME,LAST4,DATE,PTF)
19 ;;STAYS(NP,NST)
20 ;
21 N HEADER,RC
22 S HEADER=$$HEADER^RORXU002(.RORTSK,PARTAG)
23 Q:HEADER<0 HEADER
24 S RC=$$TBLDEF^RORXU002("HEADER^RORX005",HEADER)
25 Q $S(RC<0:RC,1:HEADER)
26 ;
27 ;
28 ;***** COMPILES THE "INPATIENT UTILIZATION" REPORT
29 ; REPORT CODE: 005
30 ;
31 ; .RORTSK Task number and task parameters
32 ;
33 ; The ^TMP("RORX005",$J) global node is used by this function.
34 ;
35 ; ^TMP("RORX005",$J,
36 ;
37 ; "IP", Number of inpatients
38 ; DFN, Last 4 digits of SSN
39 ; "D") Number of days
40 ; "S") Number of overnight stays
41 ; "V") Number of short stays
42 ;
43 ; "IPB",
44 ;# BedSectID,
45 ; "D") Number of days
46 ; "P", Number of patients
47 ; DFN)
48 ; "S") Number of overnight stays
49 ; "V") Number of short stays
50 ; "B",
51 ; BedSectName,
52 ;% BedSectID)
53 ;
54 ; "IPD", Total number of days
55 ; NumOfDays, Number of patients
56 ; PatientName,
57 ; DFN)
58 ;
59 ; "IPMLOS", Median Length Of Stay
60 ;* BedSectID, Median Length Of Stay
61 ; NumOfDays,
62 ; Seq#)
63 ;
64 ; "IPNOBS",
65 ; PatientName,
66 ; Date,
67 ; PTF#,
68 ; DFN)
69 ;
70 ; "IPS", Total number of stays
71 ; NumOfStays, Number of patients
72 ; PatientName,
73 ; DFN)
74 ;
75 ; "IPV") Total number of short stays
76 ;
77 ; Bed section IDs (BedSectID):
78 ; -1 No bed section [#%*]
79 ; 0 Whole patient's stays [ *]
80 ; >0 Bed section ID (IEN;File#) [# *]
81 ;
82 ; Return Values:
83 ; <0 Error code
84 ; 0 Ok
85 ;
86IPUTL(RORTSK) ;
87 N ROREDT ; End date
88 N RORREG ; Registry IEN
89 N RORSDT ; Start date
90 ;
91 N ECNT,RC,REPORT,SFLAGS,TMP
92 S (ECNT,RC)=0
93 K ^TMP("RORX005",$J)
94 ;--- Root node of the report
95 S REPORT=$$ADDVAL^RORTSK11(RORTSK,"REPORT")
96 Q:REPORT<0 REPORT
97 ;
98 ;--- Get and prepare the report parameters
99 S RORREG=$$PARAM^RORTSK01("REGIEN")
100 S RC=$$PARAMS(REPORT,.RORSDT,.ROREDT,.SFLAGS) Q:RC<0 RC
101 ;
102 ;--- Report header
103 S RC=$$HEADER(REPORT) Q:RC<0 RC
104 ;
105 D
106 . ;--- Query the registry
107 . D TPPSETUP^RORTSK01(70)
108 . S RC=$$QUERY^RORX005A(SFLAGS)
109 . I RC Q:RC<0 S ECNT=ECNT+RC
110 . ;--- Sort the data
111 . D TPPSETUP^RORTSK01(15)
112 . S RC=$$SORT^RORX005B()
113 . I RC Q:RC<0 S ECNT=ECNT+RC
114 . ;--- Store the results
115 . D TPPSETUP^RORTSK01(15)
116 . S RC=$$STORE^RORX005C(REPORT)
117 . I RC Q:RC<0 S ECNT=ECNT+RC
118 ;
119 ;--- Cleanup
120 K ^TMP("RORX005",$J)
121 Q $S(RC<0:RC,ECNT>0:-43,1:0)
122 ;
123 ;***** OUTPUTS THE PARAMETERS TO THE REPORT
124 ;
125 ; PARTAG Reference (IEN) to the parent tag
126 ;
127 ; [.STDT] Start and end dates of the report
128 ; [.ENDT] are returned via these parameters
129 ;
130 ; [.FLAGS] Flags for the $$SKIP^RORXU005 are
131 ; returned via this parameter
132 ;
133 ; Return Values:
134 ; <0 Error code
135 ; >0 IEN of the PARAMETERS element
136 ;
137PARAMS(PARTAG,STDT,ENDT,FLAGS) ;
138 N PARAMS,TMP
139 S PARAMS=$$PARAMS^RORXU002(.RORTSK,PARTAG,.STDT,.ENDT,.FLAGS)
140 Q:PARAMS<0 PARAMS
141 ;--- Process the list of divisions
142 S TMP=$$DIVLST^RORXU006(.RORTSK,PARAMS)
143 Q:TMP<0 TMP
144 ;--- Additional parameters
145 F NAME="MAXUTNUM" D
146 . S TMP=$$PARAM^RORTSK01(NAME)
147 . D:TMP'="" ADDVAL^RORTSK11(RORTSK,NAME,TMP,PARAMS)
148 ;---
149 Q PARAMS
Note: See TracBrowser for help on using the repository browser.