| [613] | 1 | GMRCTU1 ; SLC/KR Get DD Info ; [11/8/99 1:57pm]
|
|---|
| 2 | ;;3.0;CONSULT/REQUEST TRACKING;**9**;Dec 27, 1997
|
|---|
| 3 | ;
|
|---|
| 4 | INFO(FILE,FIELD,ORA) ;
|
|---|
| 5 | ;
|
|---|
| 6 | ; DIC Global Root for <FILE>
|
|---|
| 7 | ; LOC Global Subscript Location (#;#) for <FIELD>
|
|---|
| 8 | ;
|
|---|
| 9 | ; INFO(<file #>,<field #>,.ARRAY)
|
|---|
| 10 | ;
|
|---|
| 11 | ; Returns
|
|---|
| 12 | ;
|
|---|
| 13 | ; ARRAY("DIC",0)=Global Root
|
|---|
| 14 | ; ARRAY("DIC",1)=File Root
|
|---|
| 15 | ; ARRAY("DIC",2)=Subfile Root
|
|---|
| 16 | ; ARRAY("DIC",..)=Subfile Root
|
|---|
| 17 | ; ARRAY("FILE")=Target File/Subfile Number
|
|---|
| 18 | ; ARRAY("FIELD")=Target Field
|
|---|
| 19 | ; ARRAY("NAME")=Target Field Name
|
|---|
| 20 | ; ARRAY("LOC")=Subscript and Piece
|
|---|
| 21 | ;
|
|---|
| 22 | N DIC,LOC,SUB,SUBI,SFS,SNS S (DIC,LOC)="",FILE=+($G(FILE)),FIELD=+($G(FIELD))
|
|---|
| 23 | Q:FILE=0!(FIELD=0) Q:'$D(^DD(FILE))
|
|---|
| 24 | S ORA("FILE")=FILE,ORA("FIELD")=FIELD
|
|---|
| 25 | D GETDD
|
|---|
| 26 | S:$L(DIC) ORA("DIC",0)=$P(DIC,"(",1)_"(",ORA("DIC",1)=DIC
|
|---|
| 27 | S:$L($G(SFS)) ORA("DIC",1,"P")=SFS
|
|---|
| 28 | S:$L(LOC) ORA("LOC")=LOC
|
|---|
| 29 | Q
|
|---|
| 30 | GETDD ; Get file roots from DD
|
|---|
| 31 | ;
|
|---|
| 32 | ; FILE Current File #
|
|---|
| 33 | ; FIELD Current Field #
|
|---|
| 34 | ; DIC Current Global Root
|
|---|
| 35 | ; LOC Current Global Subscript Location (#;#)
|
|---|
| 36 | ; ARY( Temporay Storage Array (contains DD)
|
|---|
| 37 | ; ORA( Output Array
|
|---|
| 38 | ;
|
|---|
| 39 | N ARY M ARY(FILE,FIELD,0)=^DD(FILE,FIELD,0)
|
|---|
| 40 | M ARY(FILE,0,"UP")=^DD(FILE,0,"UP")
|
|---|
| 41 | S ORA("NAME")=$P($G(ARY(FILE,FIELD,0)),"^",1)
|
|---|
| 42 | S:'$L($G(LOC))&($D(ARY(FILE,FIELD,0))) LOC=$P(ARY(FILE,FIELD,0),"^",4)
|
|---|
| 43 | D CURRDD:'$D(ARY(FILE,0,"UP")),NEXTDD:$D(ARY(FILE,0,"UP"))
|
|---|
| 44 | Q
|
|---|
| 45 | CURRDD ; Current DD
|
|---|
| 46 | ;
|
|---|
| 47 | ; FILE Current File #
|
|---|
| 48 | ; DIC Current Global Root
|
|---|
| 49 | ; SFS Subfile Specifier Array
|
|---|
| 50 | ; ARY( Temporary Storage Array (contains DD)
|
|---|
| 51 | ;
|
|---|
| 52 | S DIC=$$ROOT^DILFD(FILE,0,"GL")
|
|---|
| 53 | S SFS=$P($$ROOT^DILFD(FILE,0),"^",2)
|
|---|
| 54 | Q
|
|---|
| 55 | NEXTDD ; Next DD Level (for subfiles)
|
|---|
| 56 | ;
|
|---|
| 57 | ; OLDFILE Previous File #
|
|---|
| 58 | ; OLDFIELD Previous Field #
|
|---|
| 59 | ; OLDDIC Previous Global Root
|
|---|
| 60 | ; OLDLOC Previous Global Subscript Location (#;#)
|
|---|
| 61 | ; FILE Current File #
|
|---|
| 62 | ; FIELD Current Field #
|
|---|
| 63 | ; DIC Current Global Root
|
|---|
| 64 | ; SNS Subfile Number and Subfile Specifier
|
|---|
| 65 | ; LOC Current Global Subscript Location (#;#)
|
|---|
| 66 | ; ARY( Temporay Storage Array (contains DD)
|
|---|
| 67 | ; ORA( Output Array
|
|---|
| 68 | ; SUB( Subscript Array
|
|---|
| 69 | ; SFS( Subfile Specifier Array
|
|---|
| 70 | ; SUBI Subscript Counter
|
|---|
| 71 | ; SS Subscript
|
|---|
| 72 | ; DA Internal Entry Number Array
|
|---|
| 73 | ; CT1 Miscellaneous Counter #1
|
|---|
| 74 | ; CT2 Miscellaneous Counter #2
|
|---|
| 75 | ;
|
|---|
| 76 | N FILE2,FIELD2,DIC2,LOC2,CT1,CT2
|
|---|
| 77 | S LOC2=LOC,(FILE2,FIELD2)=FILE N FILE,FIELD,DIC
|
|---|
| 78 | S FILE=$G(ARY(FILE2,0,"UP"))
|
|---|
| 79 | N ARY M ARY(FILE,"SB",FIELD2)=^DD(FILE,"SB",FIELD2)
|
|---|
| 80 | S FIELD=$O(ARY(FILE,"SB",FILE2,0))
|
|---|
| 81 | M ARY(FILE,FIELD,0)=^DD(FILE,FIELD,0)
|
|---|
| 82 | S SNS=$P($G(ARY(FILE,FIELD,0)),"^",2)
|
|---|
| 83 | S SUBI=+($O(SUB(" "),-1)),SUBI=SUBI+1
|
|---|
| 84 | S SUB(SUBI)=$P($P($G(ARY(FILE,FIELD,0)),"^",4),";",1),DIC=""
|
|---|
| 85 | S SFS(SUBI)=SNS
|
|---|
| 86 | D GETDD
|
|---|
| 87 | S LOC=LOC2 I $L(DIC) D
|
|---|
| 88 | . S ORA("DIC",0)=$P(DIC,"(",1)_"(",ORA("DIC",1)=DIC
|
|---|
| 89 | . N DA,SS F CT1=SUBI:-1:1 S DA="DA("_CT1_")",DIC=DIC_DA_"," D
|
|---|
| 90 | . . F CT2=SUBI:-1:1 D
|
|---|
| 91 | . . . 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))
|
|---|
| 92 | Q
|
|---|
