Annotation of freem_fileman/DICL.m, revision 1.1.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:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to DICL.m CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Coherent Logic Development] / freem_fileman