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