- XUGOT1 ; BT/OAK-BP - COMPARE LOCAL/NATIONAL CHECKSUMS REPORT ;10/20/2006
- ;;8.0;KERNEL;**369**;Jul 10, 1995;Build 27
- Q
- REPORT ;
- W !!,">>> This processing will take about thirty minutes."
- W !," It will save your time if you send this report"
- W !," to a printer.",!
- S %ZIS="Q" D ^%ZIS I POP D ^%ZISC,END Q
- ; Queue report via Taskman
- I $D(IO("Q")) D G END
- . N ZTDESC,ZTSK,ZTRTN,ZTIO,ZTSAVE
- . S ZTRTN="ENT^XUGOT1",ZTDESC="Compare local/national checksums report"
- . D ^%ZTLOAD,^%ZISC
- . W !,"Task ",$S($G(ZTSK):ZTSK,1:"NOT")," Queued"
- . K IO("Q")
- ENT ;
- K ^TMP($J)
- N CKRTP F CKRTP=1:1:9 S CKRTP(CKRTP)=0
- N SLX,SL S U="^",SLX="ZL @RTN S SL=$T(@RTN+1)"
- ;Use SUMB in XPDRSUM
- N XUIEN S XUIEN=0 F S XUIEN=$O(^DIC(9.8,XUIEN)) Q:XUIEN'>0 D
- . N RTN,X S (RTN,X)=$P($G(^DIC(9.8,XUIEN,0)),U) I $L(RTN)=0 Q
- . I $P($G(^DIC(9.8,XUIEN,0)),U,2)'="R" Q
- . S CKRTP(1)=CKRTP(1)+1 ;Total count of routines reviewed (#1)
- . N TRACK S TRACK=$$TRACK(XUIEN) I TRACK'>0 S CKRTP(3)=CKRTP(3)+1 Q ; routine isn't being tracked (#3)
- . I $L(RTN)>8 S ^TMP($J,8,RTN)="",CKRTP(8)=CKRTP(8)+1 Q
- . N NSUM,NLPATCH S NSUM=$$NSUM(XUIEN),NLPATCH=$$NLPATCH(XUIEN)
- . I NSUM="",TRACK'=1 Q ; check for national checksum is empty, and not Local Track
- . I TRACK>2 Q ; Quit if routine is marked as "National - Deleted or NOT tracked"
- . X ^%ZOSF("TEST") I '$T S CKRTP(2)=CKRTP(2)+1,^TMP($J,2,RTN)=NSUM_"^"_NLPATCH Q ;routine is not found on the system (#2)
- . X SLX ; get the second line
- . I SL="" S SL=$$GETSL^XUGOT(X)
- . N LSUM S LSUM=$$LSUM(RTN) I $E(LSUM,2,10)'>0 S CKRTP(2)=CKRTP(2)+1,^TMP($J,2,RTN)=NSUM_"^"_NLPATCH Q ;routine is not found on the system (#2)
- . I NSUM=LSUM S CKRTP(4)=CKRTP(4)+1 Q ;national and local checksums match (#4)
- . I TRACK=1 S ^TMP($J,5,RTN)=NSUM_"^"_LSUM,CKRTP(5)=CKRTP(5)+1 Q ; Local tracked (#5)
- . ;--------- national and local checksums don't match
- . N XUN1,XUN2,XUN3,XUN4,XUL1,XUL2,XUL3,XUA,XUP,XULM,XUPN S XULM="Yes",XUPN="No"
- . S XUP=$$PACK^XUGOT(RTN,SL) ;Patch and version AAA*Z.Z*
- . N NPL2 S NPL2=$$NPL2^XUGOT(XUIEN) I +$P(SL,";",3)=$P(NPL2,"*",2) S $P(XUP,"*",2)=$P(NPL2,"*",2)
- . S XUL2=$$LPLIST(SL)
- . S XUL2=$$LPATCH(XUL2) ;Last patch number from the second line
- . S XUL3=XUP_XUL2 ;Latest local patch base on second line
- . S XUN1=$$NPL1(XUIEN,LSUM,XUL2) ;Number national patch list and patch that matches LSUM.
- . S XUN3=$$NLPATCH(XUIEN) ;Last patch name from Patch multiple fields
- . S XUN2=$P(XUN3,"*",3) ;Last patch number from the last patch name
- . S XUN4=$$XUN4^XUGOT(XUN3) ;Last Version from the last patch name
- . I $P(XUN1,"^",3)'="" S XULM="Unknown"
- . I $P(XUN1,"^",2)'="" S XULM="No"
- . I XUL2'="",XUL2'=XUN2,$$LPLIST(SL)[XUN2 S XUPN="Testing "_XUP_XUL2,XULM="Unknown"
- . I XUL2'="" S XUA=$P($P(XUN1,"^"),XUL2_",",2) I XUA'="" S XUPN=XUP_XUA I $P(NPL2,"*")'="",$P(NPL2,"*",2)'="" S XUPN=NPL2_"*"_XUA ; Missing patches
- . I +XUL2'="",XUL2=XUN2 S ^TMP($J,6,RTN)=NSUM_"^"_LSUM_"^"_XUL3_"^Yes^No",CKRTP(6)=CKRTP(6)+1 Q
- . I XUL2'="",XUL2'=+XUL2 S ^TMP($J,6,RTN)=NSUM_"^"_LSUM_"^"_XUL3_"^Yes^Unknown",CKRTP(6)=CKRTP(6)+1 Q
- . I XUL2'="",XUL2'=XUN2,$$LPLIST(SL)'[XUN2,$P(XUN1,"^")'[XUL2 S ^TMP($J,6,RTN)=NSUM_"^"_LSUM_"^"_XUL3_"^Unknown^"_XUN3,CKRTP(6)=CKRTP(6)+1 Q
- . I XUL2="" S XULM="Unknown"
- . I XUL2="",XUN2="" S XUPN=XUN3
- . I XUL2="",XUN2'="" S XUPN=XUP_$P(XUN1,"^")
- . N XUNV,XULV S XULV=+$P(SL,";",3),XUNV=$$RT^XUGOT(RTN)
- . I XUN4'>0 S XUN4=+$P(XUNV,"^",3)
- . I $P(XUNV,"^")="",$$SL^XUGOT(SL)="" S ^TMP($J,9,RTN)="",CKRTP(9)=CKRTP(9)+1 Q
- . N XUK S XUK=0
- . I $P(XUNV,"^")="" D
- . . N XUL3A S XUL3A=$$SL^XUGOT(SL)_"*"_XULV_"*",XULM="Unknown",XUPN="Unknown"
- . . I $$SL^XUGOT(SL)="" S XUL3A=$P(XUN3,"*",1,2)_"*"
- . . I XUL3A="*" S XUL3A=NPL2_"*"
- . . S XUL3=XUL3A_XUL2
- . . I XUL2'="",XUL2'=XUN2,$$LPLIST(SL)[XUN2 S XUPN="Testing "_XUL3,XULM="Unknown"
- . . I XUL2'="" S XUA=$P($P(XUN1,"^"),XUL2_",",2) I XUA'="" S XUPN=XUP_XUA I $P(NPL2,"*")'="",$P(NPL2,"*",2)'="" S XUPN=NPL2_"*"_XUA ; Missing patches
- . . S ^TMP($J,6,RTN)=NSUM_"^"_LSUM_"^"_XUL3_"^"_XULM_"^"_XUPN,CKRTP(6)=CKRTP(6)+1,XUK=1
- . I XUK=1 Q
- . ; version off
- . N XUK S XUK=0
- . I XULV>0,XULV'=XUN4 D
- . . N XUL3A S XUL3A=$$SL^XUGOT(SL)_"*"_XULV_"*",XULM="Unknown",XUPN="Unknown"
- . . I $$SL^XUGOT(SL)="" S XUL3A=$P(XUN3,"*",1,2)_"*"
- . . I XUL3A="*" S XUL3A=NPL2_"*"
- . . S XUL3=XUL3A_XUL2
- . . I XUL2'="",XUL2'=XUN2,$$LPLIST(SL)[XUN2 S XUPN="Testing "_XUL3,XULM="Unknown"
- . . I XUL2'="" S XUA=$P($P(XUN1,"^"),XUL2_",",2) I XUA'="" S XUPN=XUP_XUA I $P(NPL2,"*")'="",$P(NPL2,"*",2)'="" S XUPN=NPL2_"*"_XUA ; Missing patches
- . . S ^TMP($J,6,RTN)=NSUM_"^"_LSUM_"^"_XUL3_"^"_XULM_"^"_XUPN,CKRTP(6)=CKRTP(6)+1,XUK=1
- . I XUK=1 Q
- . S ^TMP($J,6,RTN)=NSUM_"^"_LSUM_"^"_XUL3_"^"_XULM_"^"_XUPN,CKRTP(6)=CKRTP(6)+1 Q
- D PRT
- Q
- ;
- PRT N ST,Y4 S ST=0,Y4=1
- N IOC,IOC1 S IOC=(IO=IO(0)),IOC1=$E(IOST,1,2)["C-"
- U IO W:IOC1 @IOF
- W !,$$PG(Y4)
- N HDR1,HDR2,RPTYP
- F RPTYP=5,6,7,2,9,8,3,4,1 Q:ST D
- . I RPTYP=1 W !,"ROUTINE FILE TOTAL ENTRIES COUNT (",CKRTP(1),")",!
- . I RPTYP=2,CKRTP(2)>0 W !,"ROUTINES NOT FOUND IN THE SYSTEM (",CKRTP(2),")" D CN W ! D CN I CKRTP(2) D HEADER
- . I RPTYP=3,CKRTP(3)>0 W !,"ROUTINES NOT MARKED FOR TRACKING (",CKRTP(3),")",!
- . I RPTYP=4,CKRTP(4)>0 W !,"ROUTINES WITH MATCHING CHECKSUMS (",CKRTP(4),")",!
- . I RPTYP=5,CKRTP(5)>0 W "ROUTINES MARKED FOR LOCAL TRACKING (",CKRTP(5),")",! I CKRTP(5) D HEADER
- . I RPTYP=6,CKRTP(6)>0 W !,"ROUTINES WITH THE CHECKSUM OFF(",CKRTP(6),")" D CN W ! D CN I CKRTP(6) D HEADER
- . ;I RPTYP=7,CKRTP(7)>0 W !,"ROUTINES WITH VERSION OFF(",CKRTP(7),")" D CN W ! D CN I CKRTP(7) D HEADER
- . I RPTYP=8,CKRTP(8)>0 W !,"ROUTINES WITH MORE THAN 8 CHARACTERS NAME(",CKRTP(8),")" D CN W ! D CN I CKRTP(8) D HEADER
- . ;I RPTYP=9,CKRTP(9)>0 W !,"ROUTINES WITH NO PACKAGE ASSOCIATED WITH(",CKRTP(9),")" D CN W ! D CN I CKRTP(9) D HEADER
- . ;
- . S RTN="" F S RTN=$O(^TMP($J,RPTYP,RTN)) Q:(RTN="")!(ST) D
- . . D CN I ST Q
- . . N Y3 S Y3=$G(^TMP($J,RPTYP,RTN))
- . . I RPTYP=5 W " ",RTN,?11,$P(Y3,"^",1),?23,$P(Y3,"^",2),!
- . . I RPTYP=6 W " ",RTN,?11,$P(Y3,"^",1),?23,$P(Y3,"^",2),?35,$E($P(Y3,"^",3),1,11),?48,$P(Y3,"^",4),?57,$E($P(Y3,"^",5),1,23),!
- . . I RPTYP=7 W " ",RTN,?11,$P(Y3,"^",1),?24,$P(Y3,"^",2),?37,$P(Y3,"^",3),!
- . . I RPTYP=2 W " ",RTN,?11,$P(Y3,"^",1),?23,$P(Y3,"^",2),!
- . . I RPTYP=8 W " ",RTN,!
- . . ;I RPTYP=9 W " ",RTN,!
- . . Q
- . Q
- ;--------------------------
- END D ^%ZISC K ^TMP($J),%DT,%ZIS
- Q
- ;--------------------------
- PG(XUN) ;
- W #,$$FMTE^XLFDT(DT),?(IOM\2),"Page: ",XUN,!!
- Q ""
- ;--------------------------
- S HDR1=" Routine Nat CHKSUM ",HDR2=" ======= ========== "
- I RPTYP=2 S HDR1=HDR1_"Nat Last Patch",HDR2=HDR2_"============="
- I RPTYP=6 S HDR1=HDR1_"Our CHKSUM Our Patch Loc Mod Patches Needed",HDR2=HDR2_"========== =========== ======= =============="
- I RPTYP=5 S HDR1=" Routine CHKSUM Base Our CHKSUM",HDR2=HDR2_"==========="
- I RPTYP=7 S HDR1=" Routine Nat Version Loc Version Latest Nat Patch",HDR2=" ======= =========== =========== =============="
- I RPTYP=8 S HDR1=" Routine ",HDR2=" ======="
- ;I RPTYP=9 S HDR1=" Routine",HDR2=" ======="
- W HDR1,!
- W HDR2,!
- Q
- ;---------------------------
- %Z1 R "Enter RETURN to continue or '^' to exit: ",ST:60 S ST=$S(ST["^":1,1:0) S:'$T ST=1 W @IOF
- Q
- ;---------------------------
- CN I (($Y+2)=IOSL)!(($Y+3)=IOSL) S Y4=Y4+1 D:IOC&IOC1 %Z1 Q:ST W $$PG(Y4) D HEADER
- Q
- ;--------------------------------------------------------------------------
- LSUM(RTN) ;Get the new Checksum LOCAL
- I $G(RTN)="" Q ""
- N DIF,RTNL,X,XCNP,Y
- S X=RTN,DIF="RTNL(",XCNP=0 X ^%ZOSF("LOAD")
- S Y=$$SUMB^XPDRSUM($NA(RTNL))
- Q "B"_Y
- ;
- NSUM(IEN) ; get national checksum
- I +$G(IEN)'>0 Q ""
- N XUI,XUSUM
- S XUI=$G(^DIC(9.8,IEN,4)),XUSUM=$P(XUI,U,2)
- I XUSUM["/" S XUSUM=$P(XUSUM,"/",2)
- I XUSUM'="",XUSUM'["B" S XUSUM="B"_XUSUM ;get checksum from field #7.2
- Q XUSUM
- ;------------------------------
- NPLIST(IEN) ; get list patches from the field #7.3
- I +$G(IEN)'>0 Q ""
- N XUPLIST
- S XUPLIST=$P($G(^DIC(9.8,+IEN,4)),"^",3)
- S XUPLIST=$P(XUPLIST,"**",2)
- Q $$TRIM^XLFSTR(XUPLIST)
- ;
- NPL(IEN) ; get list patches from Patch multiple
- I '$D(^DIC(9.8,IEN,8,0)) Q ""
- N XUIEN,XUPC,XULP,XUFLP S (XULP,XUPC,XUFLP)="",XUIEN=0
- F S XUIEN=$O(^DIC(9.8,IEN,8,XUIEN)) Q:XUIEN'>0 D
- . I XULP'="" S XUPC=XUPC_","
- . S XUFLP=$P($G(^DIC(9.8,IEN,8,XUIEN,0)),"^"),XULP=$P(XUFLP,"*",3)
- . S XUPC=XUPC_XULP
- Q XUPC
- ;
- NPL1(IEN,SUM,LPN) ; get list patches from Patch multiple
- I '$D(^DIC(9.8,IEN,8,0)) Q ""
- N XUIEN,XUPC,XULP,XUFLP,XUA,XUB,XUC S (XULP,XUPC,XUFLP)="",(XUB,XUIEN,XUC)=0
- F S XUIEN=$O(^DIC(9.8,IEN,8,XUIEN)) Q:XUIEN'>0 D
- . I XULP'="" S XUPC=XUPC_","
- . S XUA=$G(^DIC(9.8,IEN,8,XUIEN,0)),XUFLP=$P(XUA,"^"),XULP=$P(XUFLP,"*",3)
- . I XULP=LPN S XUC="" I SUM'=$P(XUA,"^",2) S XUB=""
- . S XUPC=XUPC_XULP
- Q XUPC_"^"_XUB_"^"_XUC
- ;
- LPLIST(SL) ; get list of patch Number from the second line
- I $G(SL)="" Q ""
- N XUPLIST
- S XUPLIST=$P(SL,"**",2) ;XUPLIST=$P(XUPLIST,"**",2)
- S XUPLIST=$$TRIM^XLFSTR(XUPLIST)
- Q XUPLIST
- ;
- LPATCH(PLIST) ; get the last patch number of the patch list from the second line
- I $G(PLIST)="" Q ""
- N XUI,PLIST1
- S PLIST1=$TR(PLIST,","),XUI=$L(PLIST)-$L(PLIST1)
- Q $P(PLIST,",",XUI+1)
- ;
- NLPATCH(IEN) ;get national last patch name
- I +$G(IEN)'>0 Q ""
- N XUA
- S XUA=$O(^DIC(9.8,IEN,8,"A"),-1) I XUA'>0 Q ""
- S XUA=$G(^DIC(9.8,IEN,8,XUA,0)),XUA=$P(XUA,"^")
- Q XUA
- ;--------------------------------
- TRACK(IEN) ; get national information
- N XUA
- S XUA=$P($G(^DIC(9.8,IEN,6)),"^")
- I (XUA="")!(XUA="Local - don't report") S XUA=0
- I XUA="Local - report" S XUA=1
- I XUA="National - report" S XUA=2
- Q XUA
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXUGOT1 9784 printed Feb 18, 2025@23:35:59 Page 2
- XUGOT1 ; BT/OAK-BP - COMPARE LOCAL/NATIONAL CHECKSUMS REPORT ;10/20/2006
- +1 ;;8.0;KERNEL;**369**;Jul 10, 1995;Build 27
- +2 QUIT
- REPORT ;
- +1 WRITE !!,">>> This processing will take about thirty minutes."
- +2 WRITE !," It will save your time if you send this report"
- +3 WRITE !," to a printer.",!
- +4 SET %ZIS="Q"
- DO ^%ZIS
- IF POP
- DO ^%ZISC
- DO END
- QUIT
- +5 ; Queue report via Taskman
- +6 IF $DATA(IO("Q"))
- Begin DoDot:1
- +7 NEW ZTDESC,ZTSK,ZTRTN,ZTIO,ZTSAVE
- +8 SET ZTRTN="ENT^XUGOT1"
- SET ZTDESC="Compare local/national checksums report"
- +9 DO ^%ZTLOAD
- DO ^%ZISC
- +10 WRITE !,"Task ",$SELECT($GET(ZTSK):ZTSK,1:"NOT")," Queued"
- +11 KILL IO("Q")
- End DoDot:1
- GOTO END
- ENT ;
- +1 KILL ^TMP($JOB)
- +2 NEW CKRTP
- FOR CKRTP=1:1:9
- SET CKRTP(CKRTP)=0
- +3 NEW SLX,SL
- SET U="^"
- SET SLX="ZL @RTN S SL=$T(@RTN+1)"
- +4 ;Use SUMB in XPDRSUM
- +5 NEW XUIEN
- SET XUIEN=0
- FOR
- SET XUIEN=$ORDER(^DIC(9.8,XUIEN))
- if XUIEN'>0
- QUIT
- Begin DoDot:1
- +6 NEW RTN,X
- SET (RTN,X)=$PIECE($GET(^DIC(9.8,XUIEN,0)),U)
- IF $LENGTH(RTN)=0
- QUIT
- +7 IF $PIECE($GET(^DIC(9.8,XUIEN,0)),U,2)'="R"
- QUIT
- +8 ;Total count of routines reviewed (#1)
- SET CKRTP(1)=CKRTP(1)+1
- +9 ; routine isn't being tracked (#3)
- NEW TRACK
- SET TRACK=$$TRACK(XUIEN)
- IF TRACK'>0
- SET CKRTP(3)=CKRTP(3)+1
- QUIT
- +10 IF $LENGTH(RTN)>8
- SET ^TMP($JOB,8,RTN)=""
- SET CKRTP(8)=CKRTP(8)+1
- QUIT
- +11 NEW NSUM,NLPATCH
- SET NSUM=$$NSUM(XUIEN)
- SET NLPATCH=$$NLPATCH(XUIEN)
- +12 ; check for national checksum is empty, and not Local Track
- IF NSUM=""
- IF TRACK'=1
- QUIT
- +13 ; Quit if routine is marked as "National - Deleted or NOT tracked"
- IF TRACK>2
- QUIT
- +14 ;routine is not found on the system (#2)
- XECUTE ^%ZOSF("TEST")
- IF '$TEST
- SET CKRTP(2)=CKRTP(2)+1
- SET ^TMP($JOB,2,RTN)=NSUM_"^"_NLPATCH
- QUIT
- +15 ; get the second line
- XECUTE SLX
- +16 IF SL=""
- SET SL=$$GETSL^XUGOT(X)
- +17 ;routine is not found on the system (#2)
- NEW LSUM
- SET LSUM=$$LSUM(RTN)
- IF $EXTRACT(LSUM,2,10)'>0
- SET CKRTP(2)=CKRTP(2)+1
- SET ^TMP($JOB,2,RTN)=NSUM_"^"_NLPATCH
- QUIT
- +18 ;national and local checksums match (#4)
- IF NSUM=LSUM
- SET CKRTP(4)=CKRTP(4)+1
- QUIT
- +19 ; Local tracked (#5)
- IF TRACK=1
- SET ^TMP($JOB,5,RTN)=NSUM_"^"_LSUM
- SET CKRTP(5)=CKRTP(5)+1
- QUIT
- +20 ;--------- national and local checksums don't match
- +21 NEW XUN1,XUN2,XUN3,XUN4,XUL1,XUL2,XUL3,XUA,XUP,XULM,XUPN
- SET XULM="Yes"
- SET XUPN="No"
- +22 ;Patch and version AAA*Z.Z*
- SET XUP=$$PACK^XUGOT(RTN,SL)
- +23 NEW NPL2
- SET NPL2=$$NPL2^XUGOT(XUIEN)
- IF +$PIECE(SL,";",3)=$PIECE(NPL2,"*",2)
- SET $PIECE(XUP,"*",2)=$PIECE(NPL2,"*",2)
- +24 SET XUL2=$$LPLIST(SL)
- +25 ;Last patch number from the second line
- SET XUL2=$$LPATCH(XUL2)
- +26 ;Latest local patch base on second line
- SET XUL3=XUP_XUL2
- +27 ;Number national patch list and patch that matches LSUM.
- SET XUN1=$$NPL1(XUIEN,LSUM,XUL2)
- +28 ;Last patch name from Patch multiple fields
- SET XUN3=$$NLPATCH(XUIEN)
- +29 ;Last patch number from the last patch name
- SET XUN2=$PIECE(XUN3,"*",3)
- +30 ;Last Version from the last patch name
- SET XUN4=$$XUN4^XUGOT(XUN3)
- +31 IF $PIECE(XUN1,"^",3)'=""
- SET XULM="Unknown"
- +32 IF $PIECE(XUN1,"^",2)'=""
- SET XULM="No"
- +33 IF XUL2'=""
- IF XUL2'=XUN2
- IF $$LPLIST(SL)[XUN2
- SET XUPN="Testing "_XUP_XUL2
- SET XULM="Unknown"
- +34 ; Missing patches
- IF XUL2'=""
- SET XUA=$PIECE($PIECE(XUN1,"^"),XUL2_",",2)
- IF XUA'=""
- SET XUPN=XUP_XUA
- IF $PIECE(NPL2,"*")'=""
- IF $PIECE(NPL2,"*",2)'=""
- SET XUPN=NPL2_"*"_XUA
- +35 IF +XUL2'=""
- IF XUL2=XUN2
- SET ^TMP($JOB,6,RTN)=NSUM_"^"_LSUM_"^"_XUL3_"^Yes^No"
- SET CKRTP(6)=CKRTP(6)+1
- QUIT
- +36 IF XUL2'=""
- IF XUL2'=+XUL2
- SET ^TMP($JOB,6,RTN)=NSUM_"^"_LSUM_"^"_XUL3_"^Yes^Unknown"
- SET CKRTP(6)=CKRTP(6)+1
- QUIT
- +37 IF XUL2'=""
- IF XUL2'=XUN2
- IF $$LPLIST(SL)'[XUN2
- IF $PIECE(XUN1,"^")'[XUL2
- SET ^TMP($JOB,6,RTN)=NSUM_"^"_LSUM_"^"_XUL3_"^Unknown^"_XUN3
- SET CKRTP(6)=CKRTP(6)+1
- QUIT
- +38 IF XUL2=""
- SET XULM="Unknown"
- +39 IF XUL2=""
- IF XUN2=""
- SET XUPN=XUN3
- +40 IF XUL2=""
- IF XUN2'=""
- SET XUPN=XUP_$PIECE(XUN1,"^")
- +41 NEW XUNV,XULV
- SET XULV=+$PIECE(SL,";",3)
- SET XUNV=$$RT^XUGOT(RTN)
- +42 IF XUN4'>0
- SET XUN4=+$PIECE(XUNV,"^",3)
- +43 IF $PIECE(XUNV,"^")=""
- IF $$SL^XUGOT(SL)=""
- SET ^TMP($JOB,9,RTN)=""
- SET CKRTP(9)=CKRTP(9)+1
- QUIT
- +44 NEW XUK
- SET XUK=0
- +45 IF $PIECE(XUNV,"^")=""
- Begin DoDot:2
- +46 NEW XUL3A
- SET XUL3A=$$SL^XUGOT(SL)_"*"_XULV_"*"
- SET XULM="Unknown"
- SET XUPN="Unknown"
- +47 IF $$SL^XUGOT(SL)=""
- SET XUL3A=$PIECE(XUN3,"*",1,2)_"*"
- +48 IF XUL3A="*"
- SET XUL3A=NPL2_"*"
- +49 SET XUL3=XUL3A_XUL2
- +50 IF XUL2'=""
- IF XUL2'=XUN2
- IF $$LPLIST(SL)[XUN2
- SET XUPN="Testing "_XUL3
- SET XULM="Unknown"
- +51 ; Missing patches
- IF XUL2'=""
- SET XUA=$PIECE($PIECE(XUN1,"^"),XUL2_",",2)
- IF XUA'=""
- SET XUPN=XUP_XUA
- IF $PIECE(NPL2,"*")'=""
- IF $PIECE(NPL2,"*",2)'=""
- SET XUPN=NPL2_"*"_XUA
- +52 SET ^TMP($JOB,6,RTN)=NSUM_"^"_LSUM_"^"_XUL3_"^"_XULM_"^"_XUPN
- SET CKRTP(6)=CKRTP(6)+1
- SET XUK=1
- End DoDot:2
- +53 IF XUK=1
- QUIT
- +54 ; version off
- +55 NEW XUK
- SET XUK=0
- +56 IF XULV>0
- IF XULV'=XUN4
- Begin DoDot:2
- +57 NEW XUL3A
- SET XUL3A=$$SL^XUGOT(SL)_"*"_XULV_"*"
- SET XULM="Unknown"
- SET XUPN="Unknown"
- +58 IF $$SL^XUGOT(SL)=""
- SET XUL3A=$PIECE(XUN3,"*",1,2)_"*"
- +59 IF XUL3A="*"
- SET XUL3A=NPL2_"*"
- +60 SET XUL3=XUL3A_XUL2
- +61 IF XUL2'=""
- IF XUL2'=XUN2
- IF $$LPLIST(SL)[XUN2
- SET XUPN="Testing "_XUL3
- SET XULM="Unknown"
- +62 ; Missing patches
- IF XUL2'=""
- SET XUA=$PIECE($PIECE(XUN1,"^"),XUL2_",",2)
- IF XUA'=""
- SET XUPN=XUP_XUA
- IF $PIECE(NPL2,"*")'=""
- IF $PIECE(NPL2,"*",2)'=""
- SET XUPN=NPL2_"*"_XUA
- +63 SET ^TMP($JOB,6,RTN)=NSUM_"^"_LSUM_"^"_XUL3_"^"_XULM_"^"_XUPN
- SET CKRTP(6)=CKRTP(6)+1
- SET XUK=1
- End DoDot:2
- +64 IF XUK=1
- QUIT
- +65 SET ^TMP($JOB,6,RTN)=NSUM_"^"_LSUM_"^"_XUL3_"^"_XULM_"^"_XUPN
- SET CKRTP(6)=CKRTP(6)+1
- QUIT
- End DoDot:1
- +66 DO PRT
- +67 QUIT
- +68 ;
- PRT NEW ST,Y4
- SET ST=0
- SET Y4=1
- +1 NEW IOC,IOC1
- SET IOC=(IO=IO(0))
- SET IOC1=$EXTRACT(IOST,1,2)["C-"
- +2 USE IO
- if IOC1
- WRITE @IOF
- +3 WRITE !,$$PG(Y4)
- +4 NEW HDR1,HDR2,RPTYP
- +5 FOR RPTYP=5,6,7,2,9,8,3,4,1
- if ST
- QUIT
- Begin DoDot:1
- +6 IF RPTYP=1
- WRITE !,"ROUTINE FILE TOTAL ENTRIES COUNT (",CKRTP(1),")",!
- +7 IF RPTYP=2
- IF CKRTP(2)>0
- WRITE !,"ROUTINES NOT FOUND IN THE SYSTEM (",CKRTP(2),")"
- DO CN
- WRITE !
- DO CN
- IF CKRTP(2)
- DO HEADER
- +8 IF RPTYP=3
- IF CKRTP(3)>0
- WRITE !,"ROUTINES NOT MARKED FOR TRACKING (",CKRTP(3),")",!
- +9 IF RPTYP=4
- IF CKRTP(4)>0
- WRITE !,"ROUTINES WITH MATCHING CHECKSUMS (",CKRTP(4),")",!
- +10 IF RPTYP=5
- IF CKRTP(5)>0
- WRITE "ROUTINES MARKED FOR LOCAL TRACKING (",CKRTP(5),")",!
- IF CKRTP(5)
- DO HEADER
- +11 IF RPTYP=6
- IF CKRTP(6)>0
- WRITE !,"ROUTINES WITH THE CHECKSUM OFF(",CKRTP(6),")"
- DO CN
- WRITE !
- DO CN
- IF CKRTP(6)
- DO HEADER
- +12 ;I RPTYP=7,CKRTP(7)>0 W !,"ROUTINES WITH VERSION OFF(",CKRTP(7),")" D CN W ! D CN I CKRTP(7) D HEADER
- +13 IF RPTYP=8
- IF CKRTP(8)>0
- WRITE !,"ROUTINES WITH MORE THAN 8 CHARACTERS NAME(",CKRTP(8),")"
- DO CN
- WRITE !
- DO CN
- IF CKRTP(8)
- DO HEADER
- +14 ;I RPTYP=9,CKRTP(9)>0 W !,"ROUTINES WITH NO PACKAGE ASSOCIATED WITH(",CKRTP(9),")" D CN W ! D CN I CKRTP(9) D HEADER
- +15 ;
- +16 SET RTN=""
- FOR
- SET RTN=$ORDER(^TMP($JOB,RPTYP,RTN))
- if (RTN="")!(ST)
- QUIT
- Begin DoDot:2
- +17 DO CN
- IF ST
- QUIT
- +18 NEW Y3
- SET Y3=$GET(^TMP($JOB,RPTYP,RTN))
- +19 IF RPTYP=5
- WRITE " ",RTN,?11,$PIECE(Y3,"^",1),?23,$PIECE(Y3,"^",2),!
- +20 IF RPTYP=6
- WRITE " ",RTN,?11,$PIECE(Y3,"^",1),?23,$PIECE(Y3,"^",2),?35,$EXTRACT($PIECE(Y3,"^",3),1,11),?48,$PIECE(Y3,"^",4),?57,$EXTRACT($PIECE(Y3,"^",5),1,23),!
- +21 IF RPTYP=7
- WRITE " ",RTN,?11,$PIECE(Y3,"^",1),?24,$PIECE(Y3,"^",2),?37,$PIECE(Y3,"^",3),!
- +22 IF RPTYP=2
- WRITE " ",RTN,?11,$PIECE(Y3,"^",1),?23,$PIECE(Y3,"^",2),!
- +23 IF RPTYP=8
- WRITE " ",RTN,!
- +24 ;I RPTYP=9 W " ",RTN,!
- +25 QUIT
- End DoDot:2
- +26 QUIT
- End DoDot:1
- +27 ;--------------------------
- END DO ^%ZISC
- KILL ^TMP($JOB),%DT,%ZIS
- +1 QUIT
- +2 ;--------------------------
- PG(XUN) ;
- +1 WRITE #,$$FMTE^XLFDT(DT),?(IOM\2),"Page: ",XUN,!!
- +2 QUIT ""
- +3 ;--------------------------
- +1 SET HDR1=" Routine Nat CHKSUM "
- SET HDR2=" ======= ========== "
- +2 IF RPTYP=2
- SET HDR1=HDR1_"Nat Last Patch"
- SET HDR2=HDR2_"============="
- +3 IF RPTYP=6
- SET HDR1=HDR1_"Our CHKSUM Our Patch Loc Mod Patches Needed"
- SET HDR2=HDR2_"========== =========== ======= =============="
- +4 IF RPTYP=5
- SET HDR1=" Routine CHKSUM Base Our CHKSUM"
- SET HDR2=HDR2_"==========="
- +5 IF RPTYP=7
- SET HDR1=" Routine Nat Version Loc Version Latest Nat Patch"
- SET HDR2=" ======= =========== =========== =============="
- +6 IF RPTYP=8
- SET HDR1=" Routine "
- SET HDR2=" ======="
- +7 ;I RPTYP=9 S HDR1=" Routine",HDR2=" ======="
- +8 WRITE HDR1,!
- +9 WRITE HDR2,!
- +10 QUIT
- +11 ;---------------------------
- %Z1 READ "Enter RETURN to continue or '^' to exit: ",ST:60
- SET ST=$SELECT(ST["^":1,1:0)
- if '$TEST
- SET ST=1
- WRITE @IOF
- +1 QUIT
- +2 ;---------------------------
- CN IF (($Y+2)=IOSL)!(($Y+3)=IOSL)
- SET Y4=Y4+1
- if IOC&IOC1
- DO %Z1
- if ST
- QUIT
- WRITE $$PG(Y4)
- DO HEADER
- +1 QUIT
- +2 ;--------------------------------------------------------------------------
- LSUM(RTN) ;Get the new Checksum LOCAL
- +1 IF $GET(RTN)=""
- QUIT ""
- +2 NEW DIF,RTNL,X,XCNP,Y
- +3 SET X=RTN
- SET DIF="RTNL("
- SET XCNP=0
- XECUTE ^%ZOSF("LOAD")
- +4 SET Y=$$SUMB^XPDRSUM($NAME(RTNL))
- +5 QUIT "B"_Y
- +6 ;
- NSUM(IEN) ; get national checksum
- +1 IF +$GET(IEN)'>0
- QUIT ""
- +2 NEW XUI,XUSUM
- +3 SET XUI=$GET(^DIC(9.8,IEN,4))
- SET XUSUM=$PIECE(XUI,U,2)
- +4 IF XUSUM["/"
- SET XUSUM=$PIECE(XUSUM,"/",2)
- +5 ;get checksum from field #7.2
- IF XUSUM'=""
- IF XUSUM'["B"
- SET XUSUM="B"_XUSUM
- +6 QUIT XUSUM
- +7 ;------------------------------
- NPLIST(IEN) ; get list patches from the field #7.3
- +1 IF +$GET(IEN)'>0
- QUIT ""
- +2 NEW XUPLIST
- +3 SET XUPLIST=$PIECE($GET(^DIC(9.8,+IEN,4)),"^",3)
- +4 SET XUPLIST=$PIECE(XUPLIST,"**",2)
- +5 QUIT $$TRIM^XLFSTR(XUPLIST)
- +6 ;
- NPL(IEN) ; get list patches from Patch multiple
- +1 IF '$DATA(^DIC(9.8,IEN,8,0))
- QUIT ""
- +2 NEW XUIEN,XUPC,XULP,XUFLP
- SET (XULP,XUPC,XUFLP)=""
- SET XUIEN=0
- +3 FOR
- SET XUIEN=$ORDER(^DIC(9.8,IEN,8,XUIEN))
- if XUIEN'>0
- QUIT
- Begin DoDot:1
- +4 IF XULP'=""
- SET XUPC=XUPC_","
- +5 SET XUFLP=$PIECE($GET(^DIC(9.8,IEN,8,XUIEN,0)),"^")
- SET XULP=$PIECE(XUFLP,"*",3)
- +6 SET XUPC=XUPC_XULP
- End DoDot:1
- +7 QUIT XUPC
- +8 ;
- NPL1(IEN,SUM,LPN) ; get list patches from Patch multiple
- +1 IF '$DATA(^DIC(9.8,IEN,8,0))
- QUIT ""
- +2 NEW XUIEN,XUPC,XULP,XUFLP,XUA,XUB,XUC
- SET (XULP,XUPC,XUFLP)=""
- SET (XUB,XUIEN,XUC)=0
- +3 FOR
- SET XUIEN=$ORDER(^DIC(9.8,IEN,8,XUIEN))
- if XUIEN'>0
- QUIT
- Begin DoDot:1
- +4 IF XULP'=""
- SET XUPC=XUPC_","
- +5 SET XUA=$GET(^DIC(9.8,IEN,8,XUIEN,0))
- SET XUFLP=$PIECE(XUA,"^")
- SET XULP=$PIECE(XUFLP,"*",3)
- +6 IF XULP=LPN
- SET XUC=""
- IF SUM'=$PIECE(XUA,"^",2)
- SET XUB=""
- +7 SET XUPC=XUPC_XULP
- End DoDot:1
- +8 QUIT XUPC_"^"_XUB_"^"_XUC
- +9 ;
- LPLIST(SL) ; get list of patch Number from the second line
- +1 IF $GET(SL)=""
- QUIT ""
- +2 NEW XUPLIST
- +3 ;XUPLIST=$P(XUPLIST,"**",2)
- SET XUPLIST=$PIECE(SL,"**",2)
- +4 SET XUPLIST=$$TRIM^XLFSTR(XUPLIST)
- +5 QUIT XUPLIST
- +6 ;
- LPATCH(PLIST) ; get the last patch number of the patch list from the second line
- +1 IF $GET(PLIST)=""
- QUIT ""
- +2 NEW XUI,PLIST1
- +3 SET PLIST1=$TRANSLATE(PLIST,",")
- SET XUI=$LENGTH(PLIST)-$LENGTH(PLIST1)
- +4 QUIT $PIECE(PLIST,",",XUI+1)
- +5 ;
- NLPATCH(IEN) ;get national last patch name
- +1 IF +$GET(IEN)'>0
- QUIT ""
- +2 NEW XUA
- +3 SET XUA=$ORDER(^DIC(9.8,IEN,8,"A"),-1)
- IF XUA'>0
- QUIT ""
- +4 SET XUA=$GET(^DIC(9.8,IEN,8,XUA,0))
- SET XUA=$PIECE(XUA,"^")
- +5 QUIT XUA
- +6 ;--------------------------------
- TRACK(IEN) ; get national information
- +1 NEW XUA
- +2 SET XUA=$PIECE($GET(^DIC(9.8,IEN,6)),"^")
- +3 IF (XUA="")!(XUA="Local - don't report")
- SET XUA=0
- +4 IF XUA="Local - report"
- SET XUA=1
- +5 IF XUA="National - report"
- SET XUA=2
- +6 QUIT XUA
- +7 ;