| 1 | DICL2 ;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.
|
|---|
| 4 | SCREEN(DIFILE,DIEN,DIFLAGS,DIFIEN,DISCREEN,DINDEX,DI0NODE) ;
|
|---|
| 5 | ;
|
|---|
| 6 | ; return 1 if entry should be screened out
|
|---|
| 7 | ;
|
|---|
| 8 | S1 ; 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 | ;
|
|---|
| 18 | S2 ; 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
|
|---|
| 29 | S3 ; 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
|
|---|
| 40 | S4 ; 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 | .
|
|---|
| 54 | S5 . ; 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 | ;
|
|---|
| 64 | ACCEPT(DIFILE,DIEN,DIFLAGS,DIFIEN,DINDEX,DIDENT,DILIST,DI0NODE) ;
|
|---|
| 65 | ; accept an entry into the output list
|
|---|
| 66 | ;
|
|---|
| 67 | A1 ; 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 | ;
|
|---|
| 84 | A2 ; 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 | ;
|
|---|
| 99 | A3 ; 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 | ;
|
|---|
| 104 | A4 ; 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 | ;
|
|---|
