VistA-internationalization/p/RRCI18X.m

149 lines
4.4 KiB
Mathematica

RRCI18X ; Internationalization eXtractor to Excel and From Excel
;RRCI18X V0.0001;;RCR/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 QUIT
; Note: Snapshot file .84 before this run so that
; it might be restored completely.
; LNG is the language to be loaded (is optional)
; There are two major entry points to this routine;
; M2EX^RRCI18X(LNG) Will generate a series of Excel Files (30,000 rows/file)
; EX2M^RRCI18X(LNG) Will Load an Excel Sheet into the Dialog File
; P2EX^RRCI18X Will scan the Package File and build a list
M2EX(LNG) ; Load a series of excel loadable files from the Dialog File
N FILE,FN,LC,X,D0,TB,SET
S U="^",SET=""
S D0=0,FILE="",TB=$C(9)
S LC=600000,FN=-1
F S D0=$O(^DI(.84,D0)) Q:'D0 D
. S X=$P($G(^DI(.84,D0,0)),U,3)
. Q:X=""
. ;
. I $L(X," ")>1 D SEND Q ; At least one space
. I X?.E1PL.E D SEND Q ; At least some punctuation or lower case
. ;
. S ^RRCTMP("I18","ODD",X)=""
.QUIT
D ENDFILE
U 0
QUIT
; ============
TEST ; Load a series of excel loadable files from the Dialog File
N FILE,FN,LC,X,D0,TB
S U="^",SET=""
S D0=0,FILE="",TB=$C(9),EXIT=0
F D Q:EXIT
. S DIC=9.4,DIC(0)="AE"
. D ^DIC
. I Y>0 D Q
. . N K
. . S K=$P($G(^DIC(9.4,+Y,0)),U,2)
. . I $L(K) S SET(K)=""
. .QUIT
. ;
. S:(+Y)<0 EXIT=1
.QUIT
QUIT
; ============
P2EX ; Load a series of excel loadable files from the Dialog File
N FILE,FN,LC,X,D0,SET,TB
S U="^",SET=""
S D0=0,FILE="",TB=$C(9),EXIT=0
F D Q:EXIT
. S DIC=9.4,DIC(0)="AE"
. D ^DIC
. I Y>0 D Q
. . N K
. . S K=$P($G(^DIC(9.4,+Y,0)),U,2)
. . I $L(K) S SET(K)=""
. .QUIT
. ;
. S:(+Y)<0 EXIT=1
.QUIT
S LC=600000,FN=-1
F S D0=$O(^DI(.84,D0)) Q:'D0 D
. S X=$P($G(^DI(.84,D0,0)),U,3)
. Q:X=""
. ;
. D:$$PICK(D0,.SET)
. . I $L(X," ")>1 D SEND Q ; At least one space
. . I X?.E1PL.E D SEND Q ; At least some punctuation or lower case
. . ;
. . S ^RRCTMP("I18","ODD",X)=""
. .QUIT
.QUIT
D ENDFILE
U 0
QUIT
; ============
PICK(D,V) ; Find a member of the routines which matches
N T,P,J,L
S T=0,P=0
F S P=$O(^DI(.84,D,5,"B",P)) Q:P="" D Q:T
. S J=""
. F S J=$O(V(J)) Q:J="" S L=$L(J) I $E(P,1,L)=J S T=1 Q
.QUIT
QUIT T
; ============
SEND ; Resolve the String as being in DIALOG or add it.
N Y
; I LC>30000 D NEWFILE U FILE
I LC>300 D NEWFILE U FILE
S Y=$G(^DI(.84,D0,2,1,0))
I $L(Y)>$L(X) S X=Y
W X_TB_TB_TB,!
S LC=LC+1
QUIT
; ============
NEWFILE ; Close any current file (FILE) and then open a new file
N NM
S LC=0
I FILE'="" D ENDFILE ; Close the current file with an easily identifiable terminator
S FN=$G(FN)+1
S NM=$O(SET(""))
S:'$L(NM) NM="DIALOG"
S FILE="WV-"_NM_"-"_$TR($J(FN,4)," ","0")_".txt"
O FILE:NEW
U FILE
; W "ENGLISH"_TB_"SPANISH"_TB,!
W "English"_TB_"French"_TB_"Notes"_TB_"Complete/Exclude",!
QUIT
; ============
ENDFILE ; Load the Exclusion File from ^RRCTMP("I18","ODD",
N C,I
S C=$TR($J("",20)," ","#")
F I=1:1:5 W C_TB_C_TB_C_TB,!
C FILE
QUIT
; ============
LOADX ; Load the Exclusion File from ^RRCTMP("I18","ODD",
N D0,DA,F,FN,X
S U="^"
S X="",F=$G(^WVDI(250.84,0))
S (DA,D0)=0
F S X=$O(^RRCTMP("I18","ODD",X)) Q:X="" D
. S DA=$O(^WVDI(250.84,"B",X,""))
. I DA="" S D0=$P(F,U,3)+1,$P(F,U,3,4)=D0_U_D0,DA=D0
. S ^WVDI(250.84,DA,0)=X,^WVDI(250.84,"B",X,DA)=""
.QUIT
S ^WVDI(250.84,0)=F
QUIT
; ============