source: WorldVistAEHR/trunk/r/CLINICAL_CASE_REGISTRIES-ROR/RORX001.m@ 699

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

initial load of WorldVistAEHR

File size: 5.6 KB
Line 
1RORX001 ;HCIOFO/SG - LIST OF REGISTRY PATIENTS ; 9/15/05 2:13pm
2 ;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
3 ;
4 ; This routine uses the following IAs:
5 ;
6 ; #10061 DEM^VADPT (supported)
7 ;
8 Q
9 ;
10 ;***** OUTPUTS THE REPORT HEADER
11 ;
12 ; PARTAG Reference (IEN) to the parent tag
13 ;
14 ; Return Values:
15 ; <0 Error code
16 ; 0 Ok
17 ;
18HEADER(PARTAG) ;
19 N COL,COLUMNS,HEADER,TMP
20 S HEADER=$$HEADER^RORXU002(.RORTSK,PARTAG)
21 S COLUMNS=$$ADDVAL^RORTSK11(RORTSK,"TBLDEF",,HEADER)
22 D ADDATTR^RORTSK11(RORTSK,COLUMNS,"NAME","PATIENTS")
23 D ADDATTR^RORTSK11(RORTSK,COLUMNS,"HEADER","1")
24 D ADDATTR^RORTSK11(RORTSK,COLUMNS,"FOOTER","1")
25 S RORFLDS=".01"
26 ;--- Required columns
27 F COL="#","NAME" D
28 . S TMP=$$ADDVAL^RORTSK11(RORTSK,"COLUMN",,COLUMNS)
29 . D ADDATTR^RORTSK11(RORTSK,TMP,"NAME",COL)
30 ;--- Additional columns
31 F COL="DOD","CSSN","LAST4","SELRULES","SELDT","CONFDT" D
32 . Q:'$$OPTCOL^RORXU006(COL)
33 . S TMP=$$ADDVAL^RORTSK11(RORTSK,"COLUMN",,COLUMNS)
34 . D ADDATTR^RORTSK11(RORTSK,TMP,"NAME",COL)
35 ;---
36 S:$$OPTCOL^RORXU006("CONFDT") RORFLDS=RORFLDS_";2"
37 S:$$OPTCOL^RORXU006("SELDT") RORFLDS=RORFLDS_";3.2"
38 Q 0
39 ;
40 ;***** ADDS THE PATIENT DATA TO THE REPORT
41 ;
42 ; IENS IENS of the patient's record in the registry
43 ; PARTAG Reference (IEN) to the parent tag
44 ;
45 ; Return Values:
46 ; <0 Error code
47 ; 0 Ok
48 ;
49PATIENT(IENS,PARTAG) ;
50 N DFN,IATIME,NAME,RC,RORBUF,RORMSG,TMP,VA,VADM,VAHOW,VAROOT
51 D GETS^DIQ(798,IENS,RORFLDS,"I","RORBUF","RORMSG")
52 Q:$G(DIERR) $$DBS^RORERR("RORMSG",-9,,,798,IENS)
53 S DFN=$G(RORBUF(798,IENS,.01,"I"))
54 ;--- Load the demographic data
55 D DEM^VADPT
56 ;--- The <PATIENT> tag
57 S PTAG=$$ADDVAL^RORTSK11(RORTSK,"PATIENT",,PARTAG,,DFN)
58 ;--- Patient Name
59 D ADDVAL^RORTSK11(RORTSK,"NAME",VADM(1),PTAG,1)
60 ;--- Date of Death
61 D:$$OPTCOL^RORXU006("DOD")
62 . S TMP=$$DATE^RORXU002(VADM(6)\1)
63 . D ADDVAL^RORTSK11(RORTSK,"DOD",TMP,PTAG,1)
64 ;--- Coded SSN
65 D:$$OPTCOL^RORXU006("CSSN")
66 . S TMP=$$XOR^RORUTL03($P(VADM(2),U))
67 . D ADDVAL^RORTSK11(RORTSK,"CSSN",TMP,PTAG,1)
68 ;--- Last 4 digits of the SSN
69 D:$$OPTCOL^RORXU006("LAST4")
70 . D ADDVAL^RORTSK11(RORTSK,"LAST4",VA("BID"),PTAG,2)
71 ;--- Selection Rules
72 I $$OPTCOL^RORXU006("SELRULES") D Q:RC<0 RC
73 . S RC=$$SELRULES(IENS,PTAG)
74 ;--- Date Selected for the Registry
75 D:$$OPTCOL^RORXU006("SELDT")
76 . S TMP=$$DATE^RORXU002($G(RORBUF(798,IENS,3.2,"I"))\1)
77 . D ADDVAL^RORTSK11(RORTSK,"SELDT",TMP,PTAG,1)
78 ;--- Date Confirmed in the Registry
79 D:$$OPTCOL^RORXU006("CONFDT")
80 . S TMP=$$DATE^RORXU002($G(RORBUF(798,IENS,2,"I"))\1)
81 . D ADDVAL^RORTSK11(RORTSK,"CONFDT",TMP,PTAG,1)
82 ;--- Patient IEN (DFN)
83 ;S:$$OPTCOL^RORXU006("DFN") TMP=$$ADDVAL^RORTSK11(RORTSK,"DFN",DFN,PTAG)
84 ;--- Integration Control Number
85 ;D:$$OPTCOL^RORXU006("ICN")
86 ;. S TMP=$$ICN^RORUTL02(DFN)
87 ;. D ADDVAL^RORTSK11(RORTSK,"ICN",$P(TMP,"V"),PTAG,1)
88 Q 0
89 ;
90 ;***** COMPILES A LIST OF REGISTRY PATIENTS
91 ; REPORT CODE: 001
92 ;
93 ; .RORTSK Task number and task parameters
94 ;
95 ; Return Values:
96 ; <0 Error code
97 ; 0 Ok
98 ;
99REGPTLST(RORTSK) ;
100 N RORFLDS ; Fields to load from the file #798
101 N RORPTN ; Number of patients in the registry
102 N RORREG ; Registry IEN
103 ;
104 N BODY,CNT,ECNT,IEN,IENS,MODE,PTNAME,RC,REPORT,SFLAGS,TMP,XREFNODE
105 ;--- Root node of the report
106 S REPORT=$$ADDVAL^RORTSK11(RORTSK,"REPORT")
107 Q:REPORT<0 REPORT
108 ;
109 ;--- Get and prepare the report parameters
110 S RORREG=$$PARAM^RORTSK01("REGIEN")
111 S RC=$$PARAMS^RORXU002(.RORTSK,REPORT,,,.SFLAGS) Q:RC<0 RC
112 S SFLAGS=$TR(SFLAGS,"DG")
113 S:'$$PARAM^RORTSK01("PATIENTS","CONFIRMED") SFLAGS=SFLAGS_"C"
114 S:'$$PARAM^RORTSK01("PATIENTS","PENDING") SFLAGS=SFLAGS_"G"
115 D ADDVAL^RORTSK11(RORTSK,"TYPE",SFLAGS,REPORT)
116 ;
117 ;--- Initialize constants and variables
118 S RORPTN=$$REGSIZE^RORUTL02(+RORREG) S:RORPTN<0 RORPTN=0
119 S ECNT=0,XREFNODE=$NA(^RORDATA(798,"ARP",RORREG_"#"))
120 ;
121 ;--- The report header and list of patients
122 S RC=$$HEADER(REPORT) Q:RC<0 RC
123 S BODY=$$ADDVAL^RORTSK11(RORTSK,"PATIENTS",,REPORT)
124 D ADDATTR^RORTSK11(RORTSK,BODY,"TABLE","PATIENTS")
125 Q:BODY<0 BODY
126 ;
127 ;--- Browse through the registry records
128 S PTNAME="",(CNT,RC)=0
129 F S PTNAME=$O(@XREFNODE@(PTNAME)) Q:PTNAME="" D Q:RC<0
130 . S IEN=0
131 . F S IEN=$O(@XREFNODE@(PTNAME,IEN)) Q:IEN'>0 D Q:RC<0
132 . . S TMP=$S(RORPTN>0:CNT/RORPTN,1:"")
133 . . S RC=$$LOOP^RORTSK01(TMP) Q:RC<0
134 . . S IENS=IEN_",",CNT=CNT+1
135 . . ;--- Check if the patient should be skipped
136 . . Q:$$SKIP^RORXU005(IEN,SFLAGS)
137 . . ;--- Process the registry record
138 . . I $$PATIENT(IENS,BODY)<0 S ECNT=ECNT+1 Q
139 ;---
140 Q $S(RC<0:RC,ECNT>0:-43,1:0)
141 ;
142 ;***** ADDS THE SELECTION RULES TO THE REPORT
143 ;
144 ; IENS IENS of the patient's record in the registry
145 ; PARTAG Reference (IEN) to the parent tag
146 ;
147 ; Return Values:
148 ; <0 Error code
149 ; 0 Ok
150 ;
151SELRULES(IENS,PARTAG) ;
152 N CNT,I,RORBUF,RORMSG,RT,SRLTAG,TMP
153 ;--- Load the list of selection rules
154 D LIST^DIC(798.01,","_IENS,"@;.01I;1I",,,,,"B",,,"RORBUF","RORMSG")
155 Q:$G(DIERR) $$DBS^RORERR("RORMSG",-9,,,798.01,IENS)
156 ;--- The <SELRULES> ... </SELRULES> tags
157 S SRLTAG=$$ADDVAL^RORTSK11(RORTSK,"SELRULES",,PARTAG)
158 ;--- Add the selection rules to the report
159 S I="",CNT=0
160 F S I=$O(RORBUF("DILIST","ID",I)) Q:I="" D
161 . S RT=$$ADDVAL^RORTSK11(RORTSK,"RULE",,SRLTAG),CNT=CNT+1
162 . S TMP=$G(RORBUF("DILIST","ID",I,.01))
163 . S TMP=$$GET1^DIQ(798.2,TMP_",",4,,,"RORMSG")
164 . Q:$G(DIERR)!(TMP="")
165 . D ADDATTR^RORTSK11(RORTSK,RT,"DESCR",TMP)
166 . S TMP=$$DATE^RORXU002($G(RORBUF("DILIST","ID",I,1))\1)
167 . D:TMP'="" ADDATTR^RORTSK11(RORTSK,RT,"DATE",TMP)
168 ;--- Add the default item if no selection rules have been found
169 D:CNT'>0
170 . S RT=$$ADDVAL^RORTSK11(RORTSK,"RULE",,SRLTAG)
171 . D ADDATTR^RORTSK11(RORTSK,RT,"DESCR","Manual Entry")
172 Q 0
Note: See TracBrowser for help on using the repository browser.