close Warning: Can't use blame annotator: 
svn blame failed on WorldVistAEHR/trunk/r/CLINICAL_CASE_REGISTRIES-ROR/RORHIV03.m: 'GenericSWIGWrapper' object has no attribute '_wrap'

source: WorldVistAEHR/trunk/r/CLINICAL_CASE_REGISTRIES-ROR/RORHIV03.m@ 1073

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

initial load of WorldVistAEHR
File size: 5.9 KB
RevLine 
1RORHIV03 ;HCIOFO/SG - CONVERSION OF THE FILE #158 ; 5/12/05 2:53pm
2 ;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
3 ;
4 Q
5 ;
6 ;***** TRANSFERS THE CDC COMMENTS TO THE MULTIPLE #25
7CDCOMM() ;
8 N CNT,I,IENS,RC,RORBUF,RORFDA,RORMSG,TMP
9 S (CNT,RC)=0
10 ;--- Load the old comments (non-empty ones)
11 F I=3,2,1 D
12 . S TMP=$G(^IMR(158,IMRIEN,I+9))
13 . S:(TMP'="")!CNT RORBUF(I,0)=TMP,CNT=CNT+1
14 ;--- Store the comments in the new word processing field
15 D:$D(RORBUF)>1
16 . S IENS=RORIEN_","
17 . S RORFDA(799.4,IENS,25)="RORBUF"
18 . D UPDATE^DIE(,"RORFDA",,"RORMSG")
19 . I $G(DIERR) D
20 . . S RC=$$DBS^RORERR("RORMSG",-9,,,799.4,IENS)
21 Q $S(RC<0:RC,1:0)
22 ;
23 ;***** TRANSFERS THE PATIENT'S DATA FROM FILE #158 TO FILE #799.4
24 ;
25 ; IMRIEN IEN of the IMMUNOLOGY CASE STUDY file record
26 ; RORIEN IEN of the record of the ROR HIV RECORD file
27 ;
28 ; Return Values:
29 ; <0 Error code
30 ; 0 Ok
31 ;
32CNVPTDAT(IMRIEN,RORIEN) ;
33 N DA,DIK,RC,RORNODE,TMP
34 S RORNODE=""
35 ;--- Check the parameters
36 I '$D(^IMR(158,IMRIEN,0)) D Q RC
37 . S RC=$$ERROR^RORERR(-88,,,,"IMRIEN",IMRIEN)
38 I '$D(^RORDATA(799.4,RORIEN,0)) D Q RC
39 . S RC=$$ERROR^RORERR(-88,,,,"RORIEN",RORIEN)
40 ;---
41 S RORNODE=^RORDATA(799.4,RORIEN,0)
42 D COPY(0,"42>2,23>3")
43 D COPY(1,"7>4")
44 I $P(RORNODE,U,2)=4 D ; CLINICAL AIDS
45 . S $P(RORNODE,U,2)=1,TMP=$P(RORNODE,U,3)\1
46 . I TMP<1000000 S $P(RORNODE,U,3)="" Q
47 . S:'$E(TMP,4,5) $E(TMP,4,5)="01"
48 . S:'$E(TMP,6,7) $E(TMP,6,7)="01"
49 . S $P(RORNODE,U,3)=TMP
50 E S $P(RORNODE,U,2,3)=U
51 D STORE(0)
52 ;---
53 D COPY(1,"6>1,34>5,9>9,10>10,11>11,12>12,13>13,14>14")
54 D COPY(2,"16>4")
55 D COPY(102,"8>7,23>8")
56 D COPY(110,"1>2,2>3")
57 D COPY(112,"5>6")
58 D STORE(9)
59 ;---
60 D COPY(102,"19>5")
61 D COPY(110,"4>1,5>4")
62 D COPY(112,"7>2,8>3")
63 D STORE(11)
64 ;---
65 D COPY(1,"16>2,17>3,18>4")
66 D COPY(2,"54>1")
67 D COPY(102,"10>7")
68 D COPY(110,"16>5")
69 D COPY(112,"6>6")
70 D STORE(12)
71 ;---
72 D COPY(1,"26>3,20>6,28>7,29>8,30>9,31>10,32>12,21>13,22>14,23>15,24>17")
73 D TRANSL(1,19,5,"1,2,3","1,2,8")
74 D COPY(2,"21>1,23>2,53>4,55>18")
75 D COPY(102,"14>16")
76 D COPY(110,"3>11")
77 D STORE(14)
78 ;---
79 D COPY(1,"35>1,36>9")
80 D COPY(2,"49>5"),TRANSL(2,50,7,"P,N,I,U","1,0,8,9")
81 D COPY(102,"20>11")
82 D COPY(108,"27>2,28>6,29>8,30>12")
83 D COPY(110,"17>3,18>4,19>13,20>14")
84 D STORE(16)
85 ;---
86 D COPY(111,"10>1,11>2,12>3,13>4,14>5,1>6,2>7,3>8,4>9")
87 D STORE(18)
88 ;---
89 D COPY(102,"21>1,22>3")
90 D COPY(108,"31>2")
91 D COPY(111,"5>4,6>5,7>6,8>7,9>8")
92 D STORE(20)
93 ;---
94 D COPY(110,"6>1,7>2,8>4,9>5,10>6,11>7,12>8")
95 D COPY(112,"11>3")
96 D STORE(22)
97 ;---
98 D TRANSL(110,13,1,"1,2,9","1,0,9")
99 D TRANSL(110,14,2,"1,2,9","1,0,9")
100 D TRANSL(110,15,3,"1,2,9","1,0,9")
101 D COPY(112,"1>4,2>5,3>6,4>7")
102 D STORE(23)
103 ;---
104 S RC=$$INIDIAGS() Q:RC<0 RC
105 S RC=$$CDCOMM() Q:RC<0 RC
106 ;--- Reindex the entry
107 S DIK="^RORDATA(799.4,",DA=RORIEN D IX1^DIK
108 Q 0
109 ;
110 ;***** COPY THE FIELD DATA
111COPY(SRCN,PTLIST) ;
112 N DSTP,I,SRCP,TMP
113 S:'$D(RORNODE(SRCN)) RORNODE(SRCN)=$G(^IMR(158,IMRIEN,SRCN))
114 F I=1:1 S TMP=$P(PTLIST,",",I) Q:TMP="" D
115 . S SRCP=+$P(TMP,">"),DSTP=+$P(TMP,">",2)
116 . S TMP=$P(RORNODE(SRCN),U,SRCP)
117 . S:TMP'="" $P(RORNODE,U,DSTP)=TMP
118 Q
119 ;
120 ;***** TRANSFER INITIAL DIAGNOSES
121INIDIAGS() ;
122 ;;01^2;24^108;1
123 ;;02^2;25^108;2
124 ;;03^102;15^108;3
125 ;;04^2;26^108;4
126 ;;05^2;27^108;5
127 ;;06^2;28^108;6
128 ;;07^2;29^108;7
129 ;;08^2;30^108;8
130 ;;09^2;31^108;9
131 ;;10^2;32^108;10
132 ;;11^2;33^108;11
133 ;;12^2;34^108;12
134 ;;13^2;35^108;13
135 ;;14^1;36^108;14
136 ;;15^2;37^108;15
137 ;;16^2;38^108;16
138 ;;17^2;39^108;17
139 ;;18^102;16^108;18
140 ;;19^2;40^108;19
141 ;;20^2;41^108;20
142 ;;21^2;42^108;21
143 ;;22^102;17^108;22
144 ;;23^2;43^108;23
145 ;;24^2;44^108;24
146 ;;25^2;45^108;25
147 ;;26^2;46^108;26
148 ;
149 N BUF,DATE,DIAG,DIEN,I,IENS,RC,RORFDA,RORILST,RORMSG,TMP
150 K ^RORDATA(799.4,RORIEN,10) S RC=0
151 ;--- Load the old data nodes (if they have not been loaded yet)
152 F I=2,102,108 D:'$D(RORNODE(I))
153 . S RORNODE(I)=$G(^IMR(158,IMRIEN,I))
154 ;--- Prepare the data
155 F I=1:1 S BUF=$P($T(INIDIAGS+I),";;",2,99) Q:BUF="" D
156 . S DIEN=+BUF
157 . S TMP=$P(BUF,U,2),DX=$P(RORNODE(+TMP),U,$P(TMP,";",2))
158 . S DX=$TR(DX,"DPN0","12") Q:DX=""
159 . S TMP=$P(BUF,U,3),DATE=$P(RORNODE(+TMP),U,$P(TMP,";",2))
160 . ;---
161 . S IENS="+"_I_","_RORIEN_","
162 . S RORFDA(799.41,IENS,.01)=DIEN
163 . S RORFDA(799.41,IENS,.02)=DX
164 . S RORFDA(799.41,IENS,.03)=DATE
165 . S RORILST(I)=DIEN
166 ;--- Store the data
167 D:$D(RORFDA)>1
168 . D UPDATE^DIE(,"RORFDA","RORILST","RORMSG")
169 . I $G(DIERR) D Q
170 . . S RC=$$DBS^RORERR("RORMSG",-9,,,799.41)
171 ;---
172 Q $S(RC<0:RC,1:0)
173 ;
174 ;***** TEMPORARY 'AFTER UPDATE' CALL-BACK ENTRY POINT
175 ;
176 ; RORIEN An IEN of the newly added registry record
177 ; PATIEN Patient IEN
178 ; REGIEN Registry IEN
179 ;
180 ; Return Values:
181 ; <0 Error Code
182 ; 0 Ok
183 ;
184POSTUPD(RORIEN,PATIEN,REGIEN) ;
185 N CODE,IEN158,IENS,RC,RORFDA,RORMSG,TMP
186 ;--- Perform the standard HIV post-update actions
187 S RC=$$POSTUPD^RORUPD62(RORIEN,PATIEN,REGIEN) Q:RC<0 RC
188 ;--- Check if the patient is in the ICR v2.1
189 S CODE=$$XOR^RORUTL03(PATIEN)
190 S IEN158=$O(^IMR(158,"B",CODE,"")) Q:IEN158'>0 0
191 S IENS=RORIEN_","
192 ;--- Populate the DATE ENTERED with the date of first selection rule
193 S TMP=$$GET1^DIQ(798,IENS,3.2,"I",,"RORMSG")
194 D:$G(DIERR) DBS^RORERR("RORMSG",-9,,PATIEN,798,IENS)
195 S:TMP>0 RORFDA(798,IENS,1)=TMP
196 ;--- Convert the patient's data
197 D:$$CNVPTDAT(IEN158,RORIEN)'<0
198 . ;--- Replace the 'Pending' flag with 'Active'
199 . S RORFDA(798,IENS,3)=0 ; STATUS (Pending -> Active)
200 . S RORFDA(798,IENS,11)="@" ; DON'T SEND
201 ;--- Update the registry record if necessary
202 I $D(RORFDA)>1 D Q:RC<0 RC
203 . D FILE^DIE(,"RORFDA","RORMSG")
204 . S:$G(DIERR) RC=$$DBS^RORERR("RORMSG",-9,,PATIEN,798,IENS)
205 ;---
206 Q 0
207 ;
208 ;***** CREATES THE NEW DATA NODE IN THE RECORD OF THE FILE #799.4
209STORE(DSTN) ;
210 K ^RORDATA(799.4,RORIEN,DSTN)
211 S:RORNODE'="" ^RORDATA(799.4,RORIEN,DSTN)=RORNODE
212 S RORNODE=""
213 Q
214 ;
215 ;***** TRANSLATE THE SET OF CODES
216TRANSL(SRCN,SRCP,DSTP,FROM,TO) ;
217 N TMP
218 S:'$D(RORNODE(SRCN)) RORNODE(SRCN)=$G(^IMR(158,IMRIEN,SRCN))
219 S TMP=$P(RORNODE(SRCN),U,SRCP)
220 S:TMP'="" $P(RORNODE,U,DSTP)=$TR(TMP,FROM,TO)
221 Q
Note: See TracBrowser for help on using the repository browser.