Return to DICF.m CVS log

Up to [Coherent Logic Development] / freem_fileman / USER

Restructure repository

    1: DICF	;SEA/TOAD-VA FileMan: Finder, Part 1 (Main) ;11/17/94  11:23 ;
    2: 	;;21.0;VA FileMan;;Dec 28, 1994
    3: 	;Per VHA Directive 10-93-142, this routine should not be modified.
    4: 	
    5: FIND(DIFILE,DIEN,DIFLDS,DIFLAGS,DIVALUE,DIMAX,DIFORCE,DISCREEN,DID,DILIST,DIMSGA)	
    6: 	; ENTRY POINT--silent selecter
    7: 	; subroutine, DIFORCE passed by reference
    8: 	
    9: FINDX	; branch in from FIND^DIC
   10: 	I '$D(DIQUIET) N DIQUIET S DIQUIET=1
   11: 	I '$D(DIFM) N DIFM S DIFM=1 D INIZE^DIEFU
   12: 	N DA,DICOUNT,DIFAIL,DIROOT
   13: 	I $G(DIFLAGS)'["p"!($G(DIFLAGS)["l") N DILVA
   14: 	S (DICOUNT,DICOUNT(0))=+$G(DILIST("C"))
   15: 	S DICOUNT("LOOK")=0
   16: 	S DICOUNT("MORE")=0
   17: 	S DICOUNT("MAX")=$G(DIMAX) I DICOUNT("MAX")="" S DICOUNT("MAX")="*"
   18: 	S DILIST(0)=$G(DILIST(0)) I DILIST(0)<1 S DILIST(0)=1
   19: 	
   20: INPUT	
   21: 	S DIFAIL=0 D  I DIFAIL D CLOSE Q
   22: I0	. ; flags
   23: 	. S DIFLAGS=$G(DIFLAGS)
   24: 	. I DIFLAGS["O",DIFLAGS["X" S DIFLAGS=$TR(DIFLAGS,"O")
   25: 	. I DIFLAGS'["p" S DIFLAGS=DIFLAGS_"t"
   26: 	. I DIFLAGS["p" S DIFLAGS=DIFLAGS_"f"
   27: I1	. ; value
   28: 	. S DIVALUE=$G(DIVALUE)
   29: I2	. ; target_root
   30: 	. I $G(DIMSGA)'="" D
   31: 	. . K @DIMSGA@("DIMSG"),@DIMSGA@("DIERR"),@DIMSGA@("DIHELP")
   32: 	. S DILIST=$G(DILIST)
   33: 	. I DILIST'="" I DIFLAGS'["v" K @DILIST
   34: 	. I DILIST'="",DIFLAGS'["f" S DILIST=$NA(@DILIST@("DILIST"))
   35: 	. I DILIST="" S DILIST="^TMP(""DILIST"",$J)" I DIFLAGS'["v" K @DILIST
   36: 	. S DILIST("LVA")=$G(DILIST("LVA"))
   37: 	. I DILIST("LVA")="" S DILIST("LVA")="DILVA"
   38: 	. I DIFLAGS["p",DIVALUE'="",$G(@DILIST("LVA")@("V"))="" D
   39: 	. . S DIFLAGS=DIFLAGS_"t"
   40: I3	. ; file
   41: 	. S DIFILE=$G(DIFILE) I 'DIFILE S DIFAIL=1 D  Q
   42: 	. . D ERR^DICF6(202,"","","","FILE")
   43: 	. N DINODE S DINODE=$G(^DD(DIFILE,.01,0))
   44: 	. I DINODE="" S DIFAIL=1 D  Q
   45: 	. . D ERR^DICF6($S('$D(^DD(DIFILE)):401,1:406),DIFILE)
   46: 	. I $P(DINODE,U,2)["W" S DIFAIL=1 D ERR^DICF6(407,DIFILE) Q
   47: 	. S DISCREEN("F")=$G(^DD(DIFILE,0,"SCR"))
   48: I4	. ; IENS
   49: 	. S DIEN=$G(DIEN) I DIEN="" S DIEN=","
   50: 	. I '$$IEN^DIDU1(DIEN) S DIFAIL=1 D  Q
   51: 	. . I '$$IEN^DIDU1(DIEN_",") D ERR^DICF6(202,"","","","IENS") Q
   52: 	. . E  D ERR^DICF6(304,"",DIEN) Q
   53: 	. I $P(DIEN,",")'="" S DIFAIL=1 D ERR^DICF6(306,"",DIEN) Q
   54: 	. I DIEN["," D DA^DILF(DIEN,.DA) S DA=DIEN M DIEN=DA
   55: I5	. ; file root
   56: 	. S DIROOT=$$ROOT^DIQGU(DIFILE,DIEN,1,1) I $G(DIERR) S DIFAIL=1 Q
   57: 	. I DIROOT="" S DIFAIL=1 D  Q
   58: 	. . D ERR^DICF6(402,DIFILE,DIEN)
   59: 	. I $O(@DIROOT@(0))'>0 S DIFAIL=1 Q
   60: 	. S DIROOT("O")=$$OREF^DIQGU(DIROOT)
   61: 	. I DIFLAGS["v" S DIROOT("V")=DIROOT("O"),$E(DIROOT("V"))=";"
   62: 	. I DIVALUE=" " S DIROOT("Q")=$$ROOT^DIQGU(DIFILE,DIEN,"Q")
   63: I6	. ; fields
   64: 	. S DIFLDS=$G(DIFLDS)
   65: I7	. ; flags again
   66: 	. I $TR(DIFLAGS,"AMOQXfglpqtuv")'="" S DIFAIL=1 D  Q
   67: 	. . D ERR^DICF6(301,"","","",$TR(DIFLAGS,"fglpqtuv"))
   68: 	. I $O(@DIROOT@("A["))="" S DIFLAGS=DIFLAGS_"u"
   69: I8	. ; forced indexes
   70: 	. S DIFORCE=$G(DIFORCE)
   71: 	. I "*"[DIFORCE S DIFORCE=0,DIFORCE(0)="*"
   72: 	. E  I DIFORCE="#" S DIFORCE=0,DIFORCE(0)="#",DIFLAGS=DIFLAGS_"u"
   73: 	. E  D  I DIFAIL D ERR^DICF6(202,"","","","Indexes") Q
   74: 	. . S DIFORCE(0)=$G(DIFORCE)
   75: 	. . I $P(DIFORCE(0),U)="" S DIFAIL=1 Q
   76: 	. . S DIFLAGS=DIFLAGS_"M"
   77: 	. . S DIFORCE=1
   78: I9	. ; rest
   79: 	. I DICOUNT("MAX")'="*" D  Q:DIFAIL
   80: 	. . I DICOUNT("MAX")\1=DICOUNT("MAX"),DICOUNT("MAX")>0 Q
   81: 	. . S DIFAIL=1 D ERR^DICF6(202,"","","","Number")
   82: 	. S DISCREEN=$G(DISCREEN)
   83: 	. S DID=$G(DID)
   84: 	
   85: HOOK75	
   86: 	N DIHOOK75,DIOUT
   87: 	S DIHOOK75=$G(^DD(DIFILE,.01,7.5))
   88: 	S DIOUT=0
   89: 	I DIHOOK75'="",U'[DIVALUE,DIVALUE'?."?" D  I DIOUT D CLOSE Q
   90: 	. N %,D,DIC,X,Y,Y1
   91: 	. S D=DIFORCE(0)
   92: 	. S DIC=DIFILE
   93: 	. S DIC(0)=$TR(DIFLAGS,"fglpqtuv")
   94: 	. S X=DIVALUE
   95: 	. M Y=DIEN S Y=""
   96: 	. S Y1=DIEN
   97: 	. X DIHOOK75 I '$D(X)!$G(DIERR) S DIOUT=1 D:$G(DIERR)  Q
   98: 	. . D ERR^DICF6(120,DIFILE,"",.01,"Pre-lookup Transform (7.5 node)")
   99: 	. S DIVALUE=X
  100: 	. I $G(DIC("S"))'="" S DISCREEN=DIC("S")
  101: 	. I $G(DIC("V"))'="" S DISCREEN("V")=DIC("V")
  102: 	
  103: LOOKUP	
  104: 	N DIDENT
  105: 	I DIFLAGS'["f" D  I $G(DIERR) D CLOSE Q
  106: 	. D IDENTS^DICU1(DIFILE,.01,.DIROOT,DIFLDS,DID,.DIDENT)
  107: 	I DIFLAGS'["p" D SPECIAL^DICF1(DIFILE,.DIEN,DIFLAGS,.DIROOT,DIVALUE,DIFORCE(0),.DICOUNT,.DIFAIL,.DISCREEN,.DIDENT,.DIOUT,.DILIST)
  108: 	I DIOUT D CLOSE Q
  109: 	I DIFLAGS["t" D
  110: 	. D XFORM^DICF1(.DIFLAGS,.DIVALUE,.DISCREEN,.DILVA,.DILIST)
  111: 	I DIFLAGS["u" ;D UPRIGHT^DICF4(DIFILE,.DIEN,.DIFLAGS,.DIROOT,.DIVALUE,.DICOUNT,.DISCREEN,.DIDENT,.DILIST) I 1
  112: 	E  D CHKALL^DICF2(DIFILE,.DIEN,DIFLAGS,.DIROOT,.DIVALUE,.DICOUNT,.DISCREEN,.DIFORCE,.DIDENT,.DILIST)
  113: 	D CLOSE
  114: 	Q
  115: 	
  116: CLOSE	
  117: 	; cleanup
  118: 	I $G(DIMSGA)'="" D CALLOUT^DIEFU(DIMSGA)
  119: 	I '$G(DIERR),DIFLAGS'["p" S @DILIST@(0)=DICOUNT_U_DICOUNT("MAX")_U_DICOUNT("MORE")
  120: 	I DILIST'="" K @DILIST@("B")
  121: 	K ^TMP("DILVA",$J,DILIST(0))
  122: 	I DILIST(0)=1 K ^TMP("DILVA",$J)
  123: 	S DILIST("C")=DICOUNT
  124: 	Q
  125: