- LEXDSV ;ISL/KER - Defaults - Save ;04/21/2014
- ;;2.0;LEXICON UTILITY;**80**;Sep 23, 1996;Build 10
- ;
- ; Global Variables
- ; None
- ;
- ; External References
- ; FILE^DICN ICR 10009
- ; ^DIE ICR 10018
- ; ^DIK ICR 10013
- ;
- ; Needs
- ;
- ; Application File DA, Subfile DA(1) LEXAP
- ; User DUZ Sub-file .01 DINUM LEXDUZ
- ; Default value LEXDVAL
- ; Defualt name LEXDNAM
- ; Default field Sub-file field LEXFLD
- ;
- ; Sets ^LEXT(757.2,LEXAP,200,LEXDUZ,LEXFLD)=LEXDVAL
- ; and ^LEXT(757.2,LEXAP,200,LEXDUZ,(LEXFLD+.5))=LEXDNAM
- ;
- Q
- SET(LEXDUZ,LEXAP,LEXDVAL,LEXDNAM,LEXFLD) ;
- ;
- Q:'$L($G(LEXDVAL)) S:LEXDVAL["@" LEXDVAL="@",LEXDNAM="@" S DIC("P")="757.201PA"
- N LEXWARN S LEXWARN=0,(DIC,DIE)="^LEXT(757.2,"_LEXAP_",200,"
- S DA(1)=LEXAP,DA=LEXDUZ
- S DLAYGO=757.2,(DINUM,X)=LEXDUZ,DIC(0)="L"
- S DIC("DR")=LEXFLD_"////^S X=LEXDVAL" K DD,DO D FILE^DICN
- EDIT ; Lock record and edit user default
- L +^LEXT(757.2,+LEXAP,200):1
- I '$T D G EDIT
- . W:'$D(ZTQUEUED)&('LEXWARN) !,"Another user is editing this entry, please wait"
- . S LEXWARN=1 H 2
- S DA(1)=LEXAP,DA=LEXDUZ,DR=LEXFLD_"////^S X=LEXDVAL"
- D ^DIE I $L($G(LEXDNAM)) S DR=(LEXFLD+.5)_"////^S X=LEXDNAM" D ^DIE
- K DA,DR,DIE,DIC
- L -^LEXT(757.2,+LEXAP,200)
- ;
- ; Delete name if default is null
- ;
- N LEXX,LEXDEL S LEXX=0,LEXDEL=1
- F S LEXX=$O(^LEXT(757.2,LEXAP,200,LEXDUZ,LEXX)) Q:+LEXX=0 D
- . I '$L($G(^LEXT(757.2,LEXAP,200,LEXDUZ,LEXX))) D
- . . I $L($G(^LEXT(757.2,LEXAP,200,LEXDUZ,(LEXX+.5)))) D
- . . . S LEXDVAL="@",DIC("P")="757.201PA"
- . . . S (DIC,DIE)="^LEXT(757.2,"_LEXAP_",200,",DA(1)=LEXAP,DA=LEXDUZ
- . . . S DLAYGO=757.2,(DINUM,X)=LEXDUZ,DIC(0)="L"
- . . . L +^LEXT(757.2,+LEXAP,200):1 I '$T H 2 S LEXX=LEXX-.05 Q
- . . . S DR=(LEXX+.5)_"////^S X=LEXDVAL"
- . . . D ^DIE S LEXX=LEXX+.5 K DA,DR,DIE,DIC
- . . . L -^LEXT(757.2,+LEXAP,200)
- . . I '$L($G(^LEXT(757.2,LEXAP,200,LEXDUZ,(LEXX+.5)))) D
- . . . K ^LEXT(757.2,LEXAP,200,LEXDUZ,LEXX),^LEXT(757.2,LEXAP,200,LEXDUZ,(LEXX+.5))
- . I $L($G(^LEXT(757.2,LEXAP,200,LEXDUZ,LEXX))) S LEXDEL=0
- ;
- ; Delete record if all defaults are null
- ;
- I LEXDEL D
- . S (DIC,DIE,DIK)="^LEXT(757.2,"_LEXAP_",200,"
- . S DA(1)=LEXAP,DA=LEXDUZ D ^DIK
- Q
- LEXDSV ;ISL/KER - Defaults - Save ;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 ; FILE^DICN ICR 10009
- +8 ; ^DIE ICR 10018
- +9 ; ^DIK ICR 10013
- +10 ;
- +11 ; Needs
- +12 ;
- +13 ; Application File DA, Subfile DA(1) LEXAP
- +14 ; User DUZ Sub-file .01 DINUM LEXDUZ
- +15 ; Default value LEXDVAL
- +16 ; Defualt name LEXDNAM
- +17 ; Default field Sub-file field LEXFLD
- +18 ;
- +19 ; Sets ^LEXT(757.2,LEXAP,200,LEXDUZ,LEXFLD)=LEXDVAL
- +20 ; and ^LEXT(757.2,LEXAP,200,LEXDUZ,(LEXFLD+.5))=LEXDNAM
- +21 ;
- +22 QUIT
- SET(LEXDUZ,LEXAP,LEXDVAL,LEXDNAM,LEXFLD) ;
- +1 ;
- +2 IF '$LENGTH($GET(LEXDVAL))
- QUIT
- IF LEXDVAL["@"
- SET LEXDVAL="@"
- SET LEXDNAM="@"
- SET DIC("P")="757.201PA"
- +3 NEW LEXWARN
- SET LEXWARN=0
- SET (DIC,DIE)="^LEXT(757.2,"_LEXAP_",200,"
- +4 SET DA(1)=LEXAP
- SET DA=LEXDUZ
- +5 SET DLAYGO=757.2
- SET (DINUM,X)=LEXDUZ
- SET DIC(0)="L"
- +6 SET DIC("DR")=LEXFLD_"////^S X=LEXDVAL"
- KILL DD,DO
- DO FILE^DICN
- EDIT ; Lock record and edit user default
- +1 LOCK +^LEXT(757.2,+LEXAP,200):1
- +2 IF '$TEST
- Begin DoDot:1
- +3 IF '$DATA(ZTQUEUED)&('LEXWARN)
- WRITE !,"Another user is editing this entry, please wait"
- +4 SET LEXWARN=1
- HANG 2
- End DoDot:1
- GOTO EDIT
- +5 SET DA(1)=LEXAP
- SET DA=LEXDUZ
- SET DR=LEXFLD_"////^S X=LEXDVAL"
- +6 DO ^DIE
- IF $LENGTH($GET(LEXDNAM))
- SET DR=(LEXFLD+.5)_"////^S X=LEXDNAM"
- DO ^DIE
- +7 KILL DA,DR,DIE,DIC
- +8 LOCK -^LEXT(757.2,+LEXAP,200)
- +9 ;
- +10 ; Delete name if default is null
- +11 ;
- +12 NEW LEXX,LEXDEL
- SET LEXX=0
- SET LEXDEL=1
- +13 FOR
- SET LEXX=$ORDER(^LEXT(757.2,LEXAP,200,LEXDUZ,LEXX))
- IF +LEXX=0
- QUIT
- Begin DoDot:1
- +14 IF '$LENGTH($GET(^LEXT(757.2,LEXAP,200,LEXDUZ,LEXX)))
- Begin DoDot:2
- +15 IF $LENGTH($GET(^LEXT(757.2,LEXAP,200,LEXDUZ,(LEXX+.5))))
- Begin DoDot:3
- +16 SET LEXDVAL="@"
- SET DIC("P")="757.201PA"
- +17 SET (DIC,DIE)="^LEXT(757.2,"_LEXAP_",200,"
- SET DA(1)=LEXAP
- SET DA=LEXDUZ
- +18 SET DLAYGO=757.2
- SET (DINUM,X)=LEXDUZ
- SET DIC(0)="L"
- +19 LOCK +^LEXT(757.2,+LEXAP,200):1
- IF '$TEST
- HANG 2
- SET LEXX=LEXX-.05
- QUIT
- +20 SET DR=(LEXX+.5)_"////^S X=LEXDVAL"
- +21 DO ^DIE
- SET LEXX=LEXX+.5
- KILL DA,DR,DIE,DIC
- +22 LOCK -^LEXT(757.2,+LEXAP,200)
- End DoDot:3
- +23 IF '$LENGTH($GET(^LEXT(757.2,LEXAP,200,LEXDUZ,(LEXX+.5))))
- Begin DoDot:3
- +24 KILL ^LEXT(757.2,LEXAP,200,LEXDUZ,LEXX),^LEXT(757.2,LEXAP,200,LEXDUZ,(LEXX+.5))
- End DoDot:3
- End DoDot:2
- +25 IF $LENGTH($GET(^LEXT(757.2,LEXAP,200,LEXDUZ,LEXX)))
- SET LEXDEL=0
- End DoDot:1
- +26 ;
- +27 ; Delete record if all defaults are null
- +28 ;
- +29 IF LEXDEL
- Begin DoDot:1
- +30 SET (DIC,DIE,DIK)="^LEXT(757.2,"_LEXAP_",200,"
- +31 SET DA(1)=LEXAP
- SET DA=LEXDUZ
- DO ^DIK
- End DoDot:1
- +32 QUIT
