DICF ;SEA/TOAD-VA FileMan: Finder, Part 1 (Main) ;11/17/94 11:23 ; ;;21.0;VA FileMan;;Dec 28, 1994 ;Per VHA Directive 10-93-142, this routine should not be modified. FIND(DIFILE,DIEN,DIFLDS,DIFLAGS,DIVALUE,DIMAX,DIFORCE,DISCREEN,DID,DILIST,DIMSGA) ; ENTRY POINT--silent selecter ; subroutine, DIFORCE passed by reference FINDX ; branch in from FIND^DIC I '$D(DIQUIET) N DIQUIET S DIQUIET=1 I '$D(DIFM) N DIFM S DIFM=1 D INIZE^DIEFU N DA,DICOUNT,DIFAIL,DIROOT I $G(DIFLAGS)'["p"!($G(DIFLAGS)["l") N DILVA S (DICOUNT,DICOUNT(0))=+$G(DILIST("C")) S DICOUNT("LOOK")=0 S DICOUNT("MORE")=0 S DICOUNT("MAX")=$G(DIMAX) I DICOUNT("MAX")="" S DICOUNT("MAX")="*" S DILIST(0)=$G(DILIST(0)) I DILIST(0)<1 S DILIST(0)=1 INPUT S DIFAIL=0 D I DIFAIL D CLOSE Q I0 . ; flags . S DIFLAGS=$G(DIFLAGS) . I DIFLAGS["O",DIFLAGS["X" S DIFLAGS=$TR(DIFLAGS,"O") . I DIFLAGS'["p" S DIFLAGS=DIFLAGS_"t" . I DIFLAGS["p" S DIFLAGS=DIFLAGS_"f" I1 . ; value . S DIVALUE=$G(DIVALUE) I2 . ; target_root . I $G(DIMSGA)'="" D . . K @DIMSGA@("DIMSG"),@DIMSGA@("DIERR"),@DIMSGA@("DIHELP") . S DILIST=$G(DILIST) . I DILIST'="" I DIFLAGS'["v" K @DILIST . I DILIST'="",DIFLAGS'["f" S DILIST=$NA(@DILIST@("DILIST")) . I DILIST="" S DILIST="^TMP(""DILIST"",$J)" I DIFLAGS'["v" K @DILIST . S DILIST("LVA")=$G(DILIST("LVA")) . I DILIST("LVA")="" S DILIST("LVA")="DILVA" . I DIFLAGS["p",DIVALUE'="",$G(@DILIST("LVA")@("V"))="" D . . S DIFLAGS=DIFLAGS_"t" I3 . ; file . S DIFILE=$G(DIFILE) I 'DIFILE S DIFAIL=1 D Q . . D ERR^DICF6(202,"","","","FILE") . N DINODE S DINODE=$G(^DD(DIFILE,.01,0)) . I DINODE="" S DIFAIL=1 D Q . . D ERR^DICF6($S('$D(^DD(DIFILE)):401,1:406),DIFILE) . I $P(DINODE,U,2)["W" S DIFAIL=1 D ERR^DICF6(407,DIFILE) Q . S DISCREEN("F")=$G(^DD(DIFILE,0,"SCR")) I4 . ; IENS . S DIEN=$G(DIEN) I DIEN="" S DIEN="," . I '$$IEN^DIDU1(DIEN) S DIFAIL=1 D Q . . I '$$IEN^DIDU1(DIEN_",") D ERR^DICF6(202,"","","","IENS") Q . . E D ERR^DICF6(304,"",DIEN) Q . I $P(DIEN,",")'="" S DIFAIL=1 D ERR^DICF6(306,"",DIEN) Q . I DIEN["," D DA^DILF(DIEN,.DA) S DA=DIEN M DIEN=DA I5 . ; file root . S DIROOT=$$ROOT^DIQGU(DIFILE,DIEN,1,1) I $G(DIERR) S DIFAIL=1 Q . I DIROOT="" S DIFAIL=1 D Q . . D ERR^DICF6(402,DIFILE,DIEN) . I $O(@DIROOT@(0))'>0 S DIFAIL=1 Q . S DIROOT("O")=$$OREF^DIQGU(DIROOT) . I DIFLAGS["v" S DIROOT("V")=DIROOT("O"),$E(DIROOT("V"))=";" . I DIVALUE=" " S DIROOT("Q")=$$ROOT^DIQGU(DIFILE,DIEN,"Q") I6 . ; fields . S DIFLDS=$G(DIFLDS) I7 . ; flags again . I $TR(DIFLAGS,"AMOQXfglpqtuv")'="" S DIFAIL=1 D Q . . D ERR^DICF6(301,"","","",$TR(DIFLAGS,"fglpqtuv")) . I $O(@DIROOT@("A["))="" S DIFLAGS=DIFLAGS_"u" I8 . ; forced indexes . S DIFORCE=$G(DIFORCE) . I "*"[DIFORCE S DIFORCE=0,DIFORCE(0)="*" . E I DIFORCE="#" S DIFORCE=0,DIFORCE(0)="#",DIFLAGS=DIFLAGS_"u" . E D I DIFAIL D ERR^DICF6(202,"","","","Indexes") Q . . S DIFORCE(0)=$G(DIFORCE) . . I $P(DIFORCE(0),U)="" S DIFAIL=1 Q . . S DIFLAGS=DIFLAGS_"M" . . S DIFORCE=1 I9 . ; rest . I DICOUNT("MAX")'="*" D Q:DIFAIL . . I DICOUNT("MAX")\1=DICOUNT("MAX"),DICOUNT("MAX")>0 Q . . S DIFAIL=1 D ERR^DICF6(202,"","","","Number") . S DISCREEN=$G(DISCREEN) . S DID=$G(DID) HOOK75 N DIHOOK75,DIOUT S DIHOOK75=$G(^DD(DIFILE,.01,7.5)) S DIOUT=0 I DIHOOK75'="",U'[DIVALUE,DIVALUE'?."?" D I DIOUT D CLOSE Q . N %,D,DIC,X,Y,Y1 . S D=DIFORCE(0) . S DIC=DIFILE . S DIC(0)=$TR(DIFLAGS,"fglpqtuv") . S X=DIVALUE . M Y=DIEN S Y="" . S Y1=DIEN . X DIHOOK75 I '$D(X)!$G(DIERR) S DIOUT=1 D:$G(DIERR) Q . . D ERR^DICF6(120,DIFILE,"",.01,"Pre-lookup Transform (7.5 node)") . S DIVALUE=X . I $G(DIC("S"))'="" S DISCREEN=DIC("S") . I $G(DIC("V"))'="" S DISCREEN("V")=DIC("V") LOOKUP N DIDENT I DIFLAGS'["f" D I $G(DIERR) D CLOSE Q . D IDENTS^DICU1(DIFILE,.01,.DIROOT,DIFLDS,DID,.DIDENT) I DIFLAGS'["p" D SPECIAL^DICF1(DIFILE,.DIEN,DIFLAGS,.DIROOT,DIVALUE,DIFORCE(0),.DICOUNT,.DIFAIL,.DISCREEN,.DIDENT,.DIOUT,.DILIST) I DIOUT D CLOSE Q I DIFLAGS["t" D . D XFORM^DICF1(.DIFLAGS,.DIVALUE,.DISCREEN,.DILVA,.DILIST) I DIFLAGS["u" ;D UPRIGHT^DICF4(DIFILE,.DIEN,.DIFLAGS,.DIROOT,.DIVALUE,.DICOUNT,.DISCREEN,.DIDENT,.DILIST) I 1 E D CHKALL^DICF2(DIFILE,.DIEN,DIFLAGS,.DIROOT,.DIVALUE,.DICOUNT,.DISCREEN,.DIFORCE,.DIDENT,.DILIST) D CLOSE Q CLOSE ; cleanup I $G(DIMSGA)'="" D CALLOUT^DIEFU(DIMSGA) I '$G(DIERR),DIFLAGS'["p" S @DILIST@(0)=DICOUNT_U_DICOUNT("MAX")_U_DICOUNT("MORE") I DILIST'="" K @DILIST@("B") K ^TMP("DILVA",$J,DILIST(0)) I DILIST(0)=1 K ^TMP("DILVA",$J) S DILIST("C")=DICOUNT Q