Return to DICL.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DICL.m, revision 1.1

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