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 Sep 23, 2025@19:45:42 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 ;
