source: cprs/branches/tmg-cprs/m_files/TMGSIPH6.m@ 1742

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

replacing soft links with actual files

File size: 3.8 KB
RevLine 
[896]1TMGSIPH6 ;TMG/kst/SIPHON PROGRAM, FOR TRANSFERRING VISTA INSTANCES ;2/15/10
2 ;;1.0;TMG-LIB;**1**;2/15/10
3 ;
4 ;"TMG SIPHON PROGRAM, FOR TRANSFERRING VISTA INSTANCE
5 ;"Utility functions for working with transfers on client
6 ;"Especially working with XRefs of transferred records.
7 ;"Kevin Toppenberg MD
8 ;"GNU General Public License (GPL) applies
9 ;"2/15/10
10 ;
11 ;"=======================================================================
12 ;" API -- Public Functions.
13 ;"=======================================================================
14 ;"XRFILES -- allow user to select files to be re-cross referenced
15 ;
16 ;"=======================================================================
17 ;"Dependancies
18 ;"=======================================================================
19 ;"TMGUSRIF,DIK
20 ;"=======================================================================
21 ;
22XRFILES ;
23 ;"Purpose: To allow user to select files to be re-cross referenced
24 ;"Input: None
25 ;"Result: None
26 ;"Output: Cross-references will be KILL'ed then SET, at user's choice
27 NEW TMGARRAY,TMGSEL
28 NEW FILENUM SET FILENUM=0
29 FOR SET FILENUM=$ORDER(^TMG("TMGSIPH","NEED RE-XREF",FILENUM)) QUIT:(FILENUM'>0) DO
30 . NEW DISPSTR SET DISPSTR="Re-index records in file #"_FILENUM_" ("
31 . SET DISPSTR=DISPSTR_$PIECE($GET(^DIC(FILENUM,0)),"^",1)_")"
32 . SET TMGARRAY(DISPSTR)=FILENUM
33 NEW HEADER SET HEADER="Select File(s) to REINDEX. Press <ESC><ESC> when Done."
34 DO Selector^TMGUSRIF("TMGARRAY","TMGSEL",HEADER)
35 ;
36 NEW TMGABORT SET TMGABORT=0
37 NEW IDX SET IDX=""
38 FOR SET IDX=$ORDER(TMGSEL(IDX)) QUIT:(IDX="")!TMGABORT DO
39 . SET FILENUM=$GET(TMGSEL(IDX)) QUIT:FILENUM=""
40 . SET TMGABORT=($$REIX1FLE(FILENUM)'=1)
41 ;
42 DO PRESSTOCONT^TMGUSRIF;
43 QUIT
44 ;
45 ;
46REIX1FLE(FILENUM) ;
47 ;"Purpose: to re-index all the cross references in 1 file
48 ;"Input: FILENUM -- the file to reindex.
49 ;"Results: 1=OK, 0 if error.
50 ;"
51 ;"NOTE: There should not be a need to re-index subfiles, becaUse those
52 ;" IEN's are not moved / translated
53 NEW RESULT SET RESULT=1 ;"default success
54 NEW TMGCT SET TMGCT=50
55 NEW STIME SET STIME=$H
56 NEW VAFCA08 SET VAFCA08=1 ;"Prevent execution of XRef AVAFC01 (--> endless loop)
57 NEW DIK,DA,CGREF
58 SET DIK=$GET(^DIC(FILENUM,0,"GL"))
59 IF DIK="" SET RESULT=0 GOTO RXF1
60 NEW CGREF SET CGREF=$$CREF^DILF(DIK)
61 SET TMGMIN=$ORDER(@CGREF@(0))
62 SET TMGMAX=$ORDER(@CGREF@("#"),-1)
63 NEW TMGABORT SET TMGABORT=0
64 NEW TMGERR,TMGLASTE SET TMGERR=0,TMGLASTE=0
65 SET DA=0
66 FOR SET DA=$ORDER(@CGREF@(DA)) QUIT:(+DA'>0)!TMGABORT DO
67 . IF $DATA(^TMG("TMGSIPH","RE-XREF DONE",FILENUM,DA)) QUIT
68 . DO
69 . . ;"NEW $ETRAP SET $ETRAP="SET $ZTRAP=""B"" write ""$ZTRAP="",$ZTRAP,!,""Error during XRef of FILE #"",$GET(FILENUM),""; IEN="",$GET(DA),! WRITE $ZSTATUS,! SET $ETRAP="""",$ECODE="""",TMGERR=1"
70 . . NEW $ETRAP SET $ETRAP="DO HANDLERR^TMGSIPH6"
71 . . DO IX^DIK ;"Uses DIK and DA as inputs
72 . . SET ^TMG("TMGSIPH","RE-XREF DONE",FILENUM,DA)="" ;"<-- not done if error during IX^DIK
73 . SET TMGABORT=$$UserAborted^TMGUSRIF()
74 . SET TMGCT=TMGCT+1
75 . IF TMGCT>10 DO
76 . . DO ProgressBar^TMGUSRIF(DA,"Re-indexing file: "_FILENUM,TMGMIN,TMGMAX,70,STIME)
77 . . SET TMGCT=0
78 IF (TMGABORT=0)&(TMGERR=0) KILL ^TMG("TMGSIPH","NEED RE-XREF",FILENUM)
79 ELSE SET RESULT=0
80 WRITE !
81RXF1 QUIT RESULT
82 ;
83 ;
84HANDLERR ;
85 SET $ZTRAP="B"
86 IF $GET(DA)'=$GET(TMGLASTE) DO
87 . WRITE !,"Error during XRef of FILE #",$GET(FILENUM),"; IEN=",$GET(DA),!
88 . WRITE $ZSTATUS,!
89 . SET TMGERR=1
90 . SET TMGLASTE=DA
91 SET $ETRAP="",$ECODE=""
92 QUIT
93
Note: See TracBrowser for help on using the repository browser.