- DIQGDDF ;SFISC/DCL,MMW-DD ATTRIBUTE RETRIEVER (FILES) ;12:44 PM 26 Sep 1996
- ;;22.0;VA FileMan;;Mar 30, 1999
- ;Per VHA Directive 10-93-142, this routine should not be modified.
- 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
- DIQGDDF ;SFISC/DCL,MMW-DD ATTRIBUTE RETRIEVER (FILES) ;12:44 PM 26 Sep 1996
- +1 ;;22.0;VA FileMan;;Mar 30, 1999
- +2 ;Per VHA Directive 10-93-142, this routine should not be modified.
- +3 ;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