ZIBPKGF ; IHS/ADC/GTH - INSTALLATION STATUS REPORT ; [ 02/07/97 3:02 PM ]
;;3.0;IHS/VA UTILITIES;;FEB 07, 1997
;
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-999-999-9999 n:--n:--n: uucpb word: 10sne1
; dpssyg Any Timeplex 9600 .00-15 n:--n:--n: uucpdps word: uucpdps
; dpssyg Any ACU2400 FTS-999-999-9999 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
;
ZIBPKGF ; IHS/ADC/GTH - INSTALLATION STATUS REPORT ; [ 02/07/97 3:02 PM ]
+1 ;;3.0;IHS/VA UTILITIES;;FEB 07, 1997
+2 ;
+3 WRITE !!,"EXECUTION UNAUTHORIZED.",!
+4 QUIT
+5 ;
Q2 ;EP - From DIR
+1 WRITE !
FOR %=2:1:7
WRITE $PIECE($TEXT(Q2+%),";;",2),!
+2 ;; This utility reads thru the PACKAGE file for versions and
+3 ;; dates of installed packages, writes the info to a file,
+4 ;; and uucp's the file to the area machine and/or a central
+5 ;; machine, probably cmbsyb. The info sent to cmbsyb will
+6 ;; be copied to MailMan for auto processing into the
+7 ;; Application Implementation Status options.
+8 QUIT
+9 ;
+10 ; cmbsyb Any Timeplex 9600 .30-30 n:--n:--n: uucpb word: 10sne1
+11 ; cmbsyb Any ACU 2400 FTS-999-999-9999 n:--n:--n: uucpb word: 10sne1
+12 ; dpssyg Any Timeplex 9600 .00-15 n:--n:--n: uucpdps word: uucpdps
+13 ; dpssyg Any ACU2400 FTS-999-999-9999 n:--n:--n: uucpdps word: uucpdps
+14 ;
OPT ;EP - Set option in OPTION file.
+1 IF $PIECE(^%ZOSF("OS"),"^")'="MSM-UNIX"
WRITE !!,"SORRY. MSM-UNIX only.",!
QUIT
+2 IF $SELECT('$DATA(DUZ(0)):1,DUZ(0)'="@":1,1:0)
WRITE !,"PROGRAMMER ACCESS REQUIRED",!
QUIT
+3 DO HOME^%ZIS
DO DT^DICRW
IF '$LENGTH($PIECE(^AUTTSITE(1,0),U,14))
DO 00
DO Q2
+4 NEW DA,DIC,DIE,DIR,DR
+5 SET Y=1
SET %="Enter a number to choose the systems to which you want this report sent"
+6 IF $LENGTH($PIECE(^AUTTSITE(1,0),U,14))
SET DIR(0)="N^1:3:0"
SET DIR("A")="Send reports to (1) "_$PIECE($TEXT(SYTM),";;",2)_" (2) "_$PIECE(^(0),U,14)_" or (3) both"
SET DIR("B")=3
SET DIR("?")=%
SET DIR("??")="^D Q2^ZIBPKGF"
DO ^DIR
IF $DATA(DIRUT)
QUIT
+7 SET DIC="^DIC(19,"
SET DIC(0)=""
SET X="ZIB INSTALLATION STATUS REPORT"
SET DIC("DR")="1///Installation Status Report;4///R;20///I "_Y_";25///START^ZIBPKGF;200///T@2110;202///25D"
+8 IF $DATA(^DIC(19,"B",X))
SET DIE=DIC
SET DA=$ORDER(^DIC(19,"B",X,0))
SET DR="20///I "_Y
DO ^DIE
IF 1
+9 IF '$TEST
KILL DD,DO
DO FILE^DICN
+10 WRITE !!,"Done."
+11 QUIT
+12 ;
START ;EP - From TaskMan.
+1 ; A = Area System Name
+2 ; D = Date Package Installed
+3 ; F = File Name
+4 ; I = HFS Name
+5 ; L = Location ASUFAC
+6 ; M = System Name to Receive all Reports
+7 ; P = Package Prefix
+8 ; R = Directory
+9 ; S = Short Description of Package
+10 ; S(1) = 1st Subscript in PACKAGE
+11 ; S(2) = 22 node Subscript in PACKAGE
+12 ; V = Version of Package
+13 ;
+14 NEW %ZIS,A,D,DA,DIC,F,I,J,L,M,N,P,R,S,V
+15 ;
+16 SET R="/usr/spool/uucppublic/"
SET L=$PIECE(^AUTTLOC($PIECE(^AUTTSITE(1,0),U),0),U,10)
+17 FOR I=0:0
SET I=$ORDER(^%ZIS(1,I))
IF 'I
QUIT
IF ^(I,"TYPE")="HFS"
SET IOP=$PIECE(^%ZIS(1,I,0),U)
DO ZIS
IF 'POP
QUIT
+18 IF POP!('I)
QUIT
+19 SET I=$PIECE(^%ZIS(1,I,0),U)
+20 KILL ^TMP($JOB)
+21 ;
+22 ; rm xmit files over 2 weeks old.
+23 ;
+24 SET X=$$JOBWAIT^%HOSTCMD("ls -l "_R_"pkg"_L_".* > /usr/mumps/zibpkg.wrk")
SET IOP=I
SET %ZIS("IOPAR")="(""/usr/mumps/zibpkg.wrk"":""R"")"
+25 DO ZIS
DO JDT
+26 USE IO
+27 FOR
READ %:300
IF %=""
QUIT
SET %=$PIECE(%,"/",5)
SET X=+$PIECE(%,".",2)
IF %?1"pkg"6N1"."3N
IF L=$EXTRACT(%,4,9)
IF ((+X>+J)!(+X<(+J-14)))
SET X=$$JOBWAIT^%HOSTCMD("rm "_R_%)
+28 SET X=$$JOBWAIT^%HOSTCMD("rm /usr/mumps/zibpkg.wrk")
+29 ; Initialize namespace, systems, and frequency.
+30 SET %=+$PIECE(^DIC(19,$ORDER(^DIC(19,"B","ZIB INSTALLATION STATUS REPORT",0)),20)," ",2)
+31 IF %>1
SET A=$PIECE(^AUTTSITE(1,0),U,14)
+32 IF '(%=2)
SET M=$PIECE($TEXT(SYTM),";;",2)
+33 ;
+34 SET F="/usr/spool/uucppublic/pkg"_L_"."_J
SET IOP=I
SET %ZIS("IOPAR")="("""_F_""":""W"")"
+35 DO ZIS
+36 USE IO
+37 SET P=""
MAIN ;
+1 FOR
SET P=$ORDER(^DIC(9.4,"C",P))
IF P=""
QUIT
Begin DoDot:1
+2 SET (S,V,D)="error"
SET S(1)=$ORDER(^DIC(9.4,"C",P,0))
+3 IF 'S(1)
QUIT
+4 SET S=$PIECE(^DIC(9.4,S(1),0),U,3)
+5 IF S=""
SET S="error"
+6 IF '$DATA(^DIC(9.4,S(1),"VERSION"))
QUIT
+7 SET V=^DIC(9.4,S(1),"VERSION")
+8 IF '$LENGTH(V)
SET V="error"
QUIT
+9 SET S(2)=$ORDER(^DIC(9.4,S(1),22,"B",V,0))
+10 IF 'S(2)
QUIT
+11 SET D=$PIECE(^DIC(9.4,S(1),22,S(2),0),U,3)
+12 QUIT
End DoDot:1
WRITE L,U,P,U,S,U,V,U,D,!
ENDMAIN ;
+1 SET IOP=I
SET %ZIS("IOPAR")="(""zib.wrk"")"
+2 DO ZIS
DO ZISC
+3 SET X=$$JOBWAIT^%HOSTCMD("rm zib.wrk")
+4 IF $DATA(M)
SET X=$$JOBWAIT^%HOSTCMD("uucp -r "_F_" "_M_"!~")
+5 IF $DATA(A)
SET X=$$JOBWAIT^%HOSTCMD("uucp -r -nroot "_F_" "_A_"!~")
+6 SET ZTREQ="@"
Q ;
+1 QUIT
+2 ;
JDT NEW X1,X2
SET X2=$EXTRACT(DT,1,3)_"0101"
SET X1=DT
DO ^%DTC
SET X=X+1
SET X="00"_X
SET J=$EXTRACT(X,$LENGTH(X)-2,$LENGTH(X))
QUIT
SYTM ;;cmbsyb
ZIS NEW A,D,F,I,J,L,M,P,R,S,V
DO ^%ZIS
QUIT
ZISC NEW A,D,F,I,J,L,M,P,R,S,V
DO ^%ZISC
QUIT
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
+1 NEW DIE,DR,DA
+2 SET DR="W $J("""",IOM-$L(%)\2)_%,!!"
+3 SET DA=$PIECE($TEXT(@($PIECE(^AUTTAREA($PIECE(^AUTTLOC($PIECE(^AUTTSITE(1,0),U),0),U,4),0),U,2))),";;",2)
+4 WRITE !
+5 FOR %="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)."
XECUTE DR
+6 SET DIE="^AUTTSITE("
SET DR=".14//"_DA
SET DA=1
+7 DO ^DIE
+8 QUIT
+9 ;
