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

DICL ;SEA/TOAD,SF/TKW-VA FileMan: Lookup: Lister ;12/14/98  13:55

 ;;22.0;VA FileMan;;Mar 30, 1999

 ;Per VHA Directive 10-93-142, this routine should not be modified.

 ;

LIST(DIFILE,DIFIEN,DIFIELDS,DIFLAGS,DINUMBER,DIFROM,DIPART,DINDEX,DISCREEN,DIWRITE,DILIST,DIMSGA,DIC) ;

 ; ENTRY POINT--return a list of entries from a file

 ; (Note: DIC parameter only passed if called from ^DICQ)

 ;

IN ; Entry point from LIST^DIC

 I '$D(DIQUIET) N DIQUIET S DIQUIET=1

 I '$D(DIFM) N DIFM S DIFM=1 D INIZE^DIEFU

 N DICLERR S DICLERR=$G(DIERR) K DIERR

 ;

INPUT ; Validate input parameters

 N DIERN,DIPE,DIDENT

 S DIFLAGS=$G(DIFLAGS)

 I DIFLAGS["I",DIFLAGS'["Q" S DIFLAGS=DIFLAGS_"Q"

 S DIFIELDS=$G(DIFIELDS)

 I DIFIELDS'["-IX" D

 . N DID S DID=";"_DIFIELDS_";"

 . I (DID["@"!(DIFLAGS["I")),DID'[";IX;",DID'[";IXE",DID'[";IXIE" Q

 . S DIDENT(-5)=1 Q

 S DINUMBER=$G(DINUMBER) I DINUMBER="" S DINUMBER="*"

 I '$D(DIPART(1)) S DIPART(1)=$G(DIPART)

 I '$D(DIFROM(1)) S DIFROM(1)=$G(DIFROM)

 I $O(DIFROM(1)) D

 . N E S E=9999 F  S E=$O(DIFROM(E),-1) Q:'E  Q:DIFROM(E)]""

 . I E N I F I=1:1:E I DIFROM(I)="" D BLD^DIALOG(202,"FROM values"),OUT Q

 . Q

 S DIFROM("IEN")=$G(DIFROM("IEN"))

 S DINDEX("WAY")=1 I DIFLAGS["B" S DINDEX("WAY")=-1

 S DINDEX=$G(DINDEX)

 I '$D(DISCREEN("S")) S DISCREEN("S")=$G(DISCREEN)

 S DIWRITE=$G(DIWRITE)

 ;

OUTPUT ; Establish output file name, starting output subscript no.

 I $G(DILIST)="" S DILIST="^TMP(""DILIST"",$J)"

 E  I DIFLAGS'["h" D  I $G(DIERR) D OUT Q

 . I DILIST'?.1"^"1U.7UN.ANP,DILIST'?.1"^%".7UN.ANP D  Q

 . . D BLD^DIALOG(202,"target array")

 . S DILIST=$NA(@DILIST@("DILIST"))

 . Q

 K @DILIST

 S DILIST("ORDER")=$S(DINDEX("WAY")=1:0,1:DINUMBER+1)

 I DINUMBER="*",DINDEX("WAY")=-1 D

 . S DINDEX("WAY")=1,DINDEX("WAY","REVERSE")=1

 . S DILIST("ORDER")=0

 . Q

 ;

FILE ; Validate file number and IENS.

 I DIFLAGS'["h" D FILE^DICUF(.DIFILE,.DIFIEN,DIFLAGS)

 I $G(DIERR) S DIFROM="",DIFROM("IEN")="" D OUT Q

 D SCREEN^DICUF(DIFLAGS,.DIFILE,.DISCREEN)

 ;

IXNAME ; Set default index name if null.

 I DINDEX'="#",DINDEX'?1U.UNP S DINDEX=$$DINDEX(DIFILE,DIFLAGS)

CHECKS ;

 I $TR(DIFLAGS,"BIKMPQSUfhu")'="" S DIERN=301,DIPE(1)=DIFLAGS D ERROUT Q

 S DIFLAGS=DIFLAGS_3

 I DINUMBER'="*",DINUMBER<1!(DINUMBER\1'=DINUMBER) D  Q

 . S DIERN=202,DIPE(1)="Number" D ERROUT

 ;

IXANDID ; Gather information about index and field data to be returned.

 N DIOUT S DIOUT=0

 D INDEX^DICUIX(.DIFILE,DIFLAGS,.DINDEX,.DIFROM,.DIPART,DINUMBER,.DISCREEN,DILIST,.DIOUT)

 I DIOUT!($G(DIERR)) D KTMPIX^DICL1 Q

 I $D(DISCREEN("V")) D VPDATA^DICUF(.DINDEX,.DISCREEN)

 I $O(DIFROM(DINDEX("#")+1))!(DINDEX'="#"&($O(DIPART(DINDEX("#"))))) D BLD^DIALOG(202,"Index"),KTMPIX^DICL1 Q

 D IDENTS^DICU1(DIFLAGS,.DIFILE,DIFIELDS,DIWRITE,.DIDENT,.DINDEX)

 I $G(DIERR) D KTMPIX^DICL1 Q

 ;

BRANCH ; Continue on to actual search.

 G PREP^DICL1

 ;

DINDEX(DIFILE,DIFLAGS) ; Set DINDEX to index name for KEY.

 N I,X S X=""

 I $G(DIFLAGS)["K" D

 . S I=$O(^DD("KEY","AP",DIFILE,"P",0)) Q:'I

 . S X=$P($G(^DD("IX",+$P($G(^DD("KEY",I,0)),U,4),0)),U,2) Q

 Q:X?1U.UNP X

 Q "B"

 ;

ERROUT D BLD^DIALOG(DIERN,.DIPE,.DIPE),OUT Q

 ;

OUT I DICLERR'=""!$G(DIERR) D

 . S DIERR=$G(DIERR)+DICLERR_U_($P($G(DIERR),U,2)+$P(DICLERR,U,2))

 I $G(DIMSGA)'="" D CALLOUT^DIEFU(DIMSGA)

 Q

 ;

 ; Possible messages returned

 ; 202   The input parameter that identifies the |1

 ; 301   The passed flag(s) '|1|' are unknown or in

 ;