source: cprs/branches/tmg-cprs/m_files/TMGSIPH.m@ 1035

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

replacing soft links with actual files
File size: 10.9 KB
RevLine 
[896]1TMGSIPH ;TMG/kst/SIPHON PROGRAM, FOR TRANSFERRING VISTA INSTANCES ;11/27/09
2 ;;1.0;TMG-LIB;**1**;11/27/09
3 ;
4 ;"TMG SIPHON PROGRAM, FOR TRANSFERRING VISTA INSTANCE
5 ;"Kevin Toppenberg MD
6 ;"GNU General Public License (GPL) applies
7 ;"11/27/09
8 ;
9 ;"=======================================================================
10 ;" API -- Public Functions.
11 ;"=======================================================================
12 ;"LAUNCHSERVER --Main entry point for launching server for Siphon
13 ;"LAUNCHCLIENT ; -- Main entry point for launching client for Siphon
14
15 ;"=======================================================================
16 ;"Dependancies
17 ;"=======================================================================
18 ;"TMGKERN2,TMGUSRIF
19 ;"=======================================================================
20 ;
21 ;"Note: The following globals are used.
22 ;"
23 ;"^TMG("TMGSIPH","DD",FILENUM,"PTR OUT",ONEREF,ENTRY)=""
24 ;" ; Note: ENTRY=DataPiece^PointedToFile^PointedToReference^IENDepth^[V]
25 ;" ; ONEREF will have multiple IEN entries if IENDepth>1, e.g. '^SC(IEN,"S",IEN(2),1,IEN(3),"C")'
26 ;" ; with order of IEN, IEN(2), IEN(3), ... etc.
27 ;"^TMG("TMGSIPH","NEED RE-XREF",FILENUM)=""
28 ;"^TMG("TMGSIPH","RE-XREF DONE",FILENUM,IEN)=""
29 ;"^TMG("TMGSIPH","DOWNLOADED",FILENUM,LocalIEN)=RemoteIEN
30 ;"^TMG("TMGSIPH","NEEDED RECORDS","PTOUT",FILENUM,RemotePointer,ReferToNodeToBeCorrected,INFO)=""
31 ;" INFO=DataPiece^PointedToFile^PointedToReference^IENDepth^[V]
32 ;"^TMG("TMGSIPH","NEEDED RECORDS","PTIN",FILENUM,IEN)=""
33 ;"^TMG("TMGSIPH","OVERWRITTEN",REF)=@REF
34 ;"^TMG("TMGSIPH","PT XLAT",FILENUM,RemoteIEN)=LocalIEN
35 ;" ;Note: if FILENUM is subfile, DON'T store in 123.02{123 format. Just use 123.02
36 ;"^TMG("TMGSIPH","ALWAYS OVERWRITE LOCAL",FILENUM)=""
37 ;"^TMG("TMGSIPH","RECORDS SYNC",FILENUM)=LastIEN^TotalNumIENS (header entries from server-side file)
38 ;"^TMG("TMGSIPH",".01 VALUE",FILENUM,RPTR)=Value (internal format)
39 ;"
40 ;"----- On server side, this array is used
41 ;"^TMG("PTXREF","OUT",FROMFILE,IENS,FROMFLD,P2FILE,PT)=""
42 ;"^TMG("PTXREF","IN",P2FILE,PT,FROMFILE,IENS,FROMFLD)=""
43 ;"^TMG("PTXREF","XREFS",FILENUM,PTR,REF)=$GET(@REF)
44 ;"^TMG("TMGSIPH",".01 VALUE",FILENUM,IEN)=VALUE ;.01 value from record IEN (server-side IEN)
45
46 ;
47LAUNCHSERVER ;
48 ;"Purpose: Main entry point for launching server for Siphon
49 NEW RESULT
50 SET RESULT=$$RUNSERVER^TMGKERN2(6321,"HANDLMSG^TMGSIPH0",1)
51 QUIT
52 ;
53 ;
54LAUNCHCLIENT ;
55 ;"Purpose: Main entry point for launching client for Siphon
56 JOB RUNCLIENT^TMGKERN2("localhost",6321)
57 NEW MSGJOB SET MSGJOB=$ZJOB
58 NEW TMGOWSAVE
59 WRITE "Background task to talk to server launched in job #",MSGJOB,!
60 NEW RESULT
61 NEW COUNT SET COUNT=1
62LC1 HANG 0.5
63 SET RESULT=$GET(^TMG("TMP","TCP",MSGJOB,"RESULT"))
64 SET COUNT=COUNT+1
65 IF COUNT>60 DO QUIT ;"60 * 0.5 = 30 seconds timeout
66 . WRITE "ERROR: Timeout waiting for client in job #",MSGJOB," to connect to server",!
67 IF RESULT="" GOTO LC1
68 IF +RESULT'=1 GOTO LC3
69 ;
70 WRITE " =====================================================",!
71 WRITE " = =",!
72 WRITE " = -= TMG SIPHON =- =",!
73 WRITE " = =",!
74 WRITE " = Transfer data from one VistA instance to another =",!
75 WRITE " = =",!
76 WRITE " =====================================================",!,!
77 WRITE "NOTE: There should be NO other VistA users on the server,",!
78 WRITE "as they might make unexpected and unmanagable changes to",!
79 WRITE "the server database, interfering with the transfer process.",!,!
80 NEW % SET %=2
81 WRITE "Make a backup copy of local records if/when overwriting"
82 DO YN^DICN WRITE !,!
83 IF %=-1 GOTO LC3
84 SET TMGOWSAVE=(%=1) ;"Used in STOREDAS^TMGSIPHU
85 DO MSGCLIENT^TMGKERN2(MSGJOB,"GET XREF AGE",.REPLY,.ERROR,5)
86 IF $DATA(ERROR) WRITE ERROR,!
87 NEW XRAGE SET XRAGE=+$GET(REPLY(1))
88 SET %=1
89 IF XRAGE>0 DO GOTO:(%=-1) LC3
90 . WRITE "Transfer information was last altered on the server ",XRAGE,"+",!
91 . WRITE "hrs ago. This should be refereshed if there has been any",!
92 . WRITE "change to records on the the server database in the interrum.",!
93 . WRITE "Refreshing can add up-front time to the transfer, but is",!
94 . WRITE "important for data integrety.",!,!
95 . WRITE "DELETE old info now and recreate during transfers"
96 . NEW % SET %=1 IF XRAGE<2 SET %=2
97 . DO YN^DICN WRITE !
98 . IF %'=1 QUIT
99 . DO MSGCLIENT^TMGKERN2(MSGJOB,"WIPE PT XREF",.REPLY,.ERROR,5)
100 . IF $DATA(ERROR) WRITE ERROR,!
101 . ELSE WRITE "OK. Old transfer information deleted on server.",!,!
102 ;
103 NEW MENU,USRSLCT,TMP
104LC2 KILL MENU,USRSLCT
105 SET MENU(0)="Pick Option for Siphoning information"
106 NEW IDX SET IDX=1
107 SET MENU(IDX)="Transfer One (1) File (by record)"_$char(9)_"TransFilebyRecs",IDX=IDX+1
108 SET MENU(IDX)="Transfer One (1) patient"_$char(9)_"TransPatient",IDX=IDX+1
109 SET MENU(IDX)="Transfer One (1) record"_$char(9)_"TransRecord",IDX=IDX+1
110 NEW NPTO SET NPTO=$$NUMNEEDED^TMGSIPH3(MSGJOB,"PTOUT")
111 NEW NPTI SET NPTI=$$NUMNEEDED^TMGSIPH3(MSGJOB,"PTIN")
112 IF NPTO>0 DO
113 . SET MENU(IDX)="Work on Unresolved Pointers OUT ("_NPTO_" pending)"_$char(9)_"ResolveNeededPointersOUT",IDX=IDX+1
114 . SET MENU(IDX)="AUTO MODE. Get all Unresolved Pointers OUT ("_NPTO_" pending)"_$char(9)_"ALLResolveNeededPointersOUT",IDX=IDX+1
115 IF NPTI>0 DO
116 . SET MENU(IDX)="Work on Unresolved Pointers IN ("_NPTI_" pending)"_$char(9)_"ResolveNeededPointersIN",IDX=IDX+1
117 . SET MENU(IDX)="AUTO MODE. Get all Unresolved Pointers IN ("_NPTI_" pending)"_$char(9)_"ALLResolveNeededPointersIN",IDX=IDX+1
118 IF (NPTO>0)&(NPTI>0) DO
119 . SET MENU(IDX)="IN & OUT AUTO MODE. Get all Unresolved Pointers IN & OUT"_$char(9)_"ALLResolveNeededPointersINOUT",IDX=IDX+1
120 SET MENU(IDX)="<UTILITY MENU>"_$char(9)_"Utility",IDX=IDX+1
121 ;
122 WRITE #
123 SET USRSLCT=$$MENU^TMGUSRIF(.MENU,"^")
124 IF USRSLCT="^" GOTO LC3
125 IF USRSLCT=0 SET USRSLCT=""
126 IF USRSLCT="ResolveNeededPointersOUT" SET TMP=$$HANDLNEEDED^TMGSIPH3(MSGJOB,"PTOUT",0) GOTO LC2
127 IF USRSLCT="ResolveNeededPointersIN" SET TMP=$$HANDLNEEDED^TMGSIPH3(MSGJOB,"PTIN",0) GOTO LC2
128 IF USRSLCT="ALLResolveNeededPointersOUT" SET TMP=$$HANDLNEEDED^TMGSIPH3(MSGJOB,"PTOUT",1) GOTO LC2
129 IF USRSLCT="ALLResolveNeededPointersIN" SET TMP=$$HANDLNEEDED^TMGSIPH3(MSGJOB,"PTIN",1) GOTO LC2
130 IF USRSLCT="ALLResolveNeededPointersINOUT" DO AUTONEEDED^TMGSIPH3(MSGJOB) GOTO LC2
131 IF USRSLCT="TransPatient" DO TRANSPT^TMGSIPH4(MSGJOB) GOTO LC2
132 IF USRSLCT="TransRecord" DO TRANSREC^TMGSIPH4(MSGJOB) GOTO LC2
133 IF USRSLCT="TransFilebyRecs" DO CHKUPDTE^TMGSIPH4(MSGJOB,1) GOTO LC2
134 IF USRSLCT="Utility" DO UTILITY(MSGJOB) GOTO LC2
135 GOTO LC2
136 ;
137LC3 DO MSGCLIENT^TMGKERN2(MSGJOB,"#BYE#",.REPLY,.ERROR,5)
138 IF $DATA(ERROR) WRITE ERROR,!
139 HANG 0.5
140 NEW Jobs
141 DO MJOBS^TMGKERNL(.Jobs)
142 IF $DATA(Jobs(MSGJOB)) do
143 . WRITE "Background client #",MSGJOB," seems hung!",!
144 . WRITE "Try typing [ESC] in server process. When the server quits",!
145 . WRITE "the background client should quit normally.",!
146 . DO PressToCont^TMGUSRIF
147 KILL ^TMG("TMP","TCP",MSGJOB)
148 QUIT
149 ;
150 ;
151UTILITY(MSGJOB) ;
152 ;"Purpose: To have utility menu
153 ;"
154 NEW MENU,USRSLCT
155U2 KILL MENU,USRSLCT
156 SET MENU(0)="Pick UTILITY Option for Siphoning information"
157 NEW IDX SET IDX=1
158 SET MENU(IDX)="Work with data dictionaries"_$char(9)_"DataDict",IDX=IDX+1
159 SET MENU(IDX)="Query server global reference entries"_$char(9)_"QueryServer",IDX=IDX+1
160 SET MENU(IDX)="Transfer server global reference entry"_$char(9)_"TransGlobal",IDX=IDX+1
161 SET MENU(IDX)="Re-Index files transferred"_$char(9)_"RE-XREF",IDX=IDX+1
162 SET MENU(IDX)="AUTO check for NEW records in set server files"_$char(9)_"AutoCheckForNewRecords",IDX=IDX+1
163 SET MENU(IDX)="Check for NEW records in server file"_$char(9)_"CheckForNewRecords",IDX=IDX+1
164 SET MENU(IDX)="Check for pointers IN to downloaded records"_$char(9)_"CheckForPointersIN",IDX=IDX+1
165 NEW NPTO SET NPTO=$$NUMNEEDED^TMGSIPH3(MSGJOB,"PTOUT")
166 NEW NPTI SET NPTI=$$NUMNEEDED^TMGSIPH3(MSGJOB,"PTIN")
167 IF NPTO>0 DO
168 . SET MENU(IDX)="EXAMINE Unresolved Pointers OUT ("_NPTO_" pending)"_$char(9)_"ExaminePointersOUT",IDX=IDX+1
169 . SET MENU(IDX)="PREVIEW Unresolved Pointers OUT ("_NPTO_" pending)"_$char(9)_"PreviewPointersOUT",IDX=IDX+1
170 . SET MENU(IDX)="UN-NEED Unresolved Pointers OUT ("_NPTO_" pending)"_$char(9)_"UnneedPointersOUT",IDX=IDX+1
171 . SET MENU(IDX)="MAP Unresolved Pointers OUT ("_NPTO_" pending) to LOCAL records"_$char(9)_"MapPointersOUTtoLocal",IDX=IDX+1
172 SET MENU(IDX)="Show Information nodes"_$char(9)_"ShowInfoNodes",IDX=IDX+1
173 SET MENU(IDX)="Show Local Data Dictionary Browser"_$char(9)_"VPE-DD",IDX=IDX+1
174 SET MENU(IDX)="Delete a record that has been downloaded"_$char(9)_"DeleteADownloadedRec",IDX=IDX+1
175 ;"SET MENU(IDX)="do FIX"_$char(9)_"FIX",IDX=IDX+1
176 SET MENU(IDX)="Transfer Entire File (BLOCK COPY)/ Auto-resume Transfer"_$char(9)_"TransferFile",IDX=IDX+1
177 ;
178 WRITE #
179 SET USRSLCT=$$MENU^TMGUSRIF(.MENU,"^")
180 IF USRSLCT="^" GOTO U3
181 IF USRSLCT=0 SET USRSLCT=""
182 IF USRSLCT="DataDict" DO COMPALLD^TMGSIPH1(MSGJOB) GOTO U2
183 IF USRSLCT="QueryServer" DO QRYSERVER^TMGSIPH3(MSGJOB) GOTO U2
184 IF USRSLCT="TransGlobal" DO TRANSREF^TMGSIPH3(MSGJOB) GOTO U2
185 IF USRSLCT="ExaminePointersOUT" DO EXAMNEED^TMGSIPH5(MSGJOB,"PTOUT") GOTO U2
186 IF USRSLCT="MapPointersOUTtoLocal" DO MAP2LOCAL^TMGSIPH3(MSGJOB) GOTO U2
187 IF USRSLCT="UnneedPointersOUT" DO KILLNEED^TMGSIPH5(MSGJOB,"PTOUT") GOTO U2
188 IF USRSLCT="PreviewPointersOUT" DO PREVIEW^TMGSIPH5(MSGJOB,"PTOUT") GOTO U2
189 IF USRSLCT="ShowInfoNodes" DO BROWSENODES^TMGMISC($NAME(^TMG("TMGSIPH"))) GOTO U2
190 IF USRSLCT="VPE-DD" DO ^%ZVEMD GOTO U2
191 IF USRSLCT="CheckForNewRecords" DO CHKUPDTE^TMGSIPH4(MSGJOB) GOTO U2
192 IF USRSLCT="AutoCheckForNewRecords" DO CHKSPUPD^TMGSIPH4(MSGJOB) GOTO U2
193 IF USRSLCT="CheckForPointersIN" DO CHKPTIN^TMGSIPH5(MSGJOB) GOTO U2
194 IF USRSLCT="RE-XREF" DO XRFILES^TMGSIPH6 GOTO U2
195 IF USRSLCT="DeleteADownloadedRec" DO DELREC^TMGSIPH5 GOTO U2
196 ;"IF USRSLCT="FIX" DO FIXSUBFILES^TMGFIX(MSGJOB) GOTO U2
197 IF USRSLCT="TransferFile" DO TRANSFILE^TMGSIPH3(MSGJOB) GOTO LC2
198
199 ;
200U3 QUIT
201 ;
Note: See TracBrowser for help on using the repository browser.