AZAXPKG ;IHS/PHXAO/AEF - CHECK PACKAGE FILE
;;1.0;ANNE'S SPECIAL ROUTINES;;AUG 4, 2004
;
DESC ;----- ROUTINE DESCRIPTION
;;
;; This routine checks the PACKAGE file for the following:
;; 1) Duplicate entries in both the package names and prefixes (namespaces)
;; 2) Missing CURRENT VERSION fields
;; 3) Compares the INSTALL and PACKAGE files to determine if there are
;; entries in the INSTALL file that are not in the PACKAGE file
;;
;;$$END
;
EN ;EP -- MAIN ENTRY POINT
;
D ^XBKVAR
D HOME^%ZIS
;
D TXT
;
D QUE("DQ^AZAXPKG","","PACKAGE FILE CHECK")
;
Q
DQ ;----- QUEUED JOB STARTS HERE
;
D ^XBKVAR
;
D PRT
;
K ^TMP("AZAX",$J,"PKGCHK")
;
D ^%ZISC
Q
PRT ;----- PRINT THE REPORT
;
N OUT,PAGE
;
S (PAGE,OUT)=0
;
D DUPCHK(.PAGE,.OUT)
Q:OUT
;
D CURVER(.PAGE,.OUT)
Q:OUT
;
D COMP(.PAGE,.OUT)
Q:OUT
;
Q
DUPCHK(PAGE,OUT) ;
;----- CHECK FOR DUPLICATE NAME ENTRIES
;
N D0,DATA,DUPE,PKG,T,XREF
;
K ^TMP("AZAX",$J,"PKGCHK")
;
S T="DUPLICATE PACKAGE NAMES/PREFIXES"
D HDR(T,.PAGE,.OUT)
Q:OUT
;
S DUPE=0
;
F XREF="B","C" D
. S PKG=""
. F S PKG=$O(^DIC(9.4,XREF,PKG)) Q:PKG']"" D
. . S D0=0
. . F S D0=$O(^DIC(9.4,XREF,PKG,D0)) Q:'D0 D
. . . Q:$O(^DIC(9.4,"C",PKG,D0,0)) ;ADDITIONAL PREFIX
. . . S ^TMP("AZAX",$J,"PKGCHK",XREF,PKG)=+$G(^TMP("AZAX",$J,"PKGCHK",XREF,PKG))+1
. . . I ^TMP("AZAX",$J,"PKGCHK",XREF,PKG)>1 S DUPE=DUPE+1
;
I DUPE'>0 D Q
. W !!?5,"NO DUPLICATES FOUND"
;
F XREF="B","C" D Q:OUT
. S PKG=""
. F S PKG=$O(^TMP("AZAX",$J,"PKGCHK",XREF,PKG)) Q:PKG']"" D Q:OUT
. . Q:^TMP("AZAX",$J,"PKGCHK",XREF,PKG)'>1
. . I $Y>(IOSL-5) D HDR(T,.PAGE,.OUT)
. . Q:OUT
. . W !
. . S D0=0
. . F S D0=$O(^DIC(9.4,XREF,PKG,D0)) Q:'D0 D Q:OUT
. . . I $Y>(IOSL-5) D HDR(T,.PAGE,.OUT)
. . . Q:OUT
. . . S DATA=$G(^DIC(9.4,D0,0))
. . . W !,$J(D0,4)_" "_$P(DATA,U)_" ("_$P(DATA,U,2)_")"
;
K ^TMP("AZAX",$J,"PKGCHK")
;
Q
CURVER(PAGE,OUT) ;
;----- CHECK FOR MISSING CURRENT VERSION
;
N D0,PKG,T
;
K ^TMP("AZAX",$J,"PKGCHK")
;
S T="PACKAGES MISSING CURRENT VERSION"
D HDR(T,.PAGE,.OUT)
Q:OUT
;
S D0=0
F S D0=$O(^DIC(9.4,D0)) Q:'D0 D
. Q:$P($G(^DIC(9.4,D0,"VERSION")),U)]""
. S PKG=$P($G(^DIC(9.4,D0,0)),U)
. Q:PKG']""
. S ^TMP("AZAX",$J,"PKGCHK",PKG,D0)=""
;
I '$D(^TMP("AZAX",$J,"PKGCHK")) D Q
. W !?5,"EVERYTHING LOOKS OK"
;
S PKG=""
F S PKG=$O(^TMP("AZAX",$J,"PKGCHK",PKG)) Q:PKG']"" D Q:OUT
. S D0=0
. F S D0=$O(^TMP("AZAX",$J,"PKGCHK",PKG,D0)) Q:'D0 D Q:OUT
. . I $Y>(IOSL-5) D HDR(T,.PAGE,.OUT)
. . Q:OUT
. . W !,$J(D0,4)," ",PKG
;
K ^TMP("AZAX",$J,"PKGCHK")
;
Q
COMP(PAGE,OUT) ;
;----- COMPARE PACKAGE AND INSTALL FILES
;
N D0,NAME,PAT,PKG,PKGD0,T,TYPE,VER,VERD0
;
K ^TMP("AZAX",$J,"PKGCHK")
;
S T="INSTALL FILE ITEMS NOT FOUND IN PACKAGE FILE"
D HDR(T,.PAGE,.OUT)
Q:OUT
;
S D0=0
F S D0=$O(^XPD(9.7,D0)) Q:'D0 D
. Q:$P($G(^XPD(9.7,D0,0)),U,9)'=3 ;INSTALL COMPLETED
. S NAME=$P($G(^XPD(9.7,D0,0)),U)
. S TYPE="PATCH"
. I NAME'["*" S TYPE="PACKAGE"
. S PKG=$$PKG(D0)
. S VER=$$VER(D0)
. S PAT=$$PAT(D0)
. ;
. Q:PKG']""
. S PKGD0=$O(^DIC(9.4,"B",PKG,0))
. I 'PKGD0 D Q
. . S ^TMP("AZAX",$J,"PKGCHK",TYPE_" '"_PKG_"'")=""
. I '$D(^DIC(9.4,PKGD0,22,"B",VER)) D Q
. . S ^TMP("AZAX",$J,"PKGCHK",TYPE_" '"_PKG_" "_VER_"'")=""
. Q:TYPE="PACKAGE"
. S VERD0=$O(^DIC(9.4,PKGD0,22,"B",VER,0))
. I '$D(^DIC(9.4,PKGD0,22,VERD0,"PAH","B",PAT)) D Q
. . S ^TMP("AZAX",$J,"PKGCHK",TYPE_" "_NAME_" '"_PKG_" "_VER_" PATCH "_PAT_"'")=""
;
I '$D(^TMP("AZAX",$J,"PKGCHK")) D Q
. W !?5,"EVERYTHING LOOKS OK"
;
S PKG=""
F S PKG=$O(^TMP("AZAX",$J,"PKGCHK",PKG)) Q:PKG']"" D Q:OUT
. I $Y>(IOSL-5) D HDR(T,.PAGE,.OUT)
. Q:OUT
. W !,PKG
;
K ^TMP("AZAX",$J,"PKGCHK")
;
Q
PKG(D0) ;
;----- GET PACKAGE NAME
;
N %,X,Y,Z
;
S Y=""
S X=$P($G(^XPD(9.7,D0,0)),U)
I X["*" D
. S Z=$P(X,"*")
. S Z=$O(^DIC(9.4,"C",Z,0))
. I Z S Y=$P($G(^DIC(9.4,Z,0)),U)
I X'["*" D
. S %=$L(X," ")
. S Y=$P(X," ",1,%-1)
S X=$P($G(^XPD(9.7,D0,0)),U,2)
I X S Y=$P($G(^DIC(9.4,X,0)),U)
Q Y
VER(D0) ;
;----- GET VERSION NUMBER
;
N %,X,Y
;
S Y=""
S X=$P($G(^XPD(9.7,D0,0)),U)
I X["*" D
. S Y=$P(X,"*",2)
I X'["*" D
. S %=$L(X," ")
. S Y=$P(X," ",%)
Q Y
PAT(D0) ;
;----- GET PATCH NUMBER
;
N X,Y
;
S Y=""
S X=$P($G(^XPD(9.7,D0,0)),U)
I X["*" D
. S Y=$P(X,"*",3)
Q Y
HDR(T,PAGE,OUT) ;
;----- PRINT HEADER
;
N DIR,DIRUT,DTOUT,DUOUT,I,X,Y
;
I $E(IOST,1,2)="C-",$G(PAGE) S DIR(0)="E" D ^DIR K DIR I 'Y S OUT=1 Q
;
S PAGE=$G(PAGE)+1
W @IOF
W !,T
W ?49,$$NOW
W " PAGE ",PAGE
W !
F I=1:1:IOM W "-"
Q
TXT ;----- PRINT ROUTINE DESCRIPTION
;
N I,X
F I=1:1 S X=$P($T(DESC+I),";",3) Q:X["$$END" W !,X
Q
NOW() ;----- RETURNS CURRENT DATE/TIME
;
N %,%H,%I,X
D ^XBKVAR
D NOW^%DTC
S Y=DT
X ^DD("DD")
Q Y_" "_$E($P(%,".",2),1,2)_":"_$E($P(%,".",2),3,4)
;
QUE(ZTRTN,ZTSAVE,ZTDESC) ;
;----- QUEUEING CODE
;
N %ZIS,IO,POP,ZTIO,ZTSK
S %ZIS="Q"
D ^%ZIS
Q:POP
I $D(IO("Q")) D Q
. I IO("Q")
. S ZTIO=ION_";"_IOST_";"_IOM_";"_IOSL
. D ^%ZTLOAD
. I $G(ZTSK) W !,"Task #",ZTSK," queued"
D @ZTRTN
Q
AZAXPKG ;IHS/PHXAO/AEF - CHECK PACKAGE FILE
+1 ;;1.0;ANNE'S SPECIAL ROUTINES;;AUG 4, 2004
+2 ;
DESC ;----- ROUTINE DESCRIPTION
+1 ;;
+2 ;; This routine checks the PACKAGE file for the following:
+3 ;; 1) Duplicate entries in both the package names and prefixes (namespaces)
+4 ;; 2) Missing CURRENT VERSION fields
+5 ;; 3) Compares the INSTALL and PACKAGE files to determine if there are
+6 ;; entries in the INSTALL file that are not in the PACKAGE file
+7 ;;
+8 ;;$$END
+9 ;
EN ;EP -- MAIN ENTRY POINT
+1 ;
+2 DO ^XBKVAR
+3 DO HOME^%ZIS
+4 ;
+5 DO TXT
+6 ;
+7 DO QUE("DQ^AZAXPKG","","PACKAGE FILE CHECK")
+8 ;
+9 QUIT
DQ ;----- QUEUED JOB STARTS HERE
+1 ;
+2 DO ^XBKVAR
+3 ;
+4 DO PRT
+5 ;
+6 KILL ^TMP("AZAX",$JOB,"PKGCHK")
+7 ;
+8 DO ^%ZISC
+9 QUIT
PRT ;----- PRINT THE REPORT
+1 ;
+2 NEW OUT,PAGE
+3 ;
+4 SET (PAGE,OUT)=0
+5 ;
+6 DO DUPCHK(.PAGE,.OUT)
+7 IF OUT
QUIT
+8 ;
+9 DO CURVER(.PAGE,.OUT)
+10 IF OUT
QUIT
+11 ;
+12 DO COMP(.PAGE,.OUT)
+13 IF OUT
QUIT
+14 ;
+15 QUIT
DUPCHK(PAGE,OUT) ;
+1 ;----- CHECK FOR DUPLICATE NAME ENTRIES
+2 ;
+3 NEW D0,DATA,DUPE,PKG,T,XREF
+4 ;
+5 KILL ^TMP("AZAX",$JOB,"PKGCHK")
+6 ;
+7 SET T="DUPLICATE PACKAGE NAMES/PREFIXES"
+8 DO HDR(T,.PAGE,.OUT)
+9 IF OUT
QUIT
+10 ;
+11 SET DUPE=0
+12 ;
+13 FOR XREF="B","C"
Begin DoDot:1
+14 SET PKG=""
+15 FOR
SET PKG=$ORDER(^DIC(9.4,XREF,PKG))
IF PKG']""
QUIT
Begin DoDot:2
+16 SET D0=0
+17 FOR
SET D0=$ORDER(^DIC(9.4,XREF,PKG,D0))
IF 'D0
QUIT
Begin DoDot:3
+18 ;ADDITIONAL PREFIX
IF $ORDER(^DIC(9.4,"C",PKG,D0,0))
QUIT
+19 SET ^TMP("AZAX",$JOB,"PKGCHK",XREF,PKG)=+$GET(^TMP("AZAX",$JOB,"PKGCHK",XREF,PKG))+1
+20 IF ^TMP("AZAX",$JOB,"PKGCHK",XREF,PKG)>1
SET DUPE=DUPE+1
End DoDot:3
End DoDot:2
End DoDot:1
+21 ;
+22 IF DUPE'>0
Begin DoDot:1
+23 WRITE !!?5,"NO DUPLICATES FOUND"
End DoDot:1
QUIT
+24 ;
+25 FOR XREF="B","C"
Begin DoDot:1
+26 SET PKG=""
+27 FOR
SET PKG=$ORDER(^TMP("AZAX",$JOB,"PKGCHK",XREF,PKG))
IF PKG']""
QUIT
Begin DoDot:2
+28 IF ^TMP("AZAX",$JOB,"PKGCHK",XREF,PKG)'>1
QUIT
+29 IF $Y>(IOSL-5)
DO HDR(T,.PAGE,.OUT)
+30 IF OUT
QUIT
+31 WRITE !
+32 SET D0=0
+33 FOR
SET D0=$ORDER(^DIC(9.4,XREF,PKG,D0))
IF 'D0
QUIT
Begin DoDot:3
+34 IF $Y>(IOSL-5)
DO HDR(T,.PAGE,.OUT)
+35 IF OUT
QUIT
+36 SET DATA=$GET(^DIC(9.4,D0,0))
+37 WRITE !,$JUSTIFY(D0,4)_" "_$PIECE(DATA,U)_" ("_$PIECE(DATA,U,2)_")"
End DoDot:3
IF OUT
QUIT
End DoDot:2
IF OUT
QUIT
End DoDot:1
IF OUT
QUIT
+38 ;
+39 KILL ^TMP("AZAX",$JOB,"PKGCHK")
+40 ;
+41 QUIT
CURVER(PAGE,OUT) ;
+1 ;----- CHECK FOR MISSING CURRENT VERSION
+2 ;
+3 NEW D0,PKG,T
+4 ;
+5 KILL ^TMP("AZAX",$JOB,"PKGCHK")
+6 ;
+7 SET T="PACKAGES MISSING CURRENT VERSION"
+8 DO HDR(T,.PAGE,.OUT)
+9 IF OUT
QUIT
+10 ;
+11 SET D0=0
+12 FOR
SET D0=$ORDER(^DIC(9.4,D0))
IF 'D0
QUIT
Begin DoDot:1
+13 IF $PIECE($GET(^DIC(9.4,D0,"VERSION")),U)]""
QUIT
+14 SET PKG=$PIECE($GET(^DIC(9.4,D0,0)),U)
+15 IF PKG']""
QUIT
+16 SET ^TMP("AZAX",$JOB,"PKGCHK",PKG,D0)=""
End DoDot:1
+17 ;
+18 IF '$DATA(^TMP("AZAX",$JOB,"PKGCHK"))
Begin DoDot:1
+19 WRITE !?5,"EVERYTHING LOOKS OK"
End DoDot:1
QUIT
+20 ;
+21 SET PKG=""
+22 FOR
SET PKG=$ORDER(^TMP("AZAX",$JOB,"PKGCHK",PKG))
IF PKG']""
QUIT
Begin DoDot:1
+23 SET D0=0
+24 FOR
SET D0=$ORDER(^TMP("AZAX",$JOB,"PKGCHK",PKG,D0))
IF 'D0
QUIT
Begin DoDot:2
+25 IF $Y>(IOSL-5)
DO HDR(T,.PAGE,.OUT)
+26 IF OUT
QUIT
+27 WRITE !,$JUSTIFY(D0,4)," ",PKG
End DoDot:2
IF OUT
QUIT
End DoDot:1
IF OUT
QUIT
+28 ;
+29 KILL ^TMP("AZAX",$JOB,"PKGCHK")
+30 ;
+31 QUIT
COMP(PAGE,OUT) ;
+1 ;----- COMPARE PACKAGE AND INSTALL FILES
+2 ;
+3 NEW D0,NAME,PAT,PKG,PKGD0,T,TYPE,VER,VERD0
+4 ;
+5 KILL ^TMP("AZAX",$JOB,"PKGCHK")
+6 ;
+7 SET T="INSTALL FILE ITEMS NOT FOUND IN PACKAGE FILE"
+8 DO HDR(T,.PAGE,.OUT)
+9 IF OUT
QUIT
+10 ;
+11 SET D0=0
+12 FOR
SET D0=$ORDER(^XPD(9.7,D0))
IF 'D0
QUIT
Begin DoDot:1
+13 ;INSTALL COMPLETED
IF $PIECE($GET(^XPD(9.7,D0,0)),U,9)'=3
QUIT
+14 SET NAME=$PIECE($GET(^XPD(9.7,D0,0)),U)
+15 SET TYPE="PATCH"
+16 IF NAME'["*"
SET TYPE="PACKAGE"
+17 SET PKG=$$PKG(D0)
+18 SET VER=$$VER(D0)
+19 SET PAT=$$PAT(D0)
+20 ;
+21 IF PKG']""
QUIT
+22 SET PKGD0=$ORDER(^DIC(9.4,"B",PKG,0))
+23 IF 'PKGD0
Begin DoDot:2
+24 SET ^TMP("AZAX",$JOB,"PKGCHK",TYPE_" '"_PKG_"'")=""
End DoDot:2
QUIT
+25 IF '$DATA(^DIC(9.4,PKGD0,22,"B",VER))
Begin DoDot:2
+26 SET ^TMP("AZAX",$JOB,"PKGCHK",TYPE_" '"_PKG_" "_VER_"'")=""
End DoDot:2
QUIT
+27 IF TYPE="PACKAGE"
QUIT
+28 SET VERD0=$ORDER(^DIC(9.4,PKGD0,22,"B",VER,0))
+29 IF '$DATA(^DIC(9.4,PKGD0,22,VERD0,"PAH","B",PAT))
Begin DoDot:2
+30 SET ^TMP("AZAX",$JOB,"PKGCHK",TYPE_" "_NAME_" '"_PKG_" "_VER_" PATCH "_PAT_"'")=""
End DoDot:2
QUIT
End DoDot:1
+31 ;
+32 IF '$DATA(^TMP("AZAX",$JOB,"PKGCHK"))
Begin DoDot:1
+33 WRITE !?5,"EVERYTHING LOOKS OK"
End DoDot:1
QUIT
+34 ;
+35 SET PKG=""
+36 FOR
SET PKG=$ORDER(^TMP("AZAX",$JOB,"PKGCHK",PKG))
IF PKG']""
QUIT
Begin DoDot:1
+37 IF $Y>(IOSL-5)
DO HDR(T,.PAGE,.OUT)
+38 IF OUT
QUIT
+39 WRITE !,PKG
End DoDot:1
IF OUT
QUIT
+40 ;
+41 KILL ^TMP("AZAX",$JOB,"PKGCHK")
+42 ;
+43 QUIT
PKG(D0) ;
+1 ;----- GET PACKAGE NAME
+2 ;
+3 NEW %,X,Y,Z
+4 ;
+5 SET Y=""
+6 SET X=$PIECE($GET(^XPD(9.7,D0,0)),U)
+7 IF X["*"
Begin DoDot:1
+8 SET Z=$PIECE(X,"*")
+9 SET Z=$ORDER(^DIC(9.4,"C",Z,0))
+10 IF Z
SET Y=$PIECE($GET(^DIC(9.4,Z,0)),U)
End DoDot:1
+11 IF X'["*"
Begin DoDot:1
+12 SET %=$LENGTH(X," ")
+13 SET Y=$PIECE(X," ",1,%-1)
End DoDot:1
+14 SET X=$PIECE($GET(^XPD(9.7,D0,0)),U,2)
+15 IF X
SET Y=$PIECE($GET(^DIC(9.4,X,0)),U)
+16 QUIT Y
VER(D0) ;
+1 ;----- GET VERSION NUMBER
+2 ;
+3 NEW %,X,Y
+4 ;
+5 SET Y=""
+6 SET X=$PIECE($GET(^XPD(9.7,D0,0)),U)
+7 IF X["*"
Begin DoDot:1
+8 SET Y=$PIECE(X,"*",2)
End DoDot:1
+9 IF X'["*"
Begin DoDot:1
+10 SET %=$LENGTH(X," ")
+11 SET Y=$PIECE(X," ",%)
End DoDot:1
+12 QUIT Y
PAT(D0) ;
+1 ;----- GET PATCH NUMBER
+2 ;
+3 NEW X,Y
+4 ;
+5 SET Y=""
+6 SET X=$PIECE($GET(^XPD(9.7,D0,0)),U)
+7 IF X["*"
Begin DoDot:1
+8 SET Y=$PIECE(X,"*",3)
End DoDot:1
+9 QUIT Y
HDR(T,PAGE,OUT) ;
+1 ;----- PRINT HEADER
+2 ;
+3 NEW DIR,DIRUT,DTOUT,DUOUT,I,X,Y
+4 ;
+5 IF $EXTRACT(IOST,1,2)="C-"
IF $GET(PAGE)
SET DIR(0)="E"
DO ^DIR
KILL DIR
IF 'Y
SET OUT=1
QUIT
+6 ;
+7 SET PAGE=$GET(PAGE)+1
+8 WRITE @IOF
+9 WRITE !,T
+10 WRITE ?49,$$NOW
+11 WRITE " PAGE ",PAGE
+12 WRITE !
+13 FOR I=1:1:IOM
WRITE "-"
+14 QUIT
TXT ;----- PRINT ROUTINE DESCRIPTION
+1 ;
+2 NEW I,X
+3 FOR I=1:1
SET X=$PIECE($TEXT(DESC+I),";",3)
IF X["$$END"
QUIT
WRITE !,X
+4 QUIT
NOW() ;----- RETURNS CURRENT DATE/TIME
+1 ;
+2 NEW %,%H,%I,X
+3 DO ^XBKVAR
+4 DO NOW^%DTC
+5 SET Y=DT
+6 XECUTE ^DD("DD")
+7 QUIT Y_" "_$EXTRACT($PIECE(%,".",2),1,2)_":"_$EXTRACT($PIECE(%,".",2),3,4)
+8 ;
QUE(ZTRTN,ZTSAVE,ZTDESC) ;
+1 ;----- QUEUEING CODE
+2 ;
+3 NEW %ZIS,IO,POP,ZTIO,ZTSK
+4 SET %ZIS="Q"
+5 DO ^%ZIS
+6 IF POP
QUIT
+7 IF $DATA(IO("Q"))
Begin DoDot:1
+8 IF IO("Q")
+9 SET ZTIO=ION_";"_IOST_";"_IOM_";"_IOSL
+10 DO ^%ZTLOAD
+11 IF $GET(ZTSK)
WRITE !,"Task #",ZTSK," queued"
End DoDot:1
QUIT
+12 DO @ZTRTN
+13 QUIT
