BLRP22PC ; IHS/OIT/MKK - IHS Lab Patch 1022 Post Install checksum checker ; 3070215.080303
;;5.2;LR;**1022**;September 20, 2007
;;
;; Cloned from LRNTEG created by Kernel. The reason this version was created
;; is to make sure the site's LRNTEG routine is NOT over-written.
;;
;LRNTEG ;ISC/XTSUMBLD KERNEL - Package checksum checker ;3070215.080303
;;0.0;;**1022**;
;;7.3;3070215.080303
EP ; Start here
S XT4="I 1",X=$T(+9)
W !!
W "IHS Lab Patch 1022 Checksum routine"
W !
W ?5,"Run Date: ",$TR($$HTE^XLFDT($H,"2MPZ"),"@"," ")
W !!
NEW CSSTR ; Checksum String
NEW STR ; String used to hold any errors
NEW ERR ; Error Count
NEW RCNT ; Routine Count
NEW SSTR ; String to hold $S results
S (ERR,RCNT)=0
S CSSTR="Routine"
S $E(CSSTR,11)="Checksum"
S $E(CSSTR,25)="Status"
D MES^XPDUTL(CSSTR)
D MES^XPDUTL(" ")
CONT ;
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=X
. X ^%ZOSF("RSUM")
. S $E(CSSTR,11)=XT3
. S SSTR=$S('XT3:"Routine not in UCI",XT3'=Y:"Calculated "_Y_", off by "_(Y-XT3),1:"ok")
. S $E(CSSTR,25)=SSTR
. D MES^XPDUTL(CSSTR)
. I 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)
;
W !!,"Number of Routines = ",RCNT,!
I ERR<1 W !,"No Checksum Errors detected",!
I ERR>0 D RPTERROR
;
K %1,%2,%3,X,Y,XT1,XT2,XT3,XT4
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 1022",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)
;
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 ;;
;BLR6249P;;5602469
;BLRP22PC;;6684207
;BLRALBA;;8668467
;BLRBBDDC;;3499457
;BLRCHGER;;1218264
;BLRCHGPL;;16494994
;BLRCHGPW;;6582379
;BLRESIGR;;13829242
;BLRESRCD;;2761624
;BLRESRNS;;2242512
;BLREXECU;;2586438
;BLRGMENU;;10723299
;BLRLABLC;;5552614
;BLRLINK2;;7459876
;BLRLINK3;;12391185
;BLRMERG2;;10638523
;BLRMPRL;;1077826
;BLRPCCVC;;2552930
;BLRPRE22;;16487202
;BLRRIIN;;3545940
;BLRRIIN1;;10593073
;BLRRIIN2;;12408792
;BLRSHDRC;;16738784
;BLRUTIL2;;10039542
;LR287;;5220915
;LR302;;7036526
;LR302A;;4415522
;LR302P;;3800106
;LR302PO;;9375744
;LR302POA;;2988034
;LR305;;5011529
;LR307;;2107378
;LR313;;4332772
;LR7OF1;;13628614
;LR7OF3;;9995500
;LR7OGM;;8016851
;LR7OGMC;;5100828
;LR7OGMM;;4440747
;LR7OGMU;;1286392
;LR7OR1;;12788388
;LR7OU0;;5520184
;LRCAPDAR;;7335453
;LRCE;;14020950
;LRDAGE;;1454485
;LRDPA;;7960268
;LRDPA1;;7381205
;LRDPA2;;5207850
;LREGFR;;3965285
;LRLABEL;;1176923
;LRLABLIO;;4962324
;LRMIPSU;;6418915
;LRNTEG;;4270906
;LRNTEG0;;4298995
;LRNTEG01;;4241836
;LRNTEG02;;4219835
;LRNTEG03;;4175643
;LRNTEG04;;4208853
;LRNTEG05;;4223141
;LRNTEG06;;4237104
;LRNTEG07;;4244117
;LRNTEG08;;4226241
;LRNTEG09;;4162042
;LRNTEG010;;3637375
;LRRP1;;9653615
;LRRP2;;17514598
;LRTOCOST;;25358415
;LRUPAC;;5916352
;LRUPACA;;12631718
;LRVR4;;9099233
;LRWRKIN1;;13404466
;LRWRKINC;;22516225
;;;
BLRP22PC ; IHS/OIT/MKK - IHS Lab Patch 1022 Post Install checksum checker ; 3070215.080303
+1 ;;5.2;LR;**1022**;September 20, 2007
+2 ;;
+3 ;; Cloned from LRNTEG created by Kernel. The reason this version was created
+4 ;; is to make sure the site's LRNTEG routine is NOT over-written.
+5 ;;
+6 ;LRNTEG ;ISC/XTSUMBLD KERNEL - Package checksum checker ;3070215.080303
+7 ;;0.0;;**1022**;
+8 ;;7.3;3070215.080303
EP ; Start here
+1 SET XT4="I 1"
SET X=$TEXT(+9)
+2 WRITE !!
+3 WRITE "IHS Lab Patch 1022 Checksum routine"
+4 WRITE !
+5 WRITE ?5,"Run Date: ",$TRANSLATE($$HTE^XLFDT($HOROLOG,"2MPZ"),"@"," ")
+6 WRITE !!
+7 ; Checksum String
NEW CSSTR
+8 ; String used to hold any errors
NEW STR
+9 ; Error Count
NEW ERR
+10 ; Routine Count
NEW RCNT
+11 ; String to hold $S results
NEW SSTR
+12 SET (ERR,RCNT)=0
+13 SET CSSTR="Routine"
+14 SET $EXTRACT(CSSTR,11)="Checksum"
+15 SET $EXTRACT(CSSTR,25)="Status"
+16 DO MES^XPDUTL(CSSTR)
+17 DO MES^XPDUTL(" ")
CONT ;
+1 FOR XT1=1:1
SET XT2=$TEXT(ROU+XT1)
IF XT2=""!($PIECE(XT2,";",2)="")
QUIT
Begin DoDot:1
+2 SET X=$PIECE(XT2,";",2)
SET XT3=$PIECE(XT2,";",4)
+3 XECUTE XT4
IF '$TEST
QUIT
+4 SET RCNT=RCNT+1
+5 KILL CSSTR
+6 SET CSSTR=X
+7 XECUTE ^%ZOSF("RSUM")
+8 SET $EXTRACT(CSSTR,11)=XT3
+9 SET SSTR=$SELECT('XT3:"Routine not in UCI",XT3'=Y:"Calculated "_Y_", off by "_(Y-XT3),1:"ok")
+10 SET $EXTRACT(CSSTR,25)=SSTR
+11 DO MES^XPDUTL(CSSTR)
+12 IF SSTR="ok"
QUIT
+13 ;
+14 ; Checksum error detected
+15 SET ERR=ERR+1
+16 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
+17 ;
+18 WRITE !!,"Number of Routines = ",RCNT,!
+19 IF ERR<1
WRITE !,"No Checksum Errors detected",!
+20 IF ERR>0
DO RPTERROR
+21 ;
+22 KILL %1,%2,%3,X,Y,XT1,XT2,XT3,XT4
+23 WRITE !
+24 QUIT
+25 ;
+26 ; 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 1022",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 DO SENDMAIL("CHECKSUM ERROR DETECTED",.STR)
+31 QUIT
+32 ;
+33 ; 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 ;BLR6249P;;5602469
+2 ;BLRP22PC;;6684207
+3 ;BLRALBA;;8668467
+4 ;BLRBBDDC;;3499457
+5 ;BLRCHGER;;1218264
+6 ;BLRCHGPL;;16494994
+7 ;BLRCHGPW;;6582379
+8 ;BLRESIGR;;13829242
+9 ;BLRESRCD;;2761624
+10 ;BLRESRNS;;2242512
+11 ;BLREXECU;;2586438
+12 ;BLRGMENU;;10723299
+13 ;BLRLABLC;;5552614
+14 ;BLRLINK2;;7459876
+15 ;BLRLINK3;;12391185
+16 ;BLRMERG2;;10638523
+17 ;BLRMPRL;;1077826
+18 ;BLRPCCVC;;2552930
+19 ;BLRPRE22;;16487202
+20 ;BLRRIIN;;3545940
+21 ;BLRRIIN1;;10593073
+22 ;BLRRIIN2;;12408792
+23 ;BLRSHDRC;;16738784
+24 ;BLRUTIL2;;10039542
+25 ;LR287;;5220915
+26 ;LR302;;7036526
+27 ;LR302A;;4415522
+28 ;LR302P;;3800106
+29 ;LR302PO;;9375744
+30 ;LR302POA;;2988034
+31 ;LR305;;5011529
+32 ;LR307;;2107378
+33 ;LR313;;4332772
+34 ;LR7OF1;;13628614
+35 ;LR7OF3;;9995500
+36 ;LR7OGM;;8016851
+37 ;LR7OGMC;;5100828
+38 ;LR7OGMM;;4440747
+39 ;LR7OGMU;;1286392
+40 ;LR7OR1;;12788388
+41 ;LR7OU0;;5520184
+42 ;LRCAPDAR;;7335453
+43 ;LRCE;;14020950
+44 ;LRDAGE;;1454485
+45 ;LRDPA;;7960268
+46 ;LRDPA1;;7381205
+47 ;LRDPA2;;5207850
+48 ;LREGFR;;3965285
+49 ;LRLABEL;;1176923
+50 ;LRLABLIO;;4962324
+51 ;LRMIPSU;;6418915
+52 ;LRNTEG;;4270906
+53 ;LRNTEG0;;4298995
+54 ;LRNTEG01;;4241836
+55 ;LRNTEG02;;4219835
+56 ;LRNTEG03;;4175643
+57 ;LRNTEG04;;4208853
+58 ;LRNTEG05;;4223141
+59 ;LRNTEG06;;4237104
+60 ;LRNTEG07;;4244117
+61 ;LRNTEG08;;4226241
+62 ;LRNTEG09;;4162042
+63 ;LRNTEG010;;3637375
+64 ;LRRP1;;9653615
+65 ;LRRP2;;17514598
+66 ;LRTOCOST;;25358415
+67 ;LRUPAC;;5916352
+68 ;LRUPACA;;12631718
+69 ;LRVR4;;9099233
+70 ;LRWRKIN1;;13404466
+71 ;LRWRKINC;;22516225
+72 ;;;
