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

DIKCU2.m

Go to the documentation of this file.
  1. DIKCU2 ;SFISC/MKO-ARRAY COMPARE, TEXT MANIPULATION ;2:40 PM 28 Jan 1998
  1. ;;22.0;VA FileMan;;Mar 30, 1999
  1. ;Per VHA Directive 10-93-142, this routine should not be modified.
  1. ;
  1. ;===============================
  1. ; $$GCMP(ArrayName1,ArrayName2)
  1. ;===============================
  1. ;Compare the contents of two arrays
  1. ;In:
  1. ; DIKCU2A0 = Name of array 1
  1. ; DIKCU2B0 = Name of array 2
  1. ;Returns: 1 if equal, 0 if unequal
  1. ;
  1. GCMP(DIKCU2A0,DIKCU2B0) ;
  1. N DIKCU2A,DIKCU2B,DIKCU2DA,DIKCU2DB,DIKCU2E
  1. S DIKCU2A=$G(DIKCU2A0),DIKCU2B=$G(DIKCU2B0)
  1. Q:DIKCU2A=""!(DIKCU2B="") 0
  1. ;
  1. S DIKCU2DA=$D(@DIKCU2A),DIKCU2DB=$D(@DIKCU2B)
  1. Q:DIKCU2DA'=DIKCU2DB 0
  1. I DIKCU2DA=0,DIKCU2DB=0 Q 1
  1. I DIKCU2DA#2,DIKCU2DB#2,@DIKCU2A'=@DIKCU2B Q 0
  1. ;
  1. S DIKCU2E=1
  1. S DIKCU2A0=$$OREF^DILF(DIKCU2A0),DIKCU2B0=$$OREF^DILF(DIKCU2B0)
  1. F S DIKCU2A=$Q(@DIKCU2A),DIKCU2B=$Q(@DIKCU2B) D Q:'DIKCU2E!(DIKCU2A="")!(DIKCU2B="")
  1. . I DIKCU2A=""!($P(DIKCU2A,DIKCU2A0)]""),DIKCU2B=""!($P(DIKCU2B,DIKCU2B0)]"") Q
  1. . I DIKCU2A=""!(DIKCU2B="") S DIKCU2E=0 Q
  1. . I $P(DIKCU2A,DIKCU2A0,2,999)'=$P(DIKCU2B,DIKCU2B0,2,999) S DIKCU2E=0 Q
  1. . I @DIKCU2A'=@DIKCU2B S DIKCU2E=0 Q
  1. Q DIKCU2E
  1. ;
  1. ;==================================================
  1. ; XRINFO(Xref#,.UIR,.LDif,.MaxL,.RFile,.IRoot,.SS)
  1. ;==================================================
  1. ;Get info about an index
  1. ;In:
  1. ; XR = ien of entry in Index file
  1. ;Out:
  1. ; .UIR = Closed root of index w/ X(n)
  1. ; .LDIF = Level difference between file and root file
  1. ; .MAXL(ord#) = maximum length of subscript with this order #
  1. ; .IROOT = Closed root of index (up to name)
  1. ; .RFILE = Root file #
  1. ; .SS = # of field-type subscripts
  1. ; .SS(ss#) = file#^field#^maxLen
  1. ;Example: a whole file xref defined 3 levels down; the xref resides
  1. ; on the subfile 2 levels down.
  1. ; UIR = ^DIZ(1000,DA(3),10,DA(2),20,"WF",$E(X(1),1,30),X(2))
  1. ; RFILE = 1000.03
  1. ; IROOT = ^DIZ(1000,DA(3),10,DA(2),20,"WF")
  1. ;
  1. XRINFO(XR,UIR,LDIF,MAXL,RFILE,IROOT,SS) ;
  1. K UIR,LDIF,MAXL,SS
  1. Q:$D(^DD("IX",XR,0))[0
  1. N CRV,FIL,FILE,FLD,ML,NAME,ORD,TYPE,S
  1. ;
  1. S FILE=$P(^DD("IX",XR,0),U),NAME=$P(^(0),U,2),TYPE=$P(^(0),U,8),RFILE=$P(^(0),U,9)
  1. Q:NAME=""!'FILE!'RFILE
  1. ;
  1. I FILE'=RFILE D
  1. . S LDIF=$$FLEVDIFF^DIKCU(FILE,RFILE) Q:LDIF=""
  1. . S UIR=$$FROOTDA^DIKCU(FILE,LDIF_"O") Q:UIR=""
  1. E D
  1. . S LDIF=0
  1. . S UIR=$$FROOTDA^DIKCU(FILE,"O") Q:UIR=""
  1. Q:$G(UIR)=""
  1. S UIR=UIR_""""_NAME_"""",IROOT=UIR_")"
  1. ;
  1. S S=0 F S S=$O(^DD("IX",XR,11.1,"AC",S)) Q:'S S CRV=$O(^(S,0)) D:CRV
  1. . Q:$D(^DD("IX",XR,11.1,CRV,0))[0 S ORD=$P(^(0),U),FIL=$P(^(0),U,3),FLD=$P(^(0),U,4),ML=$P(^(0),U,5)
  1. . Q:'ORD
  1. . I ML S UIR=UIR_",$E(X("_ORD_"),1,"_ML_")",MAXL(ORD)=ML
  1. . E S UIR=UIR_",X("_ORD_")"
  1. . I FIL,FLD S SS=$G(SS)+1,SS(S)=FIL_U_FLD_$S(ML:U_ML,1:"")
  1. ;
  1. S UIR=UIR_")"
  1. Q
  1. ;
  1. ;===============================
  1. ; WRAP(.Text,Width,Width1,Code)
  1. ;===============================
  1. ;Wrap the lines in array T
  1. ;In:
  1. ; .T = array of text; 1st line can be in T or T(0)
  1. ; subsequent lines are in T(1),...,T(n)
  1. ; WID = maximum length of each line (default = IOM[or 80]-1)
  1. ; if < 0 : IOM-1+WID
  1. ; WID1 = maximum length of line 1 (optional)
  1. ; if "" : WID
  1. ; if < 0 : IOM-1+WID1
  1. ; COD = 1, if lines should NOT wrap on word boundaries
  1. ;
  1. WRAP(T,WID,WID1,COD) ;Wrap the lines in the T array
  1. Q:'$D(T)
  1. N E,J,P,T0,W
  1. ;
  1. S WID=$G(WID)\1
  1. S:WID<1 WID=$G(IOM,80)-1+WID
  1. S:WID<1 WID=79
  1. ;
  1. S W=$S($G(WID1):WID1\1,$G(WID1)=0:$G(IOM,80)-1,1:WID)
  1. S:W<1 W=$G(IOM,80)-1+W
  1. S:W<1 W=79
  1. ;
  1. I $D(T(0))[0 S T0=1,T(0)=T
  1. ;
  1. ;Wrap at word boundaries
  1. I '$G(COD) F J=0:1 Q:'$D(T(J)) D
  1. . S:J=1 W=WID
  1. . S:J T(J)=$$LD(T(J))
  1. . ;
  1. . ;Line must be split
  1. . I $L(T(J))>W D
  1. .. D DOWNT
  1. .. F P=$L(T(J)," "):-1:0 Q:$L($P(T(J)," ",1,P))'>W
  1. .. I 'P S T(J+1)=$E(T(J),W+1,999),T(J)=$E(T(J),1,W)
  1. .. E S T(J+1)=$$LD($P(T(J)," ",P+1,999)),T(J)=$$TR($P(T(J)," ",1,P))
  1. . ;
  1. . ;Or line must be joined with next
  1. . E I $L(T(J))<W D
  1. .. Q:'$D(T(J+1))
  1. .. I T(J)]"",T(J)'?.E1" " S T(J)=T(J)_" "
  1. .. S T(J+1)=$$LD(T(J+1))
  1. .. ;
  1. .. F P=1:1:$L(T(J+1)," ")+1 Q:$L(T(J))+$L($P(T(J+1)," ",1,P))>W
  1. .. S T(J)=$$TR(T(J)_$P(T(J+1)," ",1,P-1))
  1. .. S T(J+1)=$$LD($P(T(J+1)," ",P,999))
  1. .. I T(J+1)="" D UPT S J=J-1
  1. ;
  1. ;Or wrap to width
  1. E F J=0:1 Q:'$D(T(J)) D
  1. . S:J=1 W=WID
  1. . ;
  1. . ;Line must be split
  1. . I $L(T(J))>W D
  1. .. D DOWNT
  1. .. S T(J+1)=$E(T(J),W+1,999)
  1. .. S T(J)=$E(T(J),1,W)
  1. . ;
  1. . ;Or joined with next
  1. . E I $L(T(J))<W D
  1. .. Q:'$D(T(J+1))
  1. .. S E=W-$L(T(J))
  1. .. S T(J)=T(J)_$E(T(J+1),1,E)
  1. .. S T(J+1)=$E(T(J+1),E+1,999)
  1. .. I T(J+1)="" D UPT S J=J-1
  1. ;
  1. I $G(T0) S T=T(0) K T(0)
  1. Q
  1. ;
  1. DOWNT ;Push the T array from element J+1 down
  1. N K
  1. F K=$O(T(""),-1):-1:J+1 S T(K+1)=T(K)
  1. S T(J+1)=""
  1. Q
  1. ;
  1. UPT ;Pop the T array from element J+1 down
  1. N K
  1. F K=J+1:1:$O(T(""),-1)-1 S T(K)=T(K+1)
  1. K T($O(T(""),-1))
  1. Q
  1. ;
  1. TR(X) ;Strip trailing spaces
  1. Q:$G(X)="" X
  1. N I
  1. F I=$L(X):-1:0 Q:$E(X,I)'=" "
  1. Q $E(X,1,I)
  1. ;
  1. LD(X) ;Strip leading spaces
  1. Q:$G(X)="" X
  1. N I
  1. F I=1:1:$L(X)+1 Q:$E(X,I)'=" "
  1. Q $E(X,I,999)
  1. ;
  1. ERR(ERR,DIFILE,DIIENS,DIFIELD,DI1,DI2,DI3) ;Build an error message
  1. N P,I,V
  1. F I="FILE","IENS","FIELD",1,2,3 S V=$G(@("DI"_I)) S:V]"" P(I)=V
  1. D BLD^DIALOG(ERR,.P,.P)
  1. Q