XPDCUSTP ;SLC/STAFF-SITE TRACKING UPDATE ALL VERSIONS, PROCESS ;7/20/94 15:37 [ 04/02/2003 8:29 AM ]
;;8.0;KERNEL;**1005,1007**;APR 1, 2003
;;7.1;Kernel;**22,35**;Oct 25, 1993
;
; from XPDCUST
PAC N ANUM,DA,DATE,DIC,DIE,DR,NEWNM,NUM,PACKAGE,VERSION,XMDUZ,XMSUB,XMTEXT,XMY K ^TMP("XPDCUP",$J),^TMP("XPDCUS",$J)
;
; LOAD^XPDCUSTL returns ^TMP("XPDCUP",$J, which is used to find the
; version of packages. The format for package names is:
; ^TMP("XPDCUP",$J,name) = version # ^ date installed ^ ^ routine names
; ^TMP("XPDCUP",$J,old name) = ^ ^ ^ routine names ^ name
D LOAD^XPDCUSTL
;
; Go thru names in the package file that are used in site tracking
W !!,"Checking application version numbers and install dates.",!
S PACKAGE="" F S PACKAGE=$O(^DIC(9.4,"B",PACKAGE)) Q:PACKAGE="" I $D(^TMP("XPDCUP",$J,PACKAGE)) D
.;
.; If this is an official name and no version number has been assigned,
.; setup the version and date
.I '$L($P(^TMP("XPDCUP",$J,PACKAGE),U,5)),'$L($P(^TMP("XPDCUP",$J,PACKAGE),U)) D Q
..D VERSION^XPDCUSTU S ^TMP("XPDCUP",$J,PACKAGE)=VERSION_U_DATE
..W !,PACKAGE," ",VERSION
..I VERSION,DATE W " ",$E(DATE,4,5),"/",$E(DATE,6,7),"/",$E(DATE,2,3)
.;
.; If this is an old name, setup the version and date for the new name
.; and change the name of the package to the new name.
.I $L($P(^TMP("XPDCUP",$J,PACKAGE),U,5)) D Q
..S DA=+$O(^DIC(9.4,"B",PACKAGE,0)) I 'DA Q
..S NEWNM=$P(^TMP("XPDCUP",$J,PACKAGE),U,5)
..I $D(^DIC(9.4,"B",NEWNM)) Q
..D VERSION^XPDCUSTU S ^TMP("XPDCUP",$J,NEWNM)=VERSION_U_DATE
..L +^DIC(9.4,DA,0) S (DIC,DIE)=9.4,DR=".01///"_NEWNM D ^DIE L -^DIC(9.4,DA,0)
..W !,PACKAGE," changed to ",NEWNM," ",VERSION I VERSION,DATE W " ",$E(DATE,4,5),"/",$E(DATE,6,7),"/",$E(DATE,2,3)
;
; Setup mail message for server
S ^TMP("XPDCUS",$J,1,0)="ALL PACKAGE VERSIONS"
S ^TMP("XPDCUS",$J,2,0)="SITE: "_SITE
S ^TMP("XPDCUS",$J,3,0)="PERSON: "_PERSON
S ^TMP("XPDCUS",$J,4,0)="PACKAGES:"
S NUM=4
S PACKAGE="" F S PACKAGE=$O(^TMP("XPDCUP",$J,PACKAGE)) Q:PACKAGE="" D
.I '$L($P(^TMP("XPDCUP",$J,PACKAGE),U,5)) S NUM=NUM+1,^TMP("XPDCUS",$J,NUM,0)=PACKAGE_U_$P(^TMP("XPDCUP",$J,PACKAGE),U,1,3)
S NUM=NUM+1
S ^TMP("XPDCUS",$J,NUM,0)="AUTO INSTRUMENTS: "
;
; Send message to server
S XMY(SERVER)="",XMDUZ=.5,XMTEXT="^TMP(""XPDCUS"",$J,",XMSUB="Site Tracking - "_SITE
D ^XMD
W !!,"A message to update site tracking is being sent to ",$P(SERVER,"@",2)
W !,"ALL DONE",!
Q
XPDCUSTP ;SLC/STAFF-SITE TRACKING UPDATE ALL VERSIONS, PROCESS ;7/20/94 15:37 [ 04/02/2003 8:29 AM ]
+1 ;;8.0;KERNEL;**1005,1007**;APR 1, 2003
+2 ;;7.1;Kernel;**22,35**;Oct 25, 1993
+3 ;
+4 ; from XPDCUST
PAC NEW ANUM,DA,DATE,DIC,DIE,DR,NEWNM,NUM,PACKAGE,VERSION,XMDUZ,XMSUB,XMTEXT,XMY
KILL ^TMP("XPDCUP",$JOB),^TMP("XPDCUS",$JOB)
+1 ;
+2 ; LOAD^XPDCUSTL returns ^TMP("XPDCUP",$J, which is used to find the
+3 ; version of packages. The format for package names is:
+4 ; ^TMP("XPDCUP",$J,name) = version # ^ date installed ^ ^ routine names
+5 ; ^TMP("XPDCUP",$J,old name) = ^ ^ ^ routine names ^ name
+6 DO LOAD^XPDCUSTL
+7 ;
+8 ; Go thru names in the package file that are used in site tracking
+9 WRITE !!,"Checking application version numbers and install dates.",!
+10 SET PACKAGE=""
FOR
SET PACKAGE=$ORDER(^DIC(9.4,"B",PACKAGE))
IF PACKAGE=""
QUIT
IF $DATA(^TMP("XPDCUP",$JOB,PACKAGE))
Begin DoDot:1
+11 ;
+12 ; If this is an official name and no version number has been assigned,
+13 ; setup the version and date
+14 IF '$LENGTH($PIECE(^TMP("XPDCUP",$JOB,PACKAGE),U,5))
IF '$LENGTH($PIECE(^TMP("XPDCUP",$JOB,PACKAGE),U))
Begin DoDot:2
+15 DO VERSION^XPDCUSTU
SET ^TMP("XPDCUP",$JOB,PACKAGE)=VERSION_U_DATE
+16 WRITE !,PACKAGE," ",VERSION
+17 IF VERSION
IF DATE
WRITE " ",$EXTRACT(DATE,4,5),"/",$EXTRACT(DATE,6,7),"/",$EXTRACT(DATE,2,3)
End DoDot:2
QUIT
+18 ;
+19 ; If this is an old name, setup the version and date for the new name
+20 ; and change the name of the package to the new name.
+21 IF $LENGTH($PIECE(^TMP("XPDCUP",$JOB,PACKAGE),U,5))
Begin DoDot:2
+22 SET DA=+$ORDER(^DIC(9.4,"B",PACKAGE,0))
IF 'DA
QUIT
+23 SET NEWNM=$PIECE(^TMP("XPDCUP",$JOB,PACKAGE),U,5)
+24 IF $DATA(^DIC(9.4,"B",NEWNM))
QUIT
+25 DO VERSION^XPDCUSTU
SET ^TMP("XPDCUP",$JOB,NEWNM)=VERSION_U_DATE
+26 LOCK +^DIC(9.4,DA,0)
SET (DIC,DIE)=9.4
SET DR=".01///"_NEWNM
DO ^DIE
LOCK -^DIC(9.4,DA,0)
+27 WRITE !,PACKAGE," changed to ",NEWNM," ",VERSION
IF VERSION
IF DATE
WRITE " ",$EXTRACT(DATE,4,5),"/",$EXTRACT(DATE,6,7),"/",$EXTRACT(DATE,2,3)
End DoDot:2
QUIT
End DoDot:1
+28 ;
+29 ; Setup mail message for server
+30 SET ^TMP("XPDCUS",$JOB,1,0)="ALL PACKAGE VERSIONS"
+31 SET ^TMP("XPDCUS",$JOB,2,0)="SITE: "_SITE
+32 SET ^TMP("XPDCUS",$JOB,3,0)="PERSON: "_PERSON
+33 SET ^TMP("XPDCUS",$JOB,4,0)="PACKAGES:"
+34 SET NUM=4
+35 SET PACKAGE=""
FOR
SET PACKAGE=$ORDER(^TMP("XPDCUP",$JOB,PACKAGE))
IF PACKAGE=""
QUIT
Begin DoDot:1
+36 IF '$LENGTH($PIECE(^TMP("XPDCUP",$JOB,PACKAGE),U,5))
SET NUM=NUM+1
SET ^TMP("XPDCUS",$JOB,NUM,0)=PACKAGE_U_$PIECE(^TMP("XPDCUP",$JOB,PACKAGE),U,1,3)
End DoDot:1
+37 SET NUM=NUM+1
+38 SET ^TMP("XPDCUS",$JOB,NUM,0)="AUTO INSTRUMENTS: "
+39 ;
+40 ; Send message to server
+41 SET XMY(SERVER)=""
SET XMDUZ=.5
SET XMTEXT="^TMP(""XPDCUS"",$J,"
SET XMSUB="Site Tracking - "_SITE
+42 DO ^XMD
+43 WRITE !!,"A message to update site tracking is being sent to ",$PIECE(SERVER,"@",2)
+44 WRITE !,"ALL DONE",!
+45 QUIT
