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

DIQGDD.m

Go to the documentation of this file.
  1. DIQGDD ;SFISC/DCL - DATA DICTIONARY ATTRIBUTE RETRIEVER ;7FEB2017
  1. ;;22.2;VA FileMan;**2**;Jan 05, 2015;Build 139
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
  1. ;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
  1. ;;Licensed under the terms of the Apache License, Version 2.0.
  1. ;
  1. ;
  1. GET(DIQGR,DA,DR,DIQGPARM,DIQGETA,DIQGERRA,DIQGIPAR) ;
  1. EN3 I $G(U)'="^" N U S U="^" ;COME HERE FROM GET1^DID
  1. I $G(DIQGIPAR)'["A" K DIERR,^TMP("DIERR",$J)
  1. I $G(DIQGR)'>0 N X S X(1)="FILE" Q $$F^DIQG(.X,1)
  1. I DIQGR=1,DA]"" S DIQGR=DA,DA="" ; BACKWARD COMPATIBILITY TO HANDLE FILE 1 $$GET1^DID(1,62.3,"","GLOBAL NAME") ;p7
  1. N DIFILE I $G(DA)="" S DA=DIQGR,DIQGR=1,DIFILE=1 I '$D(^DIC(DA,0)) S X(1)="FILE" Q $$F^DIQG(.X,1) ;LOOK IT UP IN FILE OF FILES (#1)
  1. ;S DIQGPARM=$G(DIQGPARM)_"D"
  1. I DA'?.N,$D(^DD(DIQGR,"B",DA)) S DA=$O(^(DA,"")) I $O(^(DA)) D 200 Q ""
  1. I DA'>0 D 200 Q ""
  1. I DR="REQUIRED IDENTIFIERS" G RI^DIQGDDU
  1. N DIQGSAL ;N DRSV S DRSV=DR N DR
  1. D BLDSAL($G(DIFILE),DR,.DIQGSAL) I $D(DIQGSAL)<9 D 202("ATTRIBUTE") Q ""
  1. S DIQGSAL=DR
  1. I '$G(DIFILE) N DR S DIQGPARM=$G(DIQGPARM)_"D" Q $$ONEATT(DIQGR,DA,.DIQGSAL,.DIQGETA) ;WE'RE GETTING AN ATTRIBUTE OF A FIELD
  1. ;
  1. S DR=$$ATRBT(1,DR) I 'DR D 202("ATTRIBUTE") Q ""
  1. G DDENTRY^DIQG ;WE'RE GETTING AN ATTRIBUTE OF AN ENTIRE FILE
  1. ;
  1. ;
  1. FIELD(DIQGR,DA,DR,DIQGPARM,DIQGTA,DIQGERRA,DIQGIPAR) ;
  1. EN1 N DIQGERR,DIQGEY,DIQGSAL,DIQGFNUL,DIQGSALX ;FROM FIELD^DID
  1. S DIQGEY(1)=$G(DIQGR)
  1. I $G(U)'="^" N U S U="^"
  1. I $G(DIQGIPAR)'["A" K DIERR,^TMP("DIERR",$J)
  1. I $G(DIQGR)'>0 D 202("FILE") Q
  1. I $G(DA)']"" D 202("FIELD") Q
  1. I $D(^DD(DIQGR,0))[0 D 202("FILE") Q
  1. I $G(DIQGTA)']"" D 202("TARGET ARRAY") Q
  1. S DIQGPARM=$G(DIQGPARM)_"D",DIQGFNUL=DIQGPARM["N" ;DO WE WANT NULL VALUES?
  1. I DA'?.N,$D(^DD(DIQGR,"B",DA)) S DA=$O(^(DA,"")) I $O(^(DA)) N X S X(1)=DA,X("FILE")=DIQGR D BLD^DIALOG(505,.X),FE Q
  1. I DA'>0 S DIQGEY(3)=DA D 200 Q
  1. I $D(^DD(DIQGR,DA,0))[0 S DIQGEY(3)=DA D 200 Q
  1. D BLDSAL(0,.DR,.DIQGSAL)
  1. I '$D(DIQGSAL),'$D(DIERR) D 200 Q
  1. I '$D(DIQGSAL) Q
  1. S DIQGSAL="" F S DIQGSAL=$O(DIQGSAL(DIQGSAL)) Q:DIQGSAL="" D ;NOW DIQGSAL HOLDS LIST OF ATTRIBUTES FOR WHICH WE WANT VALUES
  1. .S DIQGSALX=$$ONEATT(DIQGR,DA,.DIQGSAL,.DIQGTA)
  1. .I DIQGSALX]"" S @DIQGTA@(DIQGSAL)=DIQGSALX Q
  1. .Q:DIQGFNUL
  1. .S @DIQGTA@(DIQGSAL)=DIQGSALX
  1. .Q
  1. Q
  1. ;
  1. ;
  1. ONEATT(DIQGR,DA,DIQGSAL,DIQGTA) ;FOR FIELD DA IN FILE DIQGR, GET ATTRIBUTE 'DIQGSAL'
  1. N A,T,DIQGSALX,DIQGTAXX
  1. S:$G(DIQGTA)]"" DIQGTAXX=$S('$D(DIQGSAL(DIQGSAL,"#(word-processing)")):DIQGTA,1:$$OREF(DIQGTA)_$$Q(DIQGSAL)_")")
  1. I '$D(^DD(DIQGR,DA,0)) D BLD^DIALOG(601),FE Q ""
  1. I $P($P(^DD(DIQGR,DA,0),U,2),"t",2) D I $G(DIQGSALX)]"" Q DIQGSALX ;GFT: IS THIS AN EXTENDED DATA TYPE?
  1. .S A=$$GETMETH^DIETLIBF(DIQGR,DA,DIQGSAL) I A]"" S DIQGSALX=A Q ;FIND THE ATTRIBUTE AS A 'METHOD'
  1. .S A=$$GETPROP^DIETLIBF(DIQGR,DA,DIQGSAL) I A]"" S DIQGSALX=A ;FIND THE ATTRIBUTE AS A 'PROPERTY'
  1. .I DIQGSAL="TYPE" S DIQGSALX=$P(^DI(.81,+$P($P(^DD(DIQGR,DA,0),U,2),"t",2),0),U) ;'TYPE' EQUALS AN ENTRY IN FILE .81
  1. S A=$P(^DD(DIQGR,DA,0),U,2),T=$P(^(0),U,5,99)
  1. ;This line temporarily removed until functionality can be documented in the Developer Guide
  1. ;I DIQGSAL="POINTER" I A'["P",A'["p" Q "" ;DON'T SHOW A 'SET OF CODES' FOR A 'POINTER'
  1. I DIQGSAL="SET OF CODES",A["S" Q $P(^(0),U,3)
  1. I DIQGSAL="LAYGO",A["P" Q $S(A["'":"NO",1:"YES")
  1. I DIQGSAL="EARLIEST DATE",A["D" N Y S Y="<X!(",Y=$S(T'[Y:"",1:+$P($P(T,Y,2),">X")) X ^DD("DD") Q Y
  1. I DIQGSAL="SECONDS ALLOWED",A["D" Q $P("NO^YES",U,$P(T,"""",2)["S"+1)
  1. I DIQGSAL="TIME OF DAY",A["D" Q $P("NO^YES",U,$P(T,"""",2)["T"+1)
  1. I DIQGSAL="TIME REQUIRED",A["D" Q $P("NO^YES",U,$P(T,"""",2)["R"+1)
  1. I DIQGSAL="IMPRECISE DATE",A["D" Q $P("YES^NO",U,$P(T,"""",2)["X"+1)
  1. I DIQGSAL="CODE TO SET POINTER SCREEN",A["P" Q $G(^(12.1))
  1. I DIQGSAL="FIELD LENGTH" Q $$FL^DIQGDDU(DIQGR,DA)
  1. I $D(DIQGSAL(DIQGSAL))#2 Q $$GET^DIQG("^DD("_DIQGR_",",DA,DIQGSAL(DIQGSAL),DIQGPARM,.DIQGTAXX,"","1A") ;GET ATTRIBUTES FROM DATA DICTIONARY
  1. Q $G(DIQGSALX)
  1. ;
  1. ;
  1. ;
  1. BLDSAL(DIQGTYPE,DIQGDR,DIQGVALA) ;DIQGTYPE=1 for FILE and 0 for FIELD, DIQGDR=string/array, DIQGVALA= OUTPUT: valid attribute list array
  1. ; If DIQGDR is an array pass by reference
  1. I $G(DIQGDR)="*" D LIST^DIQGDDT($S(DIQGTYPE=1:"FILETXT",1:"FIELDTXT"),.DIQGVALA,"",3) M:DIQGTYPE'=1 DIQGVALA=^DI(.86,"B"),DIQGVALA=^DI(.87,"B") Q ;GET ALL ATTRIBUTE NAMES, INCLUDING METHODS AND PROPERTIES
  1. N DIQGER,DIQGI,DIQGX,DIQGY D LIST^DIQGDDT($S(DIQGTYPE=1:"FILETXT",1:"FIELDTXT"),.DIQGX,"",3) ;PUT LIST OF ATTRIBUTES INTO DIQGX ARRAY!
  1. M DIQGX=^DI(.86,"B"),DIQGX=^DI(.87,"B") ;MOVE PROPERTY AND METHOD NAMES INTO THE ARRAY, TOO!
  1. I $G(DIQGDR)]"" F DIQGI=1:1 S DIQGY=$P(DIQGDR,";",DIQGI) Q:DIQGY="" D
  1. .I '$D(DIQGX(DIQGY)) S DIQGER(4)=DIQGY D 200 Q
  1. .S DIQGVALA(DIQGY)=$G(DIQGX(DIQGY)) S:$D(DIQGX(DIQGY,"#(word-processing)")) DIQGVALA(DIQGY,"#(word-processing)")=DIQGX(DIQGY)
  1. Q:$D(DIQGVALA)
  1. S DIQGY="" F S DIQGY=$O(DIQGDR(DIQGY)) Q:DIQGY="" D
  1. .I '$D(DIQGX(DIQGY)) S DIQGER(4)=DIQGY D 200 Q
  1. .S DIQGVALA(DIQGY)=DIQGX(DIQGY) S:$D(DIQGX(DIQGY,"#(word-processing)")) DIQGVALA(DIQGY,"#(word-processing)")=DIQGX(DIQGY)
  1. .Q
  1. Q
  1. ;
  1. XDR(DIQGR,DR,DIQGERR) ;DIQGR DD FILE NUMBER EITHER 1 OR 0
  1. ;DR IS DR STRING TO CONVERT TO NUMERIC DR STRING
  1. S DIQGR=+$G(DIQGR),DR=$G(DR)
  1. N I,X,XDR D LIST^DIQGDDT($S(DIQGR=1:"FILETXT",1:"FIELDTXT"),.X,4,3)
  1. I $G(DR)]"" S (X,XDR)="" F I=1:1 S X=$P(DR,";",I) Q:X="" D
  1. .I '$D(X(X)) S DIQGERR(X)="" Q
  1. .S XDR=XDR_X(X)_";" Q
  1. I $D(DR)>1 S (X,XDR)="" F S X=$O(DR(X)) Q:X="" D:'$D(X(X)) S:X]"" XDR=XDR_X(X)_";"
  1. .I '$D(X(X)) S DIQGERR(X)="" Q
  1. .S XDR=XDR_X(X)_";" Q
  1. Q XDR
  1. ;
  1. ATRBT(TYPE,ATRIB) ;EXTRINSIC FUNCTION $$TEST IF VALID ATTRIBUTE
  1. ;TYPE 0 OR 1 - FIELD=0, FILE=1 (^DD(0) OR ^DD(1))
  1. ;ATRIB=ATTRIBUTE BEING REQUESTED
  1. Q:ATRIB']"" 0
  1. N X D LIST^DIQGDDT($S(TYPE=1:"FILETXT",1:"FIELDTXT"),.X,,3)
  1. Q $G(X(ATRIB))
  1. ;
  1. ;
  1. DR(TYPE) ;TYPE=1,FILE OR 0,FIELD AND RETURNS DR STRING FOR ALL ATTRIBUTES IN INTERNAL FORM (ATTRIBUTE FIELD NUMBERS 3RD ;-PIECE
  1. S TYPE=+$G(TYPE)
  1. N X,Y
  1. D LIST^DIQGDDT($S(TYPE=1:"FILETXT",1:"FIELDTXT"),.X,3)
  1. S (X,Y)=.01 F S Y=$O(X(Y)) Q:Y'>0 S X=X_";"_Y
  1. Q X
  1. ;
  1. FILELST(DIDARRAY) ;PASS TARGET ARRAY BY REFERENCE * * LIST FILE ATTRIBUTES * *
  1. EN4 N EQL,TP,TYPE,DIQGDFLG
  1. S TYPE="FILETXT",DIQGDFLG="L"
  1. G ENLST^DIQGDDT
  1. ;
  1. FIELDLST(DIDARRAY) ;PASS TARGET ARRAY BY REFERENCE * * LIST FIELD ATTRIBUTES * *
  1. EN5 N EQL,TP,TYPE,DIQGDFLG
  1. S TYPE="FIELDTXT",DIQGDFLG="L"
  1. G ENLST^DIQGDDT
  1. ;
  1. OREF(X) N X1,X2 S X1=$P(X,"(")_"(",X2=$$OR2($P(X,"(",2)) Q:X2="" X1 Q X1_X2_","
  1. ;
  1. OR2(%) Q:%=")"!(%=",") "" Q:$L(%)=1 % S:"),"[$E(%,$L(%)) %=$E(%,1,$L(%)-1) Q %
  1. ;
  1. Q(%Z) S %Z(%Z)="",%Z=$Q(%Z("")) Q $E(%Z,4,$L(%Z)-1)
  1. ;
  1. 200 D BLD^DIALOG(200),FE Q ;ERROR MESSAGE
  1. ;
  1. 202(E) N X S X(1)=E
  1. D BLD^DIALOG(202,.X),FE
  1. Q
  1. FE I $G(DIQGERRA)]"" D CALLOUT^DIEFU(DIQGERRA)
  1. Q