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