DIALOGZ ;O-OIFO/GFT - CREATE AND USE FOREIGN-LANGUAGE ADDITIONS TO THE DATA DICTIONARY ;1JUNE2016
;;22.2;VA FileMan;**2**;Jan 05, 2016;Build 139
;;Per VA Directive 6402, this routine should not be modified.
;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
;;Licensed under the terms of the Apache License, Version 2.0.
;GFT;**1004,1020,1042,1053**
;
;FOREIGN-LANGUAGE UTILITES
;
D LANG($G(DUZ("LANG"),1)) Q
;
ENGLISH ;
D LANG(1) Q
GERMAN ;
D LANG(2) Q
SPANISH ;
D LANG(3) Q
FINNISH ;
D LANG(5) Q
PORTUG ;
D LANG(7) Q
ARABIC ;
D LANG(10) Q
;
LANG(LANG) ;
N DIC,DIR,DIAL,Y,DLAYGO,DIF,DIE,DSTART,DIALFILE,DA,DR,DIALDD,DUOUT
S U="^",LANG(0)=$G(^DI(.85,LANG,0))
I LANG(0) S DIAL=$P(LANG(0),U,2) ;EITHER VERSION OF THE LANGUAGE FILE WILL GET DIAL=LANGUAGE NAME
E Q:'$$GOODLANG(.LANG) S DIAL=$P(LANG(0),U)
D D^DICRW Q:Y<1
FILE S (DIALFILE,DSTART)=+Y,DIF=$P(Y,U,2) I $D(^DIC(DIALFILE,"ALANG",LANG,0)) S DIR("B")=^(0)
D DIR(60) I X="@"!'$D(DUOUT) D
.I $D(DIR("B")) K ^DIC("ALANG"_LANG,DIR("B"),DIALFILE)
.I Y="" K ^DIC(DIALFILE,"ALANG",LANG) W " <DELETED!>" Q
.S ^DIC("ALANG"_LANG,Y,DIALFILE)="",^DIC(DIALFILE,"ALANG",LANG,0)=Y
K DIR
FIELDS F D Q:'$D(DSTART)
.S DIC="^DD(DIALFILE,",DIC(0)="AEQM"
.D DICW(DIALFILE)
.W !! D ^DIC I Y<0 D Q
..I DIALFILE=DSTART K DSTART Q
..S DIALFILE=DSTART
.K DIR,DUOUT S DIALDD=+Y,DIF=$P(Y,U,2)
.I $D(^DD(DIALFILE,DIALDD,.008,LANG,0)) S DIR("B")=^(0)
.D DIR(60) K DIR I X="@"!'$D(DUOUT) D
..S ^DD(DIALFILE,DIALDD,.008,LANG,0)=Y
..I Y="" K ^(0) W " <DELETED!>"
.S Y=+$P(^DD(DIALFILE,DIALDD,0),U,2) I Y,$D(^DD(Y,.01,0)),$P(^(0),U,2)'["W" S DIALFILE=Y Q ;GO DOWN INTO MULTIPLE
HLP .D:$G(^DD(DIALFILE,DIALDD,3))]"" Q:$D(DUOUT)
..W !!,"Current ",DIF," Field Help " S DIF="Prompt" W DIF,": "
..W:$X+$L(^(3))>75 !?2 W ^(3) D
...N DUZ S DUZ("LANG")=LANG I $D(^(.009,LANG,0)) S DIR("B")=^(0)
..D DIR(240) Q:X'="@"&$D(DUOUT)
..K DIR S ^DD(DIALFILE,DIALDD,.009,LANG,0)=Y
..I Y="" K ^(0) W " <DELETED!>"
SET .D:$P(^DD(DIALFILE,DIALDD,0),U,2)["S"
..N SET
..S SET=$$SL($P(^(0),U,3)),DIF="SET values"
..W !!,"Current ",DIF,": " W:$X+$L(SET)>75 !?2 W SET
..I $D(^(.007,LANG,0)) S DIR("B")=^(0)
..S DIR("?")="YOU MUST ENTER "_$L($$SL(SET),";")_" EXTERNAL VALUES, SEPARATED BY SEMICOLONS(;)"
..D DIR("240^S X=$$SL^DIALOGZ(X) K:$L(X,"";"")-$L(SET,"";"")!(X["":"") X") Q:X'="@"&$D(DUOUT)
..K DIR S ^DD(DIALFILE,DIALDD,.007,LANG,0)=Y
..I Y="" K ^(0) W " <DELETED!>"
W !!! Q
;
SL(S) ;
I S?.E1";" S S=$E(S,1,$L(S)-1)
Q S
;
;
DIR(LN) S DIR("A")=DIAL_" translation of "_DIF,DIR(0)="FO^2:"_LN
K DUOUT G ^DIR
;
FILENAME(FILE) ;
N N,F
I 'FILE Q "FIELD"
I $D(^DIC(FILE,0))#2 D Q F
.S F=$P(^(0),"^")
.I $G(DUZ("LANG")),$D(^("ALANG",DUZ("LANG"),0))#2 S F=^(0)
S N=$G(^DD(FILE,0,"UP")) I N]"" S F=$O(^DD(N,"SB",FILE,0)) I F Q $$LABEL(N,F)
Q ""
;
;
LABEL(FILE,FIELD) ;Called many places to return the foreign-language FIELD NAME
N N
S N=$P($G(^DD(FILE,FIELD,0)),"^") I N="" Q N
I $P(^(0),"^",2)["W",$G(^DD(FILE,0,"UP")) Q $$LABEL(^("UP"),$O(^DD(^("UP"),"SB",FILE,0)))
I $G(DUZ("LANG")),$D(^(.008,DUZ("LANG"),0))#2 Q ^(0)
Q N
;
HELP(FILE,FIELD) ;
G 3:FILE<2!'$G(DUZ("LANG")),3:$G(^DD(FILE,FIELD,3))'?.P&(DUZ("LANG")'>1)
I $D(^DD(FILE,FIELD,.009,DUZ("LANG"),0))#2 Q ^(0)
N Y,DICATT5,DICATT2,P
S DICATT2=$P(^DD(FILE,FIELD,0),U,2),DICATT5=$P(^(0),U,5,999)
EXT I DICATT2["t" S Y=$G(^DI(.81,+$P(DICATT2,"t",2),11)) G Y ;GET SHORT DESCRIPTION OF DATA TYPE!
I DICATT2["D" D
.D EARLY^DICATTD1 S:$D(Y) P(1)=Y D LATEST^DICATTD1 S:$D(Y) P(2)=Y
.K Y I $D(P(1)) S Y=$$EZBLD^DIALOG($S($D(P(2)):9114,1:9114.01),.P)
I DICATT2["N" D
.S P(1)=+$P(DICATT5,"X<",2) Q:'P(1)
.S P(2)=+$P(DICATT5,"X>",2)
.S P(3)=$P(DICATT5,"1"".""",2)-1 I P(3)<0 S P(3)=0 S:DICATT5["""$""" P(3)=2
.S Y=$$EZBLD^DIALOG($S(DICATT5["""$""":9118.1,1:9118),.P)
I DICATT2["F" D
.S P(1)=+$P(DICATT5,"$L(X)<",2) I P(1) S P(2)=+$P(DICATT5,"$L(X)>",2) I P(2) S Y=$$EZBLD^DIALOG($S(P(1)=P(2):9119.1,1:9119),.P) ;"ENTER FROM |1| TO |2| CHARACTERS ..."
I $D(Y) S ^DD(FILE,FIELD,.009,DUZ("LANG"),0)=Y
Y I $G(Y)]"" Q Y
3 Q $G(^DD(FILE,FIELD,3))
;
DICW(FILE) ;
S DIC("W")="N % S %=$P(^(0),U,2)" ; + NEXT 2 LINES WRITE OUT FIELD NAME IN 2 LANGUAGES
I $G(DUZ("LANG"))>1 S DIC("W")=DIC("W")_" W:$D(^(.008,DUZ(""LANG""),0)) ?37,$$LABEL^DIALOGZ("_FILE_",+Y)"
S DIC("W")=DIC("W")_" W:% $P("" (multiple)^ (word-processing)"",U,$P($G(^DD(+%,.01,0)),U,2)[""W""+1)"
Q
;
;
SETIN() ;NAKED REFERENCE Builds the SET STRING user sees, with 1,2,3...
N C,P
S C=$P(^(0),U,3)
I $D(^(.007,DUZ("LANG"),0)) D
.S C=^(0) F P=1:1:$L(C,";") S $P(C,";",P)=P_":"_$P(C,";",P)
E D
.N TRY,OUT,O
.S TRY="" F P=1:1 Q:$P(C,";",P)="" S O=$P($P(C,";",P),":",2),OUT=$$YESORNO(O),TRY=TRY_P_":"_OUT_";" I OUT=O K TRY Q
.I $D(TRY) S C=TRY
Q C
;
SETOUT() ;NAKED REFERENCE Builds the SET STRING that converts INTERNAL to user's EXTERNAL
N P,V,C
S C=$P(^(0),U,3)
I $D(^(.007,DUZ("LANG"),0)) D
.F P=1:1:$L(^(0),";") S V=$P(C,";",P),$P(V,":",2)=$P(^(0),";",P),$P(C,";",P)=V
E F P=1:1:$L(C,";") S V=$P(C,";",P),$P(V,":",2)=$$YESORNO($P(V,":",2)),$P(C,";",P)=V
Q C
;
YESORNO(Y) ;TRY TO TURN YES OR NO INTO 'SI', WHATEVER
Q:'$G(DUZ("LANG")) Y
I $$UP^DILIBF(Y)="YES",$D(^DI(.84,7001,4,DUZ("LANG"),1,1,0)) Q $P(^(0),U)
I $$UP^DILIBF(Y)="NO",$D(^DI(.84,7001,4,DUZ("LANG"),1,1,0)) Q $P(^(0),U,2)
Q Y
;
GOODLANG(Y) ;Check for language available for translation -- DPC
;Input = user's input ID NUMBER and zero node of language file entry
;Returns 1 for good language, 0 for no translation
;Only living languages can be translated
I Y(0)="" W Y_" is not an ID NUMBER of a language in the Language file." Q 0
I $P(Y(0),U,7)'="L" W $P(Y(0),U)_" is not a living language. Translating is prohibited." Q 0
Q 1
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDIALOGZ 5968 printed Apr 09, 2024@21:46:05 Page 2
DIALOGZ ;O-OIFO/GFT - CREATE AND USE FOREIGN-LANGUAGE ADDITIONS TO THE DATA DICTIONARY ;1JUNE2016
+1 ;;22.2;VA FileMan;**2**;Jan 05, 2016;Build 139
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
+4 ;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
+5 ;;Licensed under the terms of the Apache License, Version 2.0.
+6 ;GFT;**1004,1020,1042,1053**
+7 ;
+8 ;FOREIGN-LANGUAGE UTILITES
+9 ;
+10 DO LANG($GET(DUZ("LANG"),1))
QUIT
+11 ;
ENGLISH ;
+1 DO LANG(1)
QUIT
GERMAN ;
+1 DO LANG(2)
QUIT
SPANISH ;
+1 DO LANG(3)
QUIT
FINNISH ;
+1 DO LANG(5)
QUIT
PORTUG ;
+1 DO LANG(7)
QUIT
ARABIC ;
+1 DO LANG(10)
QUIT
+2 ;
LANG(LANG) ;
+1 NEW DIC,DIR,DIAL,Y,DLAYGO,DIF,DIE,DSTART,DIALFILE,DA,DR,DIALDD,DUOUT
+2 SET U="^"
SET LANG(0)=$GET(^DI(.85,LANG,0))
+3 ;EITHER VERSION OF THE LANGUAGE FILE WILL GET DIAL=LANGUAGE NAME
IF LANG(0)
SET DIAL=$PIECE(LANG(0),U,2)
+4 IF '$TEST
if '$$GOODLANG(.LANG)
QUIT
SET DIAL=$PIECE(LANG(0),U)
+5 DO D^DICRW
if Y<1
QUIT
FILE SET (DIALFILE,DSTART)=+Y
SET DIF=$PIECE(Y,U,2)
IF $DATA(^DIC(DIALFILE,"ALANG",LANG,0))
SET DIR("B")=^(0)
+1 DO DIR(60)
IF X="@"!'$DATA(DUOUT)
Begin DoDot:1
+2 IF $DATA(DIR("B"))
KILL ^DIC("ALANG"_LANG,DIR("B"),DIALFILE)
+3 IF Y=""
KILL ^DIC(DIALFILE,"ALANG",LANG)
WRITE " <DELETED!>"
QUIT
+4 SET ^DIC("ALANG"_LANG,Y,DIALFILE)=""
SET ^DIC(DIALFILE,"ALANG",LANG,0)=Y
End DoDot:1
+5 KILL DIR
FIELDS FOR
Begin DoDot:1
+1 SET DIC="^DD(DIALFILE,"
SET DIC(0)="AEQM"
+2 DO DICW(DIALFILE)
+3 WRITE !!
DO ^DIC
IF Y<0
Begin DoDot:2
+4 IF DIALFILE=DSTART
KILL DSTART
QUIT
+5 SET DIALFILE=DSTART
End DoDot:2
QUIT
+6 KILL DIR,DUOUT
SET DIALDD=+Y
SET DIF=$PIECE(Y,U,2)
+7 IF $DATA(^DD(DIALFILE,DIALDD,.008,LANG,0))
SET DIR("B")=^(0)
+8 DO DIR(60)
KILL DIR
IF X="@"!'$DATA(DUOUT)
Begin DoDot:2
+9 SET ^DD(DIALFILE,DIALDD,.008,LANG,0)=Y
+10 IF Y=""
KILL ^(0)
WRITE " <DELETED!>"
End DoDot:2
+11 ;GO DOWN INTO MULTIPLE
SET Y=+$PIECE(^DD(DIALFILE,DIALDD,0),U,2)
IF Y
IF $DATA(^DD(Y,.01,0))
IF $PIECE(^(0),U,2)'["W"
SET DIALFILE=Y
QUIT
HLP if $GET(^DD(DIALFILE,DIALDD,3))]""
Begin DoDot:2
+1 WRITE !!,"Current ",DIF," Field Help "
SET DIF="Prompt"
WRITE DIF,": "
+2 if $X+$LENGTH(^(3))>75
WRITE !?2
WRITE ^(3)
Begin DoDot:3
+3 NEW DUZ
SET DUZ("LANG")=LANG
IF $DATA(^(.009,LANG,0))
SET DIR("B")=^(0)
End DoDot:3
+4 DO DIR(240)
if X'="@"&$DATA(DUOUT)
QUIT
+5 KILL DIR
SET ^DD(DIALFILE,DIALDD,.009,LANG,0)=Y
+6 IF Y=""
KILL ^(0)
WRITE " <DELETED!>"
End DoDot:2
if $DATA(DUOUT)
QUIT
SET if $PIECE(^DD(DIALFILE,DIALDD,0),U,2)["S"
Begin DoDot:2
+1 NEW SET
+2 SET SET=$$SL($PIECE(^(0),U,3))
SET DIF="SET values"
+3 WRITE !!,"Current ",DIF,": "
if $X+$LENGTH(SET)>75
WRITE !?2
WRITE SET
+4 IF $DATA(^(.007,LANG,0))
SET DIR("B")=^(0)
+5 SET DIR("?")="YOU MUST ENTER "_$LENGTH($$SL(SET),";")_" EXTERNAL VALUES, SEPARATED BY SEMICOLONS(;)"
+6 DO DIR("240^S X=$$SL^DIALOGZ(X) K:$L(X,"";"")-$L(SET,"";"")!(X["":"") X")
if X'="@"&$DATA(DUOUT)
QUIT
+7 KILL DIR
SET ^DD(DIALFILE,DIALDD,.007,LANG,0)=Y
+8 IF Y=""
KILL ^(0)
WRITE " <DELETED!>"
End DoDot:2
End DoDot:1
if '$DATA(DSTART)
QUIT
+9 WRITE !!!
QUIT
+10 ;
SL(S) ;
+1 IF S?.E1";"
SET S=$EXTRACT(S,1,$LENGTH(S)-1)
+2 QUIT S
+3 ;
+4 ;
DIR(LN) SET DIR("A")=DIAL_" translation of "_DIF
SET DIR(0)="FO^2:"_LN
+1 KILL DUOUT
GOTO ^DIR
+2 ;
FILENAME(FILE) ;
+1 NEW N,F
+2 IF 'FILE
QUIT "FIELD"
+3 IF $DATA(^DIC(FILE,0))#2
Begin DoDot:1
+4 SET F=$PIECE(^(0),"^")
+5 IF $GET(DUZ("LANG"))
IF $DATA(^("ALANG",DUZ("LANG"),0))#2
SET F=^(0)
End DoDot:1
QUIT F
+6 SET N=$GET(^DD(FILE,0,"UP"))
IF N]""
SET F=$ORDER(^DD(N,"SB",FILE,0))
IF F
QUIT $$LABEL(N,F)
+7 QUIT ""
+8 ;
+9 ;
LABEL(FILE,FIELD) ;Called many places to return the foreign-language FIELD NAME
+1 NEW N
+2 SET N=$PIECE($GET(^DD(FILE,FIELD,0)),"^")
IF N=""
QUIT N
+3 IF $PIECE(^(0),"^",2)["W"
IF $GET(^DD(FILE,0,"UP"))
QUIT $$LABEL(^("UP"),$ORDER(^DD(^("UP"),"SB",FILE,0)))
+4 IF $GET(DUZ("LANG"))
IF $DATA(^(.008,DUZ("LANG"),0))#2
QUIT ^(0)
+5 QUIT N
+6 ;
HELP(FILE,FIELD) ;
+1 if FILE<2!'$GET(DUZ("LANG"))
GOTO 3
if $GET(^DD(FILE,FIELD,3))'?.P&(DUZ("LANG")'>1)
GOTO 3
+2 IF $DATA(^DD(FILE,FIELD,.009,DUZ("LANG"),0))#2
QUIT ^(0)
+3 NEW Y,DICATT5,DICATT2,P
+4 SET DICATT2=$PIECE(^DD(FILE,FIELD,0),U,2)
SET DICATT5=$PIECE(^(0),U,5,999)
EXT ;GET SHORT DESCRIPTION OF DATA TYPE!
IF DICATT2["t"
SET Y=$GET(^DI(.81,+$PIECE(DICATT2,"t",2),11))
GOTO Y
+1 IF DICATT2["D"
Begin DoDot:1
+2 DO EARLY^DICATTD1
if $DATA(Y)
SET P(1)=Y
DO LATEST^DICATTD1
if $DATA(Y)
SET P(2)=Y
+3 KILL Y
IF $DATA(P(1))
SET Y=$$EZBLD^DIALOG($SELECT($DATA(P(2)):9114,1:9114.01),.P)
End DoDot:1
+4 IF DICATT2["N"
Begin DoDot:1
+5 SET P(1)=+$PIECE(DICATT5,"X<",2)
if 'P(1)
QUIT
+6 SET P(2)=+$PIECE(DICATT5,"X>",2)
+7 SET P(3)=$PIECE(DICATT5,"1"".""",2)-1
IF P(3)<0
SET P(3)=0
if DICATT5["""$"""
SET P(3)=2
+8 SET Y=$$EZBLD^DIALOG($SELECT(DICATT5["""$""":9118.1,1:9118),.P)
End DoDot:1
+9 IF DICATT2["F"
Begin DoDot:1
+10 ;"ENTER FROM |1| TO |2| CHARACTERS ..."
SET P(1)=+$PIECE(DICATT5,"$L(X)<",2)
IF P(1)
SET P(2)=+$PIECE(DICATT5,"$L(X)>",2)
IF P(2)
SET Y=$$EZBLD^DIALOG($SELECT(P(1)=P(2):9119.1,1:9119),.P)
End DoDot:1
+11 IF $DATA(Y)
SET ^DD(FILE,FIELD,.009,DUZ("LANG"),0)=Y
Y IF $GET(Y)]""
QUIT Y
3 QUIT $GET(^DD(FILE,FIELD,3))
+1 ;
DICW(FILE) ;
+1 ; + NEXT 2 LINES WRITE OUT FIELD NAME IN 2 LANGUAGES
SET DIC("W")="N % S %=$P(^(0),U,2)"
+2 IF $GET(DUZ("LANG"))>1
SET DIC("W")=DIC("W")_" W:$D(^(.008,DUZ(""LANG""),0)) ?37,$$LABEL^DIALOGZ("_FILE_",+Y)"
+3 SET DIC("W")=DIC("W")_" W:% $P("" (multiple)^ (word-processing)"",U,$P($G(^DD(+%,.01,0)),U,2)[""W""+1)"
+4 QUIT
+5 ;
+6 ;
SETIN() ;NAKED REFERENCE Builds the SET STRING user sees, with 1,2,3...
+1 NEW C,P
+2 SET C=$PIECE(^(0),U,3)
+3 IF $DATA(^(.007,DUZ("LANG"),0))
Begin DoDot:1
+4 SET C=^(0)
FOR P=1:1:$LENGTH(C,";")
SET $PIECE(C,";",P)=P_":"_$PIECE(C,";",P)
End DoDot:1
+5 IF '$TEST
Begin DoDot:1
+6 NEW TRY,OUT,O
+7 SET TRY=""
FOR P=1:1
if $PIECE(C,";",P)=""
QUIT
SET O=$PIECE($PIECE(C,";",P),":",2)
SET OUT=$$YESORNO(O)
SET TRY=TRY_P_":"_OUT_";"
IF OUT=O
KILL TRY
QUIT
+8 IF $DATA(TRY)
SET C=TRY
End DoDot:1
+9 QUIT C
+10 ;
SETOUT() ;NAKED REFERENCE Builds the SET STRING that converts INTERNAL to user's EXTERNAL
+1 NEW P,V,C
+2 SET C=$PIECE(^(0),U,3)
+3 IF $DATA(^(.007,DUZ("LANG"),0))
Begin DoDot:1
+4 FOR P=1:1:$LENGTH(^(0),";")
SET V=$PIECE(C,";",P)
SET $PIECE(V,":",2)=$PIECE(^(0),";",P)
SET $PIECE(C,";",P)=V
End DoDot:1
+5 IF '$TEST
FOR P=1:1:$LENGTH(C,";")
SET V=$PIECE(C,";",P)
SET $PIECE(V,":",2)=$$YESORNO($PIECE(V,":",2))
SET $PIECE(C,";",P)=V
+6 QUIT C
+7 ;
YESORNO(Y) ;TRY TO TURN YES OR NO INTO 'SI', WHATEVER
+1 if '$GET(DUZ("LANG"))
QUIT Y
+2 IF $$UP^DILIBF(Y)="YES"
IF $DATA(^DI(.84,7001,4,DUZ("LANG"),1,1,0))
QUIT $PIECE(^(0),U)
+3 IF $$UP^DILIBF(Y)="NO"
IF $DATA(^DI(.84,7001,4,DUZ("LANG"),1,1,0))
QUIT $PIECE(^(0),U,2)
+4 QUIT Y
+5 ;
GOODLANG(Y) ;Check for language available for translation -- DPC
+1 ;Input = user's input ID NUMBER and zero node of language file entry
+2 ;Returns 1 for good language, 0 for no translation
+3 ;Only living languages can be translated
+4 IF Y(0)=""
WRITE Y_" is not an ID NUMBER of a language in the Language file."
QUIT 0
+5 IF $PIECE(Y(0),U,7)'="L"
WRITE $PIECE(Y(0),U)_" is not a living language. Translating is prohibited."
QUIT 0
+6 QUIT 1
+7 ;
