BLRP25PC ; IHS/OIT/MKK - IHS Lab Patch 1025 Post install Checksum checker ;DEC 09, 2008 8:30 AM
;;5.2;IHS LABORATORY;**1025**;NOV 01, 1997
;;
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=$TR($P(XT2,";",2)," ")
. S XT3=$TR($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
... K CSSTR
... S $E(CSSTR,1,4)="****"
... S $E(CSSTR,6)=X
... S $E(CSSTR,26)=SSTR
... S $E(CSSTR,46)="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-999-999-9999.",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 ;;
;BLREXEC2;;5628952
;BLRMENU;;447878
;BLRMMRPT;;3417134
;BLRP41UI;;11319880
;BLRP41UP;;7639709
;BLRPCCBD;;1306119
;BLRPOC;;21027406
;BLRPRE25;;25330757
;BLRUTIL3;;3276664
;BLRVPTCH;;1896846
;LRVRPOCU;;8922327
;BLRALBA;;9158370
;BLRLINK2;;6773921
;BLRLINK3;;13802313
;BLRLINKP;;15982489
;BLRPCCVC;;2813203
;BLRPST;;7736873
;BLRTNB;;16690204
;BLRTNM;;29685300
;LREXPD;;5043997
;LRMIPC;;4289609
;LRMISEZB;;9753528
;LRMISR1;;3325470
;LRMITSPE;;6984513
;LRORD;;21951290
;LRORDK;;14521313
;LRRP1;;14957981
;LRRP2;;19052582
;LRSORC1A;;7595298
;LRTT5P1;;14263908
;LRUPAD;;7881930
;LRWLST;;18706544
;LRWRKLS1;;5404205
;LRX;;18631413
;;;
BLRP25PC ; IHS/OIT/MKK - IHS Lab Patch 1025 Post install Checksum checker ;DEC 09, 2008 8:30 AM
+1 ;;5.2;IHS LABORATORY;**1025**;NOV 01, 1997
+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=$TRANSLATE($PIECE(XT2,";",2)," ")
+5 SET XT3=$TRANSLATE($PIECE(XT2,";",4)," ")
+6 XECUTE XT4
IF '$TEST
QUIT
+7 SET RCNT=RCNT+1
+8 KILL CSSTR
+9 SET CSSTR=$JUSTIFY(RCNT,3)
+10 SET $EXTRACT(CSSTR,6)=X
+11 XECUTE ^%ZOSF("RSUM")
+12 SET $EXTRACT(CSSTR,16)=XT3
+13 SET SSTR=$SELECT('XT3:"Not in UCI",XT3'=Y:"**Error**",1:"OK")
+14 SET $EXTRACT(CSSTR,26)=SSTR
+15 IF XT3'=0
Begin DoDot:2
+16 SET STR=$GET(^ROUTINE(X,0,2))
+17 SET VERSION=$PIECE(STR,";",3)
+18 SET $EXTRACT(CSSTR,36)=VERSION
+19 SET PATCH=$REVERSE($PIECE($REVERSE($PIECE($PIECE(STR,";",5),"*",3)),",",1))
+20 SET $EXTRACT(CSSTR,46)=PATCH
+21 IF XT3'=Y
Begin DoDot:3
+22 KILL CSSTR
+23 SET $EXTRACT(CSSTR,1,4)="****"
+24 SET $EXTRACT(CSSTR,6)=X
+25 SET $EXTRACT(CSSTR,26)=SSTR
+26 SET $EXTRACT(CSSTR,46)="Calc "_Y_", off by "_(Y-XT3)
+27 SET $EXTRACT(CSSTR,77,80)="****"
End DoDot:3
End DoDot:2
+28 DO MES^XPDUTL(CSSTR)
+29 IF $$UP^XLFSTR(SSTR)="OK"
QUIT
+30 ;
+31 ; Checksum error detected
+32 SET ERR=ERR+1
+33 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
+34 ;
+35 KILL CSSTR
+36 SET CSSTR(1)=" "
+37 SET CSSTR(2)="Number of Routines = "_RCNT
+38 SET CSSTR(3)=" "
+39 DO BMES^XPDUTL(.CSSTR)
+40 ;
+41 IF ERR<1
Begin DoDot:1
+42 SET CSSTR(2)="No Checksum Errors detected"
+43 DO MES^XPDUTL(.CSSTR)
End DoDot:1
+44 ;
+45 IF ERR>0
DO RPTERROR
+46 ;
+47 WRITE !
+48 QUIT
+49 ;
+50 ; 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-999-999-9999.",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 ;BLREXEC2;;5628952
+2 ;BLRMENU;;447878
+3 ;BLRMMRPT;;3417134
+4 ;BLRP41UI;;11319880
+5 ;BLRP41UP;;7639709
+6 ;BLRPCCBD;;1306119
+7 ;BLRPOC;;21027406
+8 ;BLRPRE25;;25330757
+9 ;BLRUTIL3;;3276664
+10 ;BLRVPTCH;;1896846
+11 ;LRVRPOCU;;8922327
+12 ;BLRALBA;;9158370
+13 ;BLRLINK2;;6773921
+14 ;BLRLINK3;;13802313
+15 ;BLRLINKP;;15982489
+16 ;BLRPCCVC;;2813203
+17 ;BLRPST;;7736873
+18 ;BLRTNB;;16690204
+19 ;BLRTNM;;29685300
+20 ;LREXPD;;5043997
+21 ;LRMIPC;;4289609
+22 ;LRMISEZB;;9753528
+23 ;LRMISR1;;3325470
+24 ;LRMITSPE;;6984513
+25 ;LRORD;;21951290
+26 ;LRORDK;;14521313
+27 ;LRRP1;;14957981
+28 ;LRRP2;;19052582
+29 ;LRSORC1A;;7595298
+30 ;LRTT5P1;;14263908
+31 ;LRUPAD;;7881930
+32 ;LRWLST;;18706544
+33 ;LRWRKLS1;;5404205
+34 ;LRX;;18631413
+35 ;;;
