- XPDCUSTU ;SLC/STAFF-SITE TRACKING UPDATE ALL VERSIONS, UTILITY ;7/20/94 15:38 [ 04/02/2003 8:29 AM ]
- ;;8.0;KERNEL;**1005,1007**;APR 1, 2003
- ;;7.1;Kernel;**22,35**;Oct 25, 1993
- ;
- VERSION ; from XPDCUSTP
- ; return version and date of package
- N IFN
- ;
- S IFN=+$O(^DIC(9.4,"B",PACKAGE,0))
- S VERSION=$G(^DIC(9.4,IFN,"VERSION"))
- S DATE=$$DATE(IFN,VERSION)
- S ROUTINES=$P(^TMP("XPDCUP",$J,PACKAGE),U,4) I '$L(ROUTINES) Q
- S ROUTINE="" F CNT=1:1 S ROUTINE=$P(ROUTINES,",",CNT) Q:ROUTINE="" D
- .S VERSION=$$MAX(VERSION,$$VER(ROUTINE))
- ; if package installed but no 'CURRENT VERSION' in Package file
- I VERSION,'DATE S DATE=$$DATE(IFN,VERSION)
- I 'DATE,VERSION,VERSION'[".",VERSION=+VERSION S VERSION=VERSION_".0",DATE=$$DATE(IFN,VERSION)
- Q
- ;
- DATE(IFN,VERSION) ; $$(package ifn,version) -> date of install
- N IFN1
- ;
- I 'VERSION Q ""
- S IFN1=+$O(^DIC(9.4,IFN,22,"B",VERSION,0))
- Q $P($G(^DIC(9.4,IFN,22,IFN1,0)),U,3)
- ;
- VER(ROUTINE) ; $$(routine) -> version #
- N STRIP,VER
- ;
- ; get version # from 2nd line of routine
- I '$L(ROUTINE) Q ""
- S VER=$P($T(@ROUTINE+1^@ROUTINE),";",3) I '$L(VER) Q ""
- ;
- ; strip spaces and text from version #
- F Q:$E(VER)'=" " S VER=$E(VER,2,245)
- F STRIP="VERSION","Version","version","V","v" I $E(VER,1,$L(STRIP))=STRIP S VER=$E(VER,$L(STRIP)+1,$L(VER)) Q
- F Q:$E(VER)'=" " S VER=$E(VER,2,245)
- Q $P(VER," ")
- ;
- MAX(V1,V2) ; $$(version1,version2) -> highest version #
- I V1=V2 Q V1
- I +V1>+V2 Q V1
- I +V2>+V1 Q V2
- I V1'?.NP,V1?.ANP,V2?.NP Q V2 ;version1 is test, version2 is verified
- I V2'?.NP,V2?.ANP,V1?.NP Q V1 ;version2 is test, version1 is verified
- I V1?.NP,V2?.NP Q $S($L(V1)>$L(V2):V1,1:V2) ;ex. 4.0 vs 4
- I V1["T",V2["V" Q V2 ;test vs verify
- I V1["V",V2["T" Q V1 ;" "
- I V1["T",V2["T" Q $S(+$P(V1,"T",2)>+$P(V2,"T",2):V1,1:V2) ;highest test
- I V1["V",V2["V" Q $S(+$P(V1,"V",2)>+$P(V2,"V",2):V1,1:V2) ;highest verify
- Q V1 ;give up
- XPDCUSTU ;SLC/STAFF-SITE TRACKING UPDATE ALL VERSIONS, UTILITY ;7/20/94 15:38 [ 04/02/2003 8:29 AM ]
- +1 ;;8.0;KERNEL;**1005,1007**;APR 1, 2003
- +2 ;;7.1;Kernel;**22,35**;Oct 25, 1993
- +3 ;
- VERSION ; from XPDCUSTP
- +1 ; return version and date of package
- +2 NEW IFN
- +3 ;
- +4 SET IFN=+$ORDER(^DIC(9.4,"B",PACKAGE,0))
- +5 SET VERSION=$GET(^DIC(9.4,IFN,"VERSION"))
- +6 SET DATE=$$DATE(IFN,VERSION)
- +7 SET ROUTINES=$PIECE(^TMP("XPDCUP",$JOB,PACKAGE),U,4)
- IF '$LENGTH(ROUTINES)
- QUIT
- +8 SET ROUTINE=""
- FOR CNT=1:1
- SET ROUTINE=$PIECE(ROUTINES,",",CNT)
- IF ROUTINE=""
- QUIT
- Begin DoDot:1
- +9 SET VERSION=$$MAX(VERSION,$$VER(ROUTINE))
- End DoDot:1
- +10 ; if package installed but no 'CURRENT VERSION' in Package file
- +11 IF VERSION
- IF 'DATE
- SET DATE=$$DATE(IFN,VERSION)
- +12 IF 'DATE
- IF VERSION
- IF VERSION'["."
- IF VERSION=+VERSION
- SET VERSION=VERSION_".0"
- SET DATE=$$DATE(IFN,VERSION)
- +13 QUIT
- +14 ;
- DATE(IFN,VERSION) ; $$(package ifn,version) -> date of install
- +1 NEW IFN1
- +2 ;
- +3 IF 'VERSION
- QUIT ""
- +4 SET IFN1=+$ORDER(^DIC(9.4,IFN,22,"B",VERSION,0))
- +5 QUIT $PIECE($GET(^DIC(9.4,IFN,22,IFN1,0)),U,3)
- +6 ;
- VER(ROUTINE) ; $$(routine) -> version #
- +1 NEW STRIP,VER
- +2 ;
- +3 ; get version # from 2nd line of routine
- +4 IF '$LENGTH(ROUTINE)
- QUIT ""
- +5 SET VER=$PIECE($TEXT(@ROUTINE+1^@ROUTINE),";",3)
- IF '$LENGTH(VER)
- QUIT ""
- +6 ;
- +7 ; strip spaces and text from version #
- +8 FOR
- IF $EXTRACT(VER)'=" "
- QUIT
- SET VER=$EXTRACT(VER,2,245)
- +9 FOR STRIP="VERSION","Version","version","V","v"
- IF $EXTRACT(VER,1,$LENGTH(STRIP))=STRIP
- SET VER=$EXTRACT(VER,$LENGTH(STRIP)+1,$LENGTH(VER))
- QUIT
- +10 FOR
- IF $EXTRACT(VER)'=" "
- QUIT
- SET VER=$EXTRACT(VER,2,245)
- +11 QUIT $PIECE(VER," ")
- +12 ;
- MAX(V1,V2) ; $$(version1,version2) -> highest version #
- +1 IF V1=V2
- QUIT V1
- +2 IF +V1>+V2
- QUIT V1
- +3 IF +V2>+V1
- QUIT V2
- +4 ;version1 is test, version2 is verified
- IF V1'?.NP
- IF V1?.ANP
- IF V2?.NP
- QUIT V2
- +5 ;version2 is test, version1 is verified
- IF V2'?.NP
- IF V2?.ANP
- IF V1?.NP
- QUIT V1
- +6 ;ex. 4.0 vs 4
- IF V1?.NP
- IF V2?.NP
- QUIT $SELECT($LENGTH(V1)>$LENGTH(V2):V1,1:V2)
- +7 ;test vs verify
- IF V1["T"
- IF V2["V"
- QUIT V2
- +8 ;" "
- IF V1["V"
- IF V2["T"
- QUIT V1
- +9 ;highest test
- IF V1["T"
- IF V2["T"
- QUIT $SELECT(+$PIECE(V1,"T",2)>+$PIECE(V2,"T",2):V1,1:V2)
- +10 ;highest verify
- IF V1["V"
- IF V2["V"
- QUIT $SELECT(+$PIECE(V1,"V",2)>+$PIECE(V2,"V",2):V1,1:V2)
- +11 ;give up
- QUIT V1
