DIQGDDF.m

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 ---DIQGDDF   1581     printed  Apr 09, 2024@21:54:43                                                                                                                                                                                                     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