ZIBPKGF.m

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       ;