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

GMRCTU1.m

Go to the documentation of this file. 
  1. GMRCTU1 ; SLC/KR Get DD Info ; [11/8/99 1:57pm]
  1.  ;;3.0;CONSULT/REQUEST TRACKING;**9**;Dec 27, 1997
  1.  ;
  1. INFO(FILE,FIELD,ORA) ;
  1.  ;          
  1.  ;     DIC       Global Root for <FILE>
  1.  ;     LOC       Global Subscript Location  (#;#) for <FIELD>
  1.  ;          
  1.  ;     INFO(<file #>,<field #>,.ARRAY)
  1.  ;           
  1.  ;       Returns
  1.  ;            
  1.  ;         ARRAY("DIC",0)=Global Root
  1.  ;         ARRAY("DIC",1)=File Root
  1.  ;         ARRAY("DIC",2)=Subfile Root
  1.  ;         ARRAY("DIC",..)=Subfile Root
  1.  ;         ARRAY("FILE")=Target File/Subfile Number
  1.  ;         ARRAY("FIELD")=Target Field
  1.  ;         ARRAY("NAME")=Target Field Name
  1.  ;         ARRAY("LOC")=Subscript and Piece
  1.  ;            
  1.  N DIC,LOC,SUB,SUBI,SFS,SNS S (DIC,LOC)="",FILE=+($G(FILE)),FIELD=+($G(FIELD))
  1.  Q:FILE=0!(FIELD=0)  Q:'$D(^DD(FILE))
  1.  S ORA("FILE")=FILE,ORA("FIELD")=FIELD
  1.  D GETDD
  1.  S:$L(DIC) ORA("DIC",0)=$P(DIC,"(",1)_"(",ORA("DIC",1)=DIC
  1.  S:$L($G(SFS)) ORA("DIC",1,"P")=SFS
  1.  S:$L(LOC) ORA("LOC")=LOC
  1.  Q
  1. GETDD ; Get file roots from DD
  1.  ;          
  1.  ;     FILE      Current File #
  1.  ;     FIELD     Current Field #
  1.  ;     DIC       Current Global Root
  1.  ;     LOC       Current Global Subscript Location  (#;#)
  1.  ;     ARY(      Temporay Storage Array (contains DD)
  1.  ;     ORA(      Output Array
  1.  ;          
  1.  N ARY M ARY(FILE,FIELD,0)=^DD(FILE,FIELD,0)
  1.  M ARY(FILE,0,"UP")=^DD(FILE,0,"UP")
  1.  S ORA("NAME")=$P($G(ARY(FILE,FIELD,0)),"^",1)
  1.  S:'$L($G(LOC))&($D(ARY(FILE,FIELD,0))) LOC=$P(ARY(FILE,FIELD,0),"^",4)
  1.  D CURRDD:'$D(ARY(FILE,0,"UP")),NEXTDD:$D(ARY(FILE,0,"UP"))
  1.  Q
  1. CURRDD ; Current DD
  1.  ;          
  1.  ;     FILE      Current File #
  1.  ;     DIC       Current Global Root
  1.  ;     SFS       Subfile Specifier Array
  1.  ;     ARY(      Temporary Storage Array (contains DD)
  1.  ;               
  1.  S DIC=$$ROOT^DILFD(FILE,0,"GL")
  1.  S SFS=$P($$ROOT^DILFD(FILE,0),"^",2)
  1.  Q
  1. NEXTDD ; Next DD Level (for subfiles)
  1.  ;          
  1.  ;     OLDFILE   Previous File #
  1.  ;     OLDFIELD  Previous Field #
  1.  ;     OLDDIC    Previous Global Root
  1.  ;     OLDLOC    Previous Global Subscript Location  (#;#)
  1.  ;     FILE      Current File #
  1.  ;     FIELD     Current Field #
  1.  ;     DIC       Current Global Root
  1.  ;     SNS       Subfile Number and Subfile Specifier
  1.  ;     LOC       Current Global Subscript Location  (#;#)
  1.  ;     ARY(      Temporay Storage Array (contains DD)
  1.  ;     ORA(      Output Array
  1.  ;     SUB(      Subscript Array
  1.  ;     SFS(      Subfile Specifier Array
  1.  ;     SUBI      Subscript Counter
  1.  ;     SS        Subscript
  1.  ;     DA        Internal Entry Number Array
  1.  ;     CT1       Miscellaneous Counter #1
  1.  ;     CT2       Miscellaneous Counter #2
  1.  ;          
  1.  N FILE2,FIELD2,DIC2,LOC2,CT1,CT2
  1.  S LOC2=LOC,(FILE2,FIELD2)=FILE N FILE,FIELD,DIC
  1.  S FILE=$G(ARY(FILE2,0,"UP"))
  1.  N ARY M ARY(FILE,"SB",FIELD2)=^DD(FILE,"SB",FIELD2)
  1.  S FIELD=$O(ARY(FILE,"SB",FILE2,0))
  1.  M ARY(FILE,FIELD,0)=^DD(FILE,FIELD,0)
  1.  S SNS=$P($G(ARY(FILE,FIELD,0)),"^",2)
  1.  S SUBI=+($O(SUB(" "),-1)),SUBI=SUBI+1
  1.  S SUB(SUBI)=$P($P($G(ARY(FILE,FIELD,0)),"^",4),";",1),DIC=""
  1.  S SFS(SUBI)=SNS
  1.  D GETDD
  1.  S LOC=LOC2 I $L(DIC) D
  1.  . S ORA("DIC",0)=$P(DIC,"(",1)_"(",ORA("DIC",1)=DIC
  1.  . N DA,SS F CT1=SUBI:-1:1 S DA="DA("_CT1_")",DIC=DIC_DA_"," D
  1.  . . F CT2=SUBI:-1:1 D
  1.  . . . S SS=$G(SUB(CT2)),DIC=DIC_SS_",",ORA("DIC",(CT2+1))=DIC S:$L($G(SFS(CT2))) ORA("DIC",(CT2+1),"P")=$G(SFS(CT2))
  1.  Q