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

DICL.m

Go to the documentation of this file.
  1. DICL ;SEA/TOAD,SF/TKW-VA FileMan: Lookup: Lister ;28APR2012
  1. ;;22.2;VA FileMan;;Jan 05, 2016;Build 42
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
  1. ;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
  1. ;;Licensed under the terms of the Apache License, Version 2.0.
  1. ;
  1. ;
  1. LIST(DIFILE,DIFIEN,DIFIELDS,DIFLAGS,DINUMBER,DIFROM,DIPART,DINDEX,DISCREEN,DIWRITE,DILIST,DIMSGA,DIC) ;
  1. ; ENTRY POINT--return a list of entries from a file
  1. ; (Note: DIC parameter only passed if called from ^DICQ)
  1. ;
  1. IN ; Entry point from LIST^DIC
  1. I '$D(DIQUIET) N DIQUIET S DIQUIET=1
  1. I '$D(DIFM) N DIFM S DIFM=1 D INIZE^DIEFU
  1. N DICLERR S DICLERR=$G(DIERR) K DIERR
  1. ;
  1. INPUT ; Validate input parameters
  1. N DIERN,DIPE,DIDENT
  1. S DIFLAGS=$G(DIFLAGS)
  1. I DIFLAGS["I",DIFLAGS'["Q" S DIFLAGS=DIFLAGS_"Q"
  1. S DIFIELDS=$G(DIFIELDS)
  1. I DIFIELDS'["-IX" D
  1. . N DID S DID=";"_DIFIELDS_";"
  1. . I (DID["@"!(DIFLAGS["I")),DID'[";IX;",DID'[";IXE",DID'[";IXIE" Q
  1. . S DIDENT(-5)=1 Q
  1. S DINUMBER=$G(DINUMBER) I DINUMBER="" S DINUMBER="*"
  1. I '$D(DIPART(1)) S DIPART(1)=$G(DIPART)
  1. I '$D(DIFROM(1)) S DIFROM(1)=$G(DIFROM)
  1. I $O(DIFROM(1)) D
  1. . N E S E=9999 F S E=$O(DIFROM(E),-1) Q:'E Q:DIFROM(E)]""
  1. . I E N I F I=1:1:E I DIFROM(I)="" D BLD^DIALOG(202,"FROM values"),OUT Q
  1. . Q
  1. S DIFROM("IEN")=$G(DIFROM("IEN"))
  1. S DINDEX("WAY")=1 I DIFLAGS["B" S DINDEX("WAY")=-1
  1. S DINDEX=$G(DINDEX)
  1. I '$D(DISCREEN("S")) S DISCREEN("S")=$G(DISCREEN) D:DISCREEN("S")]""
  1. .;N X S X=DISCREEN D ^DIM I '$D(X) D BLD^DIALOG(202,"SCREEN") ;**GFT CHECK FOR GOOD MUMPS CODE
  1. S DIWRITE=$G(DIWRITE)
  1. ;
  1. OUTPUT ; Establish output file name, starting output subscript no.
  1. I $G(DILIST)="" S DILIST="^TMP(""DILIST"",$J)"
  1. E I DIFLAGS'["h" D I $G(DIERR) D OUT Q
  1. . I DILIST'?.1"^"1U.7UN.ANP,DILIST'?.1"^%".7UN.ANP D Q
  1. . . D BLD^DIALOG(202,"target array")
  1. . S DILIST=$NA(@DILIST@("DILIST"))
  1. . Q
  1. K @DILIST
  1. S DILIST("ORDER")=$S(DINDEX("WAY")=1:0,1:DINUMBER+1)
  1. I DINUMBER="*",DINDEX("WAY")=-1 D
  1. . S DINDEX("WAY")=1,DINDEX("WAY","REVERSE")=1
  1. . S DILIST("ORDER")=0
  1. . Q
  1. ;
  1. FILE ; Validate file number and IENS.
  1. I DIFLAGS'["h" D FILE^DICUF(.DIFILE,.DIFIEN,DIFLAGS)
  1. I $G(DIERR) S DIFROM="",DIFROM("IEN")="" D OUT Q
  1. D SCREEN^DICUF(DIFLAGS,.DIFILE,.DISCREEN)
  1. ;
  1. CHECKS ;
  1. I $TR(DIFLAGS,"BIKMPQSUfhuXE")'="" S DIERN=301,DIPE(1)=DIFLAGS D ERROUT Q ;GFT: "X" and "E" added
  1. S DIFLAGS=DIFLAGS_3
  1. I DINUMBER'="*",DINUMBER<1!(DINUMBER\1'=DINUMBER) D Q
  1. . S DIERN=202,DIPE(1)="Number" D ERROUT
  1. ;
  1. IXANDID ; Gather information about index and field data to be returned.
  1. N DIOUT S DIOUT=0
  1. IXNAME ; Set default index name if null.
  1. N DIGFT,DIGFTEMP
  1. I DIFLAGS["X" D DICL^DICLGFT G BADQ ;NOTE: A CROSS-REF MUST BE 1U.UN (IX^DICE); AN INDEX MUST BE 1A.AN
  1. I DINDEX'="#",DINDEX'?1U.UNP S DINDEX=$$DINDEX(DIFILE,DIFLAGS)
  1. D INDEX^DICUIX(.DIFILE,DIFLAGS,.DINDEX,.DIFROM,.DIPART,DINUMBER,.DISCREEN,DILIST,.DIOUT)
  1. BADQ I DIOUT!($G(DIERR)) D KTMPIX^DICL1 Q
  1. I $D(DISCREEN("V")) D VPDATA^DICUF(.DINDEX,.DISCREEN)
  1. I $O(DIFROM(DINDEX("#")+1))!(DINDEX'="#"&($O(DIPART(DINDEX("#"))))) D BLD^DIALOG(202,"Index"),KTMPIX^DICL1 Q
  1. D IDENTS^DICU1(DIFLAGS,.DIFILE,DIFIELDS,DIWRITE,.DIDENT,.DINDEX)
  1. I $G(DIERR) D KTMPIX^DICL1 Q
  1. ;
  1. BRANCH ; Continue on to actual search.
  1. D PREP^DICL1
  1. I $G(DIGFTEMP)["^" K @DIGFTEMP ;**
  1. Q
  1. ;
  1. DINDEX(DIFILE,DIFLAGS) ; Set DINDEX to index name for KEY. Also called at top of ^DIC & by DICF & DICF2
  1. N I,X S X=""
  1. I $G(DIFLAGS)["K" D
  1. . S I=$O(^DD("KEY","AP",DIFILE,"P",0)) Q:'I
  1. . S X=$P($G(^DD("IX",+$P($G(^DD("KEY",I,0)),U,4),0)),U,2) Q
  1. Q:X?1U.UNP X
  1. Q "B"
  1. ;
  1. ERROUT D BLD^DIALOG(DIERN,.DIPE,.DIPE),OUT Q
  1. ;
  1. OUT I DICLERR'=""!$G(DIERR) D
  1. . S DIERR=$G(DIERR)+DICLERR_U_($P($G(DIERR),U,2)+$P(DICLERR,U,2))
  1. I $G(DIMSGA)'="" D CALLOUT^DIEFU(DIMSGA)
  1. Q
  1. ;
  1. ; Possible messages returned
  1. ; 202 The input parameter that identifies the |1
  1. ; 301 The passed flag(s) '|1|' are unknown or in
  1. ;