DICF ;SEA/TOAD,SF/TKW-VA FileMan: Finder, Part 1 (Main) ;3/13/00 10:10 ;;22.0;VA FileMan;**20,31**;Mar 30, 1999 ;Per VHA Directive 10-93-142, this routine should not be modified. FIND(DIFILE,DIFIEN,DIFIELDS,DIFLAGS,DIVALUE,DINUMBER,DIFORCE,DISCREEN,DIWRITE,DILIST,DIMSGA,DINDEX,DIC,DIY,DIYX) ; ; ENTRY POINT--silent selecter ; FINDX ; branch in from FIND^DIC I '$D(DIQUIET),$G(DIC(0))'["E" N DIQUIET S DIQUIET=1 I '$D(DIFM) N DIFM S DIFM=1 D INIZE^DIEFU N DICLERR S DICLERR=$G(DIERR) K DIERR N DIEN,DIFAIL M DIEN=DIVALUE N DIVALUE M DIVALUE=DIEN K DIEN N DIDENT S DIDENT(-1)=+$G(DILIST("C")) ; INPUT ; Verify correctness of input parameters S DIFLAGS=$G(DIFLAGS) I DIFLAGS'["l" N DINDEX S DINDEX("WAY")=1 S DIFAIL=0 D I DIFAIL D CLOSE Q I0 . ; flags . I DIFLAGS["p" S DIFLAGS=DIFLAGS_"f" . I DIFLAGS'["p" D Q:DIFAIL . . I $G(DIFIELDS)["IX",DIFIELDS'["-IX" D . . . N D S D=";"_DIFIELDS_";" I D'[";IX;",D'[";IXE",D'[";IXIE" Q . . . S DIDENT(-5)=1 Q . . S DIFLAGS=DIFLAGS_4 . . I DIFLAGS["O",DIFLAGS["X" S DIFLAGS=$TR(DIFLAGS,"O") . . S DIFLAGS=DIFLAGS_"t" I1 . . ; value . . I DIFLAGS'["l" N DIERRM D I DIFAIL D ERR^DICF4(202,"","","",DIERRM) Q . . . S DIERRM="Lookup values" . . . I $G(DIVALUE(1))="" S DIVALUE(1)=$G(DIVALUE) . . . N I,DIEND S DIFAIL=1,DIEND=$O(DIVALUE(999999),-1) . . . F I=1:1:DIEND S DIVALUE(I)=$G(DIVALUE(I)) I DIVALUE(I)]"" S DIFAIL=$$BADVAL(DIVALUE(I)) Q:DIFAIL . . . Q . . Q I2 . ; target_root . S DILIST=$G(DILIST) . I DILIST'="",DIFLAGS'["l" D . . I DIFLAGS'["p" K @DILIST . . I DIFLAGS'["f" S DILIST=$NA(@DILIST@("DILIST")) . . Q . I DILIST="" S DILIST="^TMP(""DILIST"",$J)" K @DILIST I3 . ; file and screens . D:DIFLAGS'["v"&(DIFLAGS'["l") FILE^DICUF(.DIFILE,.DIFIEN,DIFLAGS) . I $G(DIERR) S DIFAIL=1 Q . D SCREEN^DICUF(DIFLAGS,.DIFILE,.DISCREEN) . D DA^DILF(DIFIEN,.DIEN) I4 . ; fields . S DIFIELDS=$G(DIFIELDS) I5 . ; flags again . I DIFLAGS'["p",DIFLAGS'["l" D Q:DIFAIL . . I $TR(DIFLAGS,"ABCKMOPQSUXfglpqtv4")'="" S DIFAIL=1 D Q . . . D ERR^DICF4(301,"","","",$TR(DIFLAGS,"fglpqtv4")) Q . . Q I6 . ; determine starting index. . I DIFLAGS'["l" D Q:DIFAIL . . S DIFORCE=$G(DIFORCE),DIFORCE(1)=1 . . I "*"[DIFORCE D . . . I DIFLAGS["M" S DIFORCE=0,DIFORCE(0)="*" Q . . . S DIFORCE(0)=$$DINDEX^DICL(DIFILE,DIFLAGS),DIFORCE=1 Q . . E D I DIFAIL D ERR^DICF4(202,"","","","Indexes") Q . . . I $P(DIFORCE,U)="" S DIFAIL=1 Q . . . S DIFORCE(0)=DIFORCE,DIFORCE=1 . . . I $P(DIFORCE(0),U,2)]"",DIFLAGS'["M" S DIFLAGS=DIFLAGS_"M" . . . Q . . I DIFORCE S DINDEX=$P(DIFORCE(0),U) Q . . S DINDEX=$$DINDEX^DICL(DIFILE,DIFLAGS) Q I7 . ; rest . I DIFLAGS'["p",DIFLAGS'["l" D Q:DIFAIL . . S DINUMBER=$S($G(DINUMBER):DINUMBER,1:"*") . . I DINUMBER'="*" D Q:DIFAIL . . . I DINUMBER\1=DINUMBER,DINUMBER>0 Q . . . S DIFAIL=1 D ERR^DICF4(202,"","","","Number") . . . Q . . Q . S DIWRITE=$G(DIWRITE) . Q I8 I DIFLAGS["P" S DIDENT(-3)="" S DIDENT(-1,"JUST LOOKING")=0,DIDENT(-1,"MAX")=DINUMBER,DIDENT(-1,"MORE?")=0 N DIOUT S DIOUT=0 ; HOOK75 ; N DIHOOK75 S DIHOOK75=$G(^DD(DIFILE,.01,7.5)) I DIHOOK75'="",DIVALUE(1)]"",DIVALUE(1)'?."?",'$O(DIVALUE(1)),DIFLAGS'["l" D I DIOUT D CLOSE Q . I DIFLAGS["p" N DIC D . . S DIC=DIFILE,DIC(0)=$TR(DIFLAGS,"2^fglpqtv4") Q . N %,D,X,Y,Y1 . S X=DIVALUE(1),D=DINDEX . M Y=DIEN S Y="",Y1=DIFIEN . X DIHOOK75 I '$D(X)!$G(DIERR) S DIOUT=1 D:$G(DIERR) Q . . S %=$$EZBLD^DIALOG(8090) . . D ERR^DICF4(120,DIFILE,"",.01,%) . S DIVALUE(1)=X,DIOUT=$$BADVAL(DIVALUE(1)) Q:DIOUT . I $G(DIC("S"))'="" S DISCREEN("S")=DIC("S") . I $G(DIC("V"))'="" S (DISCREEN("V"),DISCREEN("V",1))=DIC("V") ; LOOKUP ; I DIFLAGS'["l" D I DIOUT!($G(DIERR)) D CLOSE Q . D INDEX^DICUIX(.DIFILE,DIFLAGS,.DINDEX,"",.DIVALUE,DINUMBER,.DISCREEN,DILIST,.DIOUT) Q I '$D(DINDEX("MAXSUB")) D . S DINDEX("MAXSUB")=$P($G(^DD("OS",+$G(^DD("OS")),0)),U,7) . I DINDEX("MAXSUB") S DINDEX("MAXSUB")=DINDEX("MAXSUB")-13 Q . S DINDEX("MAXSUB")=50 Q I $D(DISCREEN("V")) D VPDATA^DICUF(.DINDEX,.DISCREEN) I (DINDEX'="#")!($O(DIVALUE(1))) D CHKVAL1^DIC0(DINDEX("#"),.DIVALUE,DIFLAGS) I $G(DIERR) D CLOSE Q I DIFLAGS'["f" D I $G(DIERR) D CLOSE Q . D IDENTS^DICU1(DIFLAGS,.DIFILE,DIFIELDS,DIWRITE,.DIDENT,.DINDEX) . Q I DIFLAGS'["p",DIFLAGS'["l" D I DIOUT!($G(DIERR)) D CLOSE Q . N I F I=2:1:DINDEX("#") Q:$G(DIVALUE(I))]"" . Q:$G(DIVALUE(I))]"" . D SPECIAL^DICF1(.DIFILE,.DIEN,DIFIEN,DIFLAGS,DIVALUE(1),.DINDEX,.DISCREEN,.DIDENT,.DIOUT,.DILIST) . Q I DIFLAGS["t" D XFORM^DICF1(.DIFLAGS,.DIVALUE,.DISCREEN,.DINDEX) I DINDEX("#")>1,DIVALUE(1)="" N S M S=DISCREEN N DISCREEN M DISCREEN=S K S D . I DIFIELDS["IX",DIFIELDS'["-IX" Q . N DISAVMAX S DISAVMAX=DINDEX("MAXSUB") . D ALTIDX^DICF0(.DINDEX,.DIFILE,.DIVALUE,.DISCREEN,DINUMBER) . S DINDEX("MAXSUB")=DISAVMAX Q D CHKALL^DICF2(.DIFILE,.DIEN,DIFIEN,.DIFLAGS,.DIVALUE,.DISCREEN,DINUMBER,.DIFORCE,.DINDEX,.DIDENT,.DILIST,.DIC,.DIY,.DIYX) D CLOSE Q ; BADVAL(DIVALUE) ; Check for invalid characters in value I "^"[DIVALUE Q 1 I DIVALUE'?.ANP D ERR^DICF4(204,"","","",DIVALUE) Q 1 Q 0 CLOSE ; ; cleanup I $G(DIMSGA)'="" D CALLOUT^DIEFU(DIMSGA) I DICLERR'=""!$G(DIERR) D . I DIFLAGS["l",+DIERR=1 Q . S DIERR=$G(DIERR)+DICLERR_U_($P($G(DIERR),U,2)+$P(DICLERR,U,2)) I $G(DIERR) D Q . Q:$G(DILIST)="" K @DILIST@("B") Q I DIFLAGS["p" S @DILIST=DIDENT(-1) Q Q:DIFLAGS["l" S @DILIST@(0)=DIDENT(-1)_U_DIDENT(-1,"MAX")_U_DIDENT(-1,"MORE?")_U_$S(DIFLAGS[2:"H",1:"") I DIFLAGS["P" S @DILIST@(0,"MAP")=$G(DIDENT(-3)) E D SETMAP^DICL1(.DIDENT,DILIST) K @DILIST@("B") Q ; ; Error messages: ; 120 The previous error occurred when performin ; 202 The input parameter that identifies the |1 ; 204 The input value contains control character ; 301 The passed flag(s) '|1|' are unknown or in ; 8090 Pre-lookup transform (7.5 node) ; 8093 Too many lookup values for this index. ; 8094 Not enough lookup values provided for an e ; 8095 Only one compound index allowed on a looku ;