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

DICF.m

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