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 ;