Return to DIQGDDT.m CVS log

Up to [Coherent Logic Development] / freem_fileman / USER

Restructure repository

    1: DIQGDDT	;SFISC/DCL-DATA DICTIONARY ATTRIBUTE TEXT ;10:22 AM  16 Nov 1994;
    2: 	;;21.0;VA FileMan;;Dec 28, 1994
    3: 	;Per VHA Directive 10-93-142, this routine should not be modified.
    4: LIST(TYPE,DIDARRAY,TP,EQL)	;DO CALL
    5: 	;TYPE="FILETXT" OR "FIELDTXT"
    6: 	;DIDARRAY=TARGET ARRAY - IS LOCAL ARRAY PASSED BY REFERENCE WHICH WILL BE SEEDED WITH FILE OR FIELD ATTRIBUTES
    7: 	;TP=TEXT PIECE USING ; AS DELIMITER
    8: 	;EQL=EQUAL TO - NULL IS DEFAUL OR PIECE OF TXT
    9: ENLST	S:$G(TP)'>0 TP=4 S:$G(EQL)'>0 EQL=99
   10: 	N DIQGI,DIQGX,DIQGY F DIQGI=1:1 S DIQGX=$T(@TYPE+DIQGI),DIQGY=$P(DIQGX,";",TP) Q:DIQGY=""  D
   11: 	.S DIDARRAY(DIQGY)=$P(DIQGX,";",EQL)
   12: 	.S:$P(DIQGX,";",5)]"" DIDARRAY(DIQGY,"#(word-processing)")=$S($G(DIQGDFLG)["L":"",1:$P(DIQGX,";",5))
   13: 	.I $P(DIQGX,";",6)]"" D
   14: 	..N TYPE
   15: 	..S TYPE=$P(DIQGX,";",7)
   16: 	..N DIQGI,DIQGX,DIQGYS
   17: 	..F DIQGI=1:1 S DIQGX=$T(@TYPE+DIQGI) Q:$P(DIQGX,";",4)=""  D
   18: 	...S DIQGYS=$P(DIQGX,";",4),DIDARRAY(DIQGY,"#",DIQGYS)=""
   19: 	...Q
   20: 	.Q
   21: 	;DIQGI,DIQGY ARE SCRATCH VARIABLES USED TO BUILD ARRAY
   22: 	;DIQGI INDEXES TEXT AND DIQGY CONTAINS THE ATTRIBUTE NAME
   23: 	Q
   24: DD	N %,%ZISOS,A,D0,D1,D2,DA,DIC,DIW,DIWF,DIWL,DIWR,DIWT,DK,DL,DN,DX,I,POP,S,X,Y,DIQGF,DIQGFN
   25: 	S DIC=1,DIC(0)="AEMQ" D ^DIC Q:Y'>0  ;Select file
   26: 	S DIC="^DD("_+Y_",",DIQGFN=+Y
   27: 	D F(DIQGFN,.DIQGF)
   28: 	D ^%ZIS Q:POP  U IO
   29: 	S DIC="^DIC(",DA=DIQGFN
   30: 	D EN^DIQ
   31: 	S X=""
   32: 	F  S X=$O(^DIC(DIQGFN,0,X)) Q:X=""  W !,X,"=",^(X)
   33: 	S DIQGF="" F  S DIQGF=$O(DIQGF(DIQGFN,DIQGF)) Q:DIQGF=""  D
   34: 	.W !,$$L("=",IOM),!,"DD NUMBER: ",DIQGF,!
   35: 	.S DA="" F  S DA=$O(DIQGF(DIQGFN,DIQGF,DA)) Q:DA=""  D
   36: 	..W !,$$L("-",IOM),!
   37: 	..S DIC="^DD("_DIQGF_"," D EN^DIQ
   38: 	..Q
   39: 	.Q
   40: 	W !!,"End of Report",!!
   41: 	D ^%ZISC
   42: 	Q
   43: 	;
   44: L(X,RM)	Q $TR($J("",RM)," ",X)
   45: 	;
   46: F(DIQGDICN,DIQGFSTA,DIQGSEL,DIQGDEL)	;
   47: 	;  DIQGDICN file number
   48: 	;  DIQGFSTA Field Selected Target Array(can be passed by reference or
   49: 	;                                       as a reference)
   50: 	;  DIQGSEL Selection Marker(optional)
   51: 	;  DIQGDEL Deselection Marker (optional)
   52: 	N %,%Y,DA,DDC,DIC,DIQGDWN,DIQGTGA,X,Y
   53: 	I $D(@("^DIC("_DIQGDICN_",0)")) W !!?4,"'",$P(^(0),"^"),"' FILE",!
   54: 	S:'$D(DIQGSEL) DIQGSEL="+" S:'$D(DIQGDEL) DIQGDEL="-"
   55: 	S DIC="^DD("_DIQGDICN_",",DIC(0)="AEMQ",X=$E($G(DIQGFSTA)),DIQGTGA=(X="^"!(X=".")) S:X="." DIQGFSTA=$E(DIQGFSTA,2,99)
   56: M	S DIC("W")="W:$P(^(0),U,2) $S($P(^DD(+$P(^(0),U,2),.01,0),U,2)[""W"":""  (word-processing)"",1:""  (multiple)"") W:$D("_$S(DIQGTGA:"@DIQGFSTA@(DIQGDICN,+$E(DIC,5,99),+Y)",1:"DIQGFSTA(DIQGDICN,+$E(DIC,5,99),+Y)")_") DIQGSEL"
   57: 	D ^DIC I Y'>0,$D(@(DIC_"0,""UP"")")) S DIC="^DD("_+^("UP")_"," G M ;Select field/back out of multiples
   58: 	S DIQGDWN="" I Y>0,$P(@(DIC_+Y_",0)"),U,2) S DIQGDWN=+$P(^(0),U,2) I $P(^DD(+$P(^(0),U,2),.01,0),U,2)'["W" D T(DIQGDWN) S DIC="^DD("_DIQGDWN_"," G M
   59: 	I Y>0,DIQGDWN>0 D T(DIQGDWN) G M
   60: 	I Y>0 D T() G M
   61: 	Q
   62: T(DWN)	;
   63: 	D @$S(DIQGTGA:"TAR(+$E(DIC,5,99),+Y,$G(DWN))",1:"TBR(+$E(DIC,5,99),+Y,$G(DWN))")
   64: 	Q
   65: TAR(DDFN,FLD,DWNFN)	;Target array is in DIQGFSTA As a global/local Reference
   66: 	I DWNFN S @DIQGFSTA@(DIQGDICN,DWNFN)=DDFN_"^"_FLD
   67: 	I '$D(@DIQGFSTA@(DIQGDICN,DDFN,FLD)) S @DIQGFSTA@(DIQGDICN,DDFN,FLD)=$S(DWNFN:DWNFN,1:"") Q
   68: 	I DWNFN,$D(@DIQGFSTA@(DIQGDICN,DWNFN))>9 Q
   69: 	N X S X=$G(@DIQGFSTA@(DIQGDICN,DDFN,FLD)) I X K @DIQGFSTA@(DIQGDICN,$P(X,"^"))
   70: 	K @DIQGFSTA@(DIQGDICN,DDFN,FLD) W DIQGDEL Q
   71: 	Q
   72: TBR(DDFN,FLD,DWNFN)	;Target array DIQGFSTA is a local array passed By Reference
   73: 	I DWNFN S DIQGFSTA(DIQGDICN,DWNFN)=DDFN_"^"_FLD
   74: 	I '$D(DIQGFSTA(DIQGDICN,DDFN,FLD)) S DIQGFSTA(DIQGDICN,DDFN,FLD)=$S(DWNFN:DWNFN,1:"") Q
   75: 	I DWNFN,$D(DIQGFSTA(DIQGDICN,DWNFN))>9 Q
   76: 	N X S X=$G(DIQGFSTA(DIQGDICN,DDFN,FLD)) I X K DIQGFSTA(DIQGDICN,$P(X,"^"))
   77: 	K DIQGFSTA(DIQGDICN,DDFN,FLD) W DIQGDEL Q
   78: 	Q
   79: 	;
   80: 	;ATRBUTE FLD #;ATRBUTE NAME;1=WORD PROCESSING
   81: FILETXT	;
   82: 	;;.01;NAME;
   83: 	;;1;GLOBAL NAME;
   84: 	;;1.1;ENTRIES;
   85: 	;;4;DESCRIPTION;1
   86: 	;;20;DEVELOPER;
   87: 	;;21;DATE;
   88: 	;;31;DD ACCESS;
   89: 	;;32;DD ACCESS;
   90: 	;;33;WR ACCESS;
   91: 	;;34;DEL ACCESS;
   92: 	;;35;LAYGO ACCESS;
   93: 	;;36;AUDIT ACCESS;
   94: 	;;50;LOOKUP PROGRAM;
   95: 	;;51;VERSION;
   96: 	;;51.1;DISTRIBUTION PACKAGE;
   97: 	;;51.2;PACKAGE REVISION DATA;
   98: 	;;54;ARCHIVE FILE;
   99: 	;;100.6;REQUIRED IDENTIFIERS;;1;RI
  100: 	;;
  101: FIELDTXT	;
  102: 	;;.01;LABEL;
  103: 	;;.1;TITLE;
  104: 	;;.2;SPECIFIER;
  105: 	;;.24;DECIMAL DEFAULT;
  106: 	;;.25;TYPE;
  107: 	;;.26;COMPUTE ALGORITHM;
  108: 	;;.28;MULTIPLE-VALUED;
  109: 	;;.3;POINTER;
  110: 	;;.4;GLOBAL SUBSCRIPT LOCATION;
  111: 	;;.5;INPUT TRANSFORM;
  112: 	;;1.1;AUDIT;
  113: 	;;1.2;AUDIT CONDITION;
  114: 	;;2;OUTPUT TRANSFORM;
  115: 	;;3;HELP-PROMPT;
  116: 	;;4;XECUTABLE HELP;
  117: 	;;8;READ ACCESS;
  118: 	;;8.5;DELETE ACCESS;
  119: 	;;9;WRITE ACCESS;
  120: 	;;9.01;COMPUTED FIELDS USED;
  121: 	;;10;SOURCE;
  122: 	;;21;DESCRIPTION;1
  123: 	;;23;TECHNICAL DESCRIPTION;1
  124: 	;;50;DATE FIELD LAST EDITED;
  125: 	;;200;FIELD LENGTH;
  126: 	;
  127: RI	;REQUIRED IDENTIFIERS
  128: 	;;1;FIELD;
  129: 	;;