BLRP24PC ; IHS/OIT/MKK - IHS Lab Patch 1024 Post install Checksum checker ; [ 12/15/2007 12:50 PM ]
;;5.2;LR;**1024**;April 8, 2008
;;
EP ; EP -- Start here
NEW CP ; Current Patch
NEW CSSTR ; Checksum String
NEW ERR ; Error Count
NEW HEAD ; HEADer array
NEW RCNT ; Routine Count
NEW PATCH ; Latest Patch Number
NEW SSTR ; String to hold $S results
NEW STR ; String variable
NEW VERSION ; Version Number
NEW %1,%2,%3,X,Y,XT1,XT2,XT3,XT4 ; Looping variables
;
S CP=$TR($P($T(+2),";",5),"*") ; Current Patch
;
S HEAD(1)=$$CJ^XLFSTR($$LOC^XBFUNC,IOM) ; Location
S HEAD(2)=$$CJ^XLFSTR("IHS Lab Patch "_CP_" Checksum routine",IOM)
;
S STR="Run Date: "_$$UP^XLFSTR($TR($$HTE^XLFDT($H,"2MPZ"),"@"," "))
S HEAD(3)=$$CJ^XLFSTR(STR,IOM)
;
S HEAD(4)=" "
;
S $E(HEAD(5),6)="Routine"
S $E(HEAD(5),16)="Checksum"
S $E(HEAD(5),26)="Status"
S $E(HEAD(5),36)="Ver"
S $E(HEAD(5),46)="Patch"
S HEAD(6)=$TR($J("",IOM)," ","-")
;
D ^XBCLS ; Clear Screen & "Home" cursor
D MES^XPDUTL(.HEAD)
;
CONT ;
S (ERR,RCNT)=0
S XT4="I 1",X=$T(+9)
F XT1=1:1 S XT2=$T(ROU+XT1) Q:XT2=""!($P(XT2,";",2)="") D
. S X=$P(XT2,";",2),XT3=$P(XT2,";",4)
. X XT4 I '$T Q
. S RCNT=RCNT+1
. K CSSTR
. S CSSTR=$J(RCNT,3)
. S $E(CSSTR,6)=X
. X ^%ZOSF("RSUM")
. S $E(CSSTR,16)=XT3
. S SSTR=$S('XT3:"Not in UCI",XT3'=Y:"**Error**",1:"ok")
. S $E(CSSTR,26)=SSTR
. I XT3'=0 D
.. S STR=$G(^ROUTINE(X,0,2))
.. S VERSION=$P(STR,";",3)
.. S $E(CSSTR,36)=VERSION
.. S PATCH=$RE($P($RE($P($P(STR,";",5),"*",3)),",",1))
.. S $E(CSSTR,46)=PATCH
.. I XT3'=Y D
... S $E(CSSTR,1,4)="****"
... S $E(CSSTR,47)="Calc "_Y_", off by "_(Y-XT3)
... S $E(CSSTR,77,80)="****"
. D MES^XPDUTL(CSSTR)
. I $$UP^XLFSTR(SSTR)="OK" Q
. ;
. ; Checksum error detected
. S ERR=ERR+1
. S ERR(ERR)=$$LJ^XLFSTR(X,8)_$J("",8)_$J(XT3,8)_$J("",10)_$J(Y,8)_$J("",10)_$J((Y-XT3),8)
;
K CSSTR
S CSSTR(1)=" "
S CSSTR(2)="Number of Routines = "_RCNT
S CSSTR(3)=" "
D BMES^XPDUTL(.CSSTR)
;
I ERR<1 D
. S CSSTR(2)="No Checksum Errors detected"
. D MES^XPDUTL(.CSSTR)
;
I ERR>0 D RPTERROR
;
W !
Q
;
; Checksum Errors detected: produce report and send E-mail to LMI Mail Group
RPTERROR ;
NEW NUMAGREE
S NUMAGREE=$S(ERR>1:"Errors",1:"Error")
W !,ERR," Checksum ",NUMAGREE," detected",!!
;
NEW LINECNT,HOWMANY,RTNN
K STR
S LINECNT=1
D ADDLINE($TR($J("",65)," ","*"),.STR,.LINECNT)
D ADDLINE(" ",.STR,.LINECNT)
D ADDLINE($$CJ^XLFSTR("IHS Lab Patch 1023",65),.STR,.LINECNT)
S HOWMANY=$S(ERR>1:"Errors",1:"Error")
S RTNN=$S(ERR>1:"Routines",1:"Routine")
D ADDLINE($$CJ^XLFSTR("Systems Environment "_HOWMANY_" Detected.",65),.STR,.LINECNT)
D ADDLINE($$CJ^XLFSTR(RTNN_" with CHECKSUM "_HOWMANY,65),.STR,.LINECNT)
D ADDLINE(" ",.STR,.LINECNT)
D ADDLINE($J("",3)_$RE($J($RE(RTNN),8))_$J("",8)_"Checksum"_$J("",8)_"Calculated"_$J("",9)_$J("Off by",9),.STR,.LINECNT)
D ADDLINE($J("",3)_"--------"_$J("",8)_"--------"_$J("",8)_"----------"_$J("",9)_$J("------",9),.STR,.LINECNT)
S ERR=0
F S ERR=$O(ERR(ERR)) Q:ERR="" D
. D ADDLINE($J("",3)_$G(ERR(ERR)),.STR,.LINECNT)
D ADDLINE(" ",.STR,.LINECNT)
D ADDLINE($$CJ^XLFSTR("Please print/capture this screen and",65),.STR,.LINECNT)
D ADDLINE($$CJ^XLFSTR("notify the Support Center at",65),.STR,.LINECNT)
D ADDLINE(" ",.STR,.LINECNT)
D ADDLINE($$CJ^XLFSTR("1-888-830-7280.",65),.STR,.LINECNT)
D ADDLINE(" ",.STR,.LINECNT)
D ADDLINE($G(STR(1)),.STR,.LINECNT)
D BMES^XPDUTL(.STR)
;
Q
;
D SENDMAIL("CHECKSUM ERROR DETECTED",.STR)
Q
;
; Routine to build STR array for display
ADDLINE(DISPSTR,ARRAY,COUNTER) ;
S ARRAY(COUNTER)=DISPSTR
S COUNTER=COUNTER+1
Q
;
ONE S XT4="I $D(^UTILITY($J,X))",X=$T(+3) W !!,"Checksum routine created on ",$P(X,";",4)," by KERNEL V",$P(X,";",3),!
W !,"Check a subset of routines:" K ^UTILITY($J) X ^%ZOSF("RSEL")
W ! G CONT
;
SENDMAIL(SUBJECT,MAILMSG) ;
D KILL^XM ; Kill any MAILMAN variables
N XMSUB,XMTO,XMINSTR,XMZ
I '$G(DUZ) N DUZ D DUZ^XUP(.5)
S XMSUB=SUBJECT
S XMTO="G.LMI"
S XMINSTR("FROM")=.5 ; POSTMASTER DUZ
S XMINSTR("ADDR FLAGS")="R" ; Ignore any restrictions (domain closed or protected by security key)
S XMZ="" ; Initialize variable
D SENDMSG^XMXAPI(DUZ,XMSUB,"MAILMSG",XMTO,.XMINSTR,.XMZ)
I $G(XMZ)="" D
. W !!,"SENDMSG^XMXAPI failed",!!
;
K X,XMDUZ,XMSUB,XMTEXT,Y ; Cleanup
Q
;
ROU ;;
;BLRCLRAL;;2907975
;BLRKIDSU;;13430377
;BLRLINK;;15204460
;BLRLINK2;;6466668
;BLRLINK3;;13568292
;BLRLOINC;;6691279
;BLRMERG2;;12336879
;BLRNLINK;;19377877
;BLRNLOIN;;7713235
;BLRP24PC;;7460374
;BLRPCCVC;;2702891
;BLRUTIL;;23683533
;BLRUTIL2;;12090473
;LRAC3;;9695372
;LRAC4;;12582925
;LR7OMERG;;16507732
;LRMISEZ1;;9433587
;;;
BLRP24PC ; IHS/OIT/MKK - IHS Lab Patch 1024 Post install Checksum checker ; [ 12/15/2007 12:50 PM ]
+1 ;;5.2;LR;**1024**;April 8, 2008
+2 ;;
EP ; EP -- Start here
+1 ; Current Patch
NEW CP
+2 ; Checksum String
NEW CSSTR
+3 ; Error Count
NEW ERR
+4 ; HEADer array
NEW HEAD
+5 ; Routine Count
NEW RCNT
+6 ; Latest Patch Number
NEW PATCH
+7 ; String to hold $S results
NEW SSTR
+8 ; String variable
NEW STR
+9 ; Version Number
NEW VERSION
+10 ; Looping variables
NEW %1,%2,%3,X,Y,XT1,XT2,XT3,XT4
+11 ;
+12 ; Current Patch
SET CP=$TRANSLATE($PIECE($TEXT(+2),";",5),"*")
+13 ;
+14 ; Location
SET HEAD(1)=$$CJ^XLFSTR($$LOC^XBFUNC,IOM)
+15 SET HEAD(2)=$$CJ^XLFSTR("IHS Lab Patch "_CP_" Checksum routine",IOM)
+16 ;
+17 SET STR="Run Date: "_$$UP^XLFSTR($TRANSLATE($$HTE^XLFDT($HOROLOG,"2MPZ"),"@"," "))
+18 SET HEAD(3)=$$CJ^XLFSTR(STR,IOM)
+19 ;
+20 SET HEAD(4)=" "
+21 ;
+22 SET $EXTRACT(HEAD(5),6)="Routine"
+23 SET $EXTRACT(HEAD(5),16)="Checksum"
+24 SET $EXTRACT(HEAD(5),26)="Status"
+25 SET $EXTRACT(HEAD(5),36)="Ver"
+26 SET $EXTRACT(HEAD(5),46)="Patch"
+27 SET HEAD(6)=$TRANSLATE($JUSTIFY("",IOM)," ","-")
+28 ;
+29 ; Clear Screen & "Home" cursor
DO ^XBCLS
+30 DO MES^XPDUTL(.HEAD)
+31 ;
CONT ;
+1 SET (ERR,RCNT)=0
+2 SET XT4="I 1"
SET X=$TEXT(+9)
+3 FOR XT1=1:1
SET XT2=$TEXT(ROU+XT1)
IF XT2=""!($PIECE(XT2,";",2)="")
QUIT
Begin DoDot:1
+4 SET X=$PIECE(XT2,";",2)
SET XT3=$PIECE(XT2,";",4)
+5 XECUTE XT4
IF '$TEST
QUIT
+6 SET RCNT=RCNT+1
+7 KILL CSSTR
+8 SET CSSTR=$JUSTIFY(RCNT,3)
+9 SET $EXTRACT(CSSTR,6)=X
+10 XECUTE ^%ZOSF("RSUM")
+11 SET $EXTRACT(CSSTR,16)=XT3
+12 SET SSTR=$SELECT('XT3:"Not in UCI",XT3'=Y:"**Error**",1:"ok")
+13 SET $EXTRACT(CSSTR,26)=SSTR
+14 IF XT3'=0
Begin DoDot:2
+15 SET STR=$GET(^ROUTINE(X,0,2))
+16 SET VERSION=$PIECE(STR,";",3)
+17 SET $EXTRACT(CSSTR,36)=VERSION
+18 SET PATCH=$REVERSE($PIECE($REVERSE($PIECE($PIECE(STR,";",5),"*",3)),",",1))
+19 SET $EXTRACT(CSSTR,46)=PATCH
+20 IF XT3'=Y
Begin DoDot:3
+21 SET $EXTRACT(CSSTR,1,4)="****"
+22 SET $EXTRACT(CSSTR,47)="Calc "_Y_", off by "_(Y-XT3)
+23 SET $EXTRACT(CSSTR,77,80)="****"
End DoDot:3
End DoDot:2
+24 DO MES^XPDUTL(CSSTR)
+25 IF $$UP^XLFSTR(SSTR)="OK"
QUIT
+26 ;
+27 ; Checksum error detected
+28 SET ERR=ERR+1
+29 SET ERR(ERR)=$$LJ^XLFSTR(X,8)_$JUSTIFY("",8)_$JUSTIFY(XT3,8)_$JUSTIFY("",10)_$JUSTIFY(Y,8)_$JUSTIFY("",10)_$JUSTIFY((Y-XT3),8)
End DoDot:1
+30 ;
+31 KILL CSSTR
+32 SET CSSTR(1)=" "
+33 SET CSSTR(2)="Number of Routines = "_RCNT
+34 SET CSSTR(3)=" "
+35 DO BMES^XPDUTL(.CSSTR)
+36 ;
+37 IF ERR<1
Begin DoDot:1
+38 SET CSSTR(2)="No Checksum Errors detected"
+39 DO MES^XPDUTL(.CSSTR)
End DoDot:1
+40 ;
+41 IF ERR>0
DO RPTERROR
+42 ;
+43 WRITE !
+44 QUIT
+45 ;
+46 ; Checksum Errors detected: produce report and send E-mail to LMI Mail Group
RPTERROR ;
+1 NEW NUMAGREE
+2 SET NUMAGREE=$SELECT(ERR>1:"Errors",1:"Error")
+3 WRITE !,ERR," Checksum ",NUMAGREE," detected",!!
+4 ;
+5 NEW LINECNT,HOWMANY,RTNN
+6 KILL STR
+7 SET LINECNT=1
+8 DO ADDLINE($TRANSLATE($JUSTIFY("",65)," ","*"),.STR,.LINECNT)
+9 DO ADDLINE(" ",.STR,.LINECNT)
+10 DO ADDLINE($$CJ^XLFSTR("IHS Lab Patch 1023",65),.STR,.LINECNT)
+11 SET HOWMANY=$SELECT(ERR>1:"Errors",1:"Error")
+12 SET RTNN=$SELECT(ERR>1:"Routines",1:"Routine")
+13 DO ADDLINE($$CJ^XLFSTR("Systems Environment "_HOWMANY_" Detected.",65),.STR,.LINECNT)
+14 DO ADDLINE($$CJ^XLFSTR(RTNN_" with CHECKSUM "_HOWMANY,65),.STR,.LINECNT)
+15 DO ADDLINE(" ",.STR,.LINECNT)
+16 DO ADDLINE($JUSTIFY("",3)_$REVERSE($JUSTIFY($REVERSE(RTNN),8))_$JUSTIFY("",8)_"Checksum"_$JUSTIFY("",8)_"Calculated"_$JUSTIFY("",9)_$JUSTIFY("Off by",9),.STR,.LINECNT)
+17 DO ADDLINE($JUSTIFY("",3)_"--------"_$JUSTIFY("",8)_"--------"_$JUSTIFY("",8)_"----------"_$JUSTIFY("",9)_$JUSTIFY("------",9),.STR,.LINECNT)
+18 SET ERR=0
+19 FOR
SET ERR=$ORDER(ERR(ERR))
IF ERR=""
QUIT
Begin DoDot:1
+20 DO ADDLINE($JUSTIFY("",3)_$GET(ERR(ERR)),.STR,.LINECNT)
End DoDot:1
+21 DO ADDLINE(" ",.STR,.LINECNT)
+22 DO ADDLINE($$CJ^XLFSTR("Please print/capture this screen and",65),.STR,.LINECNT)
+23 DO ADDLINE($$CJ^XLFSTR("notify the Support Center at",65),.STR,.LINECNT)
+24 DO ADDLINE(" ",.STR,.LINECNT)
+25 DO ADDLINE($$CJ^XLFSTR("1-888-830-7280.",65),.STR,.LINECNT)
+26 DO ADDLINE(" ",.STR,.LINECNT)
+27 DO ADDLINE($GET(STR(1)),.STR,.LINECNT)
+28 DO BMES^XPDUTL(.STR)
+29 ;
+30 QUIT
+31 ;
+32 DO SENDMAIL("CHECKSUM ERROR DETECTED",.STR)
+33 QUIT
+34 ;
+35 ; Routine to build STR array for display
ADDLINE(DISPSTR,ARRAY,COUNTER) ;
+1 SET ARRAY(COUNTER)=DISPSTR
+2 SET COUNTER=COUNTER+1
+3 QUIT
+4 ;
ONE SET XT4="I $D(^UTILITY($J,X))"
SET X=$TEXT(+3)
WRITE !!,"Checksum routine created on ",$PIECE(X,";",4)," by KERNEL V",$PIECE(X,";",3),!
+1 WRITE !,"Check a subset of routines:"
KILL ^UTILITY($JOB)
XECUTE ^%ZOSF("RSEL")
+2 WRITE !
GOTO CONT
+3 ;
SENDMAIL(SUBJECT,MAILMSG) ;
+1 ; Kill any MAILMAN variables
DO KILL^XM
+2 NEW XMSUB,XMTO,XMINSTR,XMZ
+3 IF '$GET(DUZ)
NEW DUZ
DO DUZ^XUP(.5)
+4 SET XMSUB=SUBJECT
+5 SET XMTO="G.LMI"
+6 ; POSTMASTER DUZ
SET XMINSTR("FROM")=.5
+7 ; Ignore any restrictions (domain closed or protected by security key)
SET XMINSTR("ADDR FLAGS")="R"
+8 ; Initialize variable
SET XMZ=""
+9 DO SENDMSG^XMXAPI(DUZ,XMSUB,"MAILMSG",XMTO,.XMINSTR,.XMZ)
+10 IF $GET(XMZ)=""
Begin DoDot:1
+11 WRITE !!,"SENDMSG^XMXAPI failed",!!
End DoDot:1
+12 ;
+13 ; Cleanup
KILL X,XMDUZ,XMSUB,XMTEXT,Y
+14 QUIT
+15 ;
ROU ;;
+1 ;BLRCLRAL;;2907975
+2 ;BLRKIDSU;;13430377
+3 ;BLRLINK;;15204460
+4 ;BLRLINK2;;6466668
+5 ;BLRLINK3;;13568292
+6 ;BLRLOINC;;6691279
+7 ;BLRMERG2;;12336879
+8 ;BLRNLINK;;19377877
+9 ;BLRNLOIN;;7713235
+10 ;BLRP24PC;;7460374
+11 ;BLRPCCVC;;2702891
+12 ;BLRUTIL;;23683533
+13 ;BLRUTIL2;;12090473
+14 ;LRAC3;;9695372
+15 ;LRAC4;;12582925
+16 ;LR7OMERG;;16507732
+17 ;LRMISEZ1;;9433587
+18 ;;;
