Return to DICL2.m CVS log

Up to [Coherent Logic Development] / freem_fileman / USER

Restructure repository

    1: DICL2	;SEA/TOAD-VA FileMan: Lookup: Lister, Part 3 ;11/28/94  18:40 ;
    2: 	;;21.0;VA FileMan;;Dec 28, 1994
    3: 	;Per VHA Directive 10-93-142, this routine should not be modified.
    4: 	
    5: LIST	
    6: 	F  D  Q:DIOUT1!$G(DIERR)
    7: 	. ; I $G(ZRT) S ZRT(ZRT)="LOOP "_(ZRT-2)_"^"_$ZH,ZRT=ZRT+1
    8: 	. I 'DIUSEFRM S DIENTRY=$O(@DIROOT@(DINDEX,DIENTRY),DINDEX("WAY"))
    9: 	. S DIUSEFRM=0
   10: 	. D  I DIOUT1 Q:'DICOUNT("MORE?")  D MORE D  Q:DIOUT1
   11: 	. . I DIENTRY="" S DIOUT1=1 Q
   12: 	. . I $E(DIENTRY,1,DIPARTL)'=DIPART S DIENTRY="",DIOUT1=1 Q
   13: 	. . I DITO'="",DITOIN="",DITO']]DIENTRY S DIENTRY="",DIOUT1=1 Q
   14: 	. I DIFLAGS'["p" S DIEN=DIFROM("IEN"),DIFROM("IEN")=""
   15: 	. S DIOUT2=0
   16: RECORDS	.
   17: 	. F  D  Q:DIOUT2!$G(DIERR)
   18: 	. . S DIEN=$O(@DIROOT@(DINDEX,DIENTRY,DIEN),DINDEX("WAY"))
   19: 	. . I DIEN="" S DIOUT2=1 Q
   20: 	. . I DIFLAGS'["p",DITOIN'="",DITO=DIENTRY,DIEN'<DITOIN D  Q
   21: 	. . . S DIEN="",DIENTRY="",DIOUT1=1,DIOUT2=1 Q
   22: 	. . I DIFLAGS["p" D
   23: 	. . . D BACKTRAK^DICL3(.DIFILE,DIEN,DIFILE("STACK"))
   24: 	. . E  D CONSIDER
   25: MAX	. 
   26: 	. Q:$G(DIERR)
   27: 	. I DICOUNT=DICOUNT("MAX"),'DICOUNT("JUST LOOKING") S DIOUT1=1
   28: 	Q
   29: 	
   30: MORE	; ENTRIES--for numeric partials, continue down into string subscripts
   31: 	; . . .that start with the numeric value
   32: 	S DIOUT1=0,DICOUNT("MORE?")=0
   33: 	I DINDEX("WAY")=1 S DIENTRY=$O(@DIROOT@(DINDEX,DIPART_" "),-1)
   34: 	E  S DIENTRY=DIPART+$S($E(DIPART)="-":-1,1:1)
   35: 	S DIENTRY=$O(@DIROOT@(DINDEX,DIENTRY),DINDEX("WAY"))
   36: 	Q
   37: 	
   38: SCREEN(DIFILE,DIEN,DIFLAGS,DIROOT,DIFIEN,DISCREEN,DICALSCR,DIFILSCR,DINDEX)	
   39: 	I '$$VMINUS9^DIEFU(DIFILE,","_DIEN_DIFIEN) Q 1
   40: 	I $P($G(@DIROOT@(DIEN,0)),U)="" Q 1
   41: 	
   42: S1	N DISKIP S DISKIP=0
   43: 	N DISCR
   44: 	I DISCREEN F DISCR="DIFILSCR","DICALSCR" I @DISCR'="" D  Q:DISKIP
   45: 	. N %,D S D=DINDEX
   46: 	. N DIC S DIC=DIROOT("O"),DIC(0)=$TR(DIFLAGS,"fpq")
   47: 	. N Y M Y=DIEN
   48: 	. N Y1 S Y1=DIEN_DIFIEN
   49: 	. N X S X=$G(@DIROOT@(DIEN,0)),X=""
   50: 	. I 1 X @DISCR S DISKIP='$T
   51: 	. I $G(DIERR) D
   52: 	. . S DIFLAGS=DIFLAGS_"q",DISKIP=1
   53: 	. . N DICONTXT
   54: 	. . S DICONTXT=$S(DISCR["F":"Whole File Screen",1:"Screen Parameter")
   55: 	. . D ERR^DICF6(120,DIFILE,DIEN,"",DICONTXT)
   56: 	Q DISKIP
   57: 	
   58: ACCEPT(DIFILE,DIEN,DIFLAGS,DIROOT,DIFIEN,DIENTRY,DICOUNT,DINDEX,DIDENT,DILIST)	
   59: 	I DICOUNT("JUST LOOKING") D  Q
   60: 	. S DIENTRY=DICOUNT("LAST ENTRY")
   61: 	. S DIEN=DICOUNT("LAST IEN")
   62: 	. S DICOUNT("JUST LOOKING")=0
   63: 	. S DICOUNT("MORE?")=1
   64: 	. S DIOUT2=1
   65: 	
   66: A1	S DICOUNT=DICOUNT+1
   67: 	I DICOUNT=DICOUNT("MAX") D
   68: 	. S DICOUNT("LAST ENTRY")=DIENTRY
   69: 	. S DICOUNT("LAST IEN")=DIEN
   70: 	. S DICOUNT("JUST LOOKING")=1
   71: 	
   72: A2	S DILIST("ORDER")=DILIST("ORDER")+DINDEX("WAY")
   73: 	
   74: A3	I DIFLAGS'["p" D  Q:$G(DIERR)
   75: 	. I DIFILE("INDEX")'=DIFILE N DIENS D  Q:$G(DIERR)
   76: 	. . S DIEN("SAVE")=DIEN
   77: 	. . S DIEN=$$IENS(DIROOT,DINDEX,DIENTRY,DIEN)
   78: 	. . S DIROOT("SAVE")=DIROOT
   79: 	. . S DIROOT=$$ROOT^DIQGU(DIFILE("INDEX"),DIEN,1,1) Q:$G(DIERR)
   80: 	. S @("DIVAL="_DINDEX("GET"))
   81: 	. I DIFLAGS'["I" S DIVAL=$$FORMAT^DICU2(DIFILE("INDEX"),DINDEX("FIELD"),"K",DIVAL,DINDEX("TYPE"),DINDEX("CODE"),.DIENTRY)
   82: 	. I DIFILE("INDEX")'=DIFILE S DIROOT=DIROOT("SAVE"),DIEN=DIEN("SAVE")
   83: 	E  D
   84: 	. S DIVAL=DIENTRY
   85: 	. I DIFLAGS'["I" S DIVAL=$$FORMAT^DICU2(DIFILE,DINDEX("END","FIELD"),"K",DIVAL,DINDEX("END","TYPE"),DINDEX("END","CODE"),.DIENTRY)
   86: 	
   87: A4	S @DILIST@(1,DILIST("ORDER"))=DIVAL
   88: 	I DINDEX'="#" S @DILIST@(2,DILIST("ORDER"))=DIEN
   89: 	I DIFLAGS["f" Q
   90: 	
   91: A5	S DIEN=DIEN_DIFIEN
   92: 	D IDS^DICU2(DIFILE,.DIEN,DIFLAGS_(DIFLAGS["I"),"",.DIROOT,.DINDEX,DILIST("ORDER"),.DIDENT,DILIST)
   93: 	S DIEN=+DIEN
   94: 	Q
   95: 	
   96: CONSIDER	
   97: 	; consider an entry. if not screened, add to list
   98: 	Q:$$SCREEN(DIFILE,.DIEN,DIFLAGS,.DIROOT,DIFIEN,DISCREEN,DICALSCR,DIFILSCR,DINDEX)
   99: 	D ACCEPT(.DIFILE,.DIEN,DIFLAGS,.DIROOT,DIFIEN,.DIENTRY,.DICOUNT,.DINDEX,.DIDENT,.DILIST)
  100: 	Q
  101: 	
  102: IENS(DIROOT,DINDEX,DIENTRY,DIEN)	
  103: 	; return the IENS for a whole file index entry
  104: 	N DIENS,DIENSUB
  105: 	S DIENS=DIEN_",",DIENSUB=""
  106: 	S DIROOT=$NA(@DIROOT@(DINDEX,DIENTRY,DIEN))
  107: 	F  D  Q:DIENSUB=""
  108: 	. S DIENSUB=$O(@DIROOT@(DIENSUB)) Q:DIENSUB=""
  109: 	. S DIENS=DIENSUB_","_DIENS
  110: 	. S DIROOT=$NA(@DIROOT@(DIENSUB))
  111: 	Q DIENS
  112: