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

XBGCMP.m

Go to the documentation of this file. 
  1. XBGCMP ; IHS/ADC/GTH - COMPARES TWO DIFFERENT GLOBALS ; [ 02/07/97   3:02 PM ]
  1.  ;;3.0;IHS/VA UTILITIES;;FEB 07, 1997
  1.  ;
  1.  ;;This utility is to be used to compare two globals.  The initial
  1.  ;;globals entered must be identically subscripted.  The utility will
  1.  ;;indicate which nodes of the first global have values different
  1.  ;;than similarly subscipted nodes of the second global.  It will
  1.  ;;also indicate if a node in one global exists and if a similarly
  1.  ;;subscripted node in the other does not exist.  You may utilize the
  1.  ;;[UCI,VOLUME] syntax to compare across UCIs and volume groups.
  1.  ;;  
  1.  ;;###
  1.  ;
  1.  NEW X
  1.  D INIT
  1. A ;
  1.  D ASK
  1.  I XBQ G X1
  1.  D SETUP ; sets up up print/display, calls subrtn to process gbls
  1.  G A
  1. X1 ;
  1.  D EOJ
  1.  Q
  1.  ;
  1. INIT ; Setup
  1.  D ^XBKVAR
  1.  S (XBS,XBQ)=0
  1.  X ^%ZOSF("UCI")
  1.  S XBVOL=$P(Y,",",2)
  1.  Q
  1.  ;
  1. ASK ; Get globals to be compared
  1. 1 ;
  1.  R !,"First global to compare, i.e., NAME, NAME(1) or NAME(""B""): ^",X:DTIME
  1.  D:X["?" HELP^XBHELP("XBGCMP","XBGCMP")
  1.  G:X["?" 1
  1.  I "^"[X S XBQ=1 G X2
  1.  D CHECK
  1.  I XBS S XBS=0 G 1
  1.  S XBG1=X
  1. 2 ;
  1.  R !,"Second global to compare: ^",X:DTIME
  1.  D:X["?" HELP^XBHELP("XBGCMP","XBGCMP")
  1.  G:X["?" 2
  1.  I "^"[X S XBQ=1 G X2
  1.  D CHECK
  1.  I XBS S XBS=0 G 2
  1.  S XBG2=X
  1.  D CHECK2
  1.  I XBS S XBS=0 G 1
  1. X2 ;
  1.  Q
  1.  ;
  1. CHECK ; Check each global
  1.  I X["(",X'[")" S XBS=1 W !,*7,"  Must end in "")""" G X6
  1.  S XBT=$P(X,"(")
  1.  I XBT["[" D
  1.  . I XBT'["]" W !,*7,"  Invalid cross UCI notation" S XBS=1 G X4
  1.  . S XBT=$P(XBT,"]")
  1.  . I XBT["""" F XBI=1:1:$L(XBT)  I $E(XBT,XBI)="""" S $E(XBT,XBI)="",XBI=XBI-1
  1.  . I XBT?1"["3U1","3U!(XBT?1"["3U)
  1.  . E  W !,*7,"  Invalid cross UCI notation" S XBS=1 G X4
  1.  . I XBT'[","!($P(XBT,",",2)'=XBVOL) S X="["""_$P(XBT,"[",2)_"""]"_$P(X,"]",2) G X4
  1.  . S X="["""_$P($P(XBT,"[",2),",")_"""]"_$P(X,"]",2)
  1. X4 . Q
  1.  S XBT(1)=$S($P(X,"(")["[":$P($P(X,"]",2),"("),1:$P(X,"("))
  1.  I $L(XBT(1))>8 W !,*7,"  Invalid global name" S XBS=1 G X6
  1.  I XBT(1)?1A.AN!(XBT(1)?1"XB".AN)
  1.  E  W !,*7,"  Invalid global name" S XBS=1 G X6
  1.  S XBT(2)=X,X="TRAP^XBGCMP",@^%ZOSF("TRAP"),X=XBT(2)
  1.  I '$D(@("^"_X)) W !,*7,"  Global does not exist" S XBS=1
  1. X6 ;
  1.  Q
  1.  ;
  1. TRAP ; Error trap for missing quotes
  1.  I $$Z^ZIBNSSV("ERROR")["<UNDEF" W !,*7,"*** Probably missing quotes",! S XBS=1
  1.  Q
  1.  ;
  1. CHECK2 ; Check both globals
  1.  I (XBG1["("&(XBG2'["("))!(XBG1'["("&(XBG2["(")) W !,*7,"  Starting globals must be identically subscripted",! S XBS=1 G X5
  1.  I XBG1'["("
  1.  E  I $P(XBG1,"(",2)'=$P(XBG2,"(",2) W !,*7,"  Starting globals must be identically subscripted",! S XBS=1 G X5
  1.  E  I $E(XBG1,$L(XBG1))'=")"!($E(XBG2,$L(XBG2))'=")") W !,*7,"  Starting globals must end in a "")""",! S XBS=1
  1. X5 ;
  1.  Q
  1.  ;
  1. SETUP ; Get print parameters, task?
  1.  KILL ZTSK,IOP,%ZIS
  1.  S %ZIS="PQM"
  1.  D ^%ZIS
  1.  Q:POP
  1.  I $D(IO("Q")) D QUE I 1
  1.  E  D NOQUE
  1.  Q
  1.  ;
  1. NOQUE ;
  1.  S ^DISV($I,"^%ZIS(1,")=$O(^%ZIS(1,"C",IO,""))
  1.  U IO
  1.  D PROCESS
  1.  D ^%ZISC
  1.  Q
  1.  ;
  1. QUE ;
  1.  S XBION=ION
  1.  KILL ZTSAVE
  1.  F %="XBG1","XBG2","XBION" S ZTSAVE(%)=""
  1.  S ZTRTN="PROCESS^XBGCMP",ZTDESC="COMPARE TWO GLOBALS",ZTIO="",ZTDTH=""
  1.  D ^%ZTLOAD
  1.  KILL ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK
  1.  D ^%ZISC
  1.  W !
  1.  Q
  1.  ;
  1. PROCESS ; Compare
  1.  S XBG1="^"_XBG1,XBG2="^"_XBG2,XBN=$J_$H,XBC=0
  1.  I '$D(ZTQUEUED) W:$D(IOF) @IOF W !!,"Comparison of globals ",XBG1," and ",XBG2,!
  1.  I $D(@XBG1)#2,'($D(@XBG2)#2) S XBC=XBC+1,XBTEMP=XBG1 D CHANGE S ^TMP("XBGCMP",XBN,XBTEMP)=XBG1_"   Exists~"_XBG2_"   Missing"
  1.  I '($D(@XBG1)#2),$D(@XBG2)#2 S XBC=XBC+1,XBTEMP=XBG1 D CHANGE S ^TMP("XBGCMP",XBN,XBTEMP)=XBG1_"   Missing~"_XBG2_"   Exists"
  1.  I $D(@XBG1)#2,$D(@XBG2)#2,'(@XBG1=@XBG2) S XBTEMP=XBG1 D CHANGE S XBC=XBC+1,^TMP("XBGCMP",XBN,XBTEMP)=XBG1_"   Not Equal To~"_XBG2
  1.  S XBA=$P(XBG1,"("),XBB=$P(XBG2,"("),XB=XBG1
  1.  F  S XB=$Q(@XB) Q:XB=""  D
  1.  . I '($D(@(XBB_$P(XB,XBA,2)))#2) S XBC=XBC+1,XBTEMP=XB D CHANGE S ^TMP("XBGCMP",XBN,XBTEMP)=XB_"   Exists~"_XBB_$P(XB,XBA,2)_"   Missing" G X3
  1.  . I @XB'=@(XBB_$P(XB,XBA,2)) S XBC=XBC+1,XBTEMP=XB D CHANGE S ^TMP("XBGCMP",XBN,XBTEMP)=XB_"   Not Equal To~"_XBB_$P(XB,XBA,2)
  1. X3 . Q
  1.  S XBA=$P(XBG2,"("),XBB=$P(XBG1,"("),XB=XBG2
  1.  F  S XB=$Q(@XB) Q:XB=""  D
  1.  . I '($D(@(XBB_$P(XB,XBA,2)))#2) S XBC=XBC+1,XBTEMP=XBB_$P(XB,XBA,2) D CHANGE S ^TMP("XBGCMP",XBN,XBTEMP)=XBB_$P(XB,XBA,2)_"   Missing~"_XB_"   Exists"
  1.  I '$D(ZTQUEUED) D PRINT I 1
  1.  E  D SCHED
  1.  Q
  1.  ;
  1. CHANGE ; Temp change double quotes to single
  1.  I XBTEMP["""" S XBTMP="",XBQTE=$L(XBTEMP,"""") F XBI=1:1:(XBQTE-1) S XBTMP=XBTMP_$P(XBTEMP,"""",XBI)_"" I XBI=(XBQTE-1) D
  1.  . S XBTEMP=XBTMP_$P(XBTEMP,"""",XBQTE)
  1.  KILL XBTMP,XBQTE
  1.  Q
  1.  ;
  1. PRINT ; Prints or displays results
  1.  I $D(ZTQUEUED) W:$D(IOF) @IOF W !!,"Comparison of globals ",XBG1," and ",XBG2,!
  1.  S XBL=IOSL-3,XB=""
  1.  F  S XB=$O(^TMP("XBGCMP",XBN,XB)) Q:XB=""  D  I XBL'>0 D PAUSE Q:$G(XBSTP)  S XBL=IOSL-3 W !
  1.  . I $L(^TMP("XBGCMP",XBN,XB))>76 W !,$P(^(XB),"~"),!,$P(^(XB),"~",2),! S XBL=XBL-3.25
  1.  . E  W !,$P(^TMP("XBGCMP",XBN,XB),"~"),"   ",$P(^(XB),"~",2),! S XBL=XBL-2
  1.  I '$G(XBSTP) W !,"Comparison completed with ",XBC," difference",$S(XBC'=1:"s",1:"")," found.",!
  1.  KILL ^TMP("XBGCMP",XBN)
  1.  I $D(ZTQUEUED) S ZTREQ="@" D EOJ
  1.  Q
  1.  ;
  1. PAUSE ; Quit display?
  1.  I $E(IOST,1,2)="C-" S Y=$$DIR^XBDIR("E") S:$D(DIRUT)!($D(DUOUT)) XBSTP=1 KILL DIRUT,DUOUT W !
  1.  Q
  1.  ;
  1. SCHED ; Schedules another task to print
  1.  KILL ZTSAVE
  1.  F %="XBN","XBG1","XBG2","XBC" S ZTSAVE(%)=""
  1.  S ZTRTN="PRINT^XBGCMP",ZTDESC="PRINT COMPARISON OF TWO GLOBALS",ZTIO=XBION,ZTDTH=DT
  1.  D ^%ZTLOAD
  1.  KILL ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK
  1.  Q
  1.  ;
  1. EOJ ;
  1.  KILL XB,XBA,XBB,XBC,XBI,XBL,XBG1,XBG2,XBION,XBN,XBQ,XBS,XBSTP,XBT,XBTEMP,XBTMP,XBVOL
  1.  Q
  1.  ;
  1. HELP ;EP - Dooda about the utility
  1.  ;;@;!