source: FOIAVistA/trunk/r/CLINICAL_CASE_REGISTRIES-ROR/RORX004.m@ 1394

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

initial load of FOIAVistA 6/30/08 version

File size: 4.0 KB
Line 
1RORX004 ;HOIFO/BH,SG - CLINIC FOLLOW UP ; 11/15/05 8:50am
2 ;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
3 ;
4 ; This routine uses the following IAs:
5 ;
6 ; #10040 Access to the HOSPITAL LOCATION file (supported)
7 ; #10061 2^VADPT (supported)
8 ;
9 Q
10 ;
11 ;***** COMPILES THE "CLINIC FOLLOW UP" REPORT
12 ; REPORT CODE: 004
13 ;
14 ; .RORTSK Task number and task parameters
15 ;
16 ; Return Values:
17 ; <0 Error code
18 ; 0 Ok
19 ;
20CLNFLWUP(RORTSK) ;
21 N ROREDT ; End date
22 N RORREG ; Registry IEN
23 N RORSDT ; Start date
24 ;
25 N CNT,ECNT,IEN,IENS,PATIENTS,RC,REPORT,RORPTN,SFLAGS,TMP,XREFNODE
26 ;--- Root node of the report
27 S REPORT=$$ADDVAL^RORTSK11(RORTSK,"REPORT")
28 Q:REPORT<0 REPORT
29 ;
30 ;--- Get and prepare the report parameters
31 S RORREG=$$PARAM^RORTSK01("REGIEN")
32 S RC=$$PARAMS(REPORT,.RORSDT,.ROREDT,.SFLAGS)
33 Q:RC<0 RC
34 ;
35 ;--- Initialize constants and variables
36 S RORPTN=$$REGSIZE^RORUTL02(+RORREG) S:RORPTN<0 RORPTN=0
37 S ECNT=0,XREFNODE=$NA(^RORDATA(798,"AC",RORREG))
38 ;
39 D
40 . ;--- Report header
41 . S RC=$$HEADER(REPORT) Q:RC<0
42 . S PATIENTS=$$ADDVAL^RORTSK11(RORTSK,"PATIENTS",,REPORT)
43 . I PATIENTS<0 S RC=+PATIENTS Q
44 . D ADDATTR^RORTSK11(RORTSK,PATIENTS,"TABLE","PATIENTS")
45 . ;
46 . ;--- Browse through the registry records
47 . D TPPSETUP^RORTSK01(100)
48 . S (CNT,IEN,RC)=0
49 . F S IEN=$O(@XREFNODE@(IEN)) Q:IEN'>0 D Q:RC<0
50 . . S TMP=$S(RORPTN>0:CNT/RORPTN,1:"")
51 . . S RC=$$LOOP^RORTSK01(TMP) Q:RC<0
52 . . S IENS=IEN_",",CNT=CNT+1
53 . . ;--- Check if the patient should be skipped
54 . . Q:$$SKIP^RORXU005(IEN,SFLAGS,RORSDT,ROREDT)
55 . . ;--- Process the registry record
56 . . S TMP=$$PATIENT(IENS,PATIENTS)
57 . . I TMP<0 S ECNT=ECNT+1 Q
58 . Q:RC<0
59 ;
60 ;--- Cleanup
61 Q $S(RC<0:RC,ECNT>0:-43,1:0)
62 ;
63 ;***** OUTPUTS THE REPORT HEADER
64 ;
65 ; PARTAG Reference (IEN) to the parent tag
66 ;
67 ; Return Values:
68 ; <0 Error code
69 ; 0 Ok
70 ;
71HEADER(PARTAG) ;
72 ;;PATIENTS(#,NAME,LAST4,DOD,SEEN,LSNDT)
73 ;
74 N HEADER,RC
75 S HEADER=$$HEADER^RORXU002(.RORTSK,PARTAG)
76 Q:HEADER<0 HEADER
77 S RC=$$TBLDEF^RORXU002("HEADER^RORX004",HEADER)
78 Q $S(RC<0:RC,1:HEADER)
79 ;
80 ;***** OUTPUTS THE PARAMETERS TO THE REPORT
81 ;
82 ; PARTAG Reference (IEN) to the parent tag
83 ;
84 ; [.STDT] Start and end dates of the report
85 ; [.ENDT] are returned via these parameters
86 ;
87 ; [.FLAGS] Flags for the $$SKIP^RORXU005 are
88 ; returned via this parameter
89 ;
90 ; Return Values:
91 ; <0 Error code
92 ; >0 IEN of the PARAMETERS element
93 ;
94PARAMS(PARTAG,STDT,ENDT,FLAGS) ;
95 N PARAMS,TMP
96 S PARAMS=$$PARAMS^RORXU002(.RORTSK,PARTAG,.STDT,.ENDT,.FLAGS)
97 Q:PARAMS<0 PARAMS
98 ;--- Process the list of clinics
99 S TMP=$$CLINLST^RORXU006(.RORTSK,PARAMS)
100 Q:TMP<0 TMP
101 ;---
102 Q PARAMS
103 ;
104 ;***** ADDS THE PATIENT DATA TO THE REPORT
105 ;
106 ; IENS IENS of the patient's record in the registry
107 ; PARTAG Reference (IEN) to the parent tag
108 ;
109 ; Return Values:
110 ; <0 Error code
111 ; 0 Ok
112 ; >0 Skip the patient
113 ;
114PATIENT(IENS,PARTAG) ;
115 N CHK,CLINAIDS,DFN,IEN,RC,RORBUF,RORMSG,SEEN,TMP,VA,VADM,VAHOW,VAROOT
116 S RC=0
117 S DFN=$$PTIEN^RORUTL01(+IENS)
118 ;
119 ;--- Only include patients that received utilization if care is true
120 I $$PARAM^RORTSK01("PATIENTS","CAREONLY") D Q:'TMP 1
121 . S CHK("ALL")=""
122 . S TMP=$$UTIL^RORXU003(RORSDT,ROREDT,DFN,.CHK)
123 ;
124 ;--- Select Seen/NotSeen patients
125 S SEEN=$$SEEN^RORXU001(RORSDT,ROREDT,DFN)
126 Q:'$$PARAM^RORTSK01("PATIENTS",$S(SEEN:"SEEN",1:"NOTSEEN")) 1
127 ;
128 ;--- Load the demographic data
129 D 2^VADPT
130 ;
131 ;--- The <PATIENT> tag
132 S PTAG=$$ADDVAL^RORTSK11(RORTSK,"PATIENT",,PARTAG,,DFN)
133 Q:PTAG<0 PTAG
134 ;
135 ;--- Patient Name
136 D ADDVAL^RORTSK11(RORTSK,"NAME",VADM(1),PTAG,1)
137 ;--- Last 4 digits of the SSN
138 D ADDVAL^RORTSK11(RORTSK,"LAST4",VA("BID"),PTAG,2)
139 ;--- Date of Death
140 S TMP=$$DATE^RORXU002($P(VADM(6),U)\1)
141 D ADDVAL^RORTSK11(RORTSK,"DOD",TMP,PTAG,1)
142 ;--- Seen/Not Seen
143 D ADDVAL^RORTSK11(RORTSK,"SEEN",SEEN,PTAG,1)
144 ;--- The latest date the patient was seen at any one of
145 ;--- the given clinics
146 S TMP=$$LASTVSIT^RORXU001(DFN)\1
147 D ADDVAL^RORTSK11(RORTSK,"LSNDT",$$DATE^RORXU002(TMP),PTAG,1)
148 Q 0
Note: See TracBrowser for help on using the repository browser.