Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: XUGOT

XUGOT.m

Go to the documentation of this file. 
  1. XUGOT ; DBA/CJS - COMPARE LOCAL/NATIONAL CHECKSUMS REPORT ;10/20/2006
  1.  ;;8.0;KERNEL;**369**;Jul 10, 1995;Build 27
  1.  Q
  1. LOAD ; -- use MFS to get ROUTINE file from FORUM (background job)
  1.  W !!,">>>This processing will take about thirty minutes. Please wait..."
  1.  D CLEAN
  1.  D ARRAY^XUMF(9.8)
  1.  D INPUT
  1.  Q
  1.  ;----------------------------
  1. CLEAN ; clean all entries in subfile 9.818 if $G(^DIC(9.8,RTNIEN,6))=2 (national tracking)
  1.  N RTNIEN,XUTR S RTNIEN=0
  1.  F  S RTNIEN=$O(^DIC(9.8,RTNIEN)) Q:RTNIEN'>0  D
  1.  . S XUTR=$P($G(^DIC(9.8,RTNIEN,6)),"^")
  1.  . I XUTR="National - report" S XUTR=2
  1.  . I XUTR=2 D CLN(RTNIEN) S $P(^DIC(9.8,RTNIEN,6),"^")=""
  1.  Q
  1.  ;------------------------------
  1. CLN(RTNIEN) ; clean all entries in sub-file #9.818
  1.  N XI S XI=0 F  S XI=$O(^DIC(9.8,RTNIEN,8,XI)) Q:XI'>0  D
  1.  . N DA,DIK S DA(1)=RTNIEN,DA=XI,DIK="^DIC(9.8,"_DA(1)_","_"8," D ^DIK
  1.  Q
  1.  ;------------------------------
  1. INPUT ; input routines' information in Routine file
  1.  N IDX98,ERROR,NAME,HLFS,XXX,YYY,ZZZ,AAA,BBB,CCC,FDA,X,HFLS,NODE,XUSIEN
  1.  S HLFS="^",IDX98=0
  1.  F  S IDX98=$O(^TMP("XUMF ARRAY",$J,IDX98)) Q:'IDX98  D
  1.  .S NODE=$G(^TMP("XUMF ARRAY",$J,IDX98)),NODE=$P(NODE,"^",2,99)
  1.  .S NAME=$P(NODE,HLFS,1)
  1.  . I $L(NAME)>8 Q
  1.  .S XXX=$P(NODE,HLFS,2)
  1.  . I XXX'="National - report" Q
  1.  .S YYY=$P(NODE,HLFS,3)
  1.  .S ZZZ=$P(NODE,HLFS,4)
  1.  . I +$E(ZZZ,2,10)'>0 Q
  1.  .S AAA=$P(NODE,HLFS,5)
  1.  .S BBB=$P(NODE,HLFS,6)
  1.  .S CCC=$P(NODE,HLFS,7)
  1.  .S FDA(1,9.8,"?+1,",.01)=NAME
  1.  .S FDA(1,9.8,"?+1,",1)="R"
  1.  .;S FDA(1,9.8,"?+1,",6)=2
  1.  .S FDA(1,9.8,"?+1,",7.1)=YYY
  1.  .S FDA(1,9.8,"?+1,",7.2)=ZZZ
  1.  .S FDA(1,9.8,"?+1,",7.3)=CCC
  1.  .S FDA(1,9.818,"+2,?+1,",.01)=AAA
  1.  .S FDA(1,9.818,"+2,?+1,",2)=BBB
  1.  .D UPDATE^DIE("","FDA(1)")
  1.  .D SETFLD6(NAME)
  1.  ;
  1.  K ^TMP("XUMF ARRAY",$J)
  1.  Q
  1.  ;
  1. SETFLD6(NAME) ;
  1.  N XUIEN S XUIEN=0
  1.  S XUIEN=$$FIND1^DIC(9.8,"","MX",NAME,"","","ERR")
  1.  I XUIEN'>0 Q
  1.  I $P($G(^DIC(9.8,XUIEN,6)),"^")="" S $P(^DIC(9.8,XUIEN,6),"^")=2
  1.  Q
  1.  ; -------------------- FOR XUGOT1-------------------------------
  1. PACK(RTN,SL) ; get package name
  1.  N XUS,XUS1,XUS2 S (XUS,XUS1,XUS2)=""
  1.  S XUS=$$RT(RTN) I XUS'>0 Q ""
  1.  S XUS2=$P(XUS,"^",2)
  1.  S XUS1=$$SL(SL) I XUS1'="" S XUS2=XUS1
  1.  Q XUS2_"*"_+$P(XUS,"^",3)_"*"
  1.  ;
  1. XUN4(XUS) ;
  1.  N XUN4,XUA,XUB,XUC
  1.  I $G(XUS)="" Q ""
  1.  S XUN4=+$P(XUS,"*",2) ;Last Version number from the last patch name
  1.  I XUN4>0 Q XUN4
  1.  S XUA=$L(XUS)
  1.  F XUB=1:1:XUA S XUN4=+$E(XUS,XUB,XUA) I XUN4>0 Q
  1.  Q XUN4
  1. NPL2(IEN) ; get Package name from Patch multiple
  1.  I '$D(^DIC(9.8,IEN,8,0)) Q ""
  1.  N XUIEN,XUPK,XUPK1,XUPK2 S (XUPK2,XUPK1,XUPK)="",XUIEN=0
  1.  F  S XUIEN=$O(^DIC(9.8,IEN,8,XUIEN)) Q:XUIEN'>0  D
  1.  . S XUA=$G(^DIC(9.8,IEN,8,XUIEN,0)),XUPK2=$P(XUA,"^"),XUPK=$P(XUPK2,"*"),XUPK2=$P(XUPK2,"*",2)
  1.  . I XUPK'="",$D(^DIC(9.4,"C",XUPK)) S XUPK1=XUPK_"*"_XUPK2
  1.  Q XUPK1
  1.  ;
  1. LSLPN(SL) ; return package name from the second line (piece 3rd of the second line)
  1.  Q $$TRIM^XLFSTR($P(SL,";",4))
  1.  ;
  1. SL(SL) ; get Prefix_Package from the second line
  1.  N PCK,XUST,XUIEN,Y,X
  1.  S (PCK,XUIEN)="",XUST=$$LSLPN(SL)
  1.  S X=XUST X ^%ZOSF("UPPERCASE") I Y'="" S XUIEN=$O(^DIC(9.4,"B",Y,0))
  1.  I XUIEN S PCK=$P($G(^DIC(9.4,XUIEN,0)),"^",2)
  1.  Q PCK
  1.  ;
  1.  ;-----------------------CHECK PACKAGE NAME AND VERSION---------------------------
  1. RT(RTN) ; get Package and Version base on routine name
  1.  I $G(RTN)="" Q ""
  1.  N XUST,VERSION,XUIEN,XUI,PCK,PCKNAME,XUQUIT S (PCK,PCKNAME,XUST,VERSION)="",XUIEN=""
  1.  F XUI=4,3,2 I $D(^DIC(9.4,"C",$E(RTN,1,XUI))) D  Q:XUIEN>0
  1.  . S XUIEN=$O(^DIC(9.4,"C",$E(RTN,1,XUI),0)) ;IEN FOR PACKAGE
  1.  . I XUIEN="" S XUIEN=-1 Q  ;no package found (yet)
  1.  . 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)
  1.  Q XUIEN_"^"_PCK_"^"_VERSION_"^"_PCKNAME
  1.  ;
  1. GETSL(RTN) ;
  1.  N XUSL
  1.  N DIF,XCNP K ^TMP($J,369)
  1.  S DIF="^TMP($J,369,",XCNP=0 X ^%ZOSF("LOAD")
  1.  Q $G(^TMP($J,369,2,0))