source: FOIAVistA/trunk/r/CLINICAL_CASE_REGISTRIES-ROR/RORX006A.m@ 1203

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

initial load of FOIAVistA 6/30/08 version
File size: 4.1 KB
Line 
1RORX006A ;HCIOFO/BH,SG - LAB UTILIZATION (QUERY & SORT) ; 11/8/05 8:35am
2 ;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
3 ;
4 Q
5 ;
6 ;***** LOADS AND PROCESSES THE LAB DATA
7 ;
8 ; DFN Patient IEN (in file #2)
9 ;
10 ; Return Values:
11 ; <0 Error code
12 ; 0 Ok
13 ; >0 Number of non-fatal errors
14 ;
15LABDATA(DFN) ;
16 N DST,ENDT,NR,PTNO,PTNR,PRNT,RC,TSTIEN
17 S DST=$NA(^TMP("RORX006",$J))
18 ;
19 ;--- Get the data
20 S DST("RORCB")="$$LTSCB^RORX006A",DST("RORIDT")=""
21 S RC=$$LTSEARCH^RORUTL10(DFN,RORLTST,.DST,,RORSDT,ROREDT1)
22 Q:RC<0 RC Q:$D(@DST@("PAT",DFN))<10 0
23 ;
24 ;--- Calculate intermediate totals of the tests
25 S TSTIEN=0,(PTNR,PTNT)=0
26 F S TSTIEN=$O(@DST@("PAT",DFN,"R",TSTIEN)) Q:TSTIEN'>0 D
27 . S NR=+$G(@DST@("PAT",DFN,"R",TSTIEN))
28 . S PTNR=PTNR+NR ; Number of patient's results
29 . S PTNT=PTNT+1 ; Number of different tests
30 . ;---
31 . S @DST@("RES",TSTIEN,"P")=$G(@DST@("RES",TSTIEN,"P"))+1
32 . S @DST@("RES",TSTIEN,"R")=$G(@DST@("RES",TSTIEN,"R"))+NR
33 . ;---
34 . S TMP=$G(@DST@("RES",TSTIEN,"M"))
35 . D:NR'<TMP
36 . . I NR>TMP S @DST@("RES",TSTIEN,"M")=NR_U_1 Q
37 . . S $P(@DST@("RES",TSTIEN,"M"),U,2)=$P(TMP,U,2)+1
38 ;
39 ;--- Orders
40 S @DST@("ORD")=$G(@DST@("ORD"))+$G(@DST@("PAT",DFN,"O"))
41 ;
42 ;--- Results
43 S @DST@("RES1",PTNR)=$G(@DST@("RES1",PTNR))+1
44 S @DST@("RES1",PTNR,RORPNAME,DFN)=""
45 ;
46 ;--- Other totals
47 S @DST@("PAT",DFN)=RORLAST4_U_RORDOD
48 S @DST@("PAT",DFN,"R")=PTNR_U_PTNT
49 S @DST@("PAT")=$G(@DST@("PAT"))+1
50 S @DST@("RES")=$G(@DST@("RES"))+PTNR
51 Q 0
52 ;
53 ;***** LAB SEARCH CALLBACK
54 ;
55 ; .ROR8DST Reference to the ROR8DST parameter.
56 ;
57 ; INVDT IEN of the Lab test (inverted date)
58 ;
59 ; .RESULT Reference to a local variable, which contains
60 ; the result (see the $$LTSEARCH^RORUTL10).
61 ;
62 ; Return Values:
63 ; <0 Error code (the search will be aborted)
64 ; 0 Ok
65 ; 1 Skip this result
66 ; 2 Skip this and all remaining results
67 ;
68LTSCB(ROR8DST,INVDT,RESULT) ;
69 N DFN,TMP,TSTIEN
70 S DFN=+ROR8DST("RORDFN"),TSTIEN=+RESULT(2)
71 ;--- Number of orders
72 I INVDT'=ROR8DST("RORIDT") D S ROR8DST("RORIDT")=INVDT
73 . S @ROR8DST@("PAT",DFN,"O")=$G(@ROR8DST@("PAT",DFN,"O"))+1
74 ;--- Number of results
75 S TMP=$G(@ROR8DST@("PAT",DFN,"R",TSTIEN))
76 S @ROR8DST@("PAT",DFN,"R",TSTIEN)=TMP+1
77 Q 0
78 ;
79 ;***** QUERIES THE REGISTRY
80 ;
81 ; FLAGS Flags for the $$SKIP^RORXU005
82 ;
83 ; Return Values:
84 ; <0 Error code
85 ; 0 Ok
86 ; >0 Number of non-fatal errors
87 ;
88QUERY(FLAGS) ;
89 N RORDOD ; Date of death of the current patient
90 N RORLAST4 ; Last 4 digits of the current patient's SSN
91 N RORPNAME ; Name of the current patient
92 N RORPTN ; Number of patients in the registry
93 ;
94 N CNT,ECNT,IEN,IENS,PATIEN,RC,TMP,VA,VADM,XREFNODE
95 S XREFNODE=$NA(^RORDATA(798,"AC",+RORREG))
96 S RORPTN=$$REGSIZE^RORUTL02(+RORREG) S:RORPTN<0 RORPTN=0
97 S (CNT,ECNT,RC)=0
98 ;
99 ;--- Browse through the registry records
100 S IEN=0
101 F S IEN=$O(@XREFNODE@(IEN)) Q:IEN'>0 D Q:RC<0
102 . S TMP=$S(RORPTN>0:CNT/RORPTN,1:"")
103 . S RC=$$LOOP^RORTSK01(TMP) Q:RC<0
104 . S IENS=IEN_",",CNT=CNT+1
105 . ;--- Check if the patient should be skipped
106 . Q:$$SKIP^RORXU005(IEN,FLAGS,RORSDT,ROREDT)
107 . ;
108 . ;--- Get the patient IEN (DFN)
109 . S PATIEN=$$PTIEN^RORUTL01(IEN) Q:PATIEN'>0
110 . ;
111 . ;--- Get the patient's data
112 . D VADEM^RORUTL05(PATIEN,1)
113 . S RORPNAME=VADM(1),RORLAST4=VA("BID")
114 . S RORDOD=$$DATE^RORXU002($P(VADM(6),U)\1)
115 . ;
116 . ;--- Get the Lab data
117 . S RC=$$LABDATA(PATIEN)
118 . I RC Q:RC<0 S ECNT=ECNT+RC
119 ;---
120 Q $S(RC<0:RC,1:ECNT)
121 ;
122 ;***** SORTS THE RESULTS AND COMPILES THE TOTALS
123 ;
124 ; Return Values:
125 ; <0 Error code
126 ; 0 Ok
127 ; >0 Number of non-fatal errors
128 ;
129SORT() ;
130 N ECNT,IEN,NAME,NDLT,NODE,RC,RORMSG,TMP
131 S NODE=$NA(^TMP("RORX006",$J)),(ECNT,RC)=0
132 ;---
133 S RC=$$LOOP^RORTSK01(0) Q:RC<0 RC
134 Q:$D(@NODE)<10 0
135 ;---
136 S IEN=0,NDLT=0
137 F S IEN=$O(@NODE@("RES",IEN)) Q:IEN'>0 D
138 . S NDLT=NDLT+1
139 . S NAME=$$GET1^DIQ(60,IEN,.01,,,"RORMSG")
140 . D:$G(DIERR) DBS^RORERR("RORMSG",-9,,,60,IEN)
141 . S:NAME?." " NAME="Unknown ("_IEN_")"
142 . S TMP=+$G(@NODE@("RES",IEN,"R"))
143 . S @NODE@("RES","B",TMP,NAME,IEN)=""
144 ;--- Total numbers of Lab tests
145 S $P(@NODE@("RES"),U,2)=NDLT
146 ;---
147 Q $S(RC<0:RC,1:ECNT)
Note: See TracBrowser for help on using the repository browser.