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

DIKK1.m

Go to the documentation of this file. 
  1. DIKK1 ;SFISC/MKO-CHECK KEY INTEGRITY ;9:19 AM  5 Feb 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.  ; LOADALL(File,Flag,.MF)
  1.  ;========================
  1.  ;Load info about all keys on a file. Use the "B" xref on the Key file.
  1.  ;In:
  1.  ; KFIL = File # [.31,.01]
  1.  ; FLAG [ "s" : don't include subfile under file
  1.  ;Out:
  1.  ; ^TMP("DIKK",$J,keyFile#,file#) = levDif(keyfile,file) (if > 0)
  1.  ;                                  ^openRootDA
  1.  ;                ...      file#,field#) = S X=$P($G(...),U,n)
  1.  ;                                         or S X=$E($G(...),m,n)
  1.  ;
  1.  ; ^TMP("DIKK",$J,"UI",file[.01],ui#)   = key#
  1.  ; ^TMP("DIKK",$J,"UIR",rFile[.51],ui#) = key#
  1.  ;
  1.  ; MF(file#,mField#)   = multiple node
  1.  ; MF(file#,mField#,0) = subfile#
  1.  ;
  1. LOADALL(KFIL,FLAG,MF) ;
  1.  N FLD,KEY,ROOT
  1.  ;
  1.  ;Get info for all keys on this file
  1.  S KEY=0
  1.  F  S KEY=$O(^DD("KEY","B",KFIL,KEY)) Q:'KEY  D LOADKEY(KEY,.ROOT)
  1.  Q:$G(FLAG)["s"
  1.  ;
  1.  ;Make a recursive call to get subfiles under KFIL
  1.  N CHK,FIL,MFLD,PAR,SB
  1.  D SUBFILES^DIKCU(KFIL,.SB,.MF)
  1.  S SB=0 F  S SB=$O(SB(SB)) Q:'SB  D
  1.  . D LOADALL(SB,"s") Q:'$D(^TMP("DIKK",$J,SB))
  1.  . ;
  1.  . ;Set CHK(subfile)="" for subfile and its antecedents
  1.  . S PAR=SB F  Q:$D(CHK(PAR))  S CHK(PAR)=1,PAR=$G(SB(PAR)) Q:PAR=""
  1.  ;
  1.  ;Use the CHK array to get rid of unneeded elements in MF
  1.  S FIL=0 F  S FIL=$O(MF(FIL)) Q:'FIL  D
  1.  . S MFLD=0 F  S MFLD=$O(MF(FIL,MFLD)) Q:'MFLD  D
  1.  .. K:'$D(CHK(MF(FIL,MFLD,0))) MF(FIL,MFLD)
  1.  Q
  1.  ;
  1.  ;=====================
  1.  ; LOADFLD(File,Field)
  1.  ;=====================
  1.  ;Load info for all keys of which a field is a part.
  1.  ;
  1. LOADFLD(FIL,FLD) ;
  1.  N KEY
  1.  S KEY=0 F  S KEY=$O(^DD("KEY","F",FIL,FLD,KEY)) Q:'KEY  D LOADKEY(KEY)
  1.  Q
  1.  ;
  1.  ;===================
  1.  ; LOADKEY(Key,Root)
  1.  ;===================
  1.  ;Load info about a key.
  1.  ;In:
  1.  ;  KEY   = Key #
  1.  ; .OROOT = Open root of File of Key [.31,.01] (optional) (also output)
  1.  ;Out:
  1.  ; .OROOT = Open root of File of Key [.31,.01]
  1.  ; ^TMP (see LOADALL above)
  1.  ;
  1. LOADKEY(KEY,OROOT) ;
  1.  N DEC,FIL,FLD,FLDN,KFIL,LDIF,UI,UIFIL,UIRFIL
  1.  ;
  1.  ;Get key data
  1.  S KFIL=$P($G(^DD("KEY",KEY,0)),U),UI=$P($G(^(0)),U,4) Q:'KFIL!'UI
  1.  ;
  1.  ;Get info about UI
  1.  S UIFIL=$P($G(^DD("IX",UI,0)),U),UIRFIL=$P(^(0),U,9) Q:'UIFIL!'UIRFIL
  1.  Q:$D(^TMP("DIKK",$J,"UI",UIFIL,UI))  S ^(UI)=KEY
  1.  S ^TMP("DIKK",$J,"UIR",UIRFIL,UI)=KEY
  1.  ;
  1.  ;Get root of file [.31,.01]
  1.  I $G(OROOT)="" S OROOT=$$FROOTDA^DIKCU(KFIL,"O")_"DA," Q:OROOT="DA,"
  1.  ;
  1.  ;Loop through fields in key; get data extraction code
  1.  S FLDN=0 F  S FLDN=$O(^DD("KEY",KEY,2,FLDN)) Q:'FLDN  D
  1.  . Q:'$D(^DD("KEY",KEY,2,FLDN,0))  S FLD=$P(^(0),U),FIL=$P(^(0),U,2)
  1.  . Q:'FLD!'FIL  Q:$D(^TMP("DIKK",$J,KFIL,FIL,FLD))#2
  1.  . ;
  1.  . I FIL'=KFIL N OROOT D  Q:$G(OROOT)=""
  1.  .. I $D(^TMP("DIKK",$J,KFIL,FIL))#2 S LDIF=+^(FIL),OROOT=U_$P(^(FIL),U,2,999)
  1.  .. E  D
  1.  ... S LDIF=$$FLEVDIFF^DIKCU(FIL,KFIL) Q:'LDIF
  1.  ... S OROOT=$$FROOTDA^DIKCU(FIL,LDIF_"O") Q:OROOT=""
  1.  ... S OROOT=OROOT_"DA("_LDIF_"),"
  1.  ... S ^TMP("DIKK",$J,KFIL,FIL)=LDIF_OROOT
  1.  . ;
  1.  . S DEC=$$DEC(FIL,FLD,OROOT) Q:DEC=""
  1.  . S ^TMP("DIKK",$J,KFIL,FIL,FLD)=DEC
  1.  ;
  1.  Q
  1.  ;
  1.  ;==============================
  1.  ; $$DEC(File#,Field#,OpenRoot)
  1.  ;==============================
  1.  ;Return code that sets X=data from file; examples:
  1.  ; S X=$P($G(^DIZ(1000,DA(2),"m1",DA(1),"m2",DA,0)),U,3)
  1.  ; S X=$E($G(^DIZ(1000,DA(2),"m1",DA(1),"m2",DA,0)),1,245)
  1.  ;In:
  1.  ; FIL   = File #
  1.  ; FLD   = Field #
  1.  ; OROOT = Open root of record (with DA strings) (optional)
  1.  ;
  1. DEC(FIL,FLD,OROOT) ;Get data extraction code
  1.  N ND,PC
  1.  S PC=$P($G(^DD(FIL,FLD,0)),U,4)
  1.  S ND=$P(PC,";"),PC=$P(PC,";",2) Q:ND?." " ""  Q:"0 "[PC ""
  1.  S:ND'=+$P(ND,"E") ND=""""_ND_""""
  1.  ;
  1.  I $G(OROOT)="" S OROOT=$$FROOTDA^DIKCU(FIL,"O")_"DA," Q:OROOT="DA," ""
  1.  I PC Q "S X=$P($G("_OROOT_ND_")),U,"_PC_")"
  1.  E  Q "S X=$E($G("_OROOT_ND_")),"_+$E(PC,2,999)_","_$P(PC,",",2)_")"
  1.  ;