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

DIAXU.m

Go to the documentation of this file.
  1. DIAXU ;SFISC/DCM-UPDATE DESTINATION FILE ;8/16/96 16:42
  1. ;;22.2;VA FileMan;;Jan 05, 2016;Build 42
  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. Q
  1. DIAX ;called from ^DIAX (Update Destination File option)
  1. DQ ;
  1. I $D(ZTQUEUED) N DIAR,DIAX S ZTREQ="@",DIAR=6,DIAX=1 D MRK^DIARU
  1. N DIAXF,DIAXFRT S DIAXF=$P(^DIAR(1.11,DIARC,0),U,2),DIAXFRT=$$ROOT^DILFD(DIAXF)
  1. D EXTRACT(DIAXF,DIARB,DIARP)
  1. D UPDATE^DIARU
  1. 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
  1. XREP ;
  1. I $D(ZTQUEUED) S ZTREQ="@"
  1. D ^DIAXP
  1. Q
  1. EN ; obsolete, replaced by EXTRACT
  1. N %,DIAXERR S DIAXERR=""
  1. D CLEAN^DIEFU
  1. F %=$G(DIAXF)_U_"DIAXF",$G(DIAXFE)_U_"DIAXFE",$G(DIAXT)_U_"DIAXT" I $P(%,U,1)']"" D ERR(201,$P(%,U,2))
  1. Q:$G(DIERR)
  1. D EXTRACT(DIAXF,DIAXFE,DIAXT,$S($D(DIAXDEL):"D",1:""))
  1. I '$G(DIERR),$D(^TMP("DIAXU",$J,"RESULT",DIAXF,DIAXFE)) S DIAXDA=^(DIAXFE)
  1. Q
  1. ;
  1. DIPT N X,D,SCR,DIARP,DIAR,DIPG
  1. S X=$S(DIAXT:DIAXT,1:$P($P(DIAXT,"[",2),"]")),D="F"_DIAXF,SCR="I $P(^(0),U,8)=2"
  1. S DIARP=$$FIND1^DIC(.4,"","XA",X,D,SCR,DIAXERR)
  1. Q:$G(DIERR) I 'DIARP D ERR(202,"EXTRACT TEMPLATE") Q
  1. S DIAR=6,DIPG=1,DIAXT=DIARP,DIAXDF=$P(^DIPT(DIAXT,0),U,9),DIAXDFRT=$$ROOT^DILFD(DIAXDF)
  1. D EN^DIAXM
  1. Q
  1. DIK N DIK,DA
  1. S DIK=$$ROOT^DILFD(DIAXF),DA=DIAXFE
  1. D ^DIK
  1. Q
  1. K K @DIAXTFR,@DIAXTTO
  1. Q
  1. ONE I '$$VENTRY^DIEFU(DIAXF,DIAXFE) D ERR(601,DIAXFE),STE() Q
  1. D ^DIAXD I $G(DIERR) D:$D(DIAXFILE) D STE() Q
  1. . N DIERR,A S A("IEN")=DIAXFE
  1. . D BLD^DIALOG(1300,"",.A)
  1. D ^DIAXF I $G(DIERR) D STE() Q
  1. Q:$D(DIAX)
  1. I $G(DIAXFLGS)["D" D DIK
  1. I $G(DIAXDA) S @DIAXRSLT@("RESULT",DIAXF,DIAXFE)=DIAXDA
  1. Q
  1. ;
  1. DIBT N SCR,D
  1. S D="F"_DIAXF,SCR="I $P(^(0),U,4)="_DIAXF_",'$P(^(0),U,8)"
  1. S DIAXST=$S($G(DIAXST):DIAXST,1:$$FIND1^DIC(.401,"","AX",DIAXST,D,SCR,DIAXERR))
  1. I 'DIAXST!('$D(^DIBT(DIAXST,1))) D ERR(202,"SEARCH TEMPLATE") S:$G(DIAR) DIAR="" Q
  1. N Z S Z=0 F S Z=$O(^DIBT(DIAXST,1,Z)) Q:Z'>0 D
  1. . N DIAXDA,DIAXFE,DIERR
  1. . S DIAXFE=Z
  1. . D ONE
  1. . Q:$G(DIERR)
  1. . I $G(DIAX) D Q
  1. . . N FDA,IEN
  1. . . S FDA(1.14,"+"_+DIAXFE_","_DIARC_",",.01)=DIAXDA,IEN(DIAXFE)=DIAXDA
  1. . . D UPDATE^DIE("","FDA","IEN")
  1. . . S @(DIAXFRT_"DIAXFE,-9)")=DIARC
  1. . I $G(DIAXFLGS)["D" K ^DIBT(DIAXST,1,DIAXFE)
  1. Q
  1. STE(FI,IEN) N Z
  1. S:$G(FI)="" FI=DIAXF
  1. S:$G(IEN)="" IEN=DIAXFE
  1. S DIERRZ=(DIERR+DIERRZ)_U_($P(DIERR,U,2)+($P(DIERRZ,U,2)))
  1. F DIERRLST=DIERRLST:1:$O(^TMP("DIERR",$J,"E"),-1) S Z=DIERRLST_";"
  1. S @DIAXRSLT@("RESULT","ERR",FI,IEN)=Z
  1. Q
  1. ERR(DIAXER,DIAXTXT) ;
  1. D BLD^DIALOG(DIAXER,DIAXTXT,"",DIAXERR,"F")
  1. Q
  1. EXTRACT(DIAXF,DIAXSRCE,DIAXT,DIAXFLGS,DIAXSCR,DIAXFILE,DIAXRSLT,DIAXERRA) ;
  1. N DIAXST,DIAXFE,T,DIFM,DIOVRD,DIERRLST,DIAXTFR,DIAXTTO,DIAXDF,DIAXDFRT,DIAXERR,DIERRZ,DIAXDA
  1. S DIAXRSLT=$S($G(DIAXRSLT)]"":DIAXRSLT,1:"^TMP(""DIAXU"",$J)"),(DIFM,DIOVRD)=1,(DIERRLST,DIERRZ)=0,DIAXERR=""
  1. K ^TMP("DIAXU",$J),^TMP("DIAX",$J),^TMP($J) D CLEAN^DIEFU
  1. I '$G(DIAR) D Q:$G(DIERR)
  1. . 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))
  1. . Q:$G(DIERR)
  1. . I '$$VFILE^DIEFU(DIAXF) D ERR(202,"FILE") Q
  1. . I $G(DIAXSRCE) S DIAXFE=+DIAXSRCE,T="ONE"
  1. . I $E(DIAXSRCE)="[" S DIAXST=$P($P(DIAXSRCE,"[",2),"]"),T="DIBT"
  1. . D DIPT
  1. . Q
  1. E S T="DIBT",DIAXST=DIAXSRCE
  1. D ^DIAXT I $G(DIERR) S:$G(DIAR) DIAR="" Q
  1. D @T,K
  1. I $G(DIERRZ) S DIERR=DIERRZ
  1. I $G(DIERR),$G(DIAXERRA)]"" M @DIAXERRA@("DIERR")=^TMP("DIERR",$J) K ^TMP("DIERR",$J)
  1. Q