Annotation of freem_fileman/DIQGDDT.m, revision 1.1.1.1

1.1       snw         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:        ;;

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>