Return to DICL.m CVS log

Up to [Coherent Logic Development] / freem_fileman / USER

Restructure repository

DICL	;SEA/TOAD-VA FileMan: Lookup: Lister ;10/18/94  12:02 ;
	;;21.0;VA FileMan;;Dec 28, 1994
	;Per VHA Directive 10-93-142, this routine should not be modified.
	
LIST(DIFILE,DIFIEN,DIFIELDS,DIFLAGS,DINUMBER,DIFROM,DIPART,DINDEX,DICALSCR,DIWRITE,DILIST,DIMSGA)	
	; ENTRY POINT--return a list of entries from a file
	; proc, DIFROM may be passed by ref
	
IN	; Branch point from LIST^DIC
	I '$D(DIQUIET) N DIQUIET S DIQUIET=1
	I '$D(DIFM) N DIFM S DIFM=1 D INIZE^DIEFU
	
INPUT	
	N DIERN,DIPE
	S DIFLAGS=$G(DIFLAGS)
	S DIFIELDS=$G(DIFIELDS)
	S DINUMBER=$G(DINUMBER) I DINUMBER="" S DINUMBER="*"
	S DIPART=$G(DIPART)
	S DIFROM=$G(DIFROM)
	S DIFROM("IEN")=$G(DIFROM("IEN"))
	S DINDEX("WAY")=1 I DIFLAGS["B" S DINDEX("WAY")=-1
	S DINDEX=$G(DINDEX,"B"),DINDEX=$S(DINDEX?1U.UNP:DINDEX,1:"B")
	S DICALSCR=$G(DICALSCR)
	S DIWRITE=$G(DIWRITE)
	
OUTPUT	
	I DIFLAGS'["f" D  Q:$G(DIERR)
	. I $G(DIMSGA)'="" D
	. . K @DIMSGA@("DIERR"),@DIMSGA@("DIHELP"),@DIMSGA@("DIMSG")
	. I $G(DILIST)'="" D  Q:$G(DIERR)
	. . I DILIST'?.1"^"1U.7UN.ANP,DILIST'?.1"^%".7UN.ANP D  Q
	. . . D BLD^DIALOG(202,"target array")
	. . S DILIST=$NA(@DILIST@("DILIST"))
	. . Q
	. E  S DILIST="^TMP(""DILIST"",$J)"
	. K @DILIST
	. Q
	
FILE	
	N DIFILSCR,DINODE,DIROOT,DISCREEN
	S DIFILE=+$G(DIFILE) I 'DIFILE S DIERN=202,DIPE(1)="file" D ERROUT Q
	S DINODE=$G(^DD(DIFILE,.01,0))
	I DINODE="" D  Q
	. S DIERN=$S('$D(^DD(DIFILE)):401,1:406),DIPE("FILE")=DIFILE D ERROUT Q
	I $P(DINODE,U,2)["W" S DIERN=407,DIPE("FILE")=DIFILE D ERROUT Q
	S DIFIEN=$G(DIFIEN) I DIFIEN="" S DIFIEN=","
	I '$$IEN^DIDU1(DIFIEN) D  Q
	. I '$$IEN^DIDU1(DIFIEN_",") S DIERN=202,DIPE(1)="IENS" D ERROUT Q
F1	. E  S DIERN=304,DIPE("IENS")=DIFIEN D ERROUT Q
	I $P(DIFIEN,",")'="" S DIERN=306,DIPE("IENS")=DIFIEN D ERROUT Q
	S DIROOT=$$ROOT^DIQGU(DIFILE,DIFIEN,1,1) I $G(DIERR) D OUT Q
	I DIROOT'?1"^"1U.7UN.ANP,DIROOT'?1"^%".7UN.ANP D  Q
	. S DIERN=402
	. S DIPE("FILE")=DIFILE
	. S DIPE("IEN")=DIFIEN
	. S DIPE("ROOT")=DIROOT
	. D ERROUT
	. Q
	S DIROOT("O")=$$OREF^DIQGU(DIROOT)
	S DIFILSCR=$G(^DD(DIFILE,0,"SCR"))
	I $P($G(@DIROOT@(0)),U,2)'["s" S DIFILSCR=""
	S DISCREEN=DIFILSCR'=""!(DICALSCR'="")
	
CHECKS	
	N DIFROML,DILAST,DIOUT,DIPARTL,DIUSEFRM
	I $TR(DIFLAGS,"BIf")'="" S DIERN=301,DIPE(1)=DIFLAGS D ERROUT Q
	S DIPARTL=$L(DIPART)
	S DIUSEFRM=DIFROM("IEN")'=""
	I DINUMBER'="*",DINUMBER<1!(DINUMBER\1'=DINUMBER) D  Q
	. S DIERN=202,DIPE(1)="Number" D ERROUT
	S DIOUT=0
	I DIPART'="",$E(DIFROM,1,DIPARTL)'=DIPART D
	. S DIOUT=0
	. I DINDEX("WAY")=1 D  Q
	. . I DIFROM]](DIPART_$S(+DIPART=DIPART:" ",1:"")) S DIOUT=1 Q
	. . S DIFROM=DIPART_$S(+DIPART'=DIPART:"",DIFROM']]DIPART:"",1:" ")
	. . S DIUSEFRM=1
	. . Q
C1	. ; I DINDEX("WAY")=-1
	. I DIFROM'="",DIPART]]DIFROM S DIOUT=1 Q
	. I +DIPART'=DIPART D  Q
	. . S DIFROM=DIPART
	. . S DIFROML=$L(DIFROM)
	. . S DILAST=$E(DIFROM,DIFROML)
	. . S DILAST=$C($A(DILAST)+1)
	. . S $E(DIFROM,DIFROML)=DILAST
	. . Q
	. S DIFROM=$S(DIFROM="":" ",DIFROM]](DIPART_" "):" ",1:"")
	. S DIFROM=DIPART+$S($E(DIPART)="-":-1,1:1)_DIFROM
	. Q
	I DIOUT S @DILIST@(0)="0^"_DINUMBER_"^0" Q
	
IXANDID	
	N DIDENT
	D BOTH^DICU1(.DIFILE,DIFLAGS,DIROOT,.DINDEX,DIFIELDS,DIWRITE,.DIDENT)
	I $G(DIERR) D OUT Q
	
BRANCH	
	; I $G(ZRT) S ZRT(ZRT)="BRANCH^"_$ZH,ZRT=ZRT+1
	G PREP^DICL1
	
ERR	D BLD^DIALOG(DIERN,.DIPE,.DIPE) S DIFROM="",DIFROM("IEN")="" Q
	
ERROUT	D ERR,OUT Q
	
OUT	D CALLOUT^DIEFU($G(DIMSGA)):$G(DIMSGA)'="" Q