- 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 ;
