source: WorldVistAEHR/trunk/r/VA_FILEMAN-ARJT-DI-DD-DM-DT-%DT-%RCR/DIAXU.m@ 1389

DIAXU ;SFISC/DCM-UPDATE DESTINATION FILE ;8/16/96  16:42
 ;;22.0;VA FileMan;;Mar 30, 1999
 ;Per VHA Directive 10-93-142, this routine should not be modified.
 Q
DIAX ;called from ^DIAX (Update Destination File option)
DQ ;
 I $D(ZTQUEUED) N DIAR,DIAX S ZTREQ="@",DIAR=6,DIAX=1 D MRK^DIARU
 N DIAXF,DIAXFRT S DIAXF=$P(^DIAR(1.11,DIARC,0),U,2),DIAXFRT=$$ROOT^DILFD(DIAXF)
 D EXTRACT(DIAXF,DIARB,DIARP)
 D UPDATE^DIARU
 I $D(ZTQUEUED),$G(DIERR) S ZTIO=DIAXIOP,ZTRTN="XREP^DIAXU",ZTDESC="EXTRACT TOOL EXCEPTION REPORT",ZTSAVE("^TMP(""DIAXU"",$J)")="",ZTSAVE("^TMP(""DIERR"",$J)")="",ZTSAVE("DIARC")="" D ^%ZTLOAD Q 
XREP ;
 I $D(ZTQUEUED) S ZTREQ="@"
 D ^DIAXP
 Q
EN ; obsolete, replaced by EXTRACT
 N %,DIAXERR S DIAXERR=""
 D CLEAN^DIEFU
 F %=$G(DIAXF)_U_"DIAXF",$G(DIAXFE)_U_"DIAXFE",$G(DIAXT)_U_"DIAXT" I $P(%,U,1)']"" D ERR(201,$P(%,U,2))
 Q:$G(DIERR)
 D EXTRACT(DIAXF,DIAXFE,DIAXT,$S($D(DIAXDEL):"D",1:""))
 I '$G(DIERR),$D(^TMP("DIAXU",$J,"RESULT",DIAXF,DIAXFE)) S DIAXDA=^(DIAXFE)
 Q
 ;
DIPT N X,D,SCR,DIARP,DIAR,DIPG
 S X=$S(DIAXT:DIAXT,1:$P($P(DIAXT,"[",2),"]")),D="F"_DIAXF,SCR="I $P(^(0),U,8)=2"
 S DIARP=$$FIND1^DIC(.4,"","XA",X,D,SCR,DIAXERR)
 Q:$G(DIERR)  I 'DIARP D ERR(202,"EXTRACT TEMPLATE") Q
 S DIAR=6,DIPG=1,DIAXT=DIARP,DIAXDF=$P(^DIPT(DIAXT,0),U,9),DIAXDFRT=$$ROOT^DILFD(DIAXDF)
 D EN^DIAXM
 Q
DIK N DIK,DA
 S DIK=$$ROOT^DILFD(DIAXF),DA=DIAXFE
 D ^DIK
 Q
K K @DIAXTFR,@DIAXTTO
 Q
ONE I '$$VENTRY^DIEFU(DIAXF,DIAXFE) D ERR(601,DIAXFE),STE() Q
 D ^DIAXD I $G(DIERR) D:$D(DIAXFILE)  D STE() Q
 . N DIERR,A S A("IEN")=DIAXFE
 . D BLD^DIALOG(1300,"",.A)
 D ^DIAXF I $G(DIERR) D STE() Q
 Q:$D(DIAX)
 I $G(DIAXFLGS)["D" D DIK
 I $G(DIAXDA) S @DIAXRSLT@("RESULT",DIAXF,DIAXFE)=DIAXDA
 Q
 ;
DIBT N SCR,D
 S D="F"_DIAXF,SCR="I $P(^(0),U,4)="_DIAXF_",'$P(^(0),U,8)"
 S DIAXST=$S($G(DIAXST):DIAXST,1:$$FIND1^DIC(.401,"","AX",DIAXST,D,SCR,DIAXERR))
 I 'DIAXST!('$D(^DIBT(DIAXST,1))) D ERR(202,"SEARCH TEMPLATE") S:$G(DIAR) DIAR="" Q
 N Z S Z=0 F  S Z=$O(^DIBT(DIAXST,1,Z)) Q:Z'>0  D
 . N DIAXDA,DIAXFE,DIERR
 . S DIAXFE=Z
 . D ONE
 . Q:$G(DIERR)
 . I $G(DIAX) D  Q
 . . N FDA,IEN
 . . S FDA(1.14,"+"_+DIAXFE_","_DIARC_",",.01)=DIAXDA,IEN(DIAXFE)=DIAXDA
 . . D UPDATE^DIE("","FDA","IEN")
 . . S @(DIAXFRT_"DIAXFE,-9)")=DIARC
 . I $G(DIAXFLGS)["D" K ^DIBT(DIAXST,1,DIAXFE)
 Q
STE(FI,IEN) N Z
 S:$G(FI)="" FI=DIAXF
 S:$G(IEN)="" IEN=DIAXFE
 S DIERRZ=(DIERR+DIERRZ)_U_($P(DIERR,U,2)+($P(DIERRZ,U,2)))
 F DIERRLST=DIERRLST:1:$O(^TMP("DIERR",$J,"E"),-1) S Z=DIERRLST_";"
 S @DIAXRSLT@("RESULT","ERR",FI,IEN)=Z
 Q
ERR(DIAXER,DIAXTXT) ;
 D BLD^DIALOG(DIAXER,DIAXTXT,"",DIAXERR,"F")
 Q
EXTRACT(DIAXF,DIAXSRCE,DIAXT,DIAXFLGS,DIAXSCR,DIAXFILE,DIAXRSLT,DIAXERRA) ;
 N DIAXST,DIAXFE,T,DIFM,DIOVRD,DIERRLST,DIAXTFR,DIAXTTO,DIAXDF,DIAXDFRT,DIAXERR,DIERRZ,DIAXDA
 S DIAXRSLT=$S($G(DIAXRSLT)]"":DIAXRSLT,1:"^TMP(""DIAXU"",$J)"),(DIFM,DIOVRD)=1,(DIERRLST,DIERRZ)=0,DIAXERR=""
 K ^TMP("DIAXU",$J),^TMP("DIAX",$J),^TMP($J) D CLEAN^DIEFU
 I '$G(DIAR) D  Q:$G(DIERR)
 . N %,PARAM F %=1:1:3 S PARAM=$S(%=1:$G(DIAXF)_U_"FILE",%=2:$G(DIAXSRCE)_U_"SOURCE",1:$G(DIAXT)_U_"EXTRACT TEMPLATE") I $P(PARAM,U)']"" D ERR(202,$P(PARAM,U,2))
 . Q:$G(DIERR)
 . I '$$VFILE^DIEFU(DIAXF) D ERR(202,"FILE") Q
 . I $G(DIAXSRCE) S DIAXFE=+DIAXSRCE,T="ONE"
 . I $E(DIAXSRCE)="[" S DIAXST=$P($P(DIAXSRCE,"[",2),"]"),T="DIBT"
 . D DIPT
 . Q
 E  S T="DIBT",DIAXST=DIAXSRCE
 D ^DIAXT I $G(DIERR) S:$G(DIAR) DIAR="" Q
 D @T,K
 I $G(DIERRZ) S DIERR=DIERRZ
 I $G(DIERR),$G(DIAXERRA)]"" M @DIAXERRA@("DIERR")=^TMP("DIERR",$J) K ^TMP("DIERR",$J)
 Q