1 | TMGRPC1A ;TMG/kst-RPC Functions ;2/11/10, 6/19/10
|
---|
2 | ;;1.0;TMG-LIB;**1**;2/11/10
|
---|
3 | ;
|
---|
4 | ;"TMG RPC FUNCTIONS
|
---|
5 | ;
|
---|
6 | ;"Copyright Kevin Toppenberg MD
|
---|
7 | ;"Released under GNU General Public License (GPL)
|
---|
8 | ;"
|
---|
9 | ;"=======================================================================
|
---|
10 | ;" RPC -- Public Functions.
|
---|
11 | ;"=======================================================================
|
---|
12 | ;"SETINIVL(RESULT,SECTION,KEY,VALUE) ;Entry point for TMG INIFILE SET
|
---|
13 | ;"GETINIVL(RESULT,SECTION,KEY,DEFAULT) ;Entry point for TMG INIFILE GET
|
---|
14 | ;
|
---|
15 | ;"=======================================================================
|
---|
16 | ;"PRIVATE API FUNCTIONS
|
---|
17 | ;"=======================================================================
|
---|
18 | ;
|
---|
19 | ;"=======================================================================
|
---|
20 | ;"=======================================================================
|
---|
21 | ;"Dependencies:
|
---|
22 | ;" DIC, TMGDEBUG
|
---|
23 | ;"=======================================================================
|
---|
24 | ;"=======================================================================
|
---|
25 | ;
|
---|
26 | SETINIVL(RESULT,SECTION,KEY,VALUE) ;
|
---|
27 | ;"SCOPE: Public
|
---|
28 | ;"RPC that calls this: TMG INIFILE SET
|
---|
29 | ;"Purpose: To provide an entry point for a RPC call from a client. The client
|
---|
30 | ;" will use this instead of TIniFile object in Delphi.
|
---|
31 | ;" Note: Since all data are of type string in Mumps, this will work only with strings.
|
---|
32 | ;" and type casting will have to take place in client.
|
---|
33 | ;"Input: RESULT -- an OUT PARAMETER. See output below.
|
---|
34 | ;" SECTION -- String of 'Section' to store setting in (corresponds to section in TIniFile)
|
---|
35 | ;" KEY -- String of Key value. (corresponds to Ident/Key in TIniFile)
|
---|
36 | ;" VALUE -- String of Value to set
|
---|
37 | ;"Note: Because this is a shared resource, it is expected that the client will use
|
---|
38 | ;" User.Name as the Section value.
|
---|
39 | ;" Also, any prior value will be overwritten.
|
---|
40 | ;"Output: Will return RESULT="1^Success", or -1^Error Message"
|
---|
41 | SET RESULT="1^Success"
|
---|
42 | IF $GET(SECTION)="" SET RESULT="-1^No value passed for SECTION" QUIT
|
---|
43 | IF $GET(KEY)="" SET RESULT="-1^No value passed for KEY" QUIT
|
---|
44 | SET VALUE=$GET(VALUE)
|
---|
45 | NEW X,Y,DIC,IEN,IEN2
|
---|
46 | SET DIC=22710,DIC(0)="LM" ;"Find SECTION if previously added.
|
---|
47 | SET X=SECTION
|
---|
48 | DO ^DIC SET IEN=+Y
|
---|
49 | IF IEN'>0 DO ;"For some reason LAYGO doesn't work when called by RPC
|
---|
50 | . NEW TMGFDA,TMGIEN,TMGMSG
|
---|
51 | . SET TMGFDA(22710,"+1,",.01)=SECTION
|
---|
52 | . DO UPDATE^DIE("E","TMGFDA","TMGIEN","TMGMSG")
|
---|
53 | . IF $DATA(TMGMSG("DIERR")) DO QUIT
|
---|
54 | . . SET RESULT="-1^"_$$GetErrStr^TMGDEBUG(.TMGMSG)
|
---|
55 | . SET IEN=+$GET(TMGIEN(1))
|
---|
56 | IF +RESULT=-1 GOTO SIDN
|
---|
57 | IF IEN'>0 SET RESULT="-1^Error establishing SECTION: ["_SECTION_"]" QUIT
|
---|
58 | SET DA(1)=IEN,DIC(0)="LM",DIC="^TMG(22710,"_IEN_",1,"
|
---|
59 | SET X=KEY
|
---|
60 | DO ^DIC SET IEN2=+Y
|
---|
61 | IF IEN2'>0 DO ;"For some reason LAYGO sometimes doesn't work when called by RPC
|
---|
62 | . NEW TMGFDA,TMGIEN,TMGMSG
|
---|
63 | . SET TMGFDA(22710.01,"+1,"_IEN_",",.01)=KEY
|
---|
64 | . DO UPDATE^DIE("E","TMGFDA","TMGIEN","TMGMSG")
|
---|
65 | . IF $DATA(TMGMSG("DIERR")) DO QUIT
|
---|
66 | . . SET RESULT="-1^"_$$GetErrStr^TMGDEBUG(.TMGMSG)
|
---|
67 | . SET IEN2=+$GET(TMGIEN(1))
|
---|
68 | IF +RESULT=-1 GOTO SIDN
|
---|
69 | IF IEN2'>0 SET RESULT="-1^Error establishing KEY: ["_KEY_"]" QUIT
|
---|
70 | NEW TMGFDA,TMGMSG
|
---|
71 | IF VALUE="" SET VALUE="@"
|
---|
72 | SET TMGFDA(22710.01,IEN2_","_IEN_",",1)=VALUE
|
---|
73 | DO FILE^DIE("E","TMGFDA","TMGMSG")
|
---|
74 | IF $DATA(TMGMSG("DIERR")) DO GOTO SIDN
|
---|
75 | . SET RESULT="-1^"_$$GetErrStr^TMGDEBUG(.TMGMSG)
|
---|
76 | SIDN QUIT
|
---|
77 | ;
|
---|
78 | ;
|
---|
79 | GETINIVL(RESULT,SECTION,KEY,DEFAULT) ;
|
---|
80 | ;"SCOPE: Public
|
---|
81 | ;"RPC that calls this: TMG INIFILE GET
|
---|
82 | ;"Purpose: To provide an entry point for a RPC call from a client. The client
|
---|
83 | ;" will use this instead of TIniFile object in Delphi.
|
---|
84 | ;" Note: Since all data are of type string in Mumps, this will work only with strings.
|
---|
85 | ;" and type casting will have to take place in client.
|
---|
86 | ;"Input: RESULT -- an OUT PARAMETER. See output below.
|
---|
87 | ;" SECTION -- String of 'Section' to store setting in (corresponds to section in TIniFile)
|
---|
88 | ;" KEY -- String of Key value. (corresponds to Ident/Key in TIniFile)
|
---|
89 | ;" DEFAULT -- The value to be returned, if no value found.
|
---|
90 | ;"Note: Because this is a shared resource, it is expected that the client will use
|
---|
91 | ;" User.Name as the Section value.
|
---|
92 | ;" Also, any prior value will be overwritten.
|
---|
93 | ;"Output: Will return RESULT="1^<Value>", or -1^Error Message"
|
---|
94 | IF $GET(SECTION)="" SET RESULT="-1^No value passed for SECTION" QUIT
|
---|
95 | IF $GET(KEY)="" SET RESULT="-1^No value passed for KEY" QUIT
|
---|
96 | SET DEFAULT=$GET(DEFAULT)
|
---|
97 | NEW X,Y,DIC,IEN,IEN2
|
---|
98 | SET DIC=22710,X=SECTION
|
---|
99 | DO ^DIC SET IEN=+Y
|
---|
100 | IF IEN'>0 SET RESULT="1^"_DEFAULT QUIT
|
---|
101 | SET DA(1)=IEN,DIC="^TMG(22710,"_IEN_",1,"
|
---|
102 | SET X=KEY
|
---|
103 | DO ^DIC SET IEN2=+Y
|
---|
104 | IF IEN2'>0 SET RESULT="1^"_DEFAULT QUIT
|
---|
105 | NEW VALUE SET VALUE=$GET(^TMG(22710,IEN,1,IEN2,1),DEFAULT)
|
---|
106 | IF VALUE'=DEFAULT SET VALUE=$PIECE(VALUE,"^",1)
|
---|
107 | SET RESULT="1^"_VALUE
|
---|
108 | QUIT
|
---|
109 | ;
|
---|
110 | ;
|
---|
111 | CONVERT
|
---|
112 | ;"Purpose: A temp function to convert between the old storage method and the new.
|
---|
113 | ;"Data was stored in: ^TMG("INIDATA",Section,Key,Vaue)
|
---|
114 | NEW SECTION,KEY,VALUE
|
---|
115 | SET SECTION=""
|
---|
116 | FOR SET SECTION=$ORDER(^TMG("INIDATA",SECTION)) QUIT:(SECTION="") DO
|
---|
117 | . SET KEY=""
|
---|
118 | . FOR SET KEY=$ORDER(^TMG("INIDATA",SECTION,KEY)) QUIT:(KEY="") DO
|
---|
119 | . . SET VALUE=$GET(^TMG("INIDATA",SECTION,KEY))
|
---|
120 | . . NEW RESULT
|
---|
121 | . . DO SETINIVL(.RESULT,SECTION,KEY,VALUE) ;
|
---|
122 | . . IF +RESULT>0 KILL ^TMG("INIDATA",SECTION,KEY) QUIT
|
---|
123 | . . WRITE "Error trying to store SECTION=",SECTION,"; KEY=",KEY,"; VALUE=",VALUE,!
|
---|
124 | . . WRITE " -- ",$PIECE(RESULT,"^",2),!
|
---|
125 | QUIT
|
---|
126 | ;
|
---|
127 | ;
|
---|
128 | INSTALL ;
|
---|
129 | ;"Purpose: to add the RPC's to the OPTION record OR CPRS GUI CHART
|
---|
130 | NEW DIC,X,Y,DA
|
---|
131 | SET DIC="^DIC(19,",DIC(0)="M"
|
---|
132 | SET X="OR CPRS GUI CHART"
|
---|
133 | DO ^DIC
|
---|
134 | IF +Y'>0 DO QUIT
|
---|
135 | . WRITE "ERROR. Unable to find [OR CPRS GUI CHART] in file OPTION (#19)",!
|
---|
136 | . NEW TEMP READ "Press [ENTER] to continue...",TEMP:($GET(DTIME,3600))
|
---|
137 | . WRITE !
|
---|
138 | SET DA(1)=+Y
|
---|
139 | SET DIC=DIC_DA(1)_",""RPC"","
|
---|
140 | SET DIC(0)="ML" ;"LAYGO --> add entry if not found
|
---|
141 | SET X="TMG INIFILE GET"
|
---|
142 | DO ^DIC
|
---|
143 | IF +Y'>0 DO
|
---|
144 | . WRITE "ERROR. Unable to add or find TMG INIFILE GET for subfile RPC in record",!
|
---|
145 | . WRITE "OR CPRS GUI CHART in file OPTION (#19)",!
|
---|
146 | . NEW TEMP READ "Press [ENTER] to continue...",TEMP:($GET(DTIME,3600))
|
---|
147 | . WRITE !
|
---|
148 | SET X="TMG INIFILE SET"
|
---|
149 | DO ^DIC
|
---|
150 | IF +Y'>0 DO
|
---|
151 | . WRITE "ERROR. Unable to add or find TMG INIFILE SET for subfile RPC in record",!
|
---|
152 | . WRITE "OR CPRS GUI CHART in file OPTION (#19)",!
|
---|
153 | . NEW TEMP READ "Press [ENTER] to continue...",TEMP:($GET(DTIME,3600))
|
---|
154 | . WRITE !
|
---|
155 | QUIT
|
---|
156 | ; |
---|