| 1 | ZIBPKGF ; IHS/ADC/GTH - INSTALLATION STATUS REPORT ; [ 02/07/97 3:02 PM ]
|
|---|
| 2 | ;;4.0;XB;;Jul 20, 2009;Build 2
|
|---|
| 3 | ;
|
|---|
| 4 | W !!,"EXECUTION UNAUTHORIZED.",!
|
|---|
| 5 | Q
|
|---|
| 6 | ;
|
|---|
| 7 | Q2 ;EP - From DIR
|
|---|
| 8 | W ! F %=2:1:7 W $P($T(Q2+%),";;",2),!
|
|---|
| 9 | ;; This utility reads thru the PACKAGE file for versions and
|
|---|
| 10 | ;; dates of installed packages, writes the info to a file,
|
|---|
| 11 | ;; and uucp's the file to the area machine and/or a central
|
|---|
| 12 | ;; machine, probably cmbsyb. The info sent to cmbsyb will
|
|---|
| 13 | ;; be copied to MailMan for auto processing into the
|
|---|
| 14 | ;; Application Implementation Status options.
|
|---|
| 15 | Q
|
|---|
| 16 | ;
|
|---|
| 17 | ; cmbsyb Any Timeplex 9600 .30-30 n:--n:--n: uucpb word: 10sne1
|
|---|
| 18 | ; cmbsyb Any ACU 2400 FTS-505-262-6166 n:--n:--n: uucpb word: 10sne1
|
|---|
| 19 | ; dpssyg Any Timeplex 9600 .00-15 n:--n:--n: uucpdps word: uucpdps
|
|---|
| 20 | ; dpssyg Any ACU2400 FTS-505-262-6250 n:--n:--n: uucpdps word: uucpdps
|
|---|
| 21 | ;
|
|---|
| 22 | OPT ;EP - Set option in OPTION file.
|
|---|
| 23 | I $P(^%ZOSF("OS"),"^")'="MSM-UNIX" W !!,"SORRY. MSM-UNIX only.",! Q
|
|---|
| 24 | I $S('$D(DUZ(0)):1,DUZ(0)'="@":1,1:0) W !,"PROGRAMMER ACCESS REQUIRED",! Q
|
|---|
| 25 | D HOME^%ZIS,DT^DICRW,00:'$L($P(^AUTTSITE(1,0),U,14)),Q2
|
|---|
| 26 | NEW DA,DIC,DIE,DIR,DR
|
|---|
| 27 | S Y=1,%="Enter a number to choose the systems to which you want this report sent"
|
|---|
| 28 | 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)
|
|---|
| 29 | 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"
|
|---|
| 30 | I $D(^DIC(19,"B",X)) S DIE=DIC,DA=$O(^DIC(19,"B",X,0)),DR="20///I "_Y D ^DIE I 1
|
|---|
| 31 | E KILL DD,DO D FILE^DICN
|
|---|
| 32 | W !!,"Done."
|
|---|
| 33 | Q
|
|---|
| 34 | ;
|
|---|
| 35 | START ;EP - From TaskMan.
|
|---|
| 36 | ; A = Area System Name
|
|---|
| 37 | ; D = Date Package Installed
|
|---|
| 38 | ; F = File Name
|
|---|
| 39 | ; I = HFS Name
|
|---|
| 40 | ; L = Location ASUFAC
|
|---|
| 41 | ; M = System Name to Receive all Reports
|
|---|
| 42 | ; P = Package Prefix
|
|---|
| 43 | ; R = Directory
|
|---|
| 44 | ; S = Short Description of Package
|
|---|
| 45 | ; S(1) = 1st Subscript in PACKAGE
|
|---|
| 46 | ; S(2) = 22 node Subscript in PACKAGE
|
|---|
| 47 | ; V = Version of Package
|
|---|
| 48 | ;
|
|---|
| 49 | NEW %ZIS,A,D,DA,DIC,F,I,J,L,M,N,P,R,S,V
|
|---|
| 50 | ;
|
|---|
| 51 | S R="/usr/spool/uucppublic/",L=$P(^AUTTLOC($P(^AUTTSITE(1,0),U),0),U,10)
|
|---|
| 52 | 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
|
|---|
| 53 | Q:POP!('I)
|
|---|
| 54 | S I=$P(^%ZIS(1,I,0),U)
|
|---|
| 55 | KILL ^TMP($J)
|
|---|
| 56 | ;
|
|---|
| 57 | ; rm xmit files over 2 weeks old.
|
|---|
| 58 | ;
|
|---|
| 59 | S X=$$JOBWAIT^%HOSTCMD("ls -l "_R_"pkg"_L_".* > /usr/mumps/zibpkg.wrk"),IOP=I,%ZIS("IOPAR")="(""/usr/mumps/zibpkg.wrk"":""R"")"
|
|---|
| 60 | D ZIS,JDT
|
|---|
| 61 | U IO
|
|---|
| 62 | 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_%)
|
|---|
| 63 | S X=$$JOBWAIT^%HOSTCMD("rm /usr/mumps/zibpkg.wrk")
|
|---|
| 64 | ; Initialize namespace, systems, and frequency.
|
|---|
| 65 | S %=+$P(^DIC(19,$O(^DIC(19,"B","ZIB INSTALLATION STATUS REPORT",0)),20)," ",2)
|
|---|
| 66 | I %>1 S A=$P(^AUTTSITE(1,0),U,14)
|
|---|
| 67 | I '(%=2) S M=$P($T(SYTM),";;",2)
|
|---|
| 68 | ;
|
|---|
| 69 | S F="/usr/spool/uucppublic/pkg"_L_"."_J,IOP=I,%ZIS("IOPAR")="("""_F_""":""W"")"
|
|---|
| 70 | D ZIS
|
|---|
| 71 | U IO
|
|---|
| 72 | S P=""
|
|---|
| 73 | MAIN ;
|
|---|
| 74 | F S P=$O(^DIC(9.4,"C",P)) Q:P="" D W L,U,P,U,S,U,V,U,D,!
|
|---|
| 75 | .S (S,V,D)="error",S(1)=$O(^DIC(9.4,"C",P,0))
|
|---|
| 76 | .Q:'S(1)
|
|---|
| 77 | .S S=$P(^DIC(9.4,S(1),0),U,3)
|
|---|
| 78 | .S:S="" S="error"
|
|---|
| 79 | .Q:'$D(^DIC(9.4,S(1),"VERSION"))
|
|---|
| 80 | .S V=^DIC(9.4,S(1),"VERSION")
|
|---|
| 81 | .I '$L(V) S V="error" Q
|
|---|
| 82 | .S S(2)=$O(^DIC(9.4,S(1),22,"B",V,0))
|
|---|
| 83 | .Q:'S(2)
|
|---|
| 84 | .S D=$P(^DIC(9.4,S(1),22,S(2),0),U,3)
|
|---|
| 85 | .Q
|
|---|
| 86 | ENDMAIN ;
|
|---|
| 87 | S IOP=I,%ZIS("IOPAR")="(""zib.wrk"")"
|
|---|
| 88 | D ZIS,ZISC
|
|---|
| 89 | S X=$$JOBWAIT^%HOSTCMD("rm zib.wrk")
|
|---|
| 90 | I $D(M) S X=$$JOBWAIT^%HOSTCMD("uucp -r "_F_" "_M_"!~")
|
|---|
| 91 | I $D(A) S X=$$JOBWAIT^%HOSTCMD("uucp -r -nroot "_F_" "_A_"!~")
|
|---|
| 92 | S ZTREQ="@"
|
|---|
| 93 | Q ;
|
|---|
| 94 | Q
|
|---|
| 95 | ;
|
|---|
| 96 | 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
|
|---|
| 97 | SYTM ;;cmbsyb
|
|---|
| 98 | ZIS NEW A,D,F,I,J,L,M,P,R,S,V D ^%ZIS Q
|
|---|
| 99 | ZISC NEW A,D,F,I,J,L,M,P,R,S,V D ^%ZISC Q
|
|---|
| 100 | 10 ;;abr-ab
|
|---|
| 101 | 11 ;;bji-ao
|
|---|
| 102 | 20 ;;albisc
|
|---|
| 103 | 30 ;;akarea
|
|---|
| 104 | 40 ;;bilcsy
|
|---|
| 105 | 50 ;;okc-ao
|
|---|
| 106 | 51 ;;nsa-oa
|
|---|
| 107 | 60 ;;phx-ao
|
|---|
| 108 | 61 ;;cao-as
|
|---|
| 109 | 70 ;;pordps
|
|---|
| 110 | 80 ;;nav-aa
|
|---|
| 111 | 00 ;;tucdev
|
|---|
| 112 | NEW DIE,DR,DA
|
|---|
| 113 | S DR="W $J("""",IOM-$L(%)\2)_%,!!"
|
|---|
| 114 | S DA=$P($T(@($P(^AUTTAREA($P(^AUTTLOC($P(^AUTTSITE(1,0),U),0),U,4),0),U,2))),";;",2)
|
|---|
| 115 | W !
|
|---|
| 116 | 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
|
|---|
| 117 | S DIE="^AUTTSITE(",DR=".14//"_DA,DA=1
|
|---|
| 118 | D ^DIE
|
|---|
| 119 | Q
|
|---|
| 120 | ;
|
|---|
