source: FOIAVistA/trunk/r/CLINICAL_CASE_REGISTRIES-ROR/RORRP032.m@ 649

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

initial load of FOIAVistA 6/30/08 version
File size: 6.6 KB
Line 
1RORRP032 ;HCIOFO/SG - RPC: LOCAL DRUG NAMES ; 11/3/05 2:26pm
2 ;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
3 ;
4 ; This routine uses the following IAs:
5 ;
6 ; #4533 ZERO^PSS50 (supported)
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 DRUG NAMES
17 ; RPC: [ROR LIST LOCAL DRUGS]
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 Drug Group. If this parameter is
25 ; defined and greater than zero then only the drugs
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 drugs is returned in the @RESULTS@(0) and
37 ; the subsequent nodes of the global array contain the drugs.
38 ;
39 ; @RESULTS@(0) Number of Local Drugs
40 ;
41 ; @RESULTS@(i) Drug Descriptor
42 ; ^01: IEN in the LOCAL DRUG NAME multiple
43 ; ^02: Local drug name
44 ; ^03: IEN of the local drug
45 ; ^04: Code of the Drug Group
46 ;
47LDLIST(RESULTS,REGIEN,GROUP) ;
48 N GROUPIEN,IENS,IR,RC,RORERRDL,RORMSG,SCR,TMP
49 D CLEAR^RORERR("LDLIST^RORRP032",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 Drug Group
59 . S GROUP=+$G(GROUP)
60 . S GROUPIEN=$S(GROUP>0:$$ITEMIEN^RORUTL09(4,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 drugs
68 S IENS=","_REGIEN_",",TMP="@;.01E;.01I;.02I"
69 D LIST^DIC(798.129,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.129,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 DRUG NAMES
88 ; RPC: [ROR UPDATE LOCAL DRUGS]
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 Drug Group.
96 ;
97 ; If this parameter is equal to 0 then every item of
98 ; the LDLST 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 DRUG NAME multiple.
101 ;
102 ; If this parameter is not zero then it should contain
103 ; a valid group code. All records of the LDLST 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 ; .LDLST( Reference to a local variable that contains
109 ; a list of local drugs
110 ;
111 ; i) Test Descriptor
112 ; ^01: Ignored
113 ; ^02: Ignored
114 ; ^03: IEN of the local drug
115 ; ^04: Code of the Drug 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 ;
126LDLUPD(RESULTS,REGIEN,GROUP,LDLST) ;
127 N DA,DIK,DRUGIEN,ECNT,GROUPIEN,GRPIEN,IENS,IR,LDL,RC,ROOT,RORERRDL,RORFDA,RORLOCK,RORMSG,RORTMP,RORTS,TMP
128 D CLEAR^RORERR("LDLUPD^RORRP032",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 Drug Group
138 . S GROUPIEN=$S($G(GROUP)>0:$$ITEMIEN^RORUTL09(4,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 DRUG NAME multiple
144 S IENS=","_REGIEN_","
145 S RC=$$LOCK^RORLOCK(798.129,IENS)
146 I RC D:RC>0 D RPCSTK^RORERR(.RESULTS,RC) Q
147 . S RC=$$ERROR^RORERR(-11,,,,"the LOCAL DRUG NAME multiple")
148 ;---
149 S RORLOCK(798.129,IENS)=""
150 S ROOT=$$ROOT^DILFD(798.129,IENS,1)
151 ;
152 ;--- Prepare the data
153 S RORTMP=$$ALLOC^RORTMP(.RORTS)
154 S IR="",RC=0
155 F S IR=$O(LDLST(IR)) Q:IR="" D Q:RC<0
156 . ;--- Check if the drug is defined in the DRUG file
157 . S DRUGIEN=+$P(LDLST(IR),U,3)
158 . D ZERO^PSS50(DRUGIEN,,,,,RORTS)
159 . Q:$G(@RORTMP@(0))'>0
160 . ;--- Assign the default Group IEN (if the GROUP is provided)
161 . I GROUPIEN>0 S LDL(GROUPIEN,DRUGIEN)="" Q
162 . ;--- Get IEN of the Drug Group
163 . S TMP=+$P(LDLST(IR),U,4)
164 . S GRPIEN=$$ITEMIEN^RORUTL09(4,REGIEN,TMP)
165 . I GRPIEN'>0 D:GRPIEN<0 Q
166 . . S RC=$$ERROR^RORERR(GRPIEN)
167 . ;--- Create the reference
168 . S LDL(GRPIEN,DRUGIEN)=""
169 D FREE^RORTMP(RORTMP)
170 I RC<0 D ERROR(.RESULTS,RC) Q
171 ;---
172 I GROUPIEN'>0 S GRPIEN="" D
173 . F S GRPIEN=$O(@ROOT@("G",GRPIEN)) Q:GRPIEN="" S LDL(GRPIEN)=""
174 E S LDL(GROUPIEN)=""
175 ;
176 ;--- Update the multiple
177 S IENS="?+1,"_REGIEN_",",ECNT=0
178 S GRPIEN=""
179 F S GRPIEN=$O(LDL(GRPIEN)) Q:GRPIEN="" D
180 . ;--- Delete the old records
181 . S DIK=$$OREF^DILF(ROOT),DA(1)=REGIEN
182 . S DRUGIEN=""
183 . F S DRUGIEN=$O(@ROOT@("G",GRPIEN,DRUGIEN)) Q:DRUGIEN="" D
184 . . S DA=""
185 . . F S DA=$O(@ROOT@("G",GRPIEN,DRUGIEN,DA)) Q:DA="" D ^DIK
186 . ;--- Store the new records
187 . S DRUGIEN=""
188 . F S DRUGIEN=$O(LDL(GRPIEN,DRUGIEN)) Q:DRUGIEN="" D
189 . . S RORFDA(798.129,IENS,.01)=DRUGIEN
190 . . S RORFDA(798.129,IENS,.02)=GRPIEN
191 . . D UPDATE^DIE(,"RORFDA",,"RORMSG")
192 . . I $G(DIERR) D S ECNT=ECNT+1 Q
193 . . . D DBS^RORERR("RORMSG",-9,,,798.129,IENS)
194 ;
195 ;--- Unlock the multiple and check for errors
196 D UNLOCK^RORLOCK(798.129,","_REGIEN_",")
197 I ECNT>0 D RPCSTK^RORERR(.RESULTS,-9) Q
198 ;--- Success
199 S RESULTS(0)=0
200 Q
Note: See TracBrowser for help on using the repository browser.