Ignore:
Timestamp:
Dec 4, 2009, 12:11:15 AM (14 years ago)
Author:
George Lilly
Message:

revised back to 6/30/08 version

File:
1 edited

Legend:

Unmodified
Added
Removed
  • WorldVistAEHR/trunk/r/KERNEL-XU-A4A7-USC-XG-XLF-XNOA-XPD-XQ-XVIR-ZI-ZOSF-ZOSV-ZT-ZU-%Z-XIP--XQAB--XUC--XUR--ZIN--ZTED/XPDIST.m

    r613 r623  
    1 XPDIST  ;SFISC/RSD - site tracking; 06/01/2006 ;03/05/2008
    2         ;;8.0;KERNEL;**66,108,185,233,350,393,486**;Jul 10, 1995;Build 5
    3         ; Per VHA Directive 2004-038, this routine should not be modified.
    4         ;Returns ""=failed, XMZ=sent
    5         ;D0=ien in file 9.7, XPY=national site tracking^address(optional)
    6 EN(D0,XPY)      ;send message
    7         N %,DIFROM,XPD,XPD0,XPD1,XPD2,XPDV,XPZ,X,X1,Z,Y,XPD6,XPDTRACK
    8         ;Get data needed
    9         I '$D(^XPD(9.7,$G(D0),0)) D BMES^XPDUTL(" INSTALL file entry missing") Q ""
    10         ;p350 -add node 6 for the Test# and Seq#. -REM
    11         S XPD0=^XPD(9.7,D0,0),XPD1=$G(^(1)),XPD2=$G(^(2)),XPD6=$G(^(6))
    12         I '$P(XPD0,U,2) D BMES^XPDUTL(" No link to PACKAGE file") Q ""
    13         S XPD=$P($G(^DIC(9.4,+$P(XPD0,U,2),0)),U),XPDV=$$VER^XPDUTL($P(XPD0,U))
    14         I XPD="" D BMES^XPDUTL(" PACKAGE file entry missing") Q ""
    15         ;XPZ(1)=start, XPZ(2)=completion date/time, XPZ(3)=run time
    16         S XPZ(1)=$P(XPD1,U),XPZ(2)=$P(XPD1,U,3),XPZ(3)=$$FMDIFF^XLFDT(XPZ(2),XPZ(1),3),XPZ(1)=$$FMTE^XLFDT(XPZ(1)),XPZ(2)=$$FMTE^XLFDT(XPZ(2))
    17         D LOCAL
    18         S XPDTRACK=$$TRACK
    19         D REMEDY ;p350 -REM
    20         Q $$FORUM()
    21 LOCAL   ;Send a message to local mail group
    22         N XMY,XPDTEXT,XMTEXT,XMDUZ,XMSUB,XMZ
    23         K ^TMP($J)
    24         S X=$$MAILGRP^XPDUTL(XPD) Q:X=""
    25         S XMY(X)="" D GETENV^%ZOSV
    26         ;Message for users
    27         S XPDTEXT(1,0)="PACKAGE INSTALL"
    28         S XPDTEXT(2,0)="SITE: "_$G(^XMB("NETNAME"))
    29         S XPDTEXT(3,0)="PACKAGE: "_XPD
    30         S XPDTEXT(4,0)="VERSION: "_XPDV
    31         S XPDTEXT(5,0)="Start time: "_XPZ(1)
    32         S XPDTEXT(6,0)="Completion time: "_XPZ(2)
    33         S XPDTEXT(7,0)="Environment: "_Y
    34         S XPDTEXT(8,0)="Installed by: "_$P($G(^VA(200,+$P(XPD0,U,11),0)),U)
    35         S XPDTEXT(9,0)="Install Name: "_$P(XPD0,U)
    36         S XPDTEXT(10,0)="Distribution Date: "_$$FMTE^XLFDT($P(XPD1,U,4))
    37         S XMDUZ=$S($P(XPD0,U,11):+$P(XPD0,U,11),1:.5),XMTEXT="XPDTEXT(",XMSUB=$P(XPD0,U)_" INSTALLATION"
    38         D ^XMD
    39         Q
    40 TRACK() ; Should VA track the installation of this patch at a national level?
    41         Q:$G(XPY)="" 0  ; No - National site tracking was not requested
    42         ;Quit if not VA production primary domain
    43         I $G(^XMB("NETNAME"))'[".VA.GOV" D BMES^XPDUTL(" Not a VA primary domain") Q 0
    44         ;X ^%ZOSF("UCI") S %=^%ZOSF("PROD")
    45         ;S:%'["," Y=$P(Y,",")
    46         ;I Y'=% D BMES^XPDUTL(" Not a production UCI") Q ""
    47         ; 486/GMB Replaced the above 3 lines with the following line:
    48         I '$$PROD^XUPROD D BMES^XPDUTL(" Not a production UCI") Q 0
    49         Q 1
    50 REMEDY  ;Send to Remedy Server - ESSRESOURCE@MED.VA.GOV *p350 -REM
    51         Q:'XPDTRACK
    52         N XMY,XPDTEXT,XMTEXT,XMDUZ,XMSUB,XMZ
    53         K ^TMP($J)
    54         S:XPY XMY("ESSRESOURCE@MED.VA.GOV")=""
    55         S:$L($P(XPY,U,2)) XMY($P(XPY,U,2))=""
    56         ;Message for server (all in one string)
    57         ;XMTEXT=Type(1),Domain(2-65),Pkg(66-95),Version(96-125),
    58         ;       StartTime(126-147),CompleteTime(148-169),RunTime(170-177),
    59         ;       Date(178-199),InstalledBy(200-229),InstallName(230-259),
    60         ;       DistributionDate(260-281),Seq#(282-286),
    61         ;       PatchTestVersion(287-317)
    62         ;
    63         S X1=1_$G(^XMB("NETNAME")) ;Type is always "1"(1=patch,0=pkg).
    64         S $E(X1,66,95)=XPD,$E(X1,96,125)=XPDV,$E(X1,126,147)=XPZ(1),$E(X1,148,169)=XPZ(2),$E(X1,170,177)=XPZ(3),$E(X1,178,199)=DT
    65         S $E(X1,200,229)=$P($G(^VA(200,+$P(XPD0,U,11),0)),U),$E(X1,230,259)=$P(XPD0,U),$E(X1,260,281)=$P(XPD1,U,4),$E(X1,282,286)=$P(XPD6,U,2),$E(X1,287,317)=$P(XPD6,U)
    66         S XPDTEXT(1,0)=X1
    67         S XMDUZ=$S($P(XPD0,U,11):+$P(XPD0,U,11),1:.5),XMTEXT="XPDTEXT(",XMSUB="KIDS-"_$P(XPD0,U)_" INSTALLATION"
    68         D ^XMD
    69         Q
    70 FORUM() ;send to Server on FORUM
    71         Q:'XPDTRACK ""
    72         N XMY,XPDTEXT,XMTEXT,XMDUZ,XMSUB,XMZ
    73         K ^TMP($J)
    74         S:XPY XMY("S.A5CSTS@FORUM.VA.GOV")=""
    75         S:$L($P(XPY,U,2)) XMY($P(XPY,U,2))=""
    76         ;Message for server
    77         S XPDTEXT(1,0)="PACKAGE INSTALL"
    78         S XPDTEXT(2,0)="SITE: "_$G(^XMB("NETNAME"))
    79         S XPDTEXT(3,0)="PACKAGE: "_XPD
    80         S XPDTEXT(4,0)="VERSION: "_XPDV
    81         S XPDTEXT(5,0)="Start time: "_XPZ(1)
    82         S XPDTEXT(6,0)="Completion time: "_XPZ(2)
    83         S XPDTEXT(7,0)="Run time: "_XPZ(3)
    84         S XPDTEXT(8,0)="DATE: "_DT
    85         S XPDTEXT(9,0)="Installed by: "_$P($G(^VA(200,+$P(XPD0,U,11),0)),U)
    86         S XPDTEXT(10,0)="Install Name: "_$P(XPD0,U)
    87         S XPDTEXT(11,0)="Distribution Date: "_$P(XPD1,U,4)
    88         S XPDTEXT(12,0)=XPD2
    89         S XMDUZ=$S($P(XPD0,U,11):+$P(XPD0,U,11),1:.5),XMTEXT="XPDTEXT(",XMSUB=$P(XPD0,U)_" INSTALLATION"
    90         D ^XMD
    91         Q "#"_$G(XMZ)
     1XPDIST ;SFISC/RSD - site tracking; 06/01/2006
     2 ;;8.0;KERNEL;**66,108,185,233,350,393**;Jul 10, 1995;Build 12
     3 ;Returns ""=failed, XMZ=sent
     4 ;D0=ien in file 9.7, XPY=national site tracking^address(optional)
     5EN(D0,XPY) ;send message
     6 N %,DIFROM,XPD,XPD0,XPD1,XPD2,XPDV,XPDTEXT,XPZ,XMDUZ,XMSUB,XMTEXT,XMY,XMZ,X,X1,Z,Y,XPD6
     7 ;Get data needed
     8 I '$D(^XPD(9.7,$G(D0),0)) D BMES^XPDUTL(" INSTALL file entry missing") Q ""
     9 ;p350 -add node 6 for the Test# and Seq#. -REM
     10 S XPD0=^XPD(9.7,D0,0),XPD1=$G(^(1)),XPD2=$G(^(2)),XPD6=$G(^(6))
     11 I '$P(XPD0,U,2) D BMES^XPDUTL(" No link to PACKAGE file") Q ""
     12 S XPD=$P($G(^DIC(9.4,+$P(XPD0,U,2),0)),U),XPDV=$$VER^XPDUTL($P(XPD0,U))
     13 I XPD="" D BMES^XPDUTL(" PACKAGE file entry missing") Q ""
     14 ;XPZ(1)=start, XPZ(2)=completion date/time, XPZ(3)=run time
     15 S XPZ(1)=$P(XPD1,U),XPZ(2)=$P(XPD1,U,3),XPZ(3)=$$FMDIFF^XLFDT(XPZ(2),XPZ(1),3),XPZ(1)=$$FMTE^XLFDT(XPZ(1)),XPZ(2)=$$FMTE^XLFDT(XPZ(2))
     16 D LOCAL
     17 D REMEDY ;p350 -REM
     18 Q $$FORUM()
     19 ;
     20 ;
     21FORUM() ;send to Server on FORUM
     22 K XMY,XPDTEXT ;393
     23 Q:$G(XPY)="" ""
     24 S:XPY XMY("S.A5CSTS@FORUM.VA.GOV")="" ;,XMY("ESSRESOURCE@MED.VA.GOV")=""
     25 S:$L($P(XPY,U,2)) XMY($P(XPY,U,2))=""
     26 K ^TMP($J)
     27 ;Quit if not VA production primary domain
     28 I $G(^XMB("NETNAME"))'[".VA.GOV" D BMES^XPDUTL(" Not a VA primary domain") Q ""
     29 X ^%ZOSF("UCI") S %=^%ZOSF("PROD")
     30 S:%'["," Y=$P(Y,",")
     31 I Y'=% D BMES^XPDUTL(" Not a production UCI") Q ""
     32 ;Message for server
     33 S XPDTEXT(1,0)="PACKAGE INSTALL"
     34 S XPDTEXT(2,0)="SITE: "_$G(^XMB("NETNAME"))
     35 S XPDTEXT(3,0)="PACKAGE: "_XPD
     36 S XPDTEXT(4,0)="VERSION: "_XPDV
     37 S XPDTEXT(5,0)="Start time: "_XPZ(1)
     38 S XPDTEXT(6,0)="Completion time: "_XPZ(2)
     39 S XPDTEXT(7,0)="Run time: "_XPZ(3)
     40 S XPDTEXT(8,0)="DATE: "_DT
     41 S XPDTEXT(9,0)="Installed by: "_$P($G(^VA(200,+$P(XPD0,U,11),0)),U)
     42 S XPDTEXT(10,0)="Install Name: "_$P(XPD0,U)
     43 S XPDTEXT(11,0)="Distribution Date: "_$P(XPD1,U,4)
     44 S XPDTEXT(12,0)=XPD2
     45 S XMDUZ=$S($P(XPD0,U,11):+$P(XPD0,U,11),1:.5),XMTEXT="XPDTEXT(",XMSUB=$P(XPD0,U)_" INSTALLATION"
     46 D ^XMD
     47 Q "#"_$G(XMZ)
     48 ;
     49LOCAL ;Send a message to local mail group
     50 K ^TMP($J),XMY,XPDTEXT,XMTEXT
     51 S X=$$MAILGRP^XPDUTL(XPD) Q:X=""
     52 S XMY(X)="" D GETENV^%ZOSV
     53 ;Message for users
     54 S XPDTEXT(1,0)="PACKAGE INSTALL"
     55 S XPDTEXT(2,0)="SITE: "_$G(^XMB("NETNAME"))
     56 S XPDTEXT(3,0)="PACKAGE: "_XPD
     57 S XPDTEXT(4,0)="VERSION: "_XPDV
     58 S XPDTEXT(5,0)="Start time: "_XPZ(1)
     59 S XPDTEXT(6,0)="Completion time: "_XPZ(2)
     60 S XPDTEXT(7,0)="Environment: "_Y
     61 S XPDTEXT(8,0)="Installed by: "_$P($G(^VA(200,+$P(XPD0,U,11),0)),U)
     62 S XPDTEXT(9,0)="Install Name: "_$P(XPD0,U)
     63 S XPDTEXT(10,0)="Distribution Date: "_$$FMTE^XLFDT($P(XPD1,U,4))
     64 S XMDUZ=$S($P(XPD0,U,11):+$P(XPD0,U,11),1:.5),XMTEXT="XPDTEXT(",XMSUB=$P(XPD0,U)_" INSTALLATION"
     65 D ^XMD
     66 Q
     67 ;
     68REMEDY ;Send to Remedy Server - ESSRESOURCE@MED.VA.GOV *p350 -REM
     69 K ^TMP($J),XMY,XPDTEXT,XMTEXT ;393
     70 Q:$G(XPY)=""
     71 S:XPY XMY("ESSRESOURCE@MED.VA.GOV")=""
     72 S:$L($P(XPY,U,2)) XMY($P(XPY,U,2))=""
     73 ;Quit if not VA production primary domain
     74 I $G(^XMB("NETNAME"))'[".VA.GOV" D BMES^XPDUTL(" Not a VA primary domain") Q
     75 X ^%ZOSF("UCI") S %=^%ZOSF("PROD")
     76 S:%'["," Y=$P(Y,",")
     77 I Y'=% D BMES^XPDUTL(" Not a production UCI") Q
     78 ;Message for server (all in one string)
     79 ;XMTEXT=Type(1),Domain(2-65),Pkg(66-95),Version(96-125),
     80 ;       StartTime(126-147),CompleteTime(148-169),RunTime(170-177),
     81 ;       Date(178-199),InstalledBy(200-229),InstallName(230-259),
     82 ;       DistributionDate(260-281),Seq#(282-286),
     83 ;       PatchTestVersion(287-317)
     84 ;
     85 S X1=1_$G(^XMB("NETNAME")) ;Type is always "1"(1=patch,0=pkg).
     86 S $E(X1,66,95)=XPD,$E(X1,96,125)=XPDV,$E(X1,126,147)=XPZ(1),$E(X1,148,169)=XPZ(2),$E(X1,170,177)=XPZ(3),$E(X1,178,199)=DT
     87 S $E(X1,200,229)=$P($G(^VA(200,+$P(XPD0,U,11),0)),U),$E(X1,230,259)=$P(XPD0,U),$E(X1,260,281)=$P(XPD1,U,4),$E(X1,282,286)=$P(XPD6,U,2),$E(X1,287,317)=$P(XPD6,U)
     88 S XPDTEXT(1,0)=X1
     89 S XMDUZ=$S($P(XPD0,U,11):+$P(XPD0,U,11),1:.5),XMTEXT="XPDTEXT(",XMSUB="KIDS-"_$P(XPD0,U)_" INSTALLATION"
     90 D ^XMD
     91 Q
Note: See TracChangeset for help on using the changeset viewer.