source: FOIAVistA/trunk/r/CLINICAL_CASE_REGISTRIES-ROR/RORRP014.m@ 770

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

initial load of FOIAVistA 6/30/08 version

File size: 4.5 KB
Line 
1RORRP014 ;HCIOFO/SG - RPC: REGISTRY INFO & PARAMETERS ; 11/14/05 8:31am
2 ;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
3 ;
4 Q
5 ;
6 ;***** RETURNS THE REGISTRY INFORMATION
7 ; RPC: [ROR GET REGISTRY INFO]
8 ;
9 ; .RESULTS Reference to a local variable where the results
10 ; are returned to.
11 ;
12 ; REGISTRY Either a registry IEN or a registry name
13 ;
14 ; Return Values:
15 ;
16 ; A negative value of the first "^"-piece of the RESULTS(0) indicates
17 ; an error (see the RPCSTK^RORERR procedure for more details).
18 ;
19 ; Otherwise, 0 is returned in the RESULTS(0) and the subsequent
20 ; nodes of the RESULTS array contain the registry information.
21 ;
22 ; RESULTS(0) 0
23 ;
24 ; RESULTS(1) Registry
25 ; ^01: IEN
26 ; ^02: Name
27 ;
28 ; RESULTS(2) National (0/1)
29 ;
30 ; RESULTS(3) Registry Description
31 ;
32 ; RESULTS(4) Last registry update date (int)
33 ;
34 ; RESULTS(5) Last data extraction date (int)
35 ;
36 ; RESULTS(6) Number of Active Patients
37 ;
38 ; RESULTS(7) Number of Pending Patients
39 ;
40 ; RESULTS(8) Registry Status
41 ; ^01: Internal value (0-Active, 1-Inactive)
42 ; ^02: External value
43 ;
44 ; RESULTS(9) reserved
45 ;
46 ; RESULTS(10) Version information
47 ; ^01: Package version
48 ; ^02: Latest patch number
49 ; ^03: Date of the latest patch (int)
50 ;
51REGINFO(RESULTS,REGISTRY) ;
52 N IENS,RC,REGIEN,RORBUF,RORERRDL,RORMSG,TMP
53 D CLEAR^RORERR("REGINFO^RORRP014",1)
54 ;--- Check the parameters
55 S TMP=$$UP^XLFSTR($G(REGISTRY)),REGIEN=+TMP
56 I TMP'=REGIEN D:TMP?3.UNP
57 . S REGIEN=$$REGIEN^RORUTL02(TMP)
58 . S:REGIEN<0 TMP=$$ERROR^RORERR(REGIEN)
59 I REGIEN'>0 D D RPCSTK^RORERR(.RESULTS,RC) Q
60 . S RC=$$ERROR^RORERR(-88,,,,"REGISTRY",$G(REGISTRY))
61 ;--- Initialize the variables
62 K RESULTS
63 ;--- Load the registry info
64 S IENS=REGIEN_",",TMP=".01;.09;1;2;4;11;19.1;19.2"
65 D GETS^DIQ(798.1,IENS,TMP,"I","RORBUF","RORMSG")
66 I $G(DIERR) D D RPCSTK^RORERR(.RESULTS,RC) Q
67 . S RC=$$DBS^RORERR("RORMSG",-9,,,798.1,IENS)
68 ;--- Registry IEN and Name
69 S RESULTS(1)=REGIEN_"^"_$G(RORBUF(798.1,IENS,.01,"I"))
70 ;--- National
71 S RESULTS(2)=+$G(RORBUF(798.1,IENS,.09,"I"))
72 ;--- Registry Description
73 S RESULTS(3)=$G(RORBUF(798.1,IENS,4,"I"))
74 ;--- Registry Updated Until
75 S RESULTS(4)=$G(RORBUF(798.1,IENS,1,"I"))
76 ;--- Data Extracted Until
77 S RESULTS(5)=$G(RORBUF(798.1,IENS,2,"I"))
78 ;--- Number of Active Patients
79 S RESULTS(6)=+$G(RORBUF(798.1,IENS,19.1,"I"))
80 ;--- Number of Pending Patients
81 S RESULTS(7)=+$G(RORBUF(798.1,IENS,19.2,"I"))
82 ;--- Registry Status
83 S TMP=+$G(RORBUF(798.1,IENS,11,"I"))
84 S $P(TMP,"^",2)=$$EXTERNAL^DILFD(798.1,11,,TMP,"RORMSG")
85 S RESULTS(8)=TMP
86 ;--- reserved (former Awaiting Acknowledgement)
87 S RESULTS(9)=""
88 ;--- Version information
89 S TMP="CLINICAL CASE REGISTRIES"
90 S RESULTS(10)=$$VERSION^XPDUTL(TMP),TMP=$$LAST^XPDUTL(TMP)
91 S:TMP>0 $P(RESULTS(10),"^",2,3)=+TMP_"^"_$P(TMP,U,2)
92 ;---
93 S RESULTS(0)=0
94 Q
95 ;
96 ;***** RETURNS LIST OF REGISTRY SELECTION RULES
97 ; RPC: [ROR LIST SELECTION RULES]
98 ;
99 ; .RESULTS Reference to a local variable where the results
100 ; are returned to.
101 ;
102 ; REGIEN Registry IEN
103 ;
104 ; See the description of the ROR LIST SELECTION RULES remote
105 ; procedure for more details.
106 ;
107 ; Return Values:
108 ;
109 ; A negative value of the first "^"-piece of the RESULTS(0) node
110 ; indicates an error (see the RPCSTK^RORERR procedure for details).
111 ;
112SELRULES(RESULTS,REGIEN) ;
113 N CNT,IEN,IENS,IRL,RC,RORBUF,RORLST,RORMSG
114 D CLEAR^RORERR("SELRULES^RORRP014",1)
115 K RESULTS S (RESULTS(0),CNT)=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 ;
124 ;=== Load the list of selection rules
125 S IENS=","_REGIEN_","
126 D LIST^DIC(798.13,IENS,"@;.01",,,,,"B",,,"RORLST","RORMSG")
127 I $G(DIERR) D D RPCSTK^RORERR(.RESULTS,RC) Q
128 . S RC=$$DBS^RORERR("RORMSG",-9,,,798.13,IENS)
129 ;
130 ;=== Add rule definitions to the results
131 S IRL=0
132 F S IRL=$O(RORLST("DILIST","ID",IRL)) Q:IRL'>0 D
133 . K RORBUF,RORMSG
134 . S NAME=RORLST("DILIST","ID",IRL,.01)
135 . S IEN=$$SRLIEN^RORUTL02(NAME,".01;4",.RORBUF) Q:IEN'>0
136 . S CNT=CNT+1,RESULTS(CNT)=IEN
137 . S $P(RESULTS(CNT),U,2)=$G(RORBUF("DILIST","ID",1,.01))
138 . S $P(RESULTS(CNT),U,3)=$G(RORBUF("DILIST","ID",1,4))
139 ;
140 ;=== Success
141 S RESULTS(0)=CNT
142 Q
Note: See TracBrowser for help on using the repository browser.