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

DICL10.m

Go to the documentation of this file.
  1. DICL10 ;SEA/TOAD,SF/TKW-VA FileMan: Lookup: Lister, Part 2 ;5/21/98 15:27
  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. POINT(DIFILE,DIFLAGS,DINDEX,DIDENT,DIEN,DIFIEN,DISCREEN,DILIST) ;
  1. ; save off the primary file info, follow the ptr chain to the end
  1. S DIFLAGS=DIFLAGS_"p"
  1. N DIVPTR,DIF S DIVPTR=$S(DINDEX(1,"TYPE")="V":1,1:0)
  1. M DIF=DIFILE N DIFILE M DIFILE=DIF K DIF
  1. D FOLLOW^DICL3(.DIFILE,"",DINDEX(1,"NODE"),1,0,"",DINDEX(1,"FIELD"),DINDEX(1,"FILE"),DIVPTR,1,.DISCREEN)
  1. D SETB^DICL3
  1. N DIX1 S DIX1="B"
  1. S DIX1("WAY")=DINDEX("WAY")
  1. N DIFROM S DIFROM(1)=$G(DINDEX(1,"FROM")),DIFROM("IEN")=""
  1. N DIPART S DIPART(1)=$G(DINDEX(1,"PART"))
  1. S DIFILE("STACK")=1_U_DIFILE("STACKEND",1)
  1. S DIFILE=$P(DIFILE("STACK"),U,3)
  1. D INDEX^DICUIX(.DIFILE,.DIFLAGS,.DIX1,.DIFROM,.DIPART)
  1. I $G(DINDEX(1,"USE")) S DIX1(1,"USE")=1
  1. N I F I="FIELD","FILE","FROM","GET","TYPE" K DIX1(1,I)
  1. K DIX1("FLIST")
  1. P1 ; no variable pointers in pointer chain
  1. I '$O(DIFILE("STACKEND",1)) D Q
  1. . D WALK^DICLIX(DIFLAGS,.DIX1,.DIDENT,.DIFILE,.DIEN,.DIFIEN,.DISCREEN,.DILIST,.DINDEX,"",.DIC)
  1. . Q
  1. P2 ; variable pointer(s) in pointer chain
  1. N DIXV
  1. S DIFLAGS=DIFLAGS_"v",DIFILE("STACK")=""
  1. S I=0 F S I=$O(DIFILE("STACKEND",I)) Q:'I D
  1. . N DIXNAME,DISUB,R S DIXNAME="DIXV("_I_")",DISUB=DIX1(1)
  1. . N DIFL,DIGL S DIFL=+$P(DIFILE("STACKEND",I),U,2),DIGL=DIFILE(DIFL,"O")
  1. . S @DIXNAME@(1)=DISUB,@DIXNAME@(1,"MORE?")=DIX1(1,"MORE?"),@DIXNAME@(2)=""
  1. . S R=DIGL_"DINDEX"
  1. . S @DIXNAME@(1,"ROOT")=R_")",@DIXNAME@(2,"ROOT")=R_",DINDEX(1))"
  1. . I $G(DINDEX(1,"USE")),DISUB'="" D
  1. . . S R=DIGL_"""B"")",DISUB=$O(@R@(DISUB),-DIX1(1,"WAY"))
  1. . . S @DIXNAME@(1)=DISUB
  1. . . Q
  1. . S R=DIGL_"""B"")",DISUB=$O(@R@(DISUB)),@DIXNAME@(1,"NXTVAL")=DISUB
  1. . I DISUB="" K @DIXNAME,DIFILE("STACKEND",I) Q
  1. . Q:DIFILE("STACK")
  1. . S DIFILE("STACK")=I_U_DIFILE("STACKEND",I)
  1. . Q
  1. K DIX1(1,"USE")
  1. I +DIFILE("STACK")=1 S DIX1(1)=DIXV(1,1)
  1. E S I="DIXV("_+DIFILE("STACK")_")" M DIX1=@I
  1. D WALK^DICLIX(DIFLAGS,.DIX1,.DIDENT,.DIFILE,.DIEN,.DIFIEN,.DISCREEN,.DILIST,.DINDEX,.DIXV,.DIC)
  1. Q
  1. ;