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

DIKCU1.m

Go to the documentation of this file. 
  1. DIKCU1 ;SFISC/MKO-FILE/RECORD INFO ;11:21 AM  20 Aug 1999 [ 04/02/2003   8:25 AM ]
  1.  ;;22.0;VA FileMan;**1001**;APR 1, 2003
  1.  ;;22.0;VA FileMan;**12**;Mar 30, 1999
  1.  ;Per VHA Directive 10-93-142, this routine should not be modified.
  1.  ;===================
  1.  ; $$VDA([.]DA,Flag)
  1.  ;===================
  1.  ;Make sure elements DA array are positive canonic numbers.
  1.  ;In:
  1.  ; [.]DA = DA array
  1.  ; F   [ R : DA can't be 0 or null
  1.  ;     [ D : generate Dialog
  1.  ;Returns: 1 if valid; 0 if invalid
  1.  ;
  1. VDA(DA,F) ;
  1.  N I,ERR
  1.  Q:$D(DA)[0 0
  1.  I $G(F)["R" D:0[DA
  1.  . S ERR=1 D:$G(F)["D" ERR^DIKCU2(202,"","","","RECORD")
  1.  I DA]"",DA<0!(DA'=+$P(DA,"E")) D
  1.  . S ERR=1 D:$G(F)["D" ERR^DIKCU2(202,"","","","RECORD")
  1.  E  F I=1:1 Q:'$D(DA(I))  I DA(I)'>0!(DA(I)'=+$P(DA(I),"E")) D  Q
  1.  . S ERR=1 D:$G(F)["D" ERR^DIKCU2(202,"","","","RECORD")
  1.  Q '$G(ERR)
  1.  ;
  1.  ;====================================
  1.  ; $$VFLAG(InputFlags,GoodFlags,Flag)
  1.  ;====================================
  1.  ;Makes sure Flags contain only Good Flags.
  1.  ;In:
  1.  ; FLAG   = flags
  1.  ; GDFLAG = good flags
  1.  ; F      [ D : generate Dialog
  1.  ;Returns: 1 if valid; 0 if invalid
  1.  ;
  1. VFLAG(FLAG,GDFLAG,F) ;
  1.  S FLAG=$G(FLAG)
  1.  I $TR($G(FLAG),$G(GDFLAG),"")'?.NP D  Q 0
  1.  . D:$G(F)["D" ERR^DIKCU2(301,"","","",FLAG)
  1.  Q 1
  1.  ;
  1.  ;=====================
  1.  ; $$VFNUM(File#,Flag)
  1.  ;=====================
  1.  ;Check that File# exists and has a non-wp .01 field
  1.  ;In:
  1.  ; FIL = File or subfile #
  1.  ; F   [ D : generate Dialog
  1.  ;Returns: 1 if valid; 0 if invalid
  1.  ;
  1. VFNUM(FIL,F) ;
  1.  Q:$G(FIL)="" 0
  1.  I '$D(^DD(FIL)) D:$G(F)["D" ERR^DIKCU2(401,FIL) Q 0
  1.  I $P($G(^DD(FIL,.01,0)),U,2)="" D:$G(F)["D" ERR^DIKCU2(406,FIL) Q 0
  1.  I $P(^DD(FIL,.01,0),U,2)["W" D:$G(F)["D" ERR^DIKCU2(407,FIL) Q 0
  1.  Q 1
  1.  ;
  1.  ;===========================
  1.  ; $$VFLD(File#,Field#,Flag)
  1.  ;===========================
  1.  ;Check that the Fil/Fld exists in the ^DD
  1.  ;In:
  1.  ; FIL = File or subfile #
  1.  ; FLD = Field #
  1.  ; F   [ D : generate Dialog
  1.  ;Returns: 1 if valid; 0 if invalid
  1.  ;
  1. VFLD(FIL,FLD,F) ;
  1.  Q:$G(FIL)="" 0  Q:$G(FLD)="" 0
  1.  I '$D(^DD(FIL,FLD)) D:$G(F)["D" ERR^DIKCU2(501,FIL,"",FLD,FLD) Q 0
  1.  Q 1
  1.  ;
  1.  ;================================================
  1.  ; FRNAME(File#,[.]Rec,FileText,RecordTxt,.Level)
  1.  ;================================================
  1.  ;Return string that identifies (sub)file and (sub)record.
  1.  ;In:
  1.  ;  FIL  = File or subfile #
  1.  ; .REC  = DA array
  1.  ;Out:
  1.  ; .FTXT = Text that identifies file
  1.  ; .RTXT = Text that identifies record
  1.  ; .LEV  = Level
  1.  ;
  1. FRNAME(FIL,REC,FTXT,RTXT,LEV) ;
  1.  K FTXT,RTXT,LEV
  1.  Q:'$G(FIL)  Q:'$D(REC)
  1.  N FINFO
  1.  D FINFO(FIL,.FINFO) Q:'$D(FINFO)
  1.  D FILENAME("",.FTXT,.FINFO)
  1.  D RECNAME("",REC,.RTXT,.FINFO)
  1.  S LEV=FINFO
  1.  Q
  1.  ;
  1.  ;=================================
  1.  ; FILENAME(File#,.NameArr,.FINFO)
  1.  ;=================================
  1.  ;Get text that identifies the (sub)file
  1.  ;In:
  1.  ;  FIL   = File or subfile #
  1.  ;In/Out:
  1.  ; .FINFO = File info array (optional) (see FINFO below)
  1.  ;Out:
  1.  ;  N     = Text (undefined if error)
  1.  ;  N(n)  = Overflow text
  1.  ;
  1. FILENAME(FIL,N,FINFO) ;
  1.  K N
  1.  I '$D(FINFO) Q:'$G(FIL)  D FINFO(FIL,.FINFO) Q:'$D(FINFO)
  1.  N I,L,T
  1.  ;
  1.  S L=FINFO,N=0,N(0)=""
  1.  F I=L:-1:0 D
  1.  . I I S T=$P(FINFO(I),U,3)_" (#"_$P(FINFO(I),U)_"), subfield #"_$P(FINFO(I),U,2)_" of "
  1.  . E  S T=$S(L:"the ",1:"")_$P(FINFO(I),U,3)_" File (#"_$P(FINFO(I),U)_")"
  1.  . I $L(N(N))+$L(T)>240 S N=N+1,N(N)=""
  1.  . S N(N)=N(N)_T
  1.  S N=N(0) K N(0)
  1.  Q
  1.  ;
  1.  ;========================================
  1.  ; RECNAME(File#,.Record,.NameArr,.FINFO)
  1.  ;========================================
  1.  ;Get text that identifies the (sub)recird
  1.  ;In:
  1.  ;    FIL = File or subfile #
  1.  ; [.]REC = DA array or IENS
  1.  ;In/Out:
  1.  ; .FINFO = File info array (optional) (see FINFO below)
  1.  ;Out:
  1.  ;  NA    = Text (undefined if error)
  1.  ;  NA(n) = Overflow text
  1.  ;
  1. RECNAME(FIL,REC,NA,FINFO) ;Return string that identifies the (sub)record
  1.  K NA
  1.  Q:'$G(REC)
  1.  I '$D(FINFO) Q:'$G(FIL)  D FINFO(FIL,.FINFO) Q:'$D(FINFO)
  1.  ;
  1.  N DA,DIERR,ERR,J,LV,LVI,MSG,NDA,ROOT,TX,V01
  1.  ;
  1.  ;Set DA array
  1.  I REC'["," M DA=REC
  1.  E  D DA^DILF(REC,.DA)
  1.  ;
  1.  S LV=FINFO,NA=0,NA(0)=""
  1.  F LVI=LV:-1:0 D  Q:$G(ERR)
  1.  . I LVI,$G(DA(LVI))'>0 S ERR=1 Q
  1.  . I 'LVI,$G(DA)'>0 S ERR=1 Q
  1.  . ;
  1.  . I '$D(DDS) D  Q:$G(ERR)
  1.  .. S ROOT=$P(FINFO(LVI),U,4,999)
  1.  .. S V01=$P($G(@ROOT@(0)),U) I V01="" S ERR=1 Q
  1.  .. S TX=$$EXTERNAL^DILFD($P(FINFO(LVI),U),.01,"",V01,"MSG")
  1.  .. I $G(DIERR) S TX=V01 K MSG,DIERR
  1.  . ;
  1.  . E  D
  1.  .. F J=LVI:-1:1 S NDA(J)=DA(J+LV-LVI)
  1.  .. S NDA=$S(LVI=LV:DA,1:DA(LV-LVI))
  1.  .. S TX=$$GET^DDSVAL($P(FINFO(LVI),U),.NDA,.01,"","E") K NDA
  1.  . ;
  1.  . I LV-LVI S TX="'"_TX_"' (#"_DA(LV-LVI)_")"
  1.  . E  S TX="'"_TX_"' (#"_DA_")"
  1.  . I LVI S TX=TX_" of "
  1.  . I $L(NA(NA))+$L(TX)>240 S NA=NA+1,NA(NA)=""
  1.  . S NA(NA)=NA(NA)_TX
  1.  ;
  1.  I $G(ERR) K NA Q
  1.  S NA=NA(0) K NA(0)
  1.  Q
  1.  ;
  1.  ;========================
  1.  ; FINFO(File#,.FileInfo)
  1.  ;========================
  1.  ;Get (sub)file info
  1.  ;In:
  1.  ; FIL = File or subfile #
  1.  ;Out:
  1.  ; FINFO    = n (level)
  1.  ; FINFO(0) = file#^^fileName^fileRootw/DA
  1.  ; FINFO(n) = subfile#^mfield#^mfieldName^^subfileRootw/DA
  1.  ;Example:
  1.  ; FINFO    = 3
  1.  ; FINFO(0) = 1000^^My File^^DIZ(1000,DA(3))
  1.  ; FINFO(1) = 1000.01^100^Mult1^^DIZ(1000,DA(3),10,DA(2))
  1.  ; FINFO(2) = 1000.02^200^Mult2^^DIZ(1000,DA(3),10,DA(2),20,DA(1))
  1.  ; FINFO(3) = 1000.03^300^Mult3^^DIZ(1000,DA(3),10,DA(2),20,DA(1),30,DA)
  1.  ;
  1. FINFO(FIL,FINFO) ;
  1.  Q:'$G(FIL)
  1.  K FINFO
  1.  ;
  1.  ;If top level, set FINFO and quit
  1.  I $D(^DIC(FIL,0,"GL"))#2 D  Q
  1.  . S FINFO=0,FINFO(0)=FIL_U_U_$P(^DIC(FIL,0),U)_U_^DIC(FIL,0,"GL")_"DA)"
  1.  ;
  1.  ;Must be a subfile level, get mult nodes, and level
  1.  N A,ERR,I,L,MFLD,ND,PAR,ROOT,SUB
  1.  S SUB=FIL
  1.  F L=0:1 S PAR=$G(^DD(SUB,0,"UP")) Q:'PAR  D  Q:$G(ERR)
  1.  . S MFLD=$O(^DD(PAR,"SB",SUB,"")) I 'MFLD S ERR=1 Q
  1.  . I $D(^DD(PAR,MFLD,0))[0 S ERR=1 Q
  1.  . S FINFO(L)=SUB_U_MFLD_U_$P(^DD(PAR,MFLD,0),U)
  1.  . ;
  1.  . S ND=$P($P(^DD(PAR,MFLD,0),U,4),";")
  1.  . S:ND'=+$P(ND,"E") ND=""""_ND_""""
  1.  . S ND(L+1)=ND
  1.  . S SUB=PAR
  1.  I $G(ERR) K FINFO,L Q
  1.  S FIL=SUB
  1.  I $D(^DIC(FIL,0))[0 K FINFO,L Q
  1.  S FINFO(L)=FIL_U_U_$P(^DIC(FIL,0),U)
  1.  ;
  1.  ;Build global roots
  1.  S ROOT=$G(^DIC(FIL,0,"GL")) I ROOT="" K FINFO,L Q
  1.  F I=L:-1:1 D
  1.  . S ROOT=ROOT_"DA("_I_")"
  1.  . S FINFO(I)=FINFO(I)_U_ROOT_")"
  1.  . S ROOT=ROOT_","_ND(I)_","
  1.  S FINFO(0)=FINFO(0)_U_ROOT_"DA)"
  1.  S FINFO=L
  1.  ;
  1.  ;Invert the FINFO array
  1.  K A M A=FINFO K FINFO S FINFO=A F A=0:1:FINFO S FINFO(A)=A(FINFO-A)
  1.  Q
  1.  ;
  1.  ;#202  The input parameter that identifies the |1| is missing or invalid.
  1.  ;#301  The passed flag(s) '|1|' are unknown or inconsistent.
  1.  ;#401  File #|FILE| does not exist.
  1.  ;#406  File #|FILE| has no .01 field definition.
  1.  ;#407  A word-processing field is not a file.
  1.  ;#501  File #|FILE| does not contain a field |1|.