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

XBTRK.m

Go to the documentation of this file.
  1. XBTRK ;IHS/ASDST/GTH - GET SITE PACKAGE INFO ; [ 10/29/2002 7:42 AM ]
  1. ;;3.0;IHS/VA UTILITIES;**9**;FEB 07, 1997
  1. ;
  1. ; IHS/SET/GTH XB*3*9 10/29/2002
  1. ;
  1. ; Thanks to Don Jackson and Carlos Cordova for the original routine.
  1. ; June 6, 2001.
  1. ;
  1. ; This routine counts the number of patched routines in each namespace
  1. ; in each entry in the PACKAGE file, and, if run in foreground, only
  1. ; delivers a mail message with the results to all local programmers.
  1. ;
  1. ; If Q'd thru option "XB PACKAGE TRACKING", in addition to the mail
  1. ; message getting generated, a file is sent to the system id(s)
  1. ; specified on the 2nd page of the TaskMan option scheduling function,
  1. ; with the id(s) set into variable XBSYSID(n), where "n" is a numeric
  1. ; subscript.
  1. ;
  1. ; The option, "XB PACKAGE TRACKING", is recommended to run every 30
  1. ; days, and is atch'd to the Site Manager's menu, "XUSITEMGR", as a
  1. ; protection against deletion by the Kernel's dangling-option cleanup
  1. ; process.
  1. ;
  1. ; The format of the data global transmitted to the System(s) is:
  1. ; CV^namespace^name^version^#routines^patch
  1. ; where "CV" means "Current Version" on that machine. If the
  1. ; first piece is "PV", the info on that node means the the version
  1. ; of the routines was a "Previous Version". This assumes there are
  1. ; no 'future' versions.
  1. ;
  1. START ;EP - From TaskMan.
  1. ;
  1. I '$D(ZTQUEUED) D Q:'$$DIR^XBDIR("Y","Proceed","N",$S($G(DTIME):DTIME,1:300),"If you answer 'Y', we'll go ahead and run this") W !
  1. . D ^XBKVAR
  1. . S ^UTILITY($J,"XBTRK")=""
  1. . D EN^XBRPTL
  1. .Q
  1. ;
  1. KILL ^XBPKDATA ; KILL of unsubscripted work global.
  1. KILL ^TMP("XBTRK",$J),^TMP("XBTRK XMD",$J)
  1. ;
  1. ; Process every entry in the PACKAGE file that has a PREFIX value.
  1. ;
  1. NEW XBI,XBN
  1. S XBI=0
  1. F S XBI=$O(^DIC(9.4,XBI)) Q:'XBI D
  1. . S XBN=$P($G(^DIC(9.4,XBI,0)),U,2)
  1. . Q:XBN=""
  1. . W:'$D(ZTQUEUED) XBN,$J("",8-$L(XBN))
  1. . D:$$RSEL^ZIBRSEL(XBN_"*") ONEP(XBN)
  1. .Q
  1. ;
  1. ; SET info ^TMP("XBTRK",$J,namespace,version,patch) into ^XBPKDATA.
  1. ; "CV"=Current Version; "PV"=Previous Version.
  1. ;
  1. S (C,N)=""
  1. ;
  1. F S N=$O(^TMP("XBTRK",$J,N)) Q:(N="") S V="" D
  1. . F S V=$O(^TMP("XBTRK",$J,N,V)) Q:(V="") S P="" D
  1. .. F S P=$O(^TMP("XBTRK",$J,N,V,P)) Q:(P="") D
  1. ... S I=$O(^DIC(9.4,"C",N,0))
  1. ... S S=$G(^DIC(9.4,I,"VERSION"))
  1. ... S C=C+1
  1. ... S ^XBPKDATA(C)=$S(S=V:"CV",1:"PV")_U_N_U_$P(^DIC(9.4,I,0),U)_U_V_U_^TMP("XBTRK",$J,N,V,P)_U_P
  1. ...Q
  1. ..Q
  1. .Q
  1. ;
  1. ; Set the 0th node.
  1. ;
  1. S %=$G(^AUTTLOC($P(^AUTTSITE(1,0),U,1),0))
  1. S ^XBPKDATA(0)=$P(%,U,10)_U_$P(^DIC(4,+%,0),U,1)_U_DT_U_DT_U_DT_U_U_C
  1. ;
  1. KILL C,N,V,P,S,X
  1. D EN^XBVK("ZIB"),SAVE:$D(XBSYSID),MAIL,EN^XBVK("XB"),^XBKTMP
  1. ;
  1. KILL ^XBPKDATA ; KILL of unsubscripted work global.
  1. Q
  1. ;
  1. ONEP(N) ;one package - N = namespace
  1. ; Process all the routines in namespace R.
  1. NEW R
  1. S R=""
  1. F S R=$O(^TMP("ZIBRSEL",$J,R)) Q:R="" D ONER(R)
  1. Q
  1. ;
  1. ONER(R) ;one routine
  1. ; Do not process init's, pre's, or post's.
  1. I R["IN0"!(R["I00")!(R["INI")!(R["PRE")!(R["POS") Q
  1. I $E(R,5,6)["I0"!(R["IN1") Q
  1. ; Get the version line, then the 3rd and 5th ";" pieces.
  1. S R=$T(+2^@R)
  1. Q:'$L($P(R,";",3))
  1. S R(3)=$P(R,";",3),R(5)=$TR($P(R,";",5),"*")
  1. ; Increment patch count in ^TMP("XBTRK",$J,namespace,version,patch)
  1. F %=1:1:$L(R(5),",") S ^TMP("XBTRK",$J,N,R(3),+$P(R(5),",",%))=$G(^TMP("XBTRK",$J,N,R(3),+$P(R(5),",",%)))+1
  1. Q
  1. ;
  1. SAVE ; Send the global to XBSYSID(n), as defined in the option schedule.
  1. ;
  1. NEW XB
  1. ;
  1. S XBQTO=$O(XBSYSID(""))
  1. Q:'$L(XBQTO)
  1. ;
  1. D XBUF
  1. S XBGL="XBPKDATA",XBMED="F",XBTLE="Package tracking info via XBTRK from",XBQ="Y",XBFN="XBTK"_$P($G(^AUTTLOC($P(^AUTTSITE(1,0),U,1),0)),U,10)_"."_$$RJ^XLFSTR($$JDT^XBFUNC(DT),3,"0"),XBFLT=1
  1. D ^XBGSAVE
  1. I $G(XBFLG)=-1,'$D(ZTQUEUED) W !,"XBGSAVE has returned this error : ",$G(XBFLG(1)),".",! I $$DIR^XBDIR("E","Press RETURN") Q
  1. ;
  1. S XBQTO=$O(XBSYSID(""))
  1. F S XBQTO=$O(XBSYSID(XBQTO)) Q:'$L(XBQTO) D Q:$G(XBFLG)=-1
  1. . D XBUF
  1. . S XBFN="XBTK"_$P($G(^AUTTLOC($P(^AUTTSITE(1,0),U,1),0)),U,10)_"."_$$RJ^XLFSTR($$JDT^XBFUNC(DT),3,"0")
  1. . I ^%ZOSF("OS")["UNIX" D UUCPQ^ZIBGSVEM I 1
  1. . E D UUCPQ^ZIBGSVEP
  1. . I $G(XBFLG)=-1,'$D(ZTQUEUED) W !,"XBGSAVE has returned this error : ",$G(XBFLG(1)),".",! I $$DIR^XBDIR("E","Press RETURN") Q
  1. .Q
  1. Q
  1. ;
  1. XBUF ;
  1. I ^%ZOSF("OS")["UNIX" S XBUF="/usr/spool/uucppublic"
  1. E S XBUF=$S($P($G(^AUTTSITE(1,1)),U,2)]"":$P(^AUTTSITE(1,1),U,2),1:"C:\EXPORT")
  1. Q
  1. ;
  1. MAIL ; Send a local mail note to current user and programmers.
  1. ;;Routine count by package, version, patch.
  1. ;;
  1. ;;This note contains a count of routines in this uci, by patch level.
  1. ;;Patch level '0' indicates the routines are not patched.
  1. ;;
  1. ;;The routines are limited to the namespaces of the packages in the PACKAGE file.
  1. ;;
  1. ;;'CV' indicates the routines belong to the currently installed version
  1. ;;of the application in the PACKAGE file. 'PV' means that the version
  1. ;;line of the routine (2nd line) does not match the currently installed
  1. ;;version of the application.
  1. ;;
  1. ;;A summary patch report can be obtained from IHS MailMan by selecting:
  1. ;; Patch User Menu ...
  1. ;;and then:
  1. ;; Latest/Highest Patch for all Packages
  1. ;;
  1. ;;For a description of how to control this report, and any file
  1. ;;produced/sent by this function, read the DESCRIPTION field of
  1. ;;option "XB PACKAGE TRACKING".
  1. ;;E.g., ITSC is requesting a copy of the file be sent to
  1. ;; "cmbsyb.hqw.DOMAIN.NAME"
  1. ;;and the option description will describe how you can control that
  1. ;;sending, or configure the option to send the information to other
  1. ;;systems.
  1. ;;
  1. ;;CV/PV Prefix Name Version #Rtns Patch
  1. ;;----- ------ ------------------ ----- ----- -----
  1. ;;
  1. ;;###
  1. NEW XMSUB,XMDUZ,XMTEXT,XMY
  1. S XMSUB=$P($T(MAIL+1),";",3),XMDUZ=$G(DUZ,.5),XMTEXT="^TMP(""XBTRK XMD"",$J,",XMY(DUZ)="",XMY(1)=""
  1. D SINGLE("XUPROGMODE")
  1. F %=1:1 D RSLT($P($T(MAIL+%),";",3)) Q:$P($T(MAIL+%+1),";",3)="###"
  1. F %=0:0 S %=$O(^XBPKDATA(%)) Q:'% S X=^(%) D
  1. . F Y=1:1:6 S X(Y)=$P(X,U,Y)
  1. . S X(3)=$E(X(3),1,18)
  1. . D RSLT(X(1)_" "_X(2)_$J("",7-$L(X(2)))_X(3)_$J("",20-$L(X(3)))_X(4)_$J("",8-$L(X(4)))_$J(X(5),5)_$J(X(6),5))
  1. .Q
  1. ; ^XBPKDATA(n)=CV^namespace^name^version^#routines^patch
  1. KILL X,Y
  1. D ^XMD
  1. KILL ^TMP("XBTRK XMD",$J)
  1. I '$D(ZTQUEUED) W !!,"The results are in your MailMan 'IN' basket.",!
  1. Q
  1. ;
  1. RSLT(%) S ^(0)=$G(^TMP("XBTRK XMD",$J,0))+1,^(^(0))=%
  1. Q
  1. ;
  1. SINGLE(K) ; Get holders of a single key K.
  1. NEW Y
  1. S Y=0
  1. Q:'$D(^XUSEC(K))
  1. F S Y=$O(^XUSEC(K,Y)) Q:'Y S XMY(Y)=""
  1. Q
  1. ;