Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DICL2

DICL2.m

Go to the documentation of this file. 
  1. DICL2 ;SEA/TOAD,SF/TKW-VA FileMan: Lookup: Lister, Part 3 ;12/13/99  09:17 [ 04/02/2003   8:25 AM ]
  1.  ;;22.0;VA FileMan;**1001**;APR 1, 2003
  1.  ;;22.0;VA FileMan;**20**;Mar 30, 1999
  1.  ;Per VHA Directive 10-93-142, this routine should not be modified.
  1. SCREEN(DIFILE,DIEN,DIFLAGS,DIFIEN,DISCREEN,DINDEX,DI0NODE) ;
  1.  ;
  1.  ; return 1 if entry should be screened out
  1.  ;
  1. S1 ; entries tagged for archiving, or missing the .01 or already on
  1.  ; the list should be screened out.
  1.  ;
  1.  I DIFILE'<2,'$$VMINUS9^DIEFU(DIFILE,","_DIEN_DIFIEN) Q 1
  1.  I $P(DI0NODE,U)="" Q 1
  1.  I DIFLAGS[4 N DIREC D  I 'DIREC Q 1
  1.  . S DIREC=DIEN I DIFLAGS["v" S DIREC=DIREC_";"_$P(DIFILE(DIFILE,"O"),U,2)
  1.  . I $D(@DILIST@("B",($E($P(DI0NODE,U),1,DINDEX("MAXSUB"))_"^"_DIREC))) S DIREC=0
  1.  . Q
  1.  ;
  1. S2 ; execute any screen on transformed lookup values
  1.  ;
  1.  N DISKIP S DISKIP=0
  1.  I DIFLAGS[4 N DISUB F DISUB=1:1:DINDEX("#") D  Q:DISKIP
  1.  . N DISCR2 S DISCR2=+$G(DINDEX(DISUB,"FOUND"))
  1.  . Q:'$D(DISCREEN(DISUB,DISCR2))
  1.  . N DIVAL,D S @DINDEX(DISUB,"GET"),D=DINDEX
  1.  . X DISCREEN(DISUB,DISCR2) S DISKIP='$T
  1.  . Q
  1.  I DISKIP Q DISKIP
  1.  N DISCR
  1. S3 ; Additional screening for using an alternate index for loop through file.
  1.  I $D(DISCREEN("X")) F DISCR=0:0 S DISCR=$O(DISCREEN("X",DISCR)) Q:'DISCR  D  Q:DISKIP
  1.  . N D,DIPART,DISUB,DIVAL,X
  1.  . X DISCREEN("X",DISCR,"GET") I DIVAL="" S DISKIP=1 Q
  1.  . F DISUB=0:0 S DISUB=$O(DISCREEN("VAL",DISCR,DISUB)) Q:'DISUB  D  Q:'DISKIP
  1.  . . S D="",DISKIP=1
  1.  . . S DIPART=DISCREEN("VAL",DISCR,DISUB) Q:$P(DIVAL,DIPART)'=""
  1.  . . S X=$G(DISCREEN("X",DISCR,DISUB)) I X]"" X X Q:'$T
  1.  . . S DISKIP=0 Q
  1.  . Q
  1.  I DISKIP Q DISKIP
  1. S4 ; Execute Screen parameter, whole file screen.
  1.  F DISCR="F","S" I $G(DISCREEN(DISCR))'="" D  Q:DISKIP
  1.  . N %,D S D=$G(DINDEX)
  1.  . N DIC S DIC=DIFILE(DIFILE,"O")
  1.  . I DIFLAGS[4 S DIC(0)=$TR(DIFLAGS,"2^fqlpqtuv4PQU")
  1.  . E  S DIC(0)=$TR(DIFLAGS,"2^fpq3BIMPQ")
  1.  . N Y M Y=DIEN
  1.  . N Y1 S Y1=DIEN_DIFIEN
  1.  . N X S X=$G(@DIFILE(DIFILE)@(DIEN,0)),X=$P(X,U)
  1.  . I DIFLAGS[4,DIFLAGS["p" N I S I=DIEN
  1.  . D
  1.  . . N DIFILE,DIXV,DIY,DIYX
  1.  . . I 1 X DISCREEN(DISCR) S DISKIP='$T
  1.  .
  1. S5 . ; if the screen returned DIERR, id the error's source with a second
  1.  . ; error and exit
  1.  .
  1.  . I $G(DIERR) D
  1.  . . S DISKIP=1
  1.  . . N DICONTXT
  1.  . . S DICONTXT=$S(DISCR["F":"Whole File Screen",1:"Screen Parameter")
  1.  . . D ERR^DICF4(120,DIFILE,DIEN,"",DICONTXT)
  1.  Q DISKIP
  1.  ;
  1. ACCEPT(DIFILE,DIEN,DIFLAGS,DIFIEN,DINDEX,DIDENT,DILIST,DI0NODE) ;
  1.  ; accept an entry into the output list
  1.  ;
  1. A1 ; if we're doing the final pass (just looking to see if there are any
  1.  ; more entries), we don't actually add it to the list, just note what
  1.  ; we found and quit
  1.  ;
  1.  I DIDENT(-1,"JUST LOOKING") D  Q
  1.  . S DIDENT(-1,"JUST LOOKING")=0
  1.  . S DIDENT(-1,"MORE?")=1
  1.  . Q:DIFLAGS[4
  1.  . N DISAME,I S DISAME=0
  1.  . F I=1:1 Q:I>DINDEX("#")  D  Q:DISAME<I
  1.  . . I DIDENT(-1,"LAST",I,"I")'=DINDEX(I) Q
  1.  . . S DISAME=I Q
  1.  . F I=1:1:(DINDEX("#")+1) K DIDENT(-1,"LAST",I,"I")
  1.  . Q:DISAME=DINDEX("#")
  1.  . F I=(DISAME+2):1:(DINDEX("#")+1) S DIDENT(-1,"LAST",I)=""
  1.  . S DIDENT(-1,"LAST","IEN")="" Q
  1.  ;
  1. A2 ; increment the number found; if it's the max, we flag to make the
  1.  ; next pass a final just looking pass
  1.  ;
  1.  S DIDENT(-1)=DIDENT(-1)+1
  1.  I DIDENT(-1)=DIDENT(-1,"MAX") D
  1.  . S DIDENT(-1,"JUST LOOKING")=1
  1.  . Q:DIFLAGS[4
  1.  . N I F I=1:1:(DINDEX("#")+1) D
  1.  . . S (DIDENT(-1,"LAST",I),DIDENT(-1,"LAST",I,"I"))=DINDEX(I)
  1.  . . I I=1,"VP"[DINDEX(I,"TYPE"),'$D(DINDEX("ROOTCNG",1)) S DIDENT(-1,"LAST",I)=DINDEX0(1)
  1.  . . Q
  1.  . S DIDENT(-1,"LAST")=DIDENT(-1,"LAST",1)
  1.  . S DIDENT(-1,"LAST","IEN")=DIEN
  1.  . Q
  1.  ;
  1. A3 ; increment (or decrement) the output list subscript
  1.  ;
  1.  S DILIST("ORDER")=$S(DIFLAGS[4:DIDENT(-1),1:DILIST("ORDER")+DINDEX("WAY"))
  1.  N DA M DA=DIEN
  1.  ;
  1. A4 ; output the specified values of the record
  1.  ;
  1.  I DIFLAGS'["f" D
  1.  . D IDS^DICU2(.DIFILE,DIEN_DIFIEN,.DIFLAGS,.DINDEX,DILIST("ORDER"),.DIDENT,DILIST,.DI0NODE)
  1.  . Q
  1.  Q:DIFLAGS'[4
  1.  N DIREC S DIREC=DIEN I DIFLAGS["v" S DIREC=DIREC_";"_$P(DIFILE(DIFILE,"O"),U,2)
  1.  I DIFLAGS["f",DIFLAGS'["p" S @DILIST@(DIDENT(-1))=DIREC
  1.  S @DILIST@("B",($E($P(DI0NODE,U),1,DINDEX("MAXSUB"))_U_DIREC))=""
  1.  Q
  1.  ;
  1.  ; Possible output messages
  1.  ; 202    The input parameter that identifies the |1
  1.  ;