Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: AZAXPKG

AZAXPKG.m

Go to the documentation of this file. 
  1. AZAXPKG ;IHS/PHXAO/AEF - CHECK PACKAGE FILE
  1.  ;;1.0;ANNE'S SPECIAL ROUTINES;;AUG 4, 2004
  1.  ;
  1. DESC ;----- ROUTINE DESCRIPTION
  1.  ;;
  1.  ;; This routine checks the PACKAGE file for the following: 
  1.  ;; 1) Duplicate entries in both the package names and prefixes (namespaces)
  1.  ;; 2) Missing CURRENT VERSION fields
  1.  ;; 3) Compares the INSTALL and PACKAGE files to determine if there are
  1.  ;;    entries in the INSTALL file that are not in the PACKAGE file
  1.  ;;     
  1.  ;;$$END
  1.  ;
  1. EN ;EP -- MAIN ENTRY POINT
  1.  ;
  1.  D ^XBKVAR
  1.  D HOME^%ZIS
  1.  ;
  1.  D TXT
  1.  ;
  1.  D QUE("DQ^AZAXPKG","","PACKAGE FILE CHECK")
  1.  ;
  1.  Q
  1. DQ ;----- QUEUED JOB STARTS HERE
  1.  ;
  1.  D ^XBKVAR
  1.  ;
  1.  D PRT
  1.  ;
  1.  K ^TMP("AZAX",$J,"PKGCHK")
  1.  ;
  1.  D ^%ZISC
  1.  Q
  1. PRT ;----- PRINT THE REPORT
  1.  ;
  1.  N OUT,PAGE
  1.  ;
  1.  S (PAGE,OUT)=0
  1.  ;
  1.  D DUPCHK(.PAGE,.OUT)
  1.  Q:OUT
  1.  ;
  1.  D CURVER(.PAGE,.OUT)
  1.  Q:OUT
  1.  ;
  1.  D COMP(.PAGE,.OUT)
  1.  Q:OUT
  1.  ;
  1.  Q 
  1. DUPCHK(PAGE,OUT) ;
  1.  ;----- CHECK FOR DUPLICATE NAME ENTRIES
  1.  ;
  1.  N D0,DATA,DUPE,PKG,T,XREF
  1.  ;
  1.  K ^TMP("AZAX",$J,"PKGCHK")
  1.  ;
  1.  S T="DUPLICATE PACKAGE NAMES/PREFIXES"
  1.  D HDR(T,.PAGE,.OUT)
  1.  Q:OUT
  1.  ;
  1.  S DUPE=0
  1.  ;
  1.  F XREF="B","C" D
  1.  . S PKG=""
  1.  . F  S PKG=$O(^DIC(9.4,XREF,PKG)) Q:PKG']""  D
  1.  . . S D0=0
  1.  . . F  S D0=$O(^DIC(9.4,XREF,PKG,D0)) Q:'D0  D
  1.  . . . Q:$O(^DIC(9.4,"C",PKG,D0,0))   ;ADDITIONAL PREFIX
  1.  . . . S ^TMP("AZAX",$J,"PKGCHK",XREF,PKG)=+$G(^TMP("AZAX",$J,"PKGCHK",XREF,PKG))+1
  1.  . . . I ^TMP("AZAX",$J,"PKGCHK",XREF,PKG)>1 S DUPE=DUPE+1
  1.  ;
  1.  I DUPE'>0 D  Q
  1.  . W !!?5,"NO DUPLICATES FOUND"
  1.  ;
  1.  F XREF="B","C" D  Q:OUT
  1.  . S PKG=""
  1.  . F  S PKG=$O(^TMP("AZAX",$J,"PKGCHK",XREF,PKG)) Q:PKG']""  D  Q:OUT
  1.  . . Q:^TMP("AZAX",$J,"PKGCHK",XREF,PKG)'>1
  1.  . . I $Y>(IOSL-5) D HDR(T,.PAGE,.OUT)
  1.  . . Q:OUT
  1.  . . W !
  1.  . . S D0=0
  1.  . . F  S D0=$O(^DIC(9.4,XREF,PKG,D0)) Q:'D0  D  Q:OUT
  1.  . . . I $Y>(IOSL-5) D HDR(T,.PAGE,.OUT)
  1.  . . . Q:OUT
  1.  . . . S DATA=$G(^DIC(9.4,D0,0))
  1.  . . . W !,$J(D0,4)_" "_$P(DATA,U)_" ("_$P(DATA,U,2)_")"
  1.  ;
  1.  K ^TMP("AZAX",$J,"PKGCHK")
  1.  ;
  1.  Q
  1. CURVER(PAGE,OUT) ;
  1.  ;----- CHECK FOR MISSING CURRENT VERSION
  1.  ;
  1.  N D0,PKG,T
  1.  ;
  1.  K ^TMP("AZAX",$J,"PKGCHK")
  1.  ;
  1.  S T="PACKAGES MISSING CURRENT VERSION"
  1.  D HDR(T,.PAGE,.OUT)
  1.  Q:OUT
  1.  ;
  1.  S D0=0
  1.  F  S D0=$O(^DIC(9.4,D0)) Q:'D0  D
  1.  . Q:$P($G(^DIC(9.4,D0,"VERSION")),U)]""
  1.  . S PKG=$P($G(^DIC(9.4,D0,0)),U)
  1.  . Q:PKG']""
  1.  . S ^TMP("AZAX",$J,"PKGCHK",PKG,D0)=""
  1.  ;
  1.  I '$D(^TMP("AZAX",$J,"PKGCHK")) D  Q
  1.  . W !?5,"EVERYTHING LOOKS OK"
  1.  ;
  1.  S PKG=""
  1.  F  S PKG=$O(^TMP("AZAX",$J,"PKGCHK",PKG)) Q:PKG']""  D  Q:OUT
  1.  . S D0=0
  1.  . F  S D0=$O(^TMP("AZAX",$J,"PKGCHK",PKG,D0)) Q:'D0  D  Q:OUT
  1.  . . I $Y>(IOSL-5) D HDR(T,.PAGE,.OUT)
  1.  . . Q:OUT
  1.  . . W !,$J(D0,4),"  ",PKG
  1.  ;
  1.  K ^TMP("AZAX",$J,"PKGCHK")
  1.  ;
  1.  Q
  1. COMP(PAGE,OUT) ;
  1.  ;----- COMPARE PACKAGE AND INSTALL FILES
  1.  ;
  1.  N D0,NAME,PAT,PKG,PKGD0,T,TYPE,VER,VERD0
  1.  ;
  1.  K ^TMP("AZAX",$J,"PKGCHK")
  1.  ;
  1.  S T="INSTALL FILE ITEMS NOT FOUND IN PACKAGE FILE"
  1.  D HDR(T,.PAGE,.OUT)
  1.  Q:OUT     
  1.  ;
  1.  S D0=0
  1.  F  S D0=$O(^XPD(9.7,D0)) Q:'D0  D
  1.  . Q:$P($G(^XPD(9.7,D0,0)),U,9)'=3   ;INSTALL COMPLETED
  1.  . S NAME=$P($G(^XPD(9.7,D0,0)),U)
  1.  . S TYPE="PATCH"
  1.  . I NAME'["*" S TYPE="PACKAGE"
  1.  . S PKG=$$PKG(D0)
  1.  . S VER=$$VER(D0)
  1.  . S PAT=$$PAT(D0)
  1.  . ;
  1.  . Q:PKG']""
  1.  . S PKGD0=$O(^DIC(9.4,"B",PKG,0))
  1.  . I 'PKGD0 D  Q
  1.  . . S ^TMP("AZAX",$J,"PKGCHK",TYPE_" '"_PKG_"'")=""
  1.  . I '$D(^DIC(9.4,PKGD0,22,"B",VER)) D  Q
  1.  . . S ^TMP("AZAX",$J,"PKGCHK",TYPE_" '"_PKG_" "_VER_"'")=""
  1.  . Q:TYPE="PACKAGE"
  1.  . S VERD0=$O(^DIC(9.4,PKGD0,22,"B",VER,0))
  1.  . I '$D(^DIC(9.4,PKGD0,22,VERD0,"PAH","B",PAT)) D  Q
  1.  . . S ^TMP("AZAX",$J,"PKGCHK",TYPE_" "_NAME_" '"_PKG_" "_VER_" PATCH "_PAT_"'")=""
  1.  ;
  1.  I '$D(^TMP("AZAX",$J,"PKGCHK")) D  Q
  1.  . W !?5,"EVERYTHING LOOKS OK"
  1.  ;
  1.  S PKG=""
  1.  F  S PKG=$O(^TMP("AZAX",$J,"PKGCHK",PKG)) Q:PKG']""  D  Q:OUT
  1.  . I $Y>(IOSL-5) D HDR(T,.PAGE,.OUT)
  1.  . Q:OUT
  1.  . W !,PKG
  1.  ;
  1.  K ^TMP("AZAX",$J,"PKGCHK")
  1.  ;
  1.  Q
  1. PKG(D0) ;
  1.  ;----- GET PACKAGE NAME
  1.  ;
  1.  N %,X,Y,Z
  1.  ;
  1.  S Y=""
  1.  S X=$P($G(^XPD(9.7,D0,0)),U)
  1.  I X["*" D
  1.  . S Z=$P(X,"*")
  1.  . S Z=$O(^DIC(9.4,"C",Z,0))
  1.  . I Z S Y=$P($G(^DIC(9.4,Z,0)),U)
  1.  I X'["*" D
  1.  . S %=$L(X," ")
  1.  . S Y=$P(X," ",1,%-1)
  1.  S X=$P($G(^XPD(9.7,D0,0)),U,2)
  1.  I X S Y=$P($G(^DIC(9.4,X,0)),U)
  1.  Q Y
  1. VER(D0) ;
  1.  ;----- GET VERSION NUMBER
  1.  ;
  1.  N %,X,Y
  1.  ;
  1.  S Y=""
  1.  S X=$P($G(^XPD(9.7,D0,0)),U)
  1.  I X["*" D
  1.  . S Y=$P(X,"*",2)
  1.  I X'["*" D
  1.  . S %=$L(X," ")
  1.  . S Y=$P(X," ",%)
  1.  Q Y
  1. PAT(D0) ;
  1.  ;----- GET PATCH NUMBER
  1.  ;
  1.  N X,Y
  1.  ;
  1.  S Y=""
  1.  S X=$P($G(^XPD(9.7,D0,0)),U)
  1.  I X["*" D
  1.  . S Y=$P(X,"*",3)
  1.  Q Y
  1. HDR(T,PAGE,OUT) ;
  1.  ;----- PRINT HEADER
  1.  ;
  1.  N DIR,DIRUT,DTOUT,DUOUT,I,X,Y
  1.  ;
  1.  I $E(IOST,1,2)="C-",$G(PAGE) S DIR(0)="E" D ^DIR K DIR I 'Y S OUT=1 Q
  1.  ;
  1.  S PAGE=$G(PAGE)+1
  1.  W @IOF
  1.  W !,T
  1.  W ?49,$$NOW
  1.  W "   PAGE ",PAGE
  1.  W !
  1.  F I=1:1:IOM W "-"
  1.  Q
  1. TXT ;----- PRINT ROUTINE DESCRIPTION
  1.  ;
  1.  N I,X
  1.  F I=1:1 S X=$P($T(DESC+I),";",3) Q:X["$$END"  W !,X
  1.  Q
  1. NOW() ;----- RETURNS CURRENT DATE/TIME
  1.  ;
  1.  N %,%H,%I,X
  1.  D ^XBKVAR
  1.  D NOW^%DTC
  1.  S Y=DT
  1.  X ^DD("DD")
  1.  Q Y_" "_$E($P(%,".",2),1,2)_":"_$E($P(%,".",2),3,4)
  1.  ;
  1. QUE(ZTRTN,ZTSAVE,ZTDESC) ;
  1.  ;----- QUEUEING CODE
  1.  ;
  1.  N %ZIS,IO,POP,ZTIO,ZTSK
  1.  S %ZIS="Q"
  1.  D ^%ZIS
  1.  Q:POP
  1.  I $D(IO("Q")) D  Q
  1.  . I IO("Q")
  1.  . S ZTIO=ION_";"_IOST_";"_IOM_";"_IOSL
  1.  . D ^%ZTLOAD
  1.  . I $G(ZTSK) W !,"Task #",ZTSK," queued"
  1.  D @ZTRTN
  1.  Q