ZIBPKGP ; IHS/ADC/GTH - PROCESS IMPLEMENTATION STATUS FILES ; [ 02/07/97 3:02 PM ]
;;3.0;IHS/VA UTILITIES;;FEB 07, 1997
;
Q
;
OPT ; 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
NEW DA,DIC,DIE,DR
D HOME^%ZIS,DT^DICRW
S X="ZIB IMPLEMENTATION STATUS",DR="W $J("""",IOM-$L(%)\2)_%,!!"
W !
F %="Option '"_X_"' will be placed","in the OPTION file for daily processing, beginning tomorrow morning","at 0530 AM. You can change the frequency/time of scheduling by","using the TaskMan option thru the Kernel." X DR
S DIC="^DIC(19,",DIC(0)="",DIC("DR")="1///ZIB Implementation Status;4///R;25///IN^ZIBPKGP;200///T+1@0530;202///1D"
I $D(^DIC(19,"B",$E(X,1,30))) S DIE=DIC,DA=$O(^DIC(19,"B",$E(X,1,30),0)),DR=DIC("DR") D DIE I 1
E KILL DD,DO D FILE
W !!,"Done.",!
Q
;
IN ;EP - From TaskMan.
; A = Date of Installation
; D = Directory
; F = File
; L = ASUFAC Code
; P = Package Prefix
; S = Short Description of Package
; S(1) = 1st Subscript of ^DIZ(8009545 (Facility)
; S(2) = 2nd Subscript of ^DIZ(8009545 (Package)
; T = Patch
; V = Version
; Z = Line of Input
; Read in status files from remote site and place in FM file.
;
NEW A,D,F,L,P,S,T,V,XMB,XMTEXT,Z
S X=$$JOBWAIT^%HOSTCMD("ls -l /usr/spool/uucppublic/pkg* > zibpkg.wrk ; ls -l /usr/spool/uucppublic/rpi* >> zibpkg.wrk")
F A=0:0 S A=$O(^%ZIS(1,A)) Q:'A I ^(A,"TYPE")="HFS" S IOP=$P(^%ZIS(1,A,0),U),%ZIS("IOPAR")="(""zibpkg.wrk"":""R"")" D ZIS Q:'POP
Q:POP!('A)
KILL ^TMP($J)
U IO
F R %:300 Q:%="" S %=$P(%,"/",5) S:%?1"pkg"6N1"."3N ^TMP($J,"PKG",%)="" S:%?1"rpi"6N1"."3N ^TMP($J,"RPI",%)=""
S F="",D="/usr/spool/uucppublic/"
MAIN ;
PKG ;
F S F=$O(^TMP($J,"PKG",F)) Q:F="" U IO:(D_F) D
. F R Z:300 Q:(Z="")!(Z'?6N1"^"1U1.3UN1"^".E) D
.. S L=$P(Z,U),P=$P(Z,U,2),S=$P(Z,U,3),V=$P(Z,U,4),A=$P(Z,U,5)
.. S:S="" S="error"
.. D FAC
.. S DA=S(2),DIE="^DIZ(8009545,"_S(1)_",1,",DR="1////"_V_";2////P;3////"_A
.. D DIE
.. S ^TMP($J,"PKG",F)=L
..Q
. S X=$$JOBWAIT^%HOSTCMD("rm "_D_F)
.Q
;
RPI ;
F S F=$O(^TMP($J,"RPI",F)) Q:F="" U IO:(D_F) D
. F R Z:300 Q:(Z="")!(Z'?6N1"^"2.4L1".v"1.2N1"."1.2N.1A.2N1"p"1.3N1"^".E) I $P(Z,U,3)="INSTALLED" D
.. S L=$P(Z,U),T=$P(Z,U,2),A=$P(Z,U,4),P=$P(T,"."),V=$P($P(T,".v",2),"p"),T=$P($P(T,".v",2),"p",2)
.. F XMB="P","V" S X=@XMB X ^DD("FUNC",$O(^DD("FUNC","B","UPPERCASE",0)),1) S @XMB=X
.. S S=P
.. D FAC
.. S DA(2)=S(1),DA(1)=S(2),DA=T
.. I '$D(^DIZ(8009545,DA(2),1,DA(1),1,0)) S ^(0)="^8009545.03^^"
.. I '$D(^DIZ(8009545,DA(2),1,DA(1),1,DA)) S (X,DINUM)=DA,DIC="^DIZ(8009545,"_DA(2)_",1,"_DA(1)_",1,",DIC(0)="",DIC("DR")="1///"_A_";2///"_$P(Z,U,2) D FILE KILL DINUM I 1
.. E S DIE="^DIZ(8009545,"_DA(2)_",1,"_DA(1)_",1,"_DA_",",DR="1///"_A_";2///"_$P(Z,U,2) D DIE
.. S ^TMP($J,"RPI",F)=L
..Q
. S X=$$JOBWAIT^%HOSTCMD("rm "_D_F)
.Q
;
ENDMAIN ;
D ZISC
S X=$$JOBWAIT^%HOSTCMD("rm zibpkg.wrk")
; ^TMP($J,"PKG",file)=facility
S F="",%=0
F S F=$O(^TMP($J,"PKG",F)) Q:F="" S %=%+1,XMTEXT(%)=" Application status received from "_^(F)
S F=""
F S F=$O(^TMP($J,"RPI",F)) Q:F="" I $L(^(F)) S %=%+1,XMTEXT(%)=" Patch application received from "_^(F)
I $L($O(^TMP($J,"PKG",""))) S XMB="ZIB PKG",XMTEXT="XMTEXT(" D XMB
KILL ^TMP($J)
Q ;
Q
;
FAC ;
I '$D(^DIZ(8009545,"B",$O(^AUTTLOC("C",L,0)))) S X=$O(^AUTTLOC("C",L,0)),DIC="^DIZ(8009545,",DIC(0)="" D FILE S S(1)=+Y I 1
E S S(1)=$O(^DIZ(8009545,"B",$O(^AUTTLOC("C",L,0)),0))
I '$D(^DIZ(8009545,S(1),1,0)) S ^(0)="^8009545.02PA^^"
I '$D(^DIC(9.4,"C",P)) S X=S,DIC="^DIC(9.4,",DIC(0)="",DIC("DR")="1///"_P_";2///"_S D FILE S S(2)=+Y I 1
E S S(2)=$O(^DIC(9.4,"C",P,0))
I '$D(^DIZ(8009545,S(1),1,"B",S(2))) S X=S(2),DA(1)=S(1),DIC="^DIZ(8009545,"_S(1)_",1,",DIC(0)="" D FILE S S(2)=+Y I 1
E S S(2)=$O(^DIZ(8009545,S(1),1,"B",S(2),0))
Q
;
FILE NEW A,D,DD,DO,F,L,P,S,T,V,Z D FILE^DICN KILL DIC Q
DIE NEW A,D,F,L,P,S,T,V,Z D ^DIE KILL DA,DR,DIE Q
XMB NEW A,D,F,L,P,S,T,V,Z D ^XMB Q
ZIS NEW A,D,F,L,P,S,T,V,Z D ^%ZIS Q
ZISC NEW A,D,F,L,P,S,T,V,Z D ^%ZISC Q
ZIBPKGP ; IHS/ADC/GTH - PROCESS IMPLEMENTATION STATUS FILES ; [ 02/07/97 3:02 PM ]
+1 ;;3.0;IHS/VA UTILITIES;;FEB 07, 1997
+2 ;
+3 QUIT
+4 ;
OPT ; 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 NEW DA,DIC,DIE,DR
+4 DO HOME^%ZIS
DO DT^DICRW
+5 SET X="ZIB IMPLEMENTATION STATUS"
SET DR="W $J("""",IOM-$L(%)\2)_%,!!"
+6 WRITE !
+7 FOR %="Option '"_X_"' will be placed","in the OPTION file for daily processing, beginning tomorrow morning","at 0530 AM. You can change the frequency/time of scheduling by","using the TaskMan option thru the Kernel."
XECUTE DR
+8 SET DIC="^DIC(19,"
SET DIC(0)=""
SET DIC("DR")="1///ZIB Implementation Status;4///R;25///IN^ZIBPKGP;200///T+1@0530;202///1D"
+9 IF $DATA(^DIC(19,"B",$EXTRACT(X,1,30)))
SET DIE=DIC
SET DA=$ORDER(^DIC(19,"B",$EXTRACT(X,1,30),0))
SET DR=DIC("DR")
DO DIE
IF 1
+10 IF '$TEST
KILL DD,DO
DO FILE
+11 WRITE !!,"Done.",!
+12 QUIT
+13 ;
IN ;EP - From TaskMan.
+1 ; A = Date of Installation
+2 ; D = Directory
+3 ; F = File
+4 ; L = ASUFAC Code
+5 ; P = Package Prefix
+6 ; S = Short Description of Package
+7 ; S(1) = 1st Subscript of ^DIZ(8009545 (Facility)
+8 ; S(2) = 2nd Subscript of ^DIZ(8009545 (Package)
+9 ; T = Patch
+10 ; V = Version
+11 ; Z = Line of Input
+12 ; Read in status files from remote site and place in FM file.
+13 ;
+14 NEW A,D,F,L,P,S,T,V,XMB,XMTEXT,Z
+15 SET X=$$JOBWAIT^%HOSTCMD("ls -l /usr/spool/uucppublic/pkg* > zibpkg.wrk ; ls -l /usr/spool/uucppublic/rpi* >> zibpkg.wrk")
+16 FOR A=0:0
SET A=$ORDER(^%ZIS(1,A))
IF 'A
QUIT
IF ^(A,"TYPE")="HFS"
SET IOP=$PIECE(^%ZIS(1,A,0),U)
SET %ZIS("IOPAR")="(""zibpkg.wrk"":""R"")"
DO ZIS
IF 'POP
QUIT
+17 IF POP!('A)
QUIT
+18 KILL ^TMP($JOB)
+19 USE IO
+20 FOR
READ %:300
IF %=""
QUIT
SET %=$PIECE(%,"/",5)
IF %?1"pkg"6N1"."3N
SET ^TMP($JOB,"PKG",%)=""
IF %?1"rpi"6N1"."3N
SET ^TMP($JOB,"RPI",%)=""
+21 SET F=""
SET D="/usr/spool/uucppublic/"
MAIN ;
PKG ;
+1 FOR
SET F=$ORDER(^TMP($JOB,"PKG",F))
IF F=""
QUIT
USE IO:(D_F)
Begin DoDot:1
+2 FOR
READ Z:300
IF (Z="")!(Z'?6N1"^"1U1.3UN1"^".E)
QUIT
Begin DoDot:2
+3 SET L=$PIECE(Z,U)
SET P=$PIECE(Z,U,2)
SET S=$PIECE(Z,U,3)
SET V=$PIECE(Z,U,4)
SET A=$PIECE(Z,U,5)
+4 IF S=""
SET S="error"
+5 DO FAC
+6 SET DA=S(2)
SET DIE="^DIZ(8009545,"_S(1)_",1,"
SET DR="1////"_V_";2////P;3////"_A
+7 DO DIE
+8 SET ^TMP($JOB,"PKG",F)=L
+9 QUIT
End DoDot:2
+10 SET X=$$JOBWAIT^%HOSTCMD("rm "_D_F)
+11 QUIT
End DoDot:1
+12 ;
RPI ;
+1 FOR
SET F=$ORDER(^TMP($JOB,"RPI",F))
IF F=""
QUIT
USE IO:(D_F)
Begin DoDot:1
+2 FOR
READ Z:300
IF (Z="")!(Z'?6N1"^"2.4L1".v"1.2N1"."1.2N.1A.2N1"p"1.3N1"^".E)
QUIT
IF $PIECE(Z,U,3)="INSTALLED"
Begin DoDot:2
+3 SET L=$PIECE(Z,U)
SET T=$PIECE(Z,U,2)
SET A=$PIECE(Z,U,4)
SET P=$PIECE(T,".")
SET V=$PIECE($PIECE(T,".v",2),"p")
SET T=$PIECE($PIECE(T,".v",2),"p",2)
+4 FOR XMB="P","V"
SET X=@XMB
XECUTE ^DD("FUNC",$ORDER(^DD("FUNC","B","UPPERCASE",0)),1)
SET @XMB=X
+5 SET S=P
+6 DO FAC
+7 SET DA(2)=S(1)
SET DA(1)=S(2)
SET DA=T
+8 IF '$DATA(^DIZ(8009545,DA(2),1,DA(1),1,0))
SET ^(0)="^8009545.03^^"
+9 IF '$DATA(^DIZ(8009545,DA(2),1,DA(1),1,DA))
SET (X,DINUM)=DA
SET DIC="^DIZ(8009545,"_DA(2)_",1,"_DA(1)_",1,"
SET DIC(0)=""
SET DIC("DR")="1///"_A_";2///"_$PIECE(Z,U,2)
DO FILE
KILL DINUM
IF 1
+10 IF '$TEST
SET DIE="^DIZ(8009545,"_DA(2)_",1,"_DA(1)_",1,"_DA_","
SET DR="1///"_A_";2///"_$PIECE(Z,U,2)
DO DIE
+11 SET ^TMP($JOB,"RPI",F)=L
+12 QUIT
End DoDot:2
+13 SET X=$$JOBWAIT^%HOSTCMD("rm "_D_F)
+14 QUIT
End DoDot:1
+15 ;
ENDMAIN ;
+1 DO ZISC
+2 SET X=$$JOBWAIT^%HOSTCMD("rm zibpkg.wrk")
+3 ; ^TMP($J,"PKG",file)=facility
+4 SET F=""
SET %=0
+5 FOR
SET F=$ORDER(^TMP($JOB,"PKG",F))
IF F=""
QUIT
SET %=%+1
SET XMTEXT(%)=" Application status received from "_^(F)
+6 SET F=""
+7 FOR
SET F=$ORDER(^TMP($JOB,"RPI",F))
IF F=""
QUIT
IF $LENGTH(^(F))
SET %=%+1
SET XMTEXT(%)=" Patch application received from "_^(F)
+8 IF $LENGTH($ORDER(^TMP($JOB,"PKG","")))
SET XMB="ZIB PKG"
SET XMTEXT="XMTEXT("
DO XMB
+9 KILL ^TMP($JOB)
Q ;
+1 QUIT
+2 ;
FAC ;
+1 IF '$DATA(^DIZ(8009545,"B",$ORDER(^AUTTLOC("C",L,0))))
SET X=$ORDER(^AUTTLOC("C",L,0))
SET DIC="^DIZ(8009545,"
SET DIC(0)=""
DO FILE
SET S(1)=+Y
IF 1
+2 IF '$TEST
SET S(1)=$ORDER(^DIZ(8009545,"B",$ORDER(^AUTTLOC("C",L,0)),0))
+3 IF '$DATA(^DIZ(8009545,S(1),1,0))
SET ^(0)="^8009545.02PA^^"
+4 IF '$DATA(^DIC(9.4,"C",P))
SET X=S
SET DIC="^DIC(9.4,"
SET DIC(0)=""
SET DIC("DR")="1///"_P_";2///"_S
DO FILE
SET S(2)=+Y
IF 1
+5 IF '$TEST
SET S(2)=$ORDER(^DIC(9.4,"C",P,0))
+6 IF '$DATA(^DIZ(8009545,S(1),1,"B",S(2)))
SET X=S(2)
SET DA(1)=S(1)
SET DIC="^DIZ(8009545,"_S(1)_",1,"
SET DIC(0)=""
DO FILE
SET S(2)=+Y
IF 1
+7 IF '$TEST
SET S(2)=$ORDER(^DIZ(8009545,S(1),1,"B",S(2),0))
+8 QUIT
+9 ;
FILE NEW A,D,DD,DO,F,L,P,S,T,V,Z
DO FILE^DICN
KILL DIC
QUIT
DIE NEW A,D,F,L,P,S,T,V,Z
DO ^DIE
KILL DA,DR,DIE
QUIT
XMB NEW A,D,F,L,P,S,T,V,Z
DO ^XMB
QUIT
ZIS NEW A,D,F,L,P,S,T,V,Z
DO ^%ZIS
QUIT
ZISC NEW A,D,F,L,P,S,T,V,Z
DO ^%ZISC
QUIT
