DIALOGU ;SFISC/MMW - FUNCTIONS FOR DIALOGS ;24MAR2010
;;22.2;VA FileMan;**7,8**;Jan 05, 2016;Build 19
;;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.
;
Q ;not for interactive use
OUT(Y,DIALF,%F) ;convert FileMan Data to language dependant output format
;Y is the value to transform, DIALF is the type of data
;%F Only for "FMTE" node. Passed from FMTE^DILIBF, indicates date format.
;DIALF must correspond to at least a subscript in the language file
;for the english language (entry #1) but may also have corresponding
;entries for other languages
I $D(Y)[0!($G(DIALF)="") Q ""
;N DINAKED,DIY S DINAKED=$NA(^(0))
N DINAKED,DIY S DINAKED=$$LGR^%ZOSV ;p7
N DILANG S DILANG=+$G(DUZ("LANG")) S:DILANG<1 DILANG=1
S DIY=$G(^DI(.85,DILANG,DIALF)) I DIY="" S:DILANG'=1 DIY=$G(^DI(.85,1,DIALF)) I DIY="" S Y="" G Q
X DIY
Q S:DINAKED]"" DINAKED=$S(DINAKED["""""":$O(@DINAKED),1:$D(@DINAKED)) ;p8
Q Y
;
PRS(D0,X) ;parse language dependant user input
;D0 is an entry in the DIALOG file
;X is the user input
;the function returns the number of the matching command word
;plus the corresponding english text. If no match was found -1 will
;be returned. If there is no user input the function returns the
;null string.
;N DINAKED,Y S DINAKED=$NA(^(0))
N DINAKED,Y S DINAKED=$$LGR^%ZOSV ;P7
I '$D(^DI(.84,+$G(D0)))!($G(X)']"") S Y=0 G Q
N R,I,I1,IL,T,W,%,DILANG
S DILANG=+$G(DUZ("LANG")) S:DILANG<1 DILANG=1
I DILANG>1,'$O(^DI(.84,D0,4,DILANG,1,0)) S DILANG=1
S X=$$OUT(X,"UC"),U="^"
S R=$S(DILANG=1:"^DI(.84,"_D0_",2)",1:"^DI(.84,"_D0_",4,"_DILANG_",1)")
S (I,I1,%)=0 F S I=$O(@R@(I)) Q:'I!% S T=$$OUT(@R@(I,0),"UC") D
.F IL=1:1 S W=$P(T,U,IL) Q:W=""!% S I1=I1+1 S:$E(W,1,$L(X))=X %=I1_U_$P(@R@(I,0),U,IL)
I '% S Y=-1 G Q
I DILANG=1 S Y=% G Q
S (I,I1)=0,%=+% F S I=$O(^DI(.84,D0,2,I)) Q:'I!(I1=%) S T=^(I,0) D
.F IL=1:1 Q:$P(T,U,IL)=""!(I1=%) S I1=I1+1,W=$P(T,U,IL)
S Y=%_U_$G(W) G Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDIALOGU 2170 printed Apr 09, 2024@21:53:13 Page 2
DIALOGU ;SFISC/MMW - FUNCTIONS FOR DIALOGS ;24MAR2010
+1 ;;22.2;VA FileMan;**7,8**;Jan 05, 2016;Build 19
+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 ;
+7 ;not for interactive use
QUIT
OUT(Y,DIALF,%F) ;convert FileMan Data to language dependant output format
+1 ;Y is the value to transform, DIALF is the type of data
+2 ;%F Only for "FMTE" node. Passed from FMTE^DILIBF, indicates date format.
+3 ;DIALF must correspond to at least a subscript in the language file
+4 ;for the english language (entry #1) but may also have corresponding
+5 ;entries for other languages
+6 IF $DATA(Y)[0!($GET(DIALF)="")
QUIT ""
+7 ;N DINAKED,DIY S DINAKED=$NA(^(0))
+8 ;p7
NEW DINAKED,DIY
SET DINAKED=$$LGR^%ZOSV
+9 NEW DILANG
SET DILANG=+$GET(DUZ("LANG"))
if DILANG<1
SET DILANG=1
+10 SET DIY=$GET(^DI(.85,DILANG,DIALF))
IF DIY=""
if DILANG'=1
SET DIY=$GET(^DI(.85,1,DIALF))
IF DIY=""
SET Y=""
GOTO Q
+11 XECUTE DIY
Q ;p8
if DINAKED]""
SET DINAKED=$SELECT(DINAKED["""""":$ORDER(@DINAKED),1:$DATA(@DINAKED))
+1 QUIT Y
+2 ;
PRS(D0,X) ;parse language dependant user input
+1 ;D0 is an entry in the DIALOG file
+2 ;X is the user input
+3 ;the function returns the number of the matching command word
+4 ;plus the corresponding english text. If no match was found -1 will
+5 ;be returned. If there is no user input the function returns the
+6 ;null string.
+7 ;N DINAKED,Y S DINAKED=$NA(^(0))
+8 ;P7
NEW DINAKED,Y
SET DINAKED=$$LGR^%ZOSV
+9 IF '$DATA(^DI(.84,+$GET(D0)))!($GET(X)']"")
SET Y=0
GOTO Q
+10 NEW R,I,I1,IL,T,W,%,DILANG
+11 SET DILANG=+$GET(DUZ("LANG"))
if DILANG<1
SET DILANG=1
+12 IF DILANG>1
IF '$ORDER(^DI(.84,D0,4,DILANG,1,0))
SET DILANG=1
+13 SET X=$$OUT(X,"UC")
SET U="^"
+14 SET R=$SELECT(DILANG=1:"^DI(.84,"_D0_",2)",1:"^DI(.84,"_D0_",4,"_DILANG_",1)")
+15 SET (I,I1,%)=0
FOR
SET I=$ORDER(@R@(I))
if 'I!%
QUIT
SET T=$$OUT(@R@(I,0),"UC")
Begin DoDot:1
+16 FOR IL=1:1
SET W=$PIECE(T,U,IL)
if W=""!%
QUIT
SET I1=I1+1
if $EXTRACT(W,1,$LENGTH(X))=X
SET %=I1_U_$PIECE(@R@(I,0),U,IL)
End DoDot:1
+17 IF '%
SET Y=-1
GOTO Q
+18 IF DILANG=1
SET Y=%
GOTO Q
+19 SET (I,I1)=0
SET %=+%
FOR
SET I=$ORDER(^DI(.84,D0,2,I))
if 'I!(I1=%)
QUIT
SET T=^(I,0)
Begin DoDot:1
+20 FOR IL=1:1
if $PIECE(T,U,IL)=""!(I1=%)
QUIT
SET I1=I1+1
SET W=$PIECE(T,U,IL)
End DoDot:1
+21 SET Y=%_U_$GET(W)
GOTO Q
