LEXDVO.m

LEXDVO ;ISL/KER - Default Vocabulary ;04/21/2014

 ;;2.0;LEXICON UTILITY;**80**;Sep 23, 1996;Build 10

 ;               

 ; Global Variables

 ;    None

 ;               

 ; External References

 ;    $$GET1^DIQ          ICR   2056

 ;    $$UP^XLFSTR         ICR  10103

 ;               

 ; Entry:  D EN^LEXDVO              LEXAP is unknown

 ;

 ; Entry:  D EN1^LEXDVO(LEXAP)     LEXAP is known

 ;

 ; Single user entry point - Saves Default Vocabulary in file 757.2

 ;

 ; Where 

 ;

 ;      LEXAP     Pointer to file 757.2

 ;      LEXCA     Action (modify/delete)

 ;      LEXDEL    Flag default for Deletion

 ;      LEXDNAM   Default Name

 ;      LEXDVAL   Default Value

 ;      LEXFIL    Flag for Filter

 ;      LEXFLD    Default field (1-4) in file 757.201

 ;      LEXUSER   DUZ of user

 ;      LEXX      Returned value

 ;

EN ; Single user, LEXAP is unknown

 N LEXAP S LEXAP=$$DFI^LEXDM4 Q:+LEXAP=0  W ! D EN1(LEXAP) Q

EN1(LEXAP) ; Single user, LEXAP is known

 N X,Y,LEXUSER,LEXX S LEXUSER=$G(DUZ) Q:+LEXUSER'>0  Q:'$L($$GET1^DIQ(200,+($G(DUZ)),.01))

 ;

 S LEXAP=$G(LEXAP) Q:LEXAP=""

 I '$D(^LEXT(757.2,+LEXAP,0))&('$D(^LEXT(757.2,"B",LEXAP)))&('$D(^LEXT(757.2,"C",$$UP^XLFSTR(LEXAP))))&('$D(^LEXT(757.2,"AN",LEXAP))) Q

 S:+LEXAP'>0 LEXAP=$$AP^LEXDFN2(LEXAP)

 ;

 Q:+($G(LEXAP))'>0  Q:+($P($G(^LEXT(757.2,+LEXAP,5)),"^",3))'>0

 K LEXFIL N LEXCA,LEXDVAL,LEXDNAM,LEXFLD S LEXFLD=3

 S LEXDVAL=$$EN^LEXDVOS Q:LEXDVAL="^^"

 S LEXDNAM=$P(LEXDVAL,"^",2),LEXDVAL=$P(LEXDVAL,"^",1)

 Q:LEXDVAL=""&(LEXDNAM="")  I LEXDVAL="",LEXDNAM'="" D  Q

 . N LEXDEL S LEXDEL=$$EN^LEXDM2(LEXUSER,LEXAP,3) I +LEXDEL>0 D KILL

 D SET

 Q

MGR(LEXX) ; Multi-user (for Manager options)

 ; Do not save vocabulary, return value to manager option

 N LEXCA,LEXDVAL,LEXDNAM S LEXCA=$$MOD^LEXDM(3) Q:LEXCA=0 "^"

 Q:(LEXCA="^^") "^^" Q:LEXCA="@" "@^Delete vocabulary"

 W ! S LEXDVAL=$$EN^LEXDVOS Q:LEXDVAL="^^" "^^"

 S LEXX=LEXDVAL Q LEXX

SET ; Set default vocabulary

 D SET^LEXDSV(LEXUSER,LEXAP,LEXDVAL,LEXDNAM,LEXFLD) Q

KILL ; Kill default vocabulary

 D SET^LEXDSV(LEXUSER,LEXAP,"@","Delete",LEXFLD) Q

LEXDVO    ;ISL/KER - Default Vocabulary ;04/21/2014

 +1       ;;2.0;LEXICON UTILITY;**80**;Sep 23, 1996;Build 10

 +2       ;               

 +3       ; Global Variables

 +4       ;    None

 +5       ;               

 +6       ; External References

 +7       ;    $$GET1^DIQ          ICR   2056

 +8       ;    $$UP^XLFSTR         ICR  10103

 +9       ;               

 +10      ; Entry:  D EN^LEXDVO              LEXAP is unknown

 +11      ;

 +12      ; Entry:  D EN1^LEXDVO(LEXAP)     LEXAP is known

 +13      ;

 +14      ; Single user entry point - Saves Default Vocabulary in file 757.2

 +15      ;

 +16      ; Where 

 +17      ;

 +18      ;      LEXAP     Pointer to file 757.2

 +19      ;      LEXCA     Action (modify/delete)

 +20      ;      LEXDEL    Flag default for Deletion

 +21      ;      LEXDNAM   Default Name

 +22      ;      LEXDVAL   Default Value

 +23      ;      LEXFIL    Flag for Filter

 +24      ;      LEXFLD    Default field (1-4) in file 757.201

 +25      ;      LEXUSER   DUZ of user

 +26      ;      LEXX      Returned value

 +27      ;

EN        ; Single user, LEXAP is unknown

 +1        NEW LEXAP

           SET LEXAP=$$DFI^LEXDM4

           IF +LEXAP=0

               QUIT 

           WRITE !

           DO EN1(LEXAP)

           QUIT 

EN1(LEXAP) ; Single user, LEXAP is known

 +1        NEW X,Y,LEXUSER,LEXX

           SET LEXUSER=$GET(DUZ)

           IF +LEXUSER'>0

               QUIT 

           IF '$LENGTH($$GET1^DIQ(200,+($GET(DUZ)),.01))

               QUIT 

 +2       ;

 +3        SET LEXAP=$GET(LEXAP)

           IF LEXAP=""

               QUIT 

 +4        IF '$DATA(^LEXT(757.2,+LEXAP,0))&('$DATA(^LEXT(757.2,"B",LEXAP)))&('$DATA(^LEXT(757.2,"C",$$UP^XLFSTR(LEXAP))))&('$DATA(^LEXT(757.2,"AN",LEXAP)))

               QUIT 

 +5        IF +LEXAP'>0

               SET LEXAP=$$AP^LEXDFN2(LEXAP)

 +6       ;

 +7        IF +($GET(LEXAP))'>0

               QUIT 

           IF +($PIECE($GET(^LEXT(757.2,+LEXAP,5)),"^",3))'>0

               QUIT 

 +8        KILL LEXFIL

           NEW LEXCA,LEXDVAL,LEXDNAM,LEXFLD

           SET LEXFLD=3

 +9        SET LEXDVAL=$$EN^LEXDVOS

           IF LEXDVAL="^^"

               QUIT 

 +10       SET LEXDNAM=$PIECE(LEXDVAL,"^",2)

           SET LEXDVAL=$PIECE(LEXDVAL,"^",1)

 +11       IF LEXDVAL=""&(LEXDNAM="")

               QUIT 

           IF LEXDVAL=""

               IF LEXDNAM'=""

                   Begin DoDot:1

 +12                   NEW LEXDEL

                       SET LEXDEL=$$EN^LEXDM2(LEXUSER,LEXAP,3)

                       IF +LEXDEL>0

                           DO KILL

                   End DoDot:1

                   QUIT 

 +13       DO SET

 +14       QUIT 

MGR(LEXX) ; Multi-user (for Manager options)

 +1       ; Do not save vocabulary, return value to manager option

 +2        NEW LEXCA,LEXDVAL,LEXDNAM

           SET LEXCA=$$MOD^LEXDM(3)

           IF LEXCA=0

               QUIT "^"

 +3        IF (LEXCA="^^")

               QUIT "^^"

           IF LEXCA="@"

               QUIT "@^Delete vocabulary"

 +4        WRITE !

           SET LEXDVAL=$$EN^LEXDVOS

           IF LEXDVAL="^^"

               QUIT "^^"

 +5        SET LEXX=LEXDVAL

           QUIT LEXX

SET       ; Set default vocabulary

 +1        DO SET^LEXDSV(LEXUSER,LEXAP,LEXDVAL,LEXDNAM,LEXFLD)

           QUIT 

KILL      ; Kill default vocabulary

 +1        DO SET^LEXDSV(LEXUSER,LEXAP,"@","Delete",LEXFLD)

           QUIT