source: cprs/branches/tmg-cprs/m_files/TMGRPC1A.m@ 1381

Last change on this file since 1381 was 896, checked in by Kevin Toppenberg, 14 years ago

replacing soft links with actual files
File size: 7.2 KB
RevLine 
[896]1TMGRPC1A ;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 ;
26SETINIVL(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)
76SIDN QUIT
77 ;
78 ;
79GETINIVL(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 ;
111CONVERT
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;
128INSTALL ;
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 ;
Note: See TracBrowser for help on using the repository browser.