source: WorldVistAEHR/trunk/r/LEXICON_UTILITY-LEX-GMPT/LEXDSV.m@ 1710

Last change on this file since 1710 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.1 KB
RevLine 
[613]1LEXDSV ; ISL Defaults - Save ; 09-23-96
2 ;;2.0;LEXICON UTILITY;;Sep 23, 1996;Build 1
3 Q
4 ;
5 ; Needs
6 ;
7 ; Application File DA, Subfile DA(1) LEXAP
8 ; User DUZ Sub-file .01 DINUM LEXDUZ
9 ; Default value LEXDVAL
10 ; Defualt name LEXDNAM
11 ; Default location Sub-file field LEXFLD
12 ;
13 ; Sets ^LEXT(757.2,LEXAP,200,LEXDUZ,LEXFLD)=LEXDVAL
14 ; and ^LEXT(757.2,LEXAP,200,LEXDUZ,(LEXFLD+.5))=LEXDNAM
15 ;
16 ;
17SET(LEXDUZ,LEXAP,LEXDVAL,LEXDNAM,LEXFLD) ;
18 ;
19 Q:'$L($G(LEXDVAL)) S:LEXDVAL["@" LEXDVAL="@",LEXDNAM="@" S DIC("P")="757.201PA"
20 N LEXWARN S LEXWARN=0,(DIC,DIE)="^LEXT(757.2,"_LEXAP_",200,"
21 S DA(1)=LEXAP,DA=LEXDUZ
22 S DLAYGO=757.2,(DINUM,X)=LEXDUZ,DIC(0)="L"
23 S DIC("DR")=LEXFLD_"////^S X=LEXDVAL" K DD,DO D FILE^DICN
24EDIT ; Lock record and edit user default
25 L +^LEXT(757.2,+LEXAP,200):1
26 I '$T D G EDIT
27 . W:'$D(ZTQUEUED)&('LEXWARN) !,"Another user is editing this entry, please wait"
28 . S LEXWARN=1 H 2
29 S DA(1)=LEXAP,DA=LEXDUZ,DR=LEXFLD_"////^S X=LEXDVAL"
30 D ^DIE I $L($G(LEXDNAM)) S DR=(LEXFLD+.5)_"////^S X=LEXDNAM" D ^DIE
31 K DA,DR,DIE,DIC
32 L -^LEXT(757.2,+LEXAP,200)
33 ;
34 ; Delete name if default is null
35 ;
36 N LEXX,LEXDEL S LEXX=0,LEXDEL=1
37 F S LEXX=$O(^LEXT(757.2,LEXAP,200,LEXDUZ,LEXX)) Q:+LEXX=0 D
38 . I '$L($G(^LEXT(757.2,LEXAP,200,LEXDUZ,LEXX))) D
39 . . I $L($G(^LEXT(757.2,LEXAP,200,LEXDUZ,(LEXX+.5)))) D
40 . . . S LEXDVAL="@",DIC("P")="757.201PA"
41 . . . S (DIC,DIE)="^LEXT(757.2,"_LEXAP_",200,",DA(1)=LEXAP,DA=LEXDUZ
42 . . . S DLAYGO=757.2,(DINUM,X)=LEXDUZ,DIC(0)="L"
43 . . . L +^LEXT(757.2,+LEXAP,200):1 I '$T H 2 S LEXX=LEXX-.05 Q
44 . . . S DR=(LEXX+.5)_"////^S X=LEXDVAL"
45 . . . D ^DIE S LEXX=LEXX+.5 K DA,DR,DIE,DIC
46 . . . L -^LEXT(757.2,+LEXAP,200)
47 . . I '$L($G(^LEXT(757.2,LEXAP,200,LEXDUZ,(LEXX+.5)))) D
48 . . . K ^LEXT(757.2,LEXAP,200,LEXDUZ,LEXX),^LEXT(757.2,LEXAP,200,LEXDUZ,(LEXX+.5))
49 . I $L($G(^LEXT(757.2,LEXAP,200,LEXDUZ,LEXX))) S LEXDEL=0
50 ;
51 ; Delete record if all defaults are null
52 ;
53 I LEXDEL D
54 . S (DIC,DIE,DIK)="^LEXT(757.2,"_LEXAP_",200,"
55 . S DA(1)=LEXAP,DA=LEXDUZ D ^DIK
56 Q
Note: See TracBrowser for help on using the repository browser.