Return to DICL.m CVS log

Up to [Coherent Logic Development] / freem_fileman / USER

Restructure repository

    1: DICL	;SEA/TOAD-VA FileMan: Lookup: Lister ;10/18/94  12:02 ;
    2: 	;;21.0;VA FileMan;;Dec 28, 1994
    3: 	;Per VHA Directive 10-93-142, this routine should not be modified.
    4: 	
    5: LIST(DIFILE,DIFIEN,DIFIELDS,DIFLAGS,DINUMBER,DIFROM,DIPART,DINDEX,DICALSCR,DIWRITE,DILIST,DIMSGA)	
    6: 	; ENTRY POINT--return a list of entries from a file
    7: 	; proc, DIFROM may be passed by ref
    8: 	
    9: IN	; Branch point from LIST^DIC
   10: 	I '$D(DIQUIET) N DIQUIET S DIQUIET=1
   11: 	I '$D(DIFM) N DIFM S DIFM=1 D INIZE^DIEFU
   12: 	
   13: INPUT	
   14: 	N DIERN,DIPE
   15: 	S DIFLAGS=$G(DIFLAGS)
   16: 	S DIFIELDS=$G(DIFIELDS)
   17: 	S DINUMBER=$G(DINUMBER) I DINUMBER="" S DINUMBER="*"
   18: 	S DIPART=$G(DIPART)
   19: 	S DIFROM=$G(DIFROM)
   20: 	S DIFROM("IEN")=$G(DIFROM("IEN"))
   21: 	S DINDEX("WAY")=1 I DIFLAGS["B" S DINDEX("WAY")=-1
   22: 	S DINDEX=$G(DINDEX,"B"),DINDEX=$S(DINDEX?1U.UNP:DINDEX,1:"B")
   23: 	S DICALSCR=$G(DICALSCR)
   24: 	S DIWRITE=$G(DIWRITE)
   25: 	
   26: OUTPUT	
   27: 	I DIFLAGS'["f" D  Q:$G(DIERR)
   28: 	. I $G(DIMSGA)'="" D
   29: 	. . K @DIMSGA@("DIERR"),@DIMSGA@("DIHELP"),@DIMSGA@("DIMSG")
   30: 	. I $G(DILIST)'="" D  Q:$G(DIERR)
   31: 	. . I DILIST'?.1"^"1U.7UN.ANP,DILIST'?.1"^%".7UN.ANP D  Q
   32: 	. . . D BLD^DIALOG(202,"target array")
   33: 	. . S DILIST=$NA(@DILIST@("DILIST"))
   34: 	. . Q
   35: 	. E  S DILIST="^TMP(""DILIST"",$J)"
   36: 	. K @DILIST
   37: 	. Q
   38: 	
   39: FILE	
   40: 	N DIFILSCR,DINODE,DIROOT,DISCREEN
   41: 	S DIFILE=+$G(DIFILE) I 'DIFILE S DIERN=202,DIPE(1)="file" D ERROUT Q
   42: 	S DINODE=$G(^DD(DIFILE,.01,0))
   43: 	I DINODE="" D  Q
   44: 	. S DIERN=$S('$D(^DD(DIFILE)):401,1:406),DIPE("FILE")=DIFILE D ERROUT Q
   45: 	I $P(DINODE,U,2)["W" S DIERN=407,DIPE("FILE")=DIFILE D ERROUT Q
   46: 	S DIFIEN=$G(DIFIEN) I DIFIEN="" S DIFIEN=","
   47: 	I '$$IEN^DIDU1(DIFIEN) D  Q
   48: 	. I '$$IEN^DIDU1(DIFIEN_",") S DIERN=202,DIPE(1)="IENS" D ERROUT Q
   49: F1	. E  S DIERN=304,DIPE("IENS")=DIFIEN D ERROUT Q
   50: 	I $P(DIFIEN,",")'="" S DIERN=306,DIPE("IENS")=DIFIEN D ERROUT Q
   51: 	S DIROOT=$$ROOT^DIQGU(DIFILE,DIFIEN,1,1) I $G(DIERR) D OUT Q
   52: 	I DIROOT'?1"^"1U.7UN.ANP,DIROOT'?1"^%".7UN.ANP D  Q
   53: 	. S DIERN=402
   54: 	. S DIPE("FILE")=DIFILE
   55: 	. S DIPE("IEN")=DIFIEN
   56: 	. S DIPE("ROOT")=DIROOT
   57: 	. D ERROUT
   58: 	. Q
   59: 	S DIROOT("O")=$$OREF^DIQGU(DIROOT)
   60: 	S DIFILSCR=$G(^DD(DIFILE,0,"SCR"))
   61: 	I $P($G(@DIROOT@(0)),U,2)'["s" S DIFILSCR=""
   62: 	S DISCREEN=DIFILSCR'=""!(DICALSCR'="")
   63: 	
   64: CHECKS	
   65: 	N DIFROML,DILAST,DIOUT,DIPARTL,DIUSEFRM
   66: 	I $TR(DIFLAGS,"BIf")'="" S DIERN=301,DIPE(1)=DIFLAGS D ERROUT Q
   67: 	S DIPARTL=$L(DIPART)
   68: 	S DIUSEFRM=DIFROM("IEN")'=""
   69: 	I DINUMBER'="*",DINUMBER<1!(DINUMBER\1'=DINUMBER) D  Q
   70: 	. S DIERN=202,DIPE(1)="Number" D ERROUT
   71: 	S DIOUT=0
   72: 	I DIPART'="",$E(DIFROM,1,DIPARTL)'=DIPART D
   73: 	. S DIOUT=0
   74: 	. I DINDEX("WAY")=1 D  Q
   75: 	. . I DIFROM]](DIPART_$S(+DIPART=DIPART:" ",1:"")) S DIOUT=1 Q
   76: 	. . S DIFROM=DIPART_$S(+DIPART'=DIPART:"",DIFROM']]DIPART:"",1:" ")
   77: 	. . S DIUSEFRM=1
   78: 	. . Q
   79: C1	. ; I DINDEX("WAY")=-1
   80: 	. I DIFROM'="",DIPART]]DIFROM S DIOUT=1 Q
   81: 	. I +DIPART'=DIPART D  Q
   82: 	. . S DIFROM=DIPART
   83: 	. . S DIFROML=$L(DIFROM)
   84: 	. . S DILAST=$E(DIFROM,DIFROML)
   85: 	. . S DILAST=$C($A(DILAST)+1)
   86: 	. . S $E(DIFROM,DIFROML)=DILAST
   87: 	. . Q
   88: 	. S DIFROM=$S(DIFROM="":" ",DIFROM]](DIPART_" "):" ",1:"")
   89: 	. S DIFROM=DIPART+$S($E(DIPART)="-":-1,1:1)_DIFROM
   90: 	. Q
   91: 	I DIOUT S @DILIST@(0)="0^"_DINUMBER_"^0" Q
   92: 	
   93: IXANDID	
   94: 	N DIDENT
   95: 	D BOTH^DICU1(.DIFILE,DIFLAGS,DIROOT,.DINDEX,DIFIELDS,DIWRITE,.DIDENT)
   96: 	I $G(DIERR) D OUT Q
   97: 	
   98: BRANCH	
   99: 	; I $G(ZRT) S ZRT(ZRT)="BRANCH^"_$ZH,ZRT=ZRT+1
  100: 	G PREP^DICL1
  101: 	
  102: ERR	D BLD^DIALOG(DIERN,.DIPE,.DIPE) S DIFROM="",DIFROM("IEN")="" Q
  103: 	
  104: ERROUT	D ERR,OUT Q
  105: 	
  106: OUT	D CALLOUT^DIEFU($G(DIMSGA)):$G(DIMSGA)'="" Q
  107: