source: FOIAVistA/trunk/r/CLINICAL_CASE_REGISTRIES-ROR/RORRP040.m@ 1208

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

initial load of FOIAVistA 6/30/08 version
File size: 5.4 KB
Line 
1RORRP040 ;HCIOFO/SG - RPC: LOCAL REGISTRY FIELDS ; 8/25/05 12:23pm
2 ;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
3 ;
4 Q
5 ;
6 ;***** LOADS THE LIST OF LOCAL FIELD DEFINITIONS
7 ; RPC: [ROR LIST LOCAL FIELDS]
8 ;
9 ; .RESULTS Reference to a local variable where the results
10 ; are returned to.
11 ;
12 ; REGIEN Registry IEN
13 ;
14 ; FLAGS Flags that control processing:
15 ; I Include inactive field definitions
16 ;
17 ; [LOCK] Lock the local fields before loading the data and
18 ; leave them locked.
19 ;
20 ; Return Values:
21 ;
22 ; A negative value of the first "^"-piece of the RESULTS(0) node
23 ; indicates an error (see the RPCSTK^RORERR procedure for details).
24 ;
25 ; If the local field table cannot be locked then the second
26 ; "^"-piece of the @RESULTS@(0) will be greater than 0 and the
27 ; node will contain the lock descriptor.
28 ;
29 ; @RESULTS@(0) Result Descriptor
30 ; ^01: Number of local fields
31 ; ^02: Lock Descriptor (see the
32 ; ... LOCK^RORLOCK for details)
33 ;
34 ; The subsequent nodes will contain local field definitions.
35 ;
36 ; See the description of the ROR LIST LOCAL FIELDS remote procedure
37 ; for more details.
38 ;
39LFLIST(RESULTS,REGIEN,FLAGS,LOCK) ;
40 N CNT,IEN,IENS,LOCKRC,NAME,RC,ROOT,RORBUF,RORERRDL,RORMSG,TMP
41 D CLEAR^RORERR("LFLIST^RORRP040",1)
42 K RESULTS S RESULTS=$$ALLOC^RORTMP()
43 ;
44 ;=== Check the parameters
45 S RC=0 D I RC<0 D RPCSTK^RORERR(.RESULTS,RC) Q
46 . ;--- Registry IEN
47 . I $G(REGIEN)'>0 D Q
48 . . S RC=$$ERROR^RORERR(-88,,,,"REGIEN",$G(REGIEN))
49 . S REGIEN=+REGIEN
50 . ;--- Flags
51 . S FLAGS=$G(FLAGS)
52 ;
53 ;=== Lock the ROR LOCAL FIELD file
54 I $G(LOCK) D I LOCKRC<0 D RPCSTK^RORERR(.RESULTS,LOCKRC) Q
55 . S LOCKRC=$$LOCK^RORLOCK(799.53)
56 ;
57 ;=== Load the list of field definitions
58 S DT=$$DT^XLFDT
59 S ROOT=$$ROOT^DILFD(799.53,,1)
60 S NAME="",(CNT,RC)=0
61 F S NAME=$O(@ROOT@("KEY",REGIEN,NAME)) Q:NAME="" D Q:RC<0
62 . S IEN=0
63 . F S IEN=$O(@ROOT@("KEY",REGIEN,NAME,IEN)) Q:IEN'>0 D Q:RC<0
64 . . S IENS=IEN_"," K RORBUF,RORMSG
65 . . D GETS^DIQ(799.53,IENS,".01;.02;1","I","RORBUF","RORMSG")
66 . . I $G(DIERR) S RC=$$DBS^RORERR("RORMSG",-9,,,798.53) Q
67 . . ;--- Skip inactive field definition if necessary
68 . . I FLAGS'["I" D I TMP>0 Q:TMP'>DT
69 . . . S TMP=+$G(RORBUF(799.53,IENS,.02,"I"))
70 . . ;--- Add the definition to the list
71 . . S CNT=CNT+1,RORBUF=IEN
72 . . S $P(RORBUF,U,2)=$G(RORBUF(799.53,IENS,.01,"I"))
73 . . S $P(RORBUF,U,3)=$G(RORBUF(799.53,IENS,.02,"I"))
74 . . S $P(RORBUF,U,4)=$G(RORBUF(799.53,IENS,1,"I"))
75 . . S @RESULTS@(CNT)=RORBUF
76 I RC<0 D RPCSTK^RORERR(.RESULTS,RC) Q
77 ;
78 ;=== Success
79 S @RESULTS@(0)=CNT_U_$G(LOCKRC)
80 Q
81 ;
82 ;***** UPDATES THE LIST OF LOCAL FIELD DEFINITIONS
83 ; RPC: [ROR UPDATE LOCAL FIELDS]
84 ;
85 ; .RESULTS Reference to a local variable
86 ;
87 ; REGIEN Registry IEN
88 ;
89 ; [CANCEL] Cancel the update and unlock the local fields
90 ;
91 ; [.LFLST] Reference to a local variable that contains
92 ; a list of local fields
93 ; .LFLST(
94 ;
95 ; i) Local Field Descriptor
96 ; ^01: IEN
97 ; ^02: Name
98 ; ^03: Inactivation Date (FileMan)
99 ; ^04: Description
100 ;
101 ; See the description of the ROR UPDATE LOCAL FIELDS remote procedure
102 ; for more details.
103 ;
104 ; Return Values:
105 ;
106 ; A negative value of the first "^"-piece of the RESULTS(0) node
107 ; indicates an error (see the RPCSTK^RORERR procedure for details).
108 ;
109 ; Otherwise, zero is returned in the RESULTS(0).
110 ;
111LFLUPD(RESULTS,REGIEN,CANCEL,LFLST) ;
112 N ECNT,I,IEN,RC,RORERRDL,TMP
113 K RESULTS
114 D CLEAR^RORERR("LFLUPD^RORRP040",1)
115 S (ECNT,RC)=0
116 ;
117 ;=== Check the parameters
118 S RC=0 D I RC<0 D RPCSTK^RORERR(.RESULTS,RC) Q
119 . ;--- Registry IEN
120 . I $G(REGIEN)'>0 D Q
121 . . S RC=$$ERROR^RORERR(-88,,,,"REGIEN",$G(REGIEN))
122 . S REGIEN=+REGIEN
123 . ;--- List of local fields
124 . S I=0
125 . F S I=$O(LFLST(I)) Q:I'>0 D
126 . . S IEN=+$P(LFLST(I),U) S:IEN>0 LFLST("AI",IEN)=I
127 ;
128 D:'$G(CANCEL)
129 . N DA,DIK,IENS,NAME,RORFDA,RORMSG,XREF
130 . ;--- Delete the old records
131 . S DIK=$$ROOT^DILFD(799.53)
132 . S XREF=DIK_"""KEY"","_REGIEN_")"
133 . S NAME=""
134 . F S NAME=$O(@XREF@(NAME)) Q:NAME="" D
135 . . S DA=""
136 . . F S DA=$O(@XREF@(NAME,DA)) Q:DA="" D
137 . . . D:'$D(LFLST("AI",DA)) LVDEL(DA),^DIK
138 . ;--- Store the new records
139 . S NODE=$$CREF^DILF(DIK)
140 . S I=0
141 . F S I=$O(LFLST(I)) Q:I'>0 D
142 . . S IEN=+$P(LFLST(I),U)
143 . . S IENS=$S(IEN'>0:"+1,",$D(@NODE@(IEN)):IEN_",",1:"+1,")
144 . . K RORFDA,RORMSG
145 . . S RORFDA(799.53,IENS,.01)=$P(LFLST(I),U,2) ; NAME
146 . . S RORFDA(799.53,IENS,.02)=$P(LFLST(I),U,3) ; DATE OF INACTIV.
147 . . S RORFDA(799.53,IENS,.03)=REGIEN ; REGISTRY
148 . . S RORFDA(799.53,IENS,1)=$P(LFLST(I),U,4) ; DESCRIPTION
149 . . I $E(IENS,1)="+" D
150 . . . D UPDATE^DIE(,"RORFDA",,"RORMSG")
151 . . E D FILE^DIE(,"RORFDA","RORMSG")
152 . . I $G(DIERR) D S ECNT=ECNT+1
153 . . . D DBS^RORERR("RORMSG",-9,,,799.53,IENS)
154 ;
155 ;=== Unlock the file and check for errors
156 D UNLOCK^RORLOCK(799.53)
157 I ECNT>0 D RPCSTK^RORERR(.RESULTS,-9) Q
158 ;--- Success
159 S RESULTS(0)=0
160 Q
161 ;
162 ;***** DELETES THE LOCAL FIELD FROM THE PATIENTS' RECORDS
163 ;
164 ; LFIEN IEN of the local field (file #799.53)
165 ;
166LVDEL(LFIEN) ;
167 N DA,DIK,XREF
168 S XREF=$$ROOT^DILFD(798)_"""ALF"","_LFIEN_")"
169 S DA(1)=""
170 F S DA(1)=$O(@XREF@(DA(1))) Q:DA(1)="" D
171 . S DA="",DIK=$$ROOT^DILFD(798.02,","_DA(1)_",")
172 . F S DA=$O(@XREF@(DA(1),DA)) Q:DA="" D ^DIK
173 Q
Note: See TracBrowser for help on using the repository browser.