XBDICV ; IHS/ADC/GTH - SET DICTIONARY VERSION NUMBERS ; [ 02/07/97 3:02 PM ]
;;3.0;IHS/VA UTILITIES;;FEB 07, 1997
;
; This routine sets FileMan dictionary version numbers.
;
START ;
I $G(DUZ(0))'="@" W !,*7," Insufficient FileMan access. DUZ(0) is not ""@""." Q
S U="^",IOP=$I
D ^%ZIS
W !!,"^XBDICV - This program sets FileMan dictionary version numbers."
;
S (XBDICVHI,XBDICVQF)=0
D GETDICS ; Get set of dictionaries
I XBDICVQF D EOJ Q
D SHOW ; Show current versions
D ASK ; See if user wants control
I XBDICVQF D EOJ Q
D VER ; Get new version number
I XBDICVQF D EOJ Q
D CHANGE ; Change version numbers
D EOJ ; Clean up
Q
;
GETDICS ; GET SET OF DICTIONARIES
D ^XBDSET
S:'$D(^UTILITY("XBDSET",$J)) XBDICVQF=1
Q
;
SHOW ; SHOW CURRENT VERSION NUMBERS
W !
S XBDICVFL=""
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
Q
;
HIGH ; SAVE HIGH VERSION NUMBER
I $D(^DD(XBDICVFL,0,"VR")),+^("VR")>+XBDICVHI S XBDICVHI=^("VR")
Q
;
ASK ;
W !!,"Do you want to be asked before setting each file? (Y/N) Y// "
R XBDICASK:$G(DTIME,300)
S:XBDICASK="" XBDICASK="Y"
I "^YyNn"'[XBDICASK W *7 G ASK
I XBDICASK["^" S XBDICVQF=1 Q
S XBDICASK=$S("Yy"[$E(XBDICASK):1,1:0)
Q
;
VER ;
R !!,"New version number: ",XBDICVVR:$G(DTIME,300)
I XBDICVVR["^" S XBDICVQF=1 Q
I XBDICVVR'?1.3N.1".".2N.1A.2N W *7 G VER
I +XBDICVVR<+XBDICVHI W !,"One or more selected files already has a version number greater than ",XBDICVVR,*7 G VER
Q
;
CHANGE ; CHANGE VERSION NUMBERS
W !
S XBDICVFL=""
F XBDICVL=0:0 S XBDICVFL=$O(^UTILITY("XBDSET",$J,XBDICVFL)) Q:XBDICVFL="" D PROCESS
Q
;
PROCESS ;
S XBDICANS="Y"
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:"")
P2 ;
I XBDICASK R XBDICANS:$G(DTIME,300) S:XBDICANS="" XBDICANS="Y" I "YyNn"'[$E(XBDICANS) D P2ERR G P2
I XBDICANS="Y" S ^DD(XBDICVFL,0,"VR")=XBDICVVR W " Changed to ",XBDICVVR
Q
;
P2ERR ;
W *7
F XBDICVI=1:1:$L(XBDICANS) W @IOBS," ",@IOBS
Q
;
EOJ ;
KILL ^UTILITY("XBDSET",$J)
KILL XBDICANS,XBDICASK,XBDICVFL,XBDICVHI,XBDICVI,XBDICVL,XBDICVQF,XBDICVVR
KILL BS,FF,RM,SL,SUB,XY
Q
;
XBDICV ; IHS/ADC/GTH - SET DICTIONARY VERSION NUMBERS ; [ 02/07/97 3:02 PM ]
+1 ;;3.0;IHS/VA UTILITIES;;FEB 07, 1997
+2 ;
+3 ; This routine sets FileMan dictionary version numbers.
+4 ;
START ;
+1 IF $GET(DUZ(0))'="@"
WRITE !,*7," Insufficient FileMan access. DUZ(0) is not ""@""."
QUIT
+2 SET U="^"
SET IOP=$IO
+3 DO ^%ZIS
+4 WRITE !!,"^XBDICV - This program sets FileMan dictionary version numbers."
+5 ;
+6 SET (XBDICVHI,XBDICVQF)=0
+7 ; Get set of dictionaries
DO GETDICS
+8 IF XBDICVQF
DO EOJ
QUIT
+9 ; Show current versions
DO SHOW
+10 ; See if user wants control
DO ASK
+11 IF XBDICVQF
DO EOJ
QUIT
+12 ; Get new version number
DO VER
+13 IF XBDICVQF
DO EOJ
QUIT
+14 ; Change version numbers
DO CHANGE
+15 ; Clean up
DO EOJ
+16 QUIT
+17 ;
GETDICS ; GET SET OF DICTIONARIES
+1 DO ^XBDSET
+2 IF '$DATA(^UTILITY("XBDSET",$JOB))
SET XBDICVQF=1
+3 QUIT
+4 ;
SHOW ; SHOW CURRENT VERSION NUMBERS
+1 WRITE !
+2 SET XBDICVFL=""
+3 FOR XBDICVL=0:0
SET XBDICVFL=$ORDER(^UTILITY("XBDSET",$JOB,XBDICVFL))
IF XBDICVFL=""
QUIT
WRITE !,$PIECE(^DIC(XBDICVFL,0),U,1),$SELECT($DATA(^DD(XBDICVFL,0,"VR")):"..Current version is "_^("VR"),1:"..No version")
DO HIGH
+4 QUIT
+5 ;
HIGH ; SAVE HIGH VERSION NUMBER
+1 IF $DATA(^DD(XBDICVFL,0,"VR"))
IF +^("VR")>+XBDICVHI
SET XBDICVHI=^("VR")
+2 QUIT
+3 ;
ASK ;
+1 WRITE !!,"Do you want to be asked before setting each file? (Y/N) Y// "
+2 READ XBDICASK:$GET(DTIME,300)
+3 IF XBDICASK=""
SET XBDICASK="Y"
+4 IF "^YyNn"'[XBDICASK
WRITE *7
GOTO ASK
+5 IF XBDICASK["^"
SET XBDICVQF=1
QUIT
+6 SET XBDICASK=$SELECT("Yy"[$EXTRACT(XBDICASK):1,1:0)
+7 QUIT
+8 ;
VER ;
+1 READ !!,"New version number: ",XBDICVVR:$GET(DTIME,300)
+2 IF XBDICVVR["^"
SET XBDICVQF=1
QUIT
+3 IF XBDICVVR'?1.3N.1".".2N.1A.2N
WRITE *7
GOTO VER
+4 IF +XBDICVVR<+XBDICVHI
WRITE !,"One or more selected files already has a version number greater than ",XBDICVVR,*7
GOTO VER
+5 QUIT
+6 ;
CHANGE ; CHANGE VERSION NUMBERS
+1 WRITE !
+2 SET XBDICVFL=""
+3 FOR XBDICVL=0:0
SET XBDICVFL=$ORDER(^UTILITY("XBDSET",$JOB,XBDICVFL))
IF XBDICVFL=""
QUIT
DO PROCESS
+4 QUIT
+5 ;
PROCESS ;
+1 SET XBDICANS="Y"
+2 WRITE !,$PIECE(^DIC(XBDICVFL,0),U,1),$SELECT($DATA(^DD(XBDICVFL,0,"VR")):"..Current version is "_^("VR"),1:"..No version"),$SELECT(XBDICASK:"..OK? Y// ",1:"")
P2 ;
+1 IF XBDICASK
READ XBDICANS:$GET(DTIME,300)
IF XBDICANS=""
SET XBDICANS="Y"
IF "YyNn"'[$EXTRACT(XBDICANS)
DO P2ERR
GOTO P2
+2 IF XBDICANS="Y"
SET ^DD(XBDICVFL,0,"VR")=XBDICVVR
WRITE " Changed to ",XBDICVVR
+3 QUIT
+4 ;
P2ERR ;
+1 WRITE *7
+2 FOR XBDICVI=1:1:$LENGTH(XBDICANS)
WRITE @IOBS," ",@IOBS
+3 QUIT
+4 ;
EOJ ;
+1 KILL ^UTILITY("XBDSET",$JOB)
+2 KILL XBDICANS,XBDICASK,XBDICVFL,XBDICVHI,XBDICVI,XBDICVL,XBDICVQF,XBDICVVR
+3 KILL BS,FF,RM,SL,SUB,XY
+4 QUIT
+5 ;
