- 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 ;;;
