source: IHS-VA_UTILITIES-XB/trunk/ZIBPKGF.m@ 1489

Last change on this file since 1489 was 642, checked in by Sam Habiel, 15 years ago

Modified directory structure; moved routines.
File size: 4.2 KB
RevLine 
[641]1ZIBPKGF ; 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 ;
7Q2 ;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 ;
22OPT ;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 ;
35START ;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=""
73MAIN ;
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
86ENDMAIN ;
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="@"
93Q ;
94 Q
95 ;
96JDT 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
97SYTM ;;cmbsyb
98ZIS NEW A,D,F,I,J,L,M,P,R,S,V D ^%ZIS Q
99ZISC NEW A,D,F,I,J,L,M,P,R,S,V D ^%ZISC Q
10010 ;;abr-ab
10111 ;;bji-ao
10220 ;;albisc
10330 ;;akarea
10440 ;;bilcsy
10550 ;;okc-ao
10651 ;;nsa-oa
10760 ;;phx-ao
10861 ;;cao-as
10970 ;;pordps
11080 ;;nav-aa
11100 ;;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 ;
Note: See TracBrowser for help on using the repository browser.