source: FOIAVistA/trunk/r/CLINICAL_CASE_REGISTRIES-ROR/RORRP031.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: 6.6 KB
Line 
1RORRP031 ;HCIOFO/SG - RPC: LOCAL LAB TEST NAMES ; 2/10/04 8:59am
2 ;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
3 ;
4 ; This routine uses the following IAs:
5 ;
6 ; #91 Access to the LABORATORY TEST file
7 ;
8 Q
9 ;
10 ;***** PROCESSES THE ERROR(S) AND UNLOCKS THE RECORD(S)
11ERROR(RESULTS,RC) ;
12 D RPCSTK^RORERR(.RESULTS,RC)
13 D UNLOCK^RORLOCK(.RORLOCK)
14 Q
15 ;
16 ;***** RETURNS THE LIST OF LOCAL TEST NAMES
17 ; RPC: [ROR LIST LOCAL LAB TESTS]
18 ;
19 ; .RESULTS Reference to a local variable where the results
20 ; are returned to.
21 ;
22 ; REGIEN Registry IEN
23 ;
24 ; [GROUP] Code of the Lab Group. If this parameter is
25 ; defined and greater than zero then only the tests
26 ; associated with this group will be returned.
27 ;
28 ; The ^TMP("DILIST",$J) global node is used by the procedure.
29 ;
30 ; Return Values:
31 ;
32 ; A negative value of the first "^"-piece of the RESULTS(0)
33 ; indicates an error (see the RPCSTK^RORERR procedure for more
34 ; details).
35 ;
36 ; Otherwise, number of lab tests is returned in the @RESULTS@(0)
37 ; and the subsequent nodes of the global array contain the tests.
38 ;
39 ; @RESULTS@(0) Number of Local Tests
40 ;
41 ; @RESULTS@(i) Test Descriptor
42 ; ^01: IEN in the LOCAL TEST NAME multiple
43 ; ^02: Local test name
44 ; ^03: IEN of the local test
45 ; ^04: Code of the Lab Group
46 ;
47LTLIST(RESULTS,REGIEN,GROUP) ;
48 N GROUPIEN,IENS,IR,RC,RORERRDL,RORMSG,SCR,TMP
49 D CLEAR^RORERR("LTLIST^RORRP031",1)
50 K RESULTS S RESULTS=$NA(^TMP("DILIST",$J)) K @RESULTS
51 ;
52 ;--- Check the parameters
53 S RC=0 D I RC<0 D RPCSTK^RORERR(.RESULTS,RC) Q
54 . ;--- Registry IEN
55 . I $G(REGIEN)'>0 D Q
56 . . S RC=$$ERROR^RORERR(-88,,,,"REGIEN",$G(REGIEN))
57 . S REGIEN=+REGIEN
58 . ;--- Code of the Lab Group
59 . S GROUP=+$G(GROUP)
60 . S GROUPIEN=$S(GROUP>0:$$ITEMIEN^RORUTL09(3,REGIEN,GROUP),1:0)
61 . I GROUPIEN<0 D Q
62 . . S RC=$$ERROR^RORERR(GROUPIEN)
63 ;
64 ;--- Compile the screen logic (be careful with naked references)
65 S SCR=""
66 S:GROUPIEN>0 SCR=SCR_"I $P($G(^(0)),U,2)="_GROUPIEN_" "
67 ;--- Get the list of tests
68 S IENS=","_REGIEN_",",TMP="@;.01E;.01I;.02I"
69 D LIST^DIC(798.128,IENS,TMP,"PU",,,,"B",SCR,,,"RORMSG")
70 I $G(DIERR) D D RPCSTK^RORERR(.RESULTS,RC) Q
71 . S RC=$$DBS^RORERR("RORMSG",-9,,,798.128,IENS)
72 ;
73 ;--- Replace the group IEN's with the group code(s)
74 S (IR,RC)=0
75 F S IR=$O(@RESULTS@(IR)) Q:IR'>0 D Q:RC<0
76 . I GROUPIEN>0 S $P(@RESULTS@(IR,0),U,4)=GROUP Q
77 . S TMP=+$P(@RESULTS@(IR,0),U,4)
78 . I TMP'>0 S $P(@RESULTS@(IR,0),U,4)="" Q
79 . S RC=$$ITEMCODE^RORUTL09(TMP)
80 . S:RC>0 $P(@RESULTS@(IR,0),U,4)=RC
81 I RC<0 D RPCSTK^RORERR(.RESULTS,RC) Q
82 ;--- Success
83 S TMP=+$G(^TMP("DILIST",$J,0))
84 K ^TMP("DILIST",$J,0) S @RESULTS@(0)=TMP
85 Q
86 ;
87 ;***** UPDATES THE LIST OF LOCAL TEST NAMES
88 ; RPC: [ROR UPDATE LOCAL LAB TESTS]
89 ;
90 ; .RESULTS Reference to a local variable where the results
91 ; are returned to.
92 ;
93 ; REGIEN Registry IEN
94 ;
95 ; GROUP Code of the Lab Group.
96 ;
97 ; If this parameter is equal to 0 then every item of
98 ; the LTLST must contain a valid group code. If an
99 ; empty list is passed into the RPC then ALL records
100 ; will be deleted from the LOCAL TEST NAME multiple.
101 ;
102 ; If this parameter is not zero then it should contain
103 ; a valid group code. All records of the LTLST will be
104 ; associated with this group. If an empty list is
105 ; passed into the RPC then only records associated
106 ; with this group will be deleted from the multiple.
107 ;
108 ; .LTLST( Reference to a local variable that contains
109 ; a list of local laboratory tests
110 ;
111 ; i) Test Descriptor
112 ; ^01: Ignored
113 ; ^02: Ignored
114 ; ^03: IEN of the local test
115 ; ^04: Code of the Lab Group
116 ; (see also the GROUP parameter)
117 ;
118 ; Return Values:
119 ;
120 ; A negative value of the first "^"-piece of the RESULTS(0)
121 ; indicates an error (see the RPCSTK^RORERR procedure for more
122 ; details).
123 ;
124 ; Otherwise, zero is returned in the RESULTS(0).
125 ;
126LTLUPD(RESULTS,REGIEN,GROUP,LTLST) ;
127 N DA,DIK,ECNT,GROUPIEN,GRPIEN,IENS,IR,LTL,RC,ROOT,RORERRDL,RORFDA,RORLOCK,RORMSG,TMP,TSTIEN
128 D CLEAR^RORERR("LTLUPD^RORRP031",1) K RESULTS
129 S ECNT=0
130 ;
131 ;--- Check the parameters
132 S RC=0 D I RC<0 D RPCSTK^RORERR(.RESULTS,RC) Q
133 . ;--- Registry IEN
134 . I $G(REGIEN)'>0 D Q
135 . . S RC=$$ERROR^RORERR(-88,,,,"REGIEN",$G(REGIEN))
136 . S REGIEN=+REGIEN
137 . ;--- Code of the Lab Group
138 . S GROUPIEN=$S($G(GROUP)>0:$$ITEMIEN^RORUTL09(3,REGIEN,GROUP),1:0)
139 . I GROUPIEN<0 D Q
140 . . S RC=$$ERROR^RORERR(-88,,,,"GROUP",$G(GROUP))
141 . S GROUP=+$G(GROUP)
142 ;
143 ;--- Lock the LOCAL TEST NAME multiple
144 S IENS=","_REGIEN_","
145 S RC=$$LOCK^RORLOCK(798.128,IENS)
146 I RC D:RC>0 D RPCSTK^RORERR(.RESULTS,RC) Q
147 . S RC=$$ERROR^RORERR(-11,,,,"the LOCAL TEST NAME multiple")
148 ;---
149 S RORLOCK(798.128,IENS)=""
150 S ROOT=$$ROOT^DILFD(798.128,IENS,1)
151 ;
152 ;--- Prepare the data
153 S IR="",RC=0
154 F S IR=$O(LTLST(IR)) Q:IR="" D Q:RC<0
155 . ;--- Check if the test is defined in the LABORATORY TEST file
156 . S TSTIEN=+$P(LTLST(IR),U,3)
157 . Q:$$FIND1^DIC(60,,,"`"_TSTIEN,,,"RORMSG")'>0
158 . ;--- Assign the default Group IEN (if the GROUP is provided)
159 . I GROUPIEN>0 S LTL(GROUPIEN,TSTIEN)="" Q
160 . ;--- Get IEN of the Lab Group
161 . S TMP=+$P(LTLST(IR),U,4)
162 . S GRPIEN=$$ITEMIEN^RORUTL09(3,REGIEN,TMP)
163 . I GRPIEN'>0 D:GRPIEN<0 Q
164 . . S RC=$$ERROR^RORERR(GRPIEN)
165 . ;--- Create the reference
166 . S LTL(GRPIEN,TSTIEN)=""
167 I RC<0 D ERROR(.RESULTS,RC) Q
168 ;
169 ;--- Mark the groups to be cleared
170 I GROUPIEN'>0 S GRPIEN="" D
171 . F S GRPIEN=$O(@ROOT@("G",GRPIEN)) Q:GRPIEN="" S LTL(GRPIEN)=""
172 E S LTL(GROUPIEN)=""
173 ;
174 ;--- Update the multiple
175 S IENS="?+1,"_REGIEN_",",ECNT=0
176 S GRPIEN=""
177 F S GRPIEN=$O(LTL(GRPIEN)) Q:GRPIEN="" D
178 . ;--- Delete the old records
179 . S DIK=$$OREF^DILF(ROOT),DA(1)=REGIEN
180 . S TSTIEN=""
181 . F S TSTIEN=$O(@ROOT@("G",GRPIEN,TSTIEN)) Q:TSTIEN="" D
182 . . S DA=""
183 . . F S DA=$O(@ROOT@("G",GRPIEN,TSTIEN,DA)) Q:DA="" D ^DIK
184 . ;--- Store the new records
185 . S TSTIEN=""
186 . F S TSTIEN=$O(LTL(GRPIEN,TSTIEN)) Q:TSTIEN="" D
187 . . S RORFDA(798.128,IENS,.01)=TSTIEN
188 . . S RORFDA(798.128,IENS,.02)=GRPIEN
189 . . D UPDATE^DIE(,"RORFDA",,"RORMSG")
190 . . I $G(DIERR) D S ECNT=ECNT+1 Q
191 . . . D DBS^RORERR("RORMSG",-9,,,798.128,IENS)
192 ;
193 ;--- Unlock the multiple and check for errors
194 D UNLOCK^RORLOCK(798.128,","_REGIEN_",")
195 I ECNT>0 D RPCSTK^RORERR(.RESULTS,-9) Q
196 ;--- Success
197 S RESULTS(0)=0
198 Q
Note: See TracBrowser for help on using the repository browser.