KMPSLK ;OAK/KAK - Thru The Looking Glass ;9/1/2015
;;2.0;SAGG PROJECT;**1**;Jul 02, 2007;Build 67
;
EN(SESSNUM,SITENUM) ;
;---------------------------------------------------------------------
; SESSNUM.. +$Horolog number of session
; SITENUM.. site number
;---------------------------------------------------------------------
;
ZER ;-- collect zeroth node information
;
N FNUM,GNAM
;
S ^XTMP("KMPS",SITENUM,SESSNUM,"@ZER",0)=$P(^DIC(0),U)_U_$P(^DIC(0),U,4)_"^DIC(^"
S ^XTMP("KMPS",SITENUM,SESSNUM,"@ZER","TM")=$S($D(^%ZTSK(-1)):^(-1),1:^%ZTSK(0))
S FNUM=0 F S FNUM=$O(^DIC(FNUM)) Q:'+FNUM D
.Q:$G(^DIC(FNUM,0))=""
.Q:'$D(^DIC(FNUM,0,"GL"))
.S GNAM=$G(^DIC(FNUM,0,"GL")) Q:GNAM=""
.;
.; file# = ^ piece 1: file_name
.; 2: # of entries
.; 3: global_name
.; 4: file_version
.; 5: last id number
.; 6: global_name (GNAM) has embedded '^' - no extra 'U' needed
.S ^XTMP("KMPS",SITENUM,SESSNUM,"@ZER",FNUM)=$P(^DIC(FNUM,0),U)_U_$P($G(@(GNAM_"0)")),U,4)_GNAM_U_$G(^DD(+$P(^DIC(FNUM,0),U,2),0,"VR"))_U_$P($G(@(GNAM_"0)")),U,3)
;
PKG ;-- collect package file information
;
N PKNUM
;
S PKNUM=0
F S PKNUM=$O(^DIC(9.4,PKNUM)) Q:'+PKNUM I $D(^DIC(9.4,PKNUM,0)) S KMPSD=$P($G(^DIC(9.4,PKNUM,0)),U,2) D
.I $E(KMPSD)="A" I ($A($E(KMPSD,2))>64)&($A($E(KMPSD,2))<88) I (($A($E(KMPSD,3))>64)&($A($E(KMPSD,3))<89)) Q
.S KMPSV=0,(KMPSVL,KMPSD)=""
.F S KMPSV=$O(^DIC(9.4,PKNUM,22,KMPSV)) Q:'+KMPSV S KMPSVL=KMPSV
.I +KMPSVL S KMPSV=$G(^DIC(9.4,PKNUM,22,KMPSVL,0)),KMPSD=$P(KMPSV,U,3),KMPSV=$P(KMPSV,U)
.;
.; pkg_name = pkg_prefix^current version^last version^install date
.S ^XTMP("KMPS",SITENUM,SESSNUM,"@PKG",$P(^DIC(9.4,PKNUM,0),U))=$P($G(^DIC(9.4,PKNUM,0)),U,2)_U_$G(^("VERSION"))_U_KMPSV_U_KMPSD
;
SYS ; Collect volume set (@VOL) and system (@SYS) information
;
D EN^%ZOSVKSD(SITENUM,SESSNUM,OS),@OS
;
K KMPSD,KMPSNM,KMPSV,KMPSVL
Q
;
CUNIX ;-- Cache for Unix/Linux
CVMS ;-- Cache for VMS platform
S ^XTMP("KMPS",SITENUM,SESSNUM,"@SYS")=$ZV_U
Q
;
CWINNT ;-- for Cache for NT platform
S ^XTMP("KMPS",SITENUM,SESSNUM,"@SYS")=$ZV_U_$S($ZU(100)=0:"Windows NT",$ZU(100)=1:"Windows 95",1:$ZU(100))
Q
;
OUT(NOWDT,OS,SESSNUM,SITENUM,XMZSENT,TEXT) ;
;---------------------------------------------------------------------
; Create 'successful' end-game message text
; NOWDT.... FM date and time that SAGG started
; OS....... type of operating system
; SESSNUM.. +$Horolog number of session
; SITENUM.. site number
; XMZSENT.. mailman message number created by SAGG
;---------------------------------------------------------------------
;
N DOW,GBL,I,J,JEND,UCIVOL,VOLS,X
;
; check to see if SAGG not started over weekend (Fri - Sun)
S DOW=$$DOW^XLFDT(NOWDT,1)
I (DOW>0)&(DOW<5) D
.S TEXT(1)=" *** It is STRONGLY recommended that the 'SAGG Master Background Task' ***"
.S TEXT(2)=" *** [KMPS SAGG REPORT] be rescheduled to run over the weekend hours. ***"
.S TEXT(3)=""
;
S TEXT(4)=" The SAGG Project collection routines monitored the following:"
S TEXT(5)=""
K VOLS
S GBL=""
F S GBL=$O(^XTMP("KMPS",SITENUM,SESSNUM,NOWDT,GBL)) Q:GBL="" D
.S UCIVOL=""
.F S UCIVOL=$O(^XTMP("KMPS",SITENUM,SESSNUM,NOWDT,GBL,UCIVOL)) Q:UCIVOL="" S VOLS(UCIVOL)=""
S X=0,UCIVOL="",JEND=$S(OS="CVMS":2,OS="CWINNT":4,1:5)
F I=6:1 Q:X D
.S TEXT(I)=" "
.F J=1:1:JEND S UCIVOL=$O(VOLS(UCIVOL)) S:UCIVOL="" X=1 Q:UCIVOL="" S TEXT(I)=TEXT(I)_UCIVOL_" "
S TEXT(I)=""
S TEXT(I+1)=" Please ensure that this list concurs with your present volume set"
S TEXT(I+2)=" configuration.",TEXT(I+3)=""
S TEXT(I+4)=" A local e-mail message #"_XMZSENT_" was created by the collection"
S TEXT(I+5)=" routines. Check the FO-ALBANY.DOMAIN.EXT NetMail Queue to ensure"
S TEXT(I+6)=" transmission delivery."
;
Q ""
;
MSG(STRTDT,SESSNUM,TEXT,COMPDT) ;-- send e-mail message to local KMP-CAPMAN mailgroup
;---------------------------------------------------------------------
; Send e-mail message to local KMP-CAPMAN mailgroup
;
; STRTDT... SAGG start date and time
; SESSNUM.. +$Horolog number of session
; TEXT..... text of message
; COMPDT... (optional) SAGG completion date and time
;---------------------------------------------------------------------
N XMSUB,XMTEXT,XMY
;
S COMPDT=+$G(COMPDT)
;
S:'$D(XMDUZ) XMDUZ=.5
S:'$D(DUZ) DUZ=.5 S U="^"
;
S TEXT(.1)=" SAGG Session: "_SESSNUM
S TEXT(.2)=" Started: "_$$FMTE^XLFDT(STRTDT,"P")_" ("_$$DOW^XLFDT(STRTDT)_")"
S:+COMPDT TEXT(.3)=" Completed: "_$$FMTE^XLFDT(COMPDT,"P")_" ("_$$DOW^XLFDT(COMPDT)_")"
S TEXT(.4)=""
S XMSUB="SAGG Project Message (Session #"_SESSNUM_")",XMTEXT="TEXT("
I $D(^XMB(3.8,"B","KMP-CAPMAN")) S XMY("G.KMP-CAPMAN")=""
D:$D(XMY) ^XMD
Q
;
END ;
K ^XTMP("KMPS",SITENUM),^XTMP("KMPS","ERROR")
K ^XTMP("KMPS","START"),^XTMP("KMPS","STOP"),^XTMP("KMPS",0)
K X,XMDUZ
S ZTREQ="@"
L -^XTMP("KMPS")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HKMPSLK 5088 printed Apr 09, 2024@20:45:41 Page 2
KMPSLK ;OAK/KAK - Thru The Looking Glass ;9/1/2015
+1 ;;2.0;SAGG PROJECT;**1**;Jul 02, 2007;Build 67
+2 ;
EN(SESSNUM,SITENUM) ;
+1 ;---------------------------------------------------------------------
+2 ; SESSNUM.. +$Horolog number of session
+3 ; SITENUM.. site number
+4 ;---------------------------------------------------------------------
+5 ;
ZER ;-- collect zeroth node information
+1 ;
+2 NEW FNUM,GNAM
+3 ;
+4 SET ^XTMP("KMPS",SITENUM,SESSNUM,"@ZER",0)=$PIECE(^DIC(0),U)_U_$PIECE(^DIC(0),U,4)_"^DIC(^"
+5 SET ^XTMP("KMPS",SITENUM,SESSNUM,"@ZER","TM")=$SELECT($DATA(^%ZTSK(-1)):^(-1),1:^%ZTSK(0))
+6 SET FNUM=0
FOR
SET FNUM=$ORDER(^DIC(FNUM))
if '+FNUM
QUIT
Begin DoDot:1
+7 if $GET(^DIC(FNUM,0))=""
QUIT
+8 if '$DATA(^DIC(FNUM,0,"GL"))
QUIT
+9 SET GNAM=$GET(^DIC(FNUM,0,"GL"))
if GNAM=""
QUIT
+10 ;
+11 ; file# = ^ piece 1: file_name
+12 ; 2: # of entries
+13 ; 3: global_name
+14 ; 4: file_version
+15 ; 5: last id number
+16 ; 6: global_name (GNAM) has embedded '^' - no extra 'U' needed
+17 SET ^XTMP("KMPS",SITENUM,SESSNUM,"@ZER",FNUM)=$PIECE(^DIC(FNUM,0),U)_U_$PIECE($GET(@(GNAM_"0)")),U,4)_GNAM_U_$GET(^DD(+$PIECE(^DIC(FNUM,0),U,2),0,"VR"))_U_$PIECE($GET(@(GNAM_"0)")),U,3)
End DoDot:1
+18 ;
PKG ;-- collect package file information
+1 ;
+2 NEW PKNUM
+3 ;
+4 SET PKNUM=0
+5 FOR
SET PKNUM=$ORDER(^DIC(9.4,PKNUM))
if '+PKNUM
QUIT
IF $DATA(^DIC(9.4,PKNUM,0))
SET KMPSD=$PIECE($GET(^DIC(9.4,PKNUM,0)),U,2)
Begin DoDot:1
+6 IF $EXTRACT(KMPSD)="A"
IF ($ASCII($EXTRACT(KMPSD,2))>64)&($ASCII($EXTRACT(KMPSD,2))<88)
IF (($ASCII($EXTRACT(KMPSD,3))>64)&($ASCII($EXTRACT(KMPSD,3))<89))
QUIT
+7 SET KMPSV=0
SET (KMPSVL,KMPSD)=""
+8 FOR
SET KMPSV=$ORDER(^DIC(9.4,PKNUM,22,KMPSV))
if '+KMPSV
QUIT
SET KMPSVL=KMPSV
+9 IF +KMPSVL
SET KMPSV=$GET(^DIC(9.4,PKNUM,22,KMPSVL,0))
SET KMPSD=$PIECE(KMPSV,U,3)
SET KMPSV=$PIECE(KMPSV,U)
+10 ;
+11 ; pkg_name = pkg_prefix^current version^last version^install date
+12 SET ^XTMP("KMPS",SITENUM,SESSNUM,"@PKG",$PIECE(^DIC(9.4,PKNUM,0),U))=$PIECE($GET(^DIC(9.4,PKNUM,0)),U,2)_U_$GET(^("VERSION"))_U_KMPSV_U_KMPSD
End DoDot:1
+13 ;
SYS ; Collect volume set (@VOL) and system (@SYS) information
+1 ;
+2 DO EN^%ZOSVKSD(SITENUM,SESSNUM,OS)
DO @OS
+3 ;
+4 KILL KMPSD,KMPSNM,KMPSV,KMPSVL
+5 QUIT
+6 ;
CUNIX ;-- Cache for Unix/Linux
CVMS ;-- Cache for VMS platform
+1 SET ^XTMP("KMPS",SITENUM,SESSNUM,"@SYS")=$ZV_U
+2 QUIT
+3 ;
CWINNT ;-- for Cache for NT platform
+1 SET ^XTMP("KMPS",SITENUM,SESSNUM,"@SYS")=$ZV_U_$SELECT($ZU(100)=0:"Windows NT",$ZU(100)=1:"Windows 95",1:$ZU(100))
+2 QUIT
+3 ;
OUT(NOWDT,OS,SESSNUM,SITENUM,XMZSENT,TEXT) ;
+1 ;---------------------------------------------------------------------
+2 ; Create 'successful' end-game message text
+3 ; NOWDT.... FM date and time that SAGG started
+4 ; OS....... type of operating system
+5 ; SESSNUM.. +$Horolog number of session
+6 ; SITENUM.. site number
+7 ; XMZSENT.. mailman message number created by SAGG
+8 ;---------------------------------------------------------------------
+9 ;
+10 NEW DOW,GBL,I,J,JEND,UCIVOL,VOLS,X
+11 ;
+12 ; check to see if SAGG not started over weekend (Fri - Sun)
+13 SET DOW=$$DOW^XLFDT(NOWDT,1)
+14 IF (DOW>0)&(DOW<5)
Begin DoDot:1
+15 SET TEXT(1)=" *** It is STRONGLY recommended that the 'SAGG Master Background Task' ***"
+16 SET TEXT(2)=" *** [KMPS SAGG REPORT] be rescheduled to run over the weekend hours. ***"
+17 SET TEXT(3)=""
End DoDot:1
+18 ;
+19 SET TEXT(4)=" The SAGG Project collection routines monitored the following:"
+20 SET TEXT(5)=""
+21 KILL VOLS
+22 SET GBL=""
+23 FOR
SET GBL=$ORDER(^XTMP("KMPS",SITENUM,SESSNUM,NOWDT,GBL))
if GBL=""
QUIT
Begin DoDot:1
+24 SET UCIVOL=""
+25 FOR
SET UCIVOL=$ORDER(^XTMP("KMPS",SITENUM,SESSNUM,NOWDT,GBL,UCIVOL))
if UCIVOL=""
QUIT
SET VOLS(UCIVOL)=""
End DoDot:1
+26 SET X=0
SET UCIVOL=""
SET JEND=$SELECT(OS="CVMS":2,OS="CWINNT":4,1:5)
+27 FOR I=6:1
if X
QUIT
Begin DoDot:1
+28 SET TEXT(I)=" "
+29 FOR J=1:1:JEND
SET UCIVOL=$ORDER(VOLS(UCIVOL))
if UCIVOL=""
SET X=1
if UCIVOL=""
QUIT
SET TEXT(I)=TEXT(I)_UCIVOL_" "
End DoDot:1
+30 SET TEXT(I)=""
+31 SET TEXT(I+1)=" Please ensure that this list concurs with your present volume set"
+32 SET TEXT(I+2)=" configuration."
SET TEXT(I+3)=""
+33 SET TEXT(I+4)=" A local e-mail message #"_XMZSENT_" was created by the collection"
+34 SET TEXT(I+5)=" routines. Check the FO-ALBANY.DOMAIN.EXT NetMail Queue to ensure"
+35 SET TEXT(I+6)=" transmission delivery."
+36 ;
+37 QUIT ""
+38 ;
MSG(STRTDT,SESSNUM,TEXT,COMPDT) ;-- send e-mail message to local KMP-CAPMAN mailgroup
+1 ;---------------------------------------------------------------------
+2 ; Send e-mail message to local KMP-CAPMAN mailgroup
+3 ;
+4 ; STRTDT... SAGG start date and time
+5 ; SESSNUM.. +$Horolog number of session
+6 ; TEXT..... text of message
+7 ; COMPDT... (optional) SAGG completion date and time
+8 ;---------------------------------------------------------------------
+9 NEW XMSUB,XMTEXT,XMY
+10 ;
+11 SET COMPDT=+$GET(COMPDT)
+12 ;
+13 if '$DATA(XMDUZ)
SET XMDUZ=.5
+14 if '$DATA(DUZ)
SET DUZ=.5
SET U="^"
+15 ;
+16 SET TEXT(.1)=" SAGG Session: "_SESSNUM
+17 SET TEXT(.2)=" Started: "_$$FMTE^XLFDT(STRTDT,"P")_" ("_$$DOW^XLFDT(STRTDT)_")"
+18 if +COMPDT
SET TEXT(.3)=" Completed: "_$$FMTE^XLFDT(COMPDT,"P")_" ("_$$DOW^XLFDT(COMPDT)_")"
+19 SET TEXT(.4)=""
+20 SET XMSUB="SAGG Project Message (Session #"_SESSNUM_")"
SET XMTEXT="TEXT("
+21 IF $DATA(^XMB(3.8,"B","KMP-CAPMAN"))
SET XMY("G.KMP-CAPMAN")=""
+22 if $DATA(XMY)
DO ^XMD
+23 QUIT
+24 ;
END ;
+1 KILL ^XTMP("KMPS",SITENUM),^XTMP("KMPS","ERROR")
+2 KILL ^XTMP("KMPS","START"),^XTMP("KMPS","STOP"),^XTMP("KMPS",0)
+3 KILL X,XMDUZ
+4 SET ZTREQ="@"
+5 LOCK -^XTMP("KMPS")
+6 QUIT
