- 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
