Return to DICL2.m CVS log

Up to [Coherent Logic Development] / freem_fileman / USER

Restructure repository

DICL2	;SEA/TOAD-VA FileMan: Lookup: Lister, Part 3 ;11/28/94  18:40 ;
	;;21.0;VA FileMan;;Dec 28, 1994
	;Per VHA Directive 10-93-142, this routine should not be modified.
	
LIST	
	F  D  Q:DIOUT1!$G(DIERR)
	. ; I $G(ZRT) S ZRT(ZRT)="LOOP "_(ZRT-2)_"^"_$ZH,ZRT=ZRT+1
	. I 'DIUSEFRM S DIENTRY=$O(@DIROOT@(DINDEX,DIENTRY),DINDEX("WAY"))
	. S DIUSEFRM=0
	. D  I DIOUT1 Q:'DICOUNT("MORE?")  D MORE D  Q:DIOUT1
	. . I DIENTRY="" S DIOUT1=1 Q
	. . I $E(DIENTRY,1,DIPARTL)'=DIPART S DIENTRY="",DIOUT1=1 Q
	. . I DITO'="",DITOIN="",DITO']]DIENTRY S DIENTRY="",DIOUT1=1 Q
	. I DIFLAGS'["p" S DIEN=DIFROM("IEN"),DIFROM("IEN")=""
	. S DIOUT2=0
RECORDS	.
	. F  D  Q:DIOUT2!$G(DIERR)
	. . S DIEN=$O(@DIROOT@(DINDEX,DIENTRY,DIEN),DINDEX("WAY"))
	. . I DIEN="" S DIOUT2=1 Q
	. . I DIFLAGS'["p",DITOIN'="",DITO=DIENTRY,DIEN'<DITOIN D  Q
	. . . S DIEN="",DIENTRY="",DIOUT1=1,DIOUT2=1 Q
	. . I DIFLAGS["p" D
	. . . D BACKTRAK^DICL3(.DIFILE,DIEN,DIFILE("STACK"))
	. . E  D CONSIDER
MAX	. 
	. Q:$G(DIERR)
	. I DICOUNT=DICOUNT("MAX"),'DICOUNT("JUST LOOKING") S DIOUT1=1
	Q
	
MORE	; ENTRIES--for numeric partials, continue down into string subscripts
	; . . .that start with the numeric value
	S DIOUT1=0,DICOUNT("MORE?")=0
	I DINDEX("WAY")=1 S DIENTRY=$O(@DIROOT@(DINDEX,DIPART_" "),-1)
	E  S DIENTRY=DIPART+$S($E(DIPART)="-":-1,1:1)
	S DIENTRY=$O(@DIROOT@(DINDEX,DIENTRY),DINDEX("WAY"))
	Q
	
SCREEN(DIFILE,DIEN,DIFLAGS,DIROOT,DIFIEN,DISCREEN,DICALSCR,DIFILSCR,DINDEX)	
	I '$$VMINUS9^DIEFU(DIFILE,","_DIEN_DIFIEN) Q 1
	I $P($G(@DIROOT@(DIEN,0)),U)="" Q 1
	
S1	N DISKIP S DISKIP=0
	N DISCR
	I DISCREEN F DISCR="DIFILSCR","DICALSCR" I @DISCR'="" D  Q:DISKIP
	. N %,D S D=DINDEX
	. N DIC S DIC=DIROOT("O"),DIC(0)=$TR(DIFLAGS,"fpq")
	. N Y M Y=DIEN
	. N Y1 S Y1=DIEN_DIFIEN
	. N X S X=$G(@DIROOT@(DIEN,0)),X=""
	. I 1 X @DISCR S DISKIP='$T
	. I $G(DIERR) D
	. . S DIFLAGS=DIFLAGS_"q",DISKIP=1
	. . N DICONTXT
	. . S DICONTXT=$S(DISCR["F":"Whole File Screen",1:"Screen Parameter")
	. . D ERR^DICF6(120,DIFILE,DIEN,"",DICONTXT)
	Q DISKIP
	
ACCEPT(DIFILE,DIEN,DIFLAGS,DIROOT,DIFIEN,DIENTRY,DICOUNT,DINDEX,DIDENT,DILIST)	
	I DICOUNT("JUST LOOKING") D  Q
	. S DIENTRY=DICOUNT("LAST ENTRY")
	. S DIEN=DICOUNT("LAST IEN")
	. S DICOUNT("JUST LOOKING")=0
	. S DICOUNT("MORE?")=1
	. S DIOUT2=1
	
A1	S DICOUNT=DICOUNT+1
	I DICOUNT=DICOUNT("MAX") D
	. S DICOUNT("LAST ENTRY")=DIENTRY
	. S DICOUNT("LAST IEN")=DIEN
	. S DICOUNT("JUST LOOKING")=1
	
A2	S DILIST("ORDER")=DILIST("ORDER")+DINDEX("WAY")
	
A3	I DIFLAGS'["p" D  Q:$G(DIERR)
	. I DIFILE("INDEX")'=DIFILE N DIENS D  Q:$G(DIERR)
	. . S DIEN("SAVE")=DIEN
	. . S DIEN=$$IENS(DIROOT,DINDEX,DIENTRY,DIEN)
	. . S DIROOT("SAVE")=DIROOT
	. . S DIROOT=$$ROOT^DIQGU(DIFILE("INDEX"),DIEN,1,1) Q:$G(DIERR)
	. S @("DIVAL="_DINDEX("GET"))
	. I DIFLAGS'["I" S DIVAL=$$FORMAT^DICU2(DIFILE("INDEX"),DINDEX("FIELD"),"K",DIVAL,DINDEX("TYPE"),DINDEX("CODE"),.DIENTRY)
	. I DIFILE("INDEX")'=DIFILE S DIROOT=DIROOT("SAVE"),DIEN=DIEN("SAVE")
	E  D
	. S DIVAL=DIENTRY
	. I DIFLAGS'["I" S DIVAL=$$FORMAT^DICU2(DIFILE,DINDEX("END","FIELD"),"K",DIVAL,DINDEX("END","TYPE"),DINDEX("END","CODE"),.DIENTRY)
	
A4	S @DILIST@(1,DILIST("ORDER"))=DIVAL
	I DINDEX'="#" S @DILIST@(2,DILIST("ORDER"))=DIEN
	I DIFLAGS["f" Q
	
A5	S DIEN=DIEN_DIFIEN
	D IDS^DICU2(DIFILE,.DIEN,DIFLAGS_(DIFLAGS["I"),"",.DIROOT,.DINDEX,DILIST("ORDER"),.DIDENT,DILIST)
	S DIEN=+DIEN
	Q
	
CONSIDER	
	; consider an entry. if not screened, add to list
	Q:$$SCREEN(DIFILE,.DIEN,DIFLAGS,.DIROOT,DIFIEN,DISCREEN,DICALSCR,DIFILSCR,DINDEX)
	D ACCEPT(.DIFILE,.DIEN,DIFLAGS,.DIROOT,DIFIEN,.DIENTRY,.DICOUNT,.DINDEX,.DIDENT,.DILIST)
	Q
	
IENS(DIROOT,DINDEX,DIENTRY,DIEN)	
	; return the IENS for a whole file index entry
	N DIENS,DIENSUB
	S DIENS=DIEN_",",DIENSUB=""
	S DIROOT=$NA(@DIROOT@(DINDEX,DIENTRY,DIEN))
	F  D  Q:DIENSUB=""
	. S DIENSUB=$O(@DIROOT@(DIENSUB)) Q:DIENSUB=""
	. S DIENS=DIENSUB_","_DIENS
	. S DIROOT=$NA(@DIROOT@(DIENSUB))
	Q DIENS