source: WorldVistAEHR/trunk/r/VA_FILEMAN-ARJT-DI-DD-DM-DT-%DT-%RCR/DICF.m@ 1474

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
 ;