99 lines
3.2 KiB
Mathematica
99 lines
3.2 KiB
Mathematica
RRCI18E ; Internationalization Converter - Editor
|
|
;RRCI18N V0.0001;;MTZ/RCR/27MAY2004
|
|
;Donated by Chris Richardson
|
|
;Initial database design by Marcus Werner
|
|
;Copyright 2008 WorldVistA. Licensed under the terms of the GNU
|
|
;General Public License See attached copy of the License.
|
|
;
|
|
;This program is free software; you can redistribute it and/or modify
|
|
;it under the terms of the GNU General Public License as published by
|
|
;the Free Software Foundation; either version 2 of the License, or
|
|
;(at your option) any later version.
|
|
;
|
|
;This program is distributed in the hope that it will be useful,
|
|
;but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
;GNU General Public License for more details.
|
|
;
|
|
;You should have received a copy of the GNU General Public License along
|
|
;with this program; if not, write to the Free Software Foundation, Inc.,
|
|
;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
|
|
V ; Note: Snapshot file .84 before this run so that
|
|
; it might be restored completely.
|
|
N CODE,END,EXIT,I,J,K,LL,RRCODE,RRCFILE,RRCIEN,RRCNODE,MSK
|
|
S (EXIT,END)=0
|
|
F S CMD=$$ASK(.EXIT) Q:EXIT!END D PROCESS(CMD)
|
|
QUIT
|
|
; ============
|
|
ASK(EXIT) ; READ THE USER'S REQUEST, RETURNING THE CURRENT
|
|
N REQ,STAT
|
|
S STAT=0
|
|
R !,"Enter the String to find: ",REQ
|
|
D
|
|
. I "^"[REQ S EXIT=1 Q
|
|
. I REQ?1"?".E D HELP Q
|
|
. S:$L(REQ)=1 REQ=$TR(REQ,"mx","MX")
|
|
. I REQ="X" D XCLUDE Q
|
|
. I REQ="M" D MOVE Q
|
|
. I REQ?1"`"1.N D NUMB Q
|
|
. N I,J,K,L
|
|
. I $D(^DI(.84,"D",REQ)) D Q
|
|
. .QUIT
|
|
. ;
|
|
. Q:STAT ; Drop out if there was a STATus returned
|
|
. S J="",STAT=0
|
|
. F I=0:1 S J=$O(^DI(.84,"D",J)) Q:J=""!(STAT>20) I J[REQ D
|
|
. . S STAT=STAT+1
|
|
. . S L(STAT)=$O(^DI(.84,"D",J,""))
|
|
. . I '(I#100) W "." W:$X>75 !
|
|
. .QUIT
|
|
. I STAT D Q
|
|
. ;
|
|
. S STAT=-99
|
|
.QUIT
|
|
QUIT STAT_"^"_REQ
|
|
; ============
|
|
HELP ; HELP MESSAGE
|
|
W !,"Enter one of the following;"
|
|
W !," a String to find: ",!," ^ to Exit"
|
|
W !," `nnn for an IEN if known",!
|
|
W !," M to Move A String to a new Number Space"
|
|
W !," X to Exclude this string from the Dialog File"
|
|
W !," ? to get this message.",!
|
|
QUIT
|
|
; ============
|
|
XCLUDE ; Exclude the current message from future extraction
|
|
I '$G(CUR) S STAT=-98 Q
|
|
;
|
|
N SET,V,W,X,Y
|
|
S V=$P(^DI(.84,CUR,0),"^",4)
|
|
I '$L(V) S STAT=-97 Q
|
|
;
|
|
S W=$O(^VWDI(250.84,"B",V,""))
|
|
D:W=""
|
|
. S W=$P($G(^VWDI(250.84,0)),"^",3)+1
|
|
. S $P(^VWDI(250.84,0),"^",2,4)="250.84^"_W_"^"_W
|
|
. S ^VWDI(250.84,W,0)=V
|
|
. S ^VWDI(250.84,"D",V,W)=""
|
|
.QUIT
|
|
; K ^DI(.84,"B",CUR),^DI(.84,"D",V,CUR),^DI(.84,CUR)
|
|
QUIT
|
|
; ============
|
|
MOVE ; Relocate the current IEN to a new location
|
|
I '$G(CUR) S STAT=-98 Q
|
|
;
|
|
QUIT
|
|
; ============
|
|
NUMB ; Establish an IEN's existance and fix it as a current source
|
|
N I,J,K
|
|
S I=+REP
|
|
S J=$D(^DI(.84,I,0))
|
|
I 'J U 0 W !," IEN: "_I_" does not exist" Q
|
|
;
|
|
S CUR=I
|
|
QUIT
|
|
; ============
|
|
SRCH ;
|
|
QUIT STAT
|
|
; ============
|