DIQGDDF ;SFISC/DCL,MMW-DD ATTRIBUTE RETRIEVER (FILES) ;12:44 PM 26 Sep 1996
;;22.2;VA FileMan;;Jan 05, 2016;Build 42
;;Per VA Directive 6402, this routine should not be modified.
;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
;;Licensed under the terms of the Apache License, Version 2.0.
;
Q ;not for interactive use
FILE(DIQGR,DR,DIQGPARM,DIQGTA,DIQGERRA,DIQGIPAR) ;
EN2 N DA
I '$G(DIQGR),$G(DIQGR)]"",$D(^DIC("B",DIQGR)) S DIQGR=$O(^(DIQGR,""))
N DIQGERR,DIQGEY,DIQGSAL,DIQGFNUL,DIQGSALX,DIQGTAXX
S DIQGEY(1)=$G(DIQGR)
I $G(U)'="^" N U S U="^"
I $G(DIQGIPAR)'["A" K DIERR,^TMP("DIERR",$J)
I $G(DIQGR)'>0 D 202^DIQGDD("FILE") Q
I $D(^DD(DIQGR,0))[0 D 202^DIQGDD("FILE") Q
S DA=DIQGR,DIQGR=1 I '$D(^DIC(DA,0)) D 202^DIQGDD("FILE") Q
I $G(DIQGTA)']"" D 202^DIQGDD("TARGET ARRAY") Q
S DIQGPARM=$G(DIQGPARM),DIQGFNUL=DIQGPARM["N"
I DA'>0 S DIQGEY(3)=DA D 200^DIQGDD Q
D BLDSAL^DIQGDD(1,.DR,.DIQGSAL)
I '$D(DIQGSAL),'$D(DIERR) D 200^DIQGDD Q
I '$D(DIQGSAL) Q
S DIQGSAL="" F S DIQGSAL=$O(DIQGSAL(DIQGSAL)) Q:DIQGSAL="" D
.I DIQGSAL="REQUIRED IDENTIFIERS" D Q
..N X
..S X=$$RIF^DIQGDDU(DA,DIQGSAL,DIQGTA)
..S:X]"" @DIQGTA@(DIQGSAL)=X
..Q
.S DIQGTAXX=$S('$D(DIQGSAL(DIQGSAL,"#(word-processing)")):DIQGTA,1:$$OREF^DIQGDD(DIQGTA)_$$Q^DIQGDD(DIQGSAL)_")")
.S DIQGSALX=$$GET^DIQG("^DIC(",DA,DIQGSAL(DIQGSAL),DIQGPARM,DIQGTAXX,"","1A")
SETF .I DIQGSALX]"" S @DIQGTA@(DIQGSAL)=DIQGSALX Q
.Q:DIQGFNUL
.S @DIQGTA@(DIQGSAL)=DIQGSALX
.Q
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDIQGDDF 1581 printed Dec 13, 2024@02:53:37 Page 2
DIQGDDF ;SFISC/DCL,MMW-DD ATTRIBUTE RETRIEVER (FILES) ;12:44 PM 26 Sep 1996
+1 ;;22.2;VA FileMan;;Jan 05, 2016;Build 42
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
+4 ;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
+5 ;;Licensed under the terms of the Apache License, Version 2.0.
+6 ;
+7 ;not for interactive use
QUIT
FILE(DIQGR,DR,DIQGPARM,DIQGTA,DIQGERRA,DIQGIPAR) ;
EN2 NEW DA
+1 IF '$GET(DIQGR)
IF $GET(DIQGR)]""
IF $DATA(^DIC("B",DIQGR))
SET DIQGR=$ORDER(^(DIQGR,""))
+2 NEW DIQGERR,DIQGEY,DIQGSAL,DIQGFNUL,DIQGSALX,DIQGTAXX
+3 SET DIQGEY(1)=$GET(DIQGR)
+4 IF $GET(U)'="^"
NEW U
SET U="^"
+5 IF $GET(DIQGIPAR)'["A"
KILL DIERR,^TMP("DIERR",$JOB)
+6 IF $GET(DIQGR)'>0
DO 202^DIQGDD("FILE")
QUIT
+7 IF $DATA(^DD(DIQGR,0))[0
DO 202^DIQGDD("FILE")
QUIT
+8 SET DA=DIQGR
SET DIQGR=1
IF '$DATA(^DIC(DA,0))
DO 202^DIQGDD("FILE")
QUIT
+9 IF $GET(DIQGTA)']""
DO 202^DIQGDD("TARGET ARRAY")
QUIT
+10 SET DIQGPARM=$GET(DIQGPARM)
SET DIQGFNUL=DIQGPARM["N"
+11 IF DA'>0
SET DIQGEY(3)=DA
DO 200^DIQGDD
QUIT
+12 DO BLDSAL^DIQGDD(1,.DR,.DIQGSAL)
+13 IF '$DATA(DIQGSAL)
IF '$DATA(DIERR)
DO 200^DIQGDD
QUIT
+14 IF '$DATA(DIQGSAL)
QUIT
+15 SET DIQGSAL=""
FOR
SET DIQGSAL=$ORDER(DIQGSAL(DIQGSAL))
if DIQGSAL=""
QUIT
Begin DoDot:1
+16 IF DIQGSAL="REQUIRED IDENTIFIERS"
Begin DoDot:2
+17 NEW X
+18 SET X=$$RIF^DIQGDDU(DA,DIQGSAL,DIQGTA)
+19 if X]""
SET @DIQGTA@(DIQGSAL)=X
+20 QUIT
End DoDot:2
QUIT
+21 SET DIQGTAXX=$SELECT('$DATA(DIQGSAL(DIQGSAL,"#(word-processing)")):DIQGTA,1:$$OREF^DIQGDD(DIQGTA)_$$Q^DIQGDD(DIQGSAL)_")")
+22 SET DIQGSALX=$$GET^DIQG("^DIC(",DA,DIQGSAL(DIQGSAL),DIQGPARM,DIQGTAXX,"","1A")
SETF IF DIQGSALX]""
SET @DIQGTA@(DIQGSAL)=DIQGSALX
QUIT
+1 if DIQGFNUL
QUIT
+2 SET @DIQGTA@(DIQGSAL)=DIQGSALX
+3 QUIT
End DoDot:1
+4 QUIT
