| [641] | 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 | ;
|
|---|
