XUGOT ; DBA/CJS - COMPARE LOCAL/NATIONAL CHECKSUMS REPORT ;10/20/2006
;;8.0;KERNEL;**369**;Jul 10, 1995;Build 27
Q
LOAD ; -- use MFS to get ROUTINE file from FORUM (background job)
W !!,">>>This processing will take about thirty minutes. Please wait..."
D CLEAN
D ARRAY^XUMF(9.8)
D INPUT
Q
;----------------------------
CLEAN ; clean all entries in subfile 9.818 if $G(^DIC(9.8,RTNIEN,6))=2 (national tracking)
N RTNIEN,XUTR S RTNIEN=0
F S RTNIEN=$O(^DIC(9.8,RTNIEN)) Q:RTNIEN'>0 D
. S XUTR=$P($G(^DIC(9.8,RTNIEN,6)),"^")
. I XUTR="National - report" S XUTR=2
. I XUTR=2 D CLN(RTNIEN) S $P(^DIC(9.8,RTNIEN,6),"^")=""
Q
;------------------------------
CLN(RTNIEN) ; clean all entries in sub-file #9.818
N XI S XI=0 F S XI=$O(^DIC(9.8,RTNIEN,8,XI)) Q:XI'>0 D
. N DA,DIK S DA(1)=RTNIEN,DA=XI,DIK="^DIC(9.8,"_DA(1)_","_"8," D ^DIK
Q
;------------------------------
INPUT ; input routines' information in Routine file
N IDX98,ERROR,NAME,HLFS,XXX,YYY,ZZZ,AAA,BBB,CCC,FDA,X,HFLS,NODE,XUSIEN
S HLFS="^",IDX98=0
F S IDX98=$O(^TMP("XUMF ARRAY",$J,IDX98)) Q:'IDX98 D
.S NODE=$G(^TMP("XUMF ARRAY",$J,IDX98)),NODE=$P(NODE,"^",2,99)
.S NAME=$P(NODE,HLFS,1)
. I $L(NAME)>8 Q
.S XXX=$P(NODE,HLFS,2)
. I XXX'="National - report" Q
.S YYY=$P(NODE,HLFS,3)
.S ZZZ=$P(NODE,HLFS,4)
. I +$E(ZZZ,2,10)'>0 Q
.S AAA=$P(NODE,HLFS,5)
.S BBB=$P(NODE,HLFS,6)
.S CCC=$P(NODE,HLFS,7)
.S FDA(1,9.8,"?+1,",.01)=NAME
.S FDA(1,9.8,"?+1,",1)="R"
.;S FDA(1,9.8,"?+1,",6)=2
.S FDA(1,9.8,"?+1,",7.1)=YYY
.S FDA(1,9.8,"?+1,",7.2)=ZZZ
.S FDA(1,9.8,"?+1,",7.3)=CCC
.S FDA(1,9.818,"+2,?+1,",.01)=AAA
.S FDA(1,9.818,"+2,?+1,",2)=BBB
.D UPDATE^DIE("","FDA(1)")
.D SETFLD6(NAME)
;
K ^TMP("XUMF ARRAY",$J)
Q
;
SETFLD6(NAME) ;
N XUIEN S XUIEN=0
S XUIEN=$$FIND1^DIC(9.8,"","MX",NAME,"","","ERR")
I XUIEN'>0 Q
I $P($G(^DIC(9.8,XUIEN,6)),"^")="" S $P(^DIC(9.8,XUIEN,6),"^")=2
Q
; -------------------- FOR XUGOT1-------------------------------
PACK(RTN,SL) ; get package name
N XUS,XUS1,XUS2 S (XUS,XUS1,XUS2)=""
S XUS=$$RT(RTN) I XUS'>0 Q ""
S XUS2=$P(XUS,"^",2)
S XUS1=$$SL(SL) I XUS1'="" S XUS2=XUS1
Q XUS2_"*"_+$P(XUS,"^",3)_"*"
;
XUN4(XUS) ;
N XUN4,XUA,XUB,XUC
I $G(XUS)="" Q ""
S XUN4=+$P(XUS,"*",2) ;Last Version number from the last patch name
I XUN4>0 Q XUN4
S XUA=$L(XUS)
F XUB=1:1:XUA S XUN4=+$E(XUS,XUB,XUA) I XUN4>0 Q
Q XUN4
NPL2(IEN) ; get Package name from Patch multiple
I '$D(^DIC(9.8,IEN,8,0)) Q ""
N XUIEN,XUPK,XUPK1,XUPK2 S (XUPK2,XUPK1,XUPK)="",XUIEN=0
F S XUIEN=$O(^DIC(9.8,IEN,8,XUIEN)) Q:XUIEN'>0 D
. S XUA=$G(^DIC(9.8,IEN,8,XUIEN,0)),XUPK2=$P(XUA,"^"),XUPK=$P(XUPK2,"*"),XUPK2=$P(XUPK2,"*",2)
. I XUPK'="",$D(^DIC(9.4,"C",XUPK)) S XUPK1=XUPK_"*"_XUPK2
Q XUPK1
;
LSLPN(SL) ; return package name from the second line (piece 3rd of the second line)
Q $$TRIM^XLFSTR($P(SL,";",4))
;
SL(SL) ; get Prefix_Package from the second line
N PCK,XUST,XUIEN,Y,X
S (PCK,XUIEN)="",XUST=$$LSLPN(SL)
S X=XUST X ^%ZOSF("UPPERCASE") I Y'="" S XUIEN=$O(^DIC(9.4,"B",Y,0))
I XUIEN S PCK=$P($G(^DIC(9.4,XUIEN,0)),"^",2)
Q PCK
;
;-----------------------CHECK PACKAGE NAME AND VERSION---------------------------
RT(RTN) ; get Package and Version base on routine name
I $G(RTN)="" Q ""
N XUST,VERSION,XUIEN,XUI,PCK,PCKNAME,XUQUIT S (PCK,PCKNAME,XUST,VERSION)="",XUIEN=""
F XUI=4,3,2 I $D(^DIC(9.4,"C",$E(RTN,1,XUI))) D Q:XUIEN>0
. S XUIEN=$O(^DIC(9.4,"C",$E(RTN,1,XUI),0)) ;IEN FOR PACKAGE
. I XUIEN="" S XUIEN=-1 Q ;no package found (yet)
. I $D(^DIC(9.4,XUIEN,0)) S XUST=$G(^DIC(9.4,XUIEN,0)),VERSION=$G(^DIC(9.4,XUIEN,"VERSION")),PCKNAME=$P(XUST,"^",1),PCK=$P(XUST,"^",2)
Q XUIEN_"^"_PCK_"^"_VERSION_"^"_PCKNAME
;
GETSL(RTN) ;
N XUSL
N DIF,XCNP K ^TMP($J,369)
S DIF="^TMP($J,369,",XCNP=0 X ^%ZOSF("LOAD")
Q $G(^TMP($J,369,2,0))
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXUGOT 3888 printed Apr 09, 2024@21:18:08 Page 2
XUGOT ; DBA/CJS - COMPARE LOCAL/NATIONAL CHECKSUMS REPORT ;10/20/2006
+1 ;;8.0;KERNEL;**369**;Jul 10, 1995;Build 27
+2 QUIT
LOAD ; -- use MFS to get ROUTINE file from FORUM (background job)
+1 WRITE !!,">>>This processing will take about thirty minutes. Please wait..."
+2 DO CLEAN
+3 DO ARRAY^XUMF(9.8)
+4 DO INPUT
+5 QUIT
+6 ;----------------------------
CLEAN ; clean all entries in subfile 9.818 if $G(^DIC(9.8,RTNIEN,6))=2 (national tracking)
+1 NEW RTNIEN,XUTR
SET RTNIEN=0
+2 FOR
SET RTNIEN=$ORDER(^DIC(9.8,RTNIEN))
if RTNIEN'>0
QUIT
Begin DoDot:1
+3 SET XUTR=$PIECE($GET(^DIC(9.8,RTNIEN,6)),"^")
+4 IF XUTR="National - report"
SET XUTR=2
+5 IF XUTR=2
DO CLN(RTNIEN)
SET $PIECE(^DIC(9.8,RTNIEN,6),"^")=""
End DoDot:1
+6 QUIT
+7 ;------------------------------
CLN(RTNIEN) ; clean all entries in sub-file #9.818
+1 NEW XI
SET XI=0
FOR
SET XI=$ORDER(^DIC(9.8,RTNIEN,8,XI))
if XI'>0
QUIT
Begin DoDot:1
+2 NEW DA,DIK
SET DA(1)=RTNIEN
SET DA=XI
SET DIK="^DIC(9.8,"_DA(1)_","_"8,"
DO ^DIK
End DoDot:1
+3 QUIT
+4 ;------------------------------
INPUT ; input routines' information in Routine file
+1 NEW IDX98,ERROR,NAME,HLFS,XXX,YYY,ZZZ,AAA,BBB,CCC,FDA,X,HFLS,NODE,XUSIEN
+2 SET HLFS="^"
SET IDX98=0
+3 FOR
SET IDX98=$ORDER(^TMP("XUMF ARRAY",$JOB,IDX98))
if 'IDX98
QUIT
Begin DoDot:1
+4 SET NODE=$GET(^TMP("XUMF ARRAY",$JOB,IDX98))
SET NODE=$PIECE(NODE,"^",2,99)
+5 SET NAME=$PIECE(NODE,HLFS,1)
+6 IF $LENGTH(NAME)>8
QUIT
+7 SET XXX=$PIECE(NODE,HLFS,2)
+8 IF XXX'="National - report"
QUIT
+9 SET YYY=$PIECE(NODE,HLFS,3)
+10 SET ZZZ=$PIECE(NODE,HLFS,4)
+11 IF +$EXTRACT(ZZZ,2,10)'>0
QUIT
+12 SET AAA=$PIECE(NODE,HLFS,5)
+13 SET BBB=$PIECE(NODE,HLFS,6)
+14 SET CCC=$PIECE(NODE,HLFS,7)
+15 SET FDA(1,9.8,"?+1,",.01)=NAME
+16 SET FDA(1,9.8,"?+1,",1)="R"
+17 ;S FDA(1,9.8,"?+1,",6)=2
+18 SET FDA(1,9.8,"?+1,",7.1)=YYY
+19 SET FDA(1,9.8,"?+1,",7.2)=ZZZ
+20 SET FDA(1,9.8,"?+1,",7.3)=CCC
+21 SET FDA(1,9.818,"+2,?+1,",.01)=AAA
+22 SET FDA(1,9.818,"+2,?+1,",2)=BBB
+23 DO UPDATE^DIE("","FDA(1)")
+24 DO SETFLD6(NAME)
End DoDot:1
+25 ;
+26 KILL ^TMP("XUMF ARRAY",$JOB)
+27 QUIT
+28 ;
SETFLD6(NAME) ;
+1 NEW XUIEN
SET XUIEN=0
+2 SET XUIEN=$$FIND1^DIC(9.8,"","MX",NAME,"","","ERR")
+3 IF XUIEN'>0
QUIT
+4 IF $PIECE($GET(^DIC(9.8,XUIEN,6)),"^")=""
SET $PIECE(^DIC(9.8,XUIEN,6),"^")=2
+5 QUIT
+6 ; -------------------- FOR XUGOT1-------------------------------
PACK(RTN,SL) ; get package name
+1 NEW XUS,XUS1,XUS2
SET (XUS,XUS1,XUS2)=""
+2 SET XUS=$$RT(RTN)
IF XUS'>0
QUIT ""
+3 SET XUS2=$PIECE(XUS,"^",2)
+4 SET XUS1=$$SL(SL)
IF XUS1'=""
SET XUS2=XUS1
+5 QUIT XUS2_"*"_+$PIECE(XUS,"^",3)_"*"
+6 ;
XUN4(XUS) ;
+1 NEW XUN4,XUA,XUB,XUC
+2 IF $GET(XUS)=""
QUIT ""
+3 ;Last Version number from the last patch name
SET XUN4=+$PIECE(XUS,"*",2)
+4 IF XUN4>0
QUIT XUN4
+5 SET XUA=$LENGTH(XUS)
+6 FOR XUB=1:1:XUA
SET XUN4=+$EXTRACT(XUS,XUB,XUA)
IF XUN4>0
QUIT
+7 QUIT XUN4
NPL2(IEN) ; get Package name from Patch multiple
+1 IF '$DATA(^DIC(9.8,IEN,8,0))
QUIT ""
+2 NEW XUIEN,XUPK,XUPK1,XUPK2
SET (XUPK2,XUPK1,XUPK)=""
SET XUIEN=0
+3 FOR
SET XUIEN=$ORDER(^DIC(9.8,IEN,8,XUIEN))
if XUIEN'>0
QUIT
Begin DoDot:1
+4 SET XUA=$GET(^DIC(9.8,IEN,8,XUIEN,0))
SET XUPK2=$PIECE(XUA,"^")
SET XUPK=$PIECE(XUPK2,"*")
SET XUPK2=$PIECE(XUPK2,"*",2)
+5 IF XUPK'=""
IF $DATA(^DIC(9.4,"C",XUPK))
SET XUPK1=XUPK_"*"_XUPK2
End DoDot:1
+6 QUIT XUPK1
+7 ;
LSLPN(SL) ; return package name from the second line (piece 3rd of the second line)
+1 QUIT $$TRIM^XLFSTR($PIECE(SL,";",4))
+2 ;
SL(SL) ; get Prefix_Package from the second line
+1 NEW PCK,XUST,XUIEN,Y,X
+2 SET (PCK,XUIEN)=""
SET XUST=$$LSLPN(SL)
+3 SET X=XUST
XECUTE ^%ZOSF("UPPERCASE")
IF Y'=""
SET XUIEN=$ORDER(^DIC(9.4,"B",Y,0))
+4 IF XUIEN
SET PCK=$PIECE($GET(^DIC(9.4,XUIEN,0)),"^",2)
+5 QUIT PCK
+6 ;
+7 ;-----------------------CHECK PACKAGE NAME AND VERSION---------------------------
RT(RTN) ; get Package and Version base on routine name
+1 IF $GET(RTN)=""
QUIT ""
+2 NEW XUST,VERSION,XUIEN,XUI,PCK,PCKNAME,XUQUIT
SET (PCK,PCKNAME,XUST,VERSION)=""
SET XUIEN=""
+3 FOR XUI=4,3,2
IF $DATA(^DIC(9.4,"C",$EXTRACT(RTN,1,XUI)))
Begin DoDot:1
+4 ;IEN FOR PACKAGE
SET XUIEN=$ORDER(^DIC(9.4,"C",$EXTRACT(RTN,1,XUI),0))
+5 ;no package found (yet)
IF XUIEN=""
SET XUIEN=-1
QUIT
+6 IF $DATA(^DIC(9.4,XUIEN,0))
SET XUST=$GET(^DIC(9.4,XUIEN,0))
SET VERSION=$GET(^DIC(9.4,XUIEN,"VERSION"))
SET PCKNAME=$PIECE(XUST,"^",1)
SET PCK=$PIECE(XUST,"^",2)
End DoDot:1
if XUIEN>0
QUIT
+7 QUIT XUIEN_"^"_PCK_"^"_VERSION_"^"_PCKNAME
+8 ;
GETSL(RTN) ;
+1 NEW XUSL
+2 NEW DIF,XCNP
KILL ^TMP($JOB,369)
+3 SET DIF="^TMP($J,369,"
SET XCNP=0
XECUTE ^%ZOSF("LOAD")
+4 QUIT $GET(^TMP($JOB,369,2,0))
