source: FOIAVistA/trunk/r/CLINICAL_CASE_REGISTRIES-ROR/RORX003.m

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

initial load of FOIAVistA 6/30/08 version
File size: 4.2 KB
Line 
1RORX003 ;HCIOFO/SG - GENERAL UTILIZATION AND DEMOGRAPHICS ; 11/14/06 8:50am
2 ;;1.5;CLINICAL CASE REGISTRIES;**1**;Feb 17, 2006;Build 24
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 N COLUMNS,HEADER,NAME,NOTES,TMP
16 S HEADER=$$HEADER^RORXU002(.RORTSK,PARTAG)
17 Q:HEADER<0 HEADER
18 S NOTES=$$ADDVAL^RORTSK11(RORTSK,"NOTES",,HEADER)
19 D ADDVAL^RORTSK11(RORTSK,"AGE_BASE_DATE",RORAGEDT,NOTES)
20 ;---
21 S COLUMNS=$$ADDVAL^RORTSK11(RORTSK,"TBLDEF",,HEADER)
22 Q:COLUMNS<0 COLUMNS
23 D ADDATTR^RORTSK11(RORTSK,COLUMNS,"HEADER","1")
24 D ADDATTR^RORTSK11(RORTSK,COLUMNS,"FOOTER","1")
25 D ADDATTR^RORTSK11(RORTSK,COLUMNS,"NAME","PATIENTS")
26 S RORFL798=".01",RORFLICR=""
27 ;--- Required columns
28 F NAME="#","NAME" D
29 . S TMP=$$ADDVAL^RORTSK11(RORTSK,"COLUMN",,COLUMNS)
30 . D ADDATTR^RORTSK11(RORTSK,TMP,"NAME",NAME)
31 ;--- SSN or LAST4
32 S NAME=$S($$OPTCOL^RORXU006("SSN"):"SSN",1:"LAST4")
33 S TMP=$$ADDVAL^RORTSK11(RORTSK,"COLUMN",,COLUMNS) Q:TMP<0 TMP
34 D ADDATTR^RORTSK11(RORTSK,TMP,"NAME",NAME)
35 ;--- Optional columns
36 F NAME="DOB","AGE","SEX","RACE","ETHN","RISK","SELDT","CONFDT","UTIL","DOD" D
37 . Q:'$$OPTCOL^RORXU006(NAME)
38 . S TMP=$$ADDVAL^RORTSK11(RORTSK,"COLUMN",,COLUMNS)
39 . D ADDATTR^RORTSK11(RORTSK,TMP,"NAME",NAME)
40 ;---
41 S:$$OPTCOL^RORXU006("CONFDT") RORFL798=RORFL798_";2"
42 S:$$OPTCOL^RORXU006("SELDT") RORFL798=RORFL798_";3.2"
43 Q HEADER
44 ;
45 ;***** COMPILES THE "GENERAL UTLIZATION AND DEMOGRAPHICS" REPORT
46 ; REPORT CODE: 003
47 ;
48 ; .RORTSK Task number and task parameters
49 ;
50 ; Return Values:
51 ; <0 Error code
52 ; 0 Ok
53 ;
54UTLDMG(RORTSK) ;
55 N RORAGEDT ; Base date for age calculations
56 N RORDTE0 ; Beginning of the Date Entered "sliding window"
57 N ROREDT ; End date
58 N RORFL798 ; Fields to load from the file #798
59 N RORFLICR ; Fields to load from the file #799.4
60 N RORREG ; Registry IEN
61 N RORRISK ; Risk factor counters
62 N RORSDT ; Start date
63 N RORSUM ; Summary data
64 N RORUTIL ; Requested utilization types
65 N RORUCNT ; Utilization counters
66 ;
67 N CNT,ECNT,IEN,IENS,PARAMS,PATIENTS,RC,REPORT,RORPTN,SFLAGS,TMP,XREFNODE
68 ;--- Root node of the report
69 S REPORT=$$ADDVAL^RORTSK11(RORTSK,"REPORT")
70 Q:REPORT<0 REPORT
71 ;
72 ;=== Get and prepare the report parameters
73 S RORREG=$$PARAM^RORTSK01("REGIEN")
74 S PARAMS=$$PARAMS^RORXU002(.RORTSK,REPORT,.RORSDT,.ROREDT,.SFLAGS)
75 Q:PARAMS<0 PARAMS
76 ;--- Default set of columns for the summary-only report
77 S XREFNODE=$NA(RORTSK("PARAMS","OPTIONAL_COLUMNS","C"))
78 I $$PARAM^RORTSK01("OPTIONS","SUMMARY") D
79 . F TMP="RACE","RISK","AGE","SEX","UTIL" D
80 . . S @XREFNODE@(TMP)=""
81 S:$$OPTCOL^RORXU006("RACE") @XREFNODE@("ETHN")=""
82 ;--- Construct the description of utilization types
83 I '$$PARAM^RORTSK01("UTIL_TYPES","ALL") D
84 . M RORUTIL=RORTSK("PARAMS","UTIL_TYPES","C")
85 E S RORUTIL("ALL")=1
86 S TMP=$$OPTXT^RORXU002(.RORUTIL,7980000.019)
87 D ADDVAL^RORTSK11(RORTSK,"UTIL_TYPES",TMP,PARAMS)
88 ;
89 ;=== Initialize constants and variables
90 S RORPTN=$$REGSIZE^RORUTL02(+RORREG) S:RORPTN<0 RORPTN=0
91 S XREFNODE=$NA(^RORDATA(798,"AC",RORREG)),ECNT=0
92 S TMP=$$FMDIFF^XLFDT(ROREDT,RORSDT)
93 S RORAGEDT=$$FMADD^XLFDT(RORSDT,TMP\2)
94 S RORDTE0=$P($$FMTE^XLFDT(DT,7),"/")-10 ; 10 year "sliding window"
95 ;
96 D
97 . ;=== Report header
98 . S RC=$$HEADER(REPORT) Q:RC<0
99 . ;---
100 . S PATIENTS=$$ADDVAL^RORTSK11(RORTSK,"PATIENTS",,REPORT)
101 . I PATIENTS<0 S RC=+PATIENTS Q
102 . D ADDATTR^RORTSK11(RORTSK,PATIENTS,"TABLE","PATIENTS")
103 . ;=== Browse through the registry records
104 . D TPPSETUP^RORTSK01(95)
105 . S (CNT,IEN,RC)=0
106 . F S IEN=$O(@XREFNODE@(IEN)) Q:IEN'>0 D Q:RC<0
107 . . S TMP=$S(RORPTN>0:CNT/RORPTN,1:"")
108 . . S RC=$$LOOP^RORTSK01(TMP) Q:RC<0
109 . . S IENS=IEN_",",CNT=CNT+1
110 . . ;--- Check if the patient should be skipped
111 . . Q:$$SKIP^RORXU005(IEN,SFLAGS,RORSDT,ROREDT)
112 . . ;--- Process the registry record
113 . . S TMP=$$PATIENT^RORX003A(IENS,PATIENTS)
114 . . I TMP<0 S ECNT=ECNT+1 Q
115 . Q:RC<0
116 . ;
117 . ;=== Report summary
118 . D TPPSETUP^RORTSK01(5)
119 . S RC=$$SUMMARY^RORX003A(REPORT,PATIENTS) Q:RC<0
120 . ;
121 . ;=== Summary only
122 . S TMP=$$PARAM^RORTSK01("OPTIONS","COMPLETE")
123 . D:'TMP UPDVAL^RORTSK11(RORTSK,PATIENTS,,,1)
124 ;
125 ;=== Cleanup
126 Q $S(RC<0:RC,ECNT>0:-43,1:0)
Note: See TracBrowser for help on using the repository browser.