| [896] | 1 | TMGSIPH6 ;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 | ;
|
|---|
| 22 | XRFILES ;
|
|---|
| 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 | ;
|
|---|
| 46 | REIX1FLE(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 !
|
|---|
| 81 | RXF1 QUIT RESULT
|
|---|
| 82 | ;
|
|---|
| 83 | ;
|
|---|
| 84 | HANDLERR ;
|
|---|
| 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 |
|
|---|
