source: WorldVistAEHR/trunk/r/VA_FILEMAN-ARJT-DI-DD-DM-DT-%DT-%RCR/DICL2.m@ 1582

Last change on this file since 1582 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 4.0 KB
Line 
1DICL2 ;SEA/TOAD,SF/TKW-VA FileMan: Lookup: Lister, Part 3 ;12/13/99 09:17
2 ;;22.0;VA FileMan;**20**;Mar 30, 1999
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4SCREEN(DIFILE,DIEN,DIFLAGS,DIFIEN,DISCREEN,DINDEX,DI0NODE) ;
5 ;
6 ; return 1 if entry should be screened out
7 ;
8S1 ; entries tagged for archiving, or missing the .01 or already on
9 ; the list should be screened out.
10 ;
11 I DIFILE'<2,'$$VMINUS9^DIEFU(DIFILE,","_DIEN_DIFIEN) Q 1
12 I $P(DI0NODE,U)="" Q 1
13 I DIFLAGS[4 N DIREC D I 'DIREC Q 1
14 . S DIREC=DIEN I DIFLAGS["v" S DIREC=DIREC_";"_$P(DIFILE(DIFILE,"O"),U,2)
15 . I $D(@DILIST@("B",($E($P(DI0NODE,U),1,DINDEX("MAXSUB"))_"^"_DIREC))) S DIREC=0
16 . Q
17 ;
18S2 ; execute any screen on transformed lookup values
19 ;
20 N DISKIP S DISKIP=0
21 I DIFLAGS[4 N DISUB F DISUB=1:1:DINDEX("#") D Q:DISKIP
22 . N DISCR2 S DISCR2=+$G(DINDEX(DISUB,"FOUND"))
23 . Q:'$D(DISCREEN(DISUB,DISCR2))
24 . N DIVAL,D S @DINDEX(DISUB,"GET"),D=DINDEX
25 . X DISCREEN(DISUB,DISCR2) S DISKIP='$T
26 . Q
27 I DISKIP Q DISKIP
28 N DISCR
29S3 ; Additional screening for using an alternate index for loop through file.
30 I $D(DISCREEN("X")) F DISCR=0:0 S DISCR=$O(DISCREEN("X",DISCR)) Q:'DISCR D Q:DISKIP
31 . N D,DIPART,DISUB,DIVAL,X
32 . X DISCREEN("X",DISCR,"GET") I DIVAL="" S DISKIP=1 Q
33 . F DISUB=0:0 S DISUB=$O(DISCREEN("VAL",DISCR,DISUB)) Q:'DISUB D Q:'DISKIP
34 . . S D="",DISKIP=1
35 . . S DIPART=DISCREEN("VAL",DISCR,DISUB) Q:$P(DIVAL,DIPART)'=""
36 . . S X=$G(DISCREEN("X",DISCR,DISUB)) I X]"" X X Q:'$T
37 . . S DISKIP=0 Q
38 . Q
39 I DISKIP Q DISKIP
40S4 ; Execute Screen parameter, whole file screen.
41 F DISCR="F","S" I $G(DISCREEN(DISCR))'="" D Q:DISKIP
42 . N %,D S D=$G(DINDEX)
43 . N DIC S DIC=DIFILE(DIFILE,"O")
44 . I DIFLAGS[4 S DIC(0)=$TR(DIFLAGS,"2^fqlpqtuv4PQU")
45 . E S DIC(0)=$TR(DIFLAGS,"2^fpq3BIMPQ")
46 . N Y M Y=DIEN
47 . N Y1 S Y1=DIEN_DIFIEN
48 . N X S X=$G(@DIFILE(DIFILE)@(DIEN,0)),X=$P(X,U)
49 . I DIFLAGS[4,DIFLAGS["p" N I S I=DIEN
50 . D
51 . . N DIFILE,DIXV,DIY,DIYX
52 . . I 1 X DISCREEN(DISCR) S DISKIP='$T
53 .
54S5 . ; if the screen returned DIERR, id the error's source with a second
55 . ; error and exit
56 .
57 . I $G(DIERR) D
58 . . S DISKIP=1
59 . . N DICONTXT
60 . . S DICONTXT=$S(DISCR["F":"Whole File Screen",1:"Screen Parameter")
61 . . D ERR^DICF4(120,DIFILE,DIEN,"",DICONTXT)
62 Q DISKIP
63 ;
64ACCEPT(DIFILE,DIEN,DIFLAGS,DIFIEN,DINDEX,DIDENT,DILIST,DI0NODE) ;
65 ; accept an entry into the output list
66 ;
67A1 ; if we're doing the final pass (just looking to see if there are any
68 ; more entries), we don't actually add it to the list, just note what
69 ; we found and quit
70 ;
71 I DIDENT(-1,"JUST LOOKING") D Q
72 . S DIDENT(-1,"JUST LOOKING")=0
73 . S DIDENT(-1,"MORE?")=1
74 . Q:DIFLAGS[4
75 . N DISAME,I S DISAME=0
76 . F I=1:1 Q:I>DINDEX("#") D Q:DISAME<I
77 . . I DIDENT(-1,"LAST",I,"I")'=DINDEX(I) Q
78 . . S DISAME=I Q
79 . F I=1:1:(DINDEX("#")+1) K DIDENT(-1,"LAST",I,"I")
80 . Q:DISAME=DINDEX("#")
81 . F I=(DISAME+2):1:(DINDEX("#")+1) S DIDENT(-1,"LAST",I)=""
82 . S DIDENT(-1,"LAST","IEN")="" Q
83 ;
84A2 ; increment the number found; if it's the max, we flag to make the
85 ; next pass a final just looking pass
86 ;
87 S DIDENT(-1)=DIDENT(-1)+1
88 I DIDENT(-1)=DIDENT(-1,"MAX") D
89 . S DIDENT(-1,"JUST LOOKING")=1
90 . Q:DIFLAGS[4
91 . N I F I=1:1:(DINDEX("#")+1) D
92 . . S (DIDENT(-1,"LAST",I),DIDENT(-1,"LAST",I,"I"))=DINDEX(I)
93 . . I I=1,"VP"[DINDEX(I,"TYPE"),'$D(DINDEX("ROOTCNG",1)) S DIDENT(-1,"LAST",I)=DINDEX0(1)
94 . . Q
95 . S DIDENT(-1,"LAST")=DIDENT(-1,"LAST",1)
96 . S DIDENT(-1,"LAST","IEN")=DIEN
97 . Q
98 ;
99A3 ; increment (or decrement) the output list subscript
100 ;
101 S DILIST("ORDER")=$S(DIFLAGS[4:DIDENT(-1),1:DILIST("ORDER")+DINDEX("WAY"))
102 N DA M DA=DIEN
103 ;
104A4 ; output the specified values of the record
105 ;
106 I DIFLAGS'["f" D
107 . D IDS^DICU2(.DIFILE,DIEN_DIFIEN,.DIFLAGS,.DINDEX,DILIST("ORDER"),.DIDENT,DILIST,.DI0NODE)
108 . Q
109 Q:DIFLAGS'[4
110 N DIREC S DIREC=DIEN I DIFLAGS["v" S DIREC=DIREC_";"_$P(DIFILE(DIFILE,"O"),U,2)
111 I DIFLAGS["f",DIFLAGS'["p" S @DILIST@(DIDENT(-1))=DIREC
112 S @DILIST@("B",($E($P(DI0NODE,U),1,DINDEX("MAXSUB"))_U_DIREC))=""
113 Q
114 ;
115 ; Possible output messages
116 ; 202 The input parameter that identifies the |1
117 ;
Note: See TracBrowser for help on using the repository browser.