DIALOGU.m

DIALOGU ;SFISC/MMW - FUNCTIONS FOR DIALOGS ;11/21/94  13:26

 ;;22.0;VA FileMan;;Mar 30, 1999

 ;Per VHA Directive 10-93-142, this routine should not be modified.

 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=$$LGR^%ZOSV

 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 D:DINAKED]""

 . I DINAKED["(" Q:$O(@(DINAKED))  Q

 . I $D(@(DINAKED))

 . Q

 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=$$LGR^%ZOSV

 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

DIALOGU   ;SFISC/MMW - FUNCTIONS FOR DIALOGS ;11/21/94  13:26

 +1       ;;22.0;VA FileMan;;Mar 30, 1999

 +2       ;Per VHA Directive 10-93-142, this routine should not be modified.

 +3       ;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        NEW DINAKED,DIY

           SET DINAKED=$$LGR^%ZOSV

 +8        NEW DILANG

           SET DILANG=+$GET(DUZ("LANG"))

           IF DILANG<1

               SET DILANG=1

 +9        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

 +10       XECUTE DIY

Q          IF DINAKED]""

               Begin DoDot:1

 +1                IF DINAKED["("

                       IF $ORDER(@(DINAKED))

                           QUIT 

                       QUIT 

 +2                IF $DATA(@(DINAKED))

 +3                QUIT 

               End DoDot:1

 +4        QUIT Y

 +5       ;

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        NEW DINAKED,Y

           SET DINAKED=$$LGR^%ZOSV

 +8        IF '$DATA(^DI(.84,+$GET(D0)))!($GET(X)']"")

               SET Y=0

               GOTO Q

 +9        NEW R,I,I1,IL,T,W,%,DILANG

 +10       SET DILANG=+$GET(DUZ("LANG"))

           IF DILANG<1

               SET DILANG=1

 +11       IF DILANG>1

               IF '$ORDER(^DI(.84,D0,4,DILANG,1,0))

                   SET DILANG=1

 +12       SET X=$$OUT(X,"UC")

           SET U="^"

 +13       SET R=$SELECT(DILANG=1:"^DI(.84,"_D0_",2)",1:"^DI(.84,"_D0_",4,"_DILANG_",1)")

 +14       SET (I,I1,%)=0

           FOR 

               SET I=$ORDER(@R@(I))

               IF 'I!%

                   QUIT 

               SET T=$$OUT(@R@(I,0),"UC")

               Begin DoDot:1

 +15               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

 +16       IF '%

               SET Y=-1

               GOTO Q

 +17       IF DILANG=1

               SET Y=%

               GOTO Q

 +18       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

 +19               FOR IL=1:1

                       IF $PIECE(T,U,IL)=""!(I1=%)

                           QUIT 

                       SET I1=I1+1

                       SET W=$PIECE(T,U,IL)

               End DoDot:1

 +20       SET Y=%_U_$GET(W)

           GOTO Q