121 lines
4.2 KiB
Mathematica
121 lines
4.2 KiB
Mathematica
ZIBPKGF ; IHS/ADC/GTH - INSTALLATION STATUS REPORT ; [ 02/07/97 3:02 PM ]
|
|
;;4.0;XB;;Jul 20, 2009;Build 2
|
|
;
|
|
W !!,"EXECUTION UNAUTHORIZED.",!
|
|
Q
|
|
;
|
|
Q2 ;EP - From DIR
|
|
W ! F %=2:1:7 W $P($T(Q2+%),";;",2),!
|
|
;; This utility reads thru the PACKAGE file for versions and
|
|
;; dates of installed packages, writes the info to a file,
|
|
;; and uucp's the file to the area machine and/or a central
|
|
;; machine, probably cmbsyb. The info sent to cmbsyb will
|
|
;; be copied to MailMan for auto processing into the
|
|
;; Application Implementation Status options.
|
|
Q
|
|
;
|
|
; cmbsyb Any Timeplex 9600 .30-30 n:--n:--n: uucpb word: 10sne1
|
|
; cmbsyb Any ACU 2400 FTS-505-262-6166 n:--n:--n: uucpb word: 10sne1
|
|
; dpssyg Any Timeplex 9600 .00-15 n:--n:--n: uucpdps word: uucpdps
|
|
; dpssyg Any ACU2400 FTS-505-262-6250 n:--n:--n: uucpdps word: uucpdps
|
|
;
|
|
OPT ;EP - Set option in OPTION file.
|
|
I $P(^%ZOSF("OS"),"^")'="MSM-UNIX" W !!,"SORRY. MSM-UNIX only.",! Q
|
|
I $S('$D(DUZ(0)):1,DUZ(0)'="@":1,1:0) W !,"PROGRAMMER ACCESS REQUIRED",! Q
|
|
D HOME^%ZIS,DT^DICRW,00:'$L($P(^AUTTSITE(1,0),U,14)),Q2
|
|
NEW DA,DIC,DIE,DIR,DR
|
|
S Y=1,%="Enter a number to choose the systems to which you want this report sent"
|
|
I $L($P(^AUTTSITE(1,0),U,14)) S DIR(0)="N^1:3:0",DIR("A")="Send reports to (1) "_$P($T(SYTM),";;",2)_" (2) "_$P(^(0),U,14)_" or (3) both",DIR("B")=3,DIR("?")=%,DIR("??")="^D Q2^ZIBPKGF" D ^DIR Q:$D(DIRUT)
|
|
S DIC="^DIC(19,",DIC(0)="",X="ZIB INSTALLATION STATUS REPORT",DIC("DR")="1///Installation Status Report;4///R;20///I "_Y_";25///START^ZIBPKGF;200///T@2110;202///25D"
|
|
I $D(^DIC(19,"B",X)) S DIE=DIC,DA=$O(^DIC(19,"B",X,0)),DR="20///I "_Y D ^DIE I 1
|
|
E KILL DD,DO D FILE^DICN
|
|
W !!,"Done."
|
|
Q
|
|
;
|
|
START ;EP - From TaskMan.
|
|
; A = Area System Name
|
|
; D = Date Package Installed
|
|
; F = File Name
|
|
; I = HFS Name
|
|
; L = Location ASUFAC
|
|
; M = System Name to Receive all Reports
|
|
; P = Package Prefix
|
|
; R = Directory
|
|
; S = Short Description of Package
|
|
; S(1) = 1st Subscript in PACKAGE
|
|
; S(2) = 22 node Subscript in PACKAGE
|
|
; V = Version of Package
|
|
;
|
|
NEW %ZIS,A,D,DA,DIC,F,I,J,L,M,N,P,R,S,V
|
|
;
|
|
S R="/usr/spool/uucppublic/",L=$P(^AUTTLOC($P(^AUTTSITE(1,0),U),0),U,10)
|
|
F I=0:0 S I=$O(^%ZIS(1,I)) Q:'I I ^(I,"TYPE")="HFS" S IOP=$P(^%ZIS(1,I,0),U) D ZIS Q:'POP
|
|
Q:POP!('I)
|
|
S I=$P(^%ZIS(1,I,0),U)
|
|
KILL ^TMP($J)
|
|
;
|
|
; rm xmit files over 2 weeks old.
|
|
;
|
|
S X=$$JOBWAIT^%HOSTCMD("ls -l "_R_"pkg"_L_".* > /usr/mumps/zibpkg.wrk"),IOP=I,%ZIS("IOPAR")="(""/usr/mumps/zibpkg.wrk"":""R"")"
|
|
D ZIS,JDT
|
|
U IO
|
|
F R %:300 Q:%="" S %=$P(%,"/",5),X=+$P(%,".",2) I %?1"pkg"6N1"."3N,L=$E(%,4,9),((+X>+J)!(+X<(+J-14))) S X=$$JOBWAIT^%HOSTCMD("rm "_R_%)
|
|
S X=$$JOBWAIT^%HOSTCMD("rm /usr/mumps/zibpkg.wrk")
|
|
; Initialize namespace, systems, and frequency.
|
|
S %=+$P(^DIC(19,$O(^DIC(19,"B","ZIB INSTALLATION STATUS REPORT",0)),20)," ",2)
|
|
I %>1 S A=$P(^AUTTSITE(1,0),U,14)
|
|
I '(%=2) S M=$P($T(SYTM),";;",2)
|
|
;
|
|
S F="/usr/spool/uucppublic/pkg"_L_"."_J,IOP=I,%ZIS("IOPAR")="("""_F_""":""W"")"
|
|
D ZIS
|
|
U IO
|
|
S P=""
|
|
MAIN ;
|
|
F S P=$O(^DIC(9.4,"C",P)) Q:P="" D W L,U,P,U,S,U,V,U,D,!
|
|
.S (S,V,D)="error",S(1)=$O(^DIC(9.4,"C",P,0))
|
|
.Q:'S(1)
|
|
.S S=$P(^DIC(9.4,S(1),0),U,3)
|
|
.S:S="" S="error"
|
|
.Q:'$D(^DIC(9.4,S(1),"VERSION"))
|
|
.S V=^DIC(9.4,S(1),"VERSION")
|
|
.I '$L(V) S V="error" Q
|
|
.S S(2)=$O(^DIC(9.4,S(1),22,"B",V,0))
|
|
.Q:'S(2)
|
|
.S D=$P(^DIC(9.4,S(1),22,S(2),0),U,3)
|
|
.Q
|
|
ENDMAIN ;
|
|
S IOP=I,%ZIS("IOPAR")="(""zib.wrk"")"
|
|
D ZIS,ZISC
|
|
S X=$$JOBWAIT^%HOSTCMD("rm zib.wrk")
|
|
I $D(M) S X=$$JOBWAIT^%HOSTCMD("uucp -r "_F_" "_M_"!~")
|
|
I $D(A) S X=$$JOBWAIT^%HOSTCMD("uucp -r -nroot "_F_" "_A_"!~")
|
|
S ZTREQ="@"
|
|
Q ;
|
|
Q
|
|
;
|
|
JDT NEW X1,X2 S X2=$E(DT,1,3)_"0101",X1=DT D ^%DTC S X=X+1,X="00"_X,J=$E(X,$L(X)-2,$L(X)) Q
|
|
SYTM ;;cmbsyb
|
|
ZIS NEW A,D,F,I,J,L,M,P,R,S,V D ^%ZIS Q
|
|
ZISC NEW A,D,F,I,J,L,M,P,R,S,V D ^%ZISC Q
|
|
10 ;;abr-ab
|
|
11 ;;bji-ao
|
|
20 ;;albisc
|
|
30 ;;akarea
|
|
40 ;;bilcsy
|
|
50 ;;okc-ao
|
|
51 ;;nsa-oa
|
|
60 ;;phx-ao
|
|
61 ;;cao-as
|
|
70 ;;pordps
|
|
80 ;;nav-aa
|
|
00 ;;tucdev
|
|
NEW DIE,DR,DA
|
|
S DR="W $J("""",IOM-$L(%)\2)_%,!!"
|
|
S DA=$P($T(@($P(^AUTTAREA($P(^AUTTLOC($P(^AUTTSITE(1,0),U),0),U,4),0),U,2))),";;",2)
|
|
W !
|
|
F %="A system id for your area computer does not exist in the RPMS SITE file.","Based on your area code, it should probably be '"_DA_"'.","Please enter an area system id into the RPMS SITE file, now.","(Calling DIE for you)." X DR
|
|
S DIE="^AUTTSITE(",DR=".14//"_DA,DA=1
|
|
D ^DIE
|
|
Q
|
|
;
|