1 | XBDICV ; IHS/ADC/GTH - SET DICTIONARY VERSION NUMBERS ; [ 02/07/97 3:02 PM ]
|
---|
2 | ;;4.0;XB;;Jul 20, 2009;Build 2
|
---|
3 | ;
|
---|
4 | ; This routine sets FileMan dictionary version numbers.
|
---|
5 | ;
|
---|
6 | START ;
|
---|
7 | I $G(DUZ(0))'="@" W !,*7," Insufficient FileMan access. DUZ(0) is not ""@""." Q
|
---|
8 | S U="^",IOP=$I
|
---|
9 | D ^%ZIS
|
---|
10 | W !!,"^XBDICV - This program sets FileMan dictionary version numbers."
|
---|
11 | ;
|
---|
12 | S (XBDICVHI,XBDICVQF)=0
|
---|
13 | D GETDICS ; Get set of dictionaries
|
---|
14 | I XBDICVQF D EOJ Q
|
---|
15 | D SHOW ; Show current versions
|
---|
16 | D ASK ; See if user wants control
|
---|
17 | I XBDICVQF D EOJ Q
|
---|
18 | D VER ; Get new version number
|
---|
19 | I XBDICVQF D EOJ Q
|
---|
20 | D CHANGE ; Change version numbers
|
---|
21 | D EOJ ; Clean up
|
---|
22 | Q
|
---|
23 | ;
|
---|
24 | GETDICS ; GET SET OF DICTIONARIES
|
---|
25 | D ^XBDSET
|
---|
26 | S:'$D(^UTILITY("XBDSET",$J)) XBDICVQF=1
|
---|
27 | Q
|
---|
28 | ;
|
---|
29 | SHOW ; SHOW CURRENT VERSION NUMBERS
|
---|
30 | W !
|
---|
31 | S XBDICVFL=""
|
---|
32 | F XBDICVL=0:0 S XBDICVFL=$O(^UTILITY("XBDSET",$J,XBDICVFL)) Q:XBDICVFL="" W !,$P(^DIC(XBDICVFL,0),U,1),$S($D(^DD(XBDICVFL,0,"VR")):"..Current version is "_^("VR"),1:"..No version") D HIGH
|
---|
33 | Q
|
---|
34 | ;
|
---|
35 | HIGH ; SAVE HIGH VERSION NUMBER
|
---|
36 | I $D(^DD(XBDICVFL,0,"VR")),+^("VR")>+XBDICVHI S XBDICVHI=^("VR")
|
---|
37 | Q
|
---|
38 | ;
|
---|
39 | ASK ;
|
---|
40 | W !!,"Do you want to be asked before setting each file? (Y/N) Y// "
|
---|
41 | R XBDICASK:$G(DTIME,300)
|
---|
42 | S:XBDICASK="" XBDICASK="Y"
|
---|
43 | I "^YyNn"'[XBDICASK W *7 G ASK
|
---|
44 | I XBDICASK["^" S XBDICVQF=1 Q
|
---|
45 | S XBDICASK=$S("Yy"[$E(XBDICASK):1,1:0)
|
---|
46 | Q
|
---|
47 | ;
|
---|
48 | VER ;
|
---|
49 | R !!,"New version number: ",XBDICVVR:$G(DTIME,300)
|
---|
50 | I XBDICVVR["^" S XBDICVQF=1 Q
|
---|
51 | I XBDICVVR'?1.3N.1".".2N.1A.2N W *7 G VER
|
---|
52 | I +XBDICVVR<+XBDICVHI W !,"One or more selected files already has a version number greater than ",XBDICVVR,*7 G VER
|
---|
53 | Q
|
---|
54 | ;
|
---|
55 | CHANGE ; CHANGE VERSION NUMBERS
|
---|
56 | W !
|
---|
57 | S XBDICVFL=""
|
---|
58 | F XBDICVL=0:0 S XBDICVFL=$O(^UTILITY("XBDSET",$J,XBDICVFL)) Q:XBDICVFL="" D PROCESS
|
---|
59 | Q
|
---|
60 | ;
|
---|
61 | PROCESS ;
|
---|
62 | S XBDICANS="Y"
|
---|
63 | W !,$P(^DIC(XBDICVFL,0),U,1),$S($D(^DD(XBDICVFL,0,"VR")):"..Current version is "_^("VR"),1:"..No version"),$S(XBDICASK:"..OK? Y// ",1:"")
|
---|
64 | P2 ;
|
---|
65 | I XBDICASK R XBDICANS:$G(DTIME,300) S:XBDICANS="" XBDICANS="Y" I "YyNn"'[$E(XBDICANS) D P2ERR G P2
|
---|
66 | I XBDICANS="Y" S ^DD(XBDICVFL,0,"VR")=XBDICVVR W " Changed to ",XBDICVVR
|
---|
67 | Q
|
---|
68 | ;
|
---|
69 | P2ERR ;
|
---|
70 | W *7
|
---|
71 | F XBDICVI=1:1:$L(XBDICANS) W @IOBS," ",@IOBS
|
---|
72 | Q
|
---|
73 | ;
|
---|
74 | EOJ ;
|
---|
75 | KILL ^UTILITY("XBDSET",$J)
|
---|
76 | KILL XBDICANS,XBDICASK,XBDICVFL,XBDICVHI,XBDICVI,XBDICVL,XBDICVQF,XBDICVVR
|
---|
77 | KILL BS,FF,RM,SL,SUB,XY
|
---|
78 | Q
|
---|
79 | ;
|
---|