Annotation of freem_fileman/DIQGDDT.m, revision 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>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to DIQGDDT.m CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Coherent Logic Development] / freem_fileman