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

DICL1.m

Go to the documentation of this file.
  1. DICL1 ;SEA/TOAD,SF/TKW-VA FileMan: Lookup: Lister, Part 2 ;10/15/98 14:19
  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. PREP ; set up subfile's DA array under DIEN, init how many found,
  1. ; set max, and init array of last entries returned.
  1. ;
  1. N DIEN D DA^DILF(DIFIEN,.DIEN)
  1. N DISUB,DIVAL,X,Y
  1. S DIDENT(-1)=0
  1. S DIDENT(-1,"MAX")=DINUMBER
  1. S DIDENT(-1,"JUST LOOKING")=0
  1. F DISUB=1:1:DINDEX("#")+1 S DIDENT(-1,"LAST",DISUB)=""
  1. S (DIDENT(-1,"LAST"),DIDENT(-1,"LAST","IEN"))=""
  1. ;
  1. PTR ; if 1st indexed field is a pointer or var.ptr., and we're not doing
  1. ; a quick list, we build info for the
  1. ; pointer chain(s) to the end file(s) and do the search.
  1. ;
  1. I "VP"[DINDEX(1,"TYPE"),DIFLAGS'["Q",'$D(DINDEX("ROOTCNG",1)) D
  1. . D POINT^DICL10(.DIFILE,.DIFLAGS,.DINDEX,.DIDENT,.DIEN,DIFIEN,.DISCREEN,.DILIST)
  1. . Q
  1. ;
  1. GETLIST ; build the output list when first subscript not a ptr. or var.ptr.
  1. ;
  1. E D
  1. . I $D(DINDEX("ROOTCNG",1)) D BLDTMP^DICLIX1(.DINDEX,.DISCREEN,DIFLAGS,.DIDENT)
  1. . D WALK^DICLIX(DIFLAGS,.DINDEX,.DIDENT,.DIFILE,.DIEN,.DIFIEN,.DISCREEN,.DILIST,"","",.DIC)
  1. ;
  1. DSPHLP ; If we're displaying entries for online ^DIC help, display the rest
  1. ;
  1. I DIFLAGS["h",$O(DICQ(0)) D
  1. . K DTOUT,DUOUT S DICQ(0,"MAP")=DIDENT(-3)
  1. . D DSP^DICQ1(.DINDEX,.DICQ,.DIC,.DIFILE)
  1. . I $G(DTOUT)!($G(DUOUT)) S (DINDEX("DONE"),DIDONE)=1 Q
  1. . S DIDENT(-1)=0
  1. . Q
  1. ;
  1. KTMPIX ; if we've built temporary indexes, we delete them:
  1. D KILLB(.DIFILE)
  1. N DISUB S DISUB=$O(DINDEX("ROOTCNG","")) I DISUB K @DINDEX(DISUB,"ROOT")
  1. ;
  1. FINAL ; cleanup after search.
  1. ;
  1. I $G(DIERR) K @DILIST D OUT^DICL Q
  1. ;
  1. ; set the output list header node and map node, output FROM values
  1. ; for last entries returned.
  1. ;
  1. I '$D(DIDENT(-1)) S DIDENT(-1)=0,DIDENT(-1,"MAX")=DINUMBER
  1. N DIHEADER S DIHEADER=DIDENT(-1)_U_DIDENT(-1,"MAX")_U_+$G(DIDENT(-1,"MORE?"))
  1. S @DILIST@(0)=DIHEADER_U_$S(DIFLAGS[2:"H",1:"")
  1. I DIFLAGS["P",$G(DIDENT(-3))]"" S @DILIST@(0,"MAP")=DIDENT(-3)
  1. E D SETMAP(.DIDENT,DILIST)
  1. N I S I=0 F S I=$O(DIDENT(-1,"LAST",I)) Q:'I D
  1. . K DIDENT(-1,"LAST",I,"I")
  1. . Q:$G(DIDENT(-1,"MORE?"))
  1. . I I=1 S (DIDENT(-1,"LAST"),DIDENT(-1,"LAST","IEN"))=""
  1. . S DIDENT(-1,"LAST",I)=""
  1. . Q
  1. K DIFROM M DIFROM=DIDENT(-1,"LAST")
  1. ;
  1. ; Move arrays to output and QUIT.
  1. D OUT^DICL
  1. Q
  1. ;
  1. KILLB(DIFILE) ; Kill temporary "B" index on current file DIFILE or pointed-to files.
  1. N DIROOT I $D(DIFILE(DIFILE,"NO B")) S DIROOT=DIFILE(DIFILE,"NO B")_")" K @DIROOT
  1. Q:'$O(DIFILE("STACK",0))
  1. N I,J,K
  1. F I=0:0 S I=$O(DIFILE("STACK",I)) Q:'I F J=0:0 S J=$O(DIFILE("STACK",I,J)) Q:'J F K=0:0 S K=$O(DIFILE("STACK",I,J,K)) Q:'K I $D(DIFILE(K,"NO B")) D
  1. . S DIROOT=DIFILE(K,"NO B")_")"
  1. . K @DIROOT Q
  1. Q
  1. ;
  1. SETMAP(DIDENT,DILIST) ; Set map node for unpacked format
  1. N I,J,K,DIMAP,DITMP S (DIMAP,I)=""
  1. F S I=$O(DIDENT(-3,I)) Q:I="" S DITMP="" D D SETM2
  1. . I I S J="" F S J=$O(DIDENT(-3,I,J)) Q:J="" D
  1. . . I J?1.N.1"I" D
  1. . . . N K S K="FID("_I_")"_$P("I^",U,J["I")
  1. . . . K:$D(DIDENT(-3,I,K)) DIDENT(-3,I,K) Q
  1. . . S DITMP=DITMP_J_"^" Q
  1. . Q:I'=0
  1. . F J=0:0 S J=$O(DIDENT(-3,0,J)) Q:'J S K="" F D Q:K=""
  1. . . S K=$O(DIDENT(-3,0,J,K)) S:K]"" DITMP=DITMP_K_"^" Q
  1. Q:DIMAP="" S $E(DIMAP,$L(DIMAP))=""
  1. S @DILIST@(0,"MAP")=DIMAP
  1. Q
  1. ;
  1. SETM2 N DILENGTH S DILENGTH=$L(DIMAP) Q:$E(DIMAP,DILENGTH-3,DILENGTH)="..."
  1. I $L(DITMP)+($L(DIMAP))>252 S DIMAP=DIMAP_"..." Q
  1. S DIMAP=DIMAP_DITMP Q
  1. ;
  1. ;