Return to DICL2.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DICL2.m, revision 1.1

1.1     ! snw         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: