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

DIEF.m

Go to the documentation of this file.
  1. DIEF ;SFISC/DPC-FILER DRIVER ;16FEB2007
  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. FILE(DIEFFLAG,DIEFAR,DIEFOUT,DIEFADAR) ;
  1. FILEX ;
  1. N DIEFF,DIEFCNOD,DIEFNODE,DIEFSPOT,DIEFDAS,DIEFIEN,DIEFRFLD,DIEFFLD,DIEFFVAL,DIEFOVAL,DIEFNVAL,DIEFTSRC,DIEFLOCK,DIEFECNT
  1. N DIDATA,DIEFFLST,DIEFFREF,DIEFFXR,DIEFLEV,DIEFRLST,DIEFTMP,DIEFTREF
  1. S DIEFFLAG=$G(DIEFFLAG)
  1. I '$D(DIQUIET) N DIQUIET S DIQUIET=1
  1. I '$D(DIFM) N DIFM S DIFM=1 D INIZE^DIEFU
  1. I '$$VERFLG^DIEFU(DIEFFLAG,"ISKEOTU") G OUT
  1. I DIEFFLAG["T",DIEFFLAG'["E" D BLD^DIALOG(301,DIEFFLAG,DIEFFLAG) G OUT
  1. I '$$VROOT^DIEFU(DIEFAR) G OUT
  1. I '($D(@DIEFAR)\10) D BLD^DIALOG(305,DIEFAR,DIEFAR) G OUT
  1. I DIEFFLAG["K" N DIEFNOLK,DIEFLCKS D LOCK^DIEF1 I DIEFNOLK G OUT
  1. ;batch conversion to internal and key validation if requested.
  1. I DIEFFLAG["T" S DIEFECNT=$G(DIERR) D G:DIEFECNT'=$G(DIERR) OUT
  1. . S DIEFAR("INT")="^TMP($J,""DIEF"")"
  1. . D VALS^DIEVS("R"_$E("U",DIEFFLAG["U"),DIEFAR,DIEFAR("INT"))
  1. . S DIEFAR("EXT")=DIEFAR,DIEFAR=DIEFAR("INT")
  1. S DIEFTMP=$$GETTMP^DIKC1("DIEF")
  1. D DRIVER
  1. OUT I $D(DIEFLOCK) D UNLOCK^DIEF1
  1. I DIEFFLAG'["S",'$G(DIERR) K @$G(DIEFAR("EXT"),DIEFAR)
  1. I $D(DIEFAR("INT")) K @DIEFAR("INT")
  1. I $G(DIEFOUT)]"" D CALLOUT^DIEFU(DIEFOUT)
  1. I $D(DIEFTMP) K @DIEFTMP
  1. Q
  1. DRIVER ;
  1. S DIEFF=""
  1. F S DIEFF=$O(@DIEFAR@(DIEFF)) Q:DIEFF="" D
  1. . I DIEFFLAG'["K",'$$VFILE^DIEFU(DIEFF,"D") Q
  1. . S DIEFFREF=$$FROOTDA^DIKCU(DIEFF,"D",.DIEFLEV,.DIEFTREF) Q:DIEFFREF=""
  1. . S DIEFDAS=""
  1. . F S DIEFDAS=$O(@DIEFAR@(DIEFF,DIEFDAS)) Q:DIEFDAS="" D
  1. . . N D,I,DA,S,DIOPER
  1. . . S DIEFIEN=DIEFDAS
  1. . . I ($E(DIEFIEN)="?"!($E(DIEFIEN)="+")),$G(DIEFADAR)]"" D
  1. . . . I $E(DIEFIEN)="+" S DIOPER="A"
  1. . . . E I $E(DIEFIEN,1,2)="?+",@DIEFADAR@($TR($P(DIEFIEN,","),"?+"),0)="+" S DIOPER="A"
  1. . . . S DIEFIEN=$$ADDCONV^DIEF1(DIEFIEN,DIEFADAR)
  1. . . S S=" " F S S=$O(@DIEFTMP@("DEL",DIEFF,S)) Q:S="" I ","_DIEFIEN?@(".E1"","_S_"""") S DIEFDAS=$C(127) Q
  1. . . Q:DIEFDAS=$C(127)
  1. . . I DIEFFLAG'["K" Q:'$$GOODIEN(DIEFF,DIEFIEN,DIEFLEV,"","D")
  1. . . F I=0:1:DIEFLEV S D="D"_(DIEFLEV-I) N @D S (DA(I),@D)=$P(DIEFIEN,",",I+1)
  1. . . S DA=DA(0) K DA(0)
  1. . . S DIDATA=$NA(@DIEFFREF@(DA))
  1. . . Q:'$$VENTRY(DIEFF,DIEFIEN,"D"_$E(9,DIEFFLAG["E"),DIDATA,DIEFTREF)
  1. . . N DOREPL S DIEFRFLD="",DOREPL=0
  1. . . F S DIEFRFLD=$O(@DIEFAR@(DIEFF,DIEFDAS,DIEFRFLD)) Q:DIEFRFLD="" D
  1. . . . N DIEFNG
  1. . . . S DIEFFLD=$$CHKFLD^DIEFU(DIEFF,DIEFRFLD) I 'DIEFFLD Q
  1. . . . I DIEFFLD=.001 D BLD^DIALOG(520,".001",".001") Q
  1. . . . S DIEFNVAL=@DIEFAR@(DIEFF,DIEFDAS,DIEFRFLD)
  1. . . . I DIEFFLAG["E",DIEFFLAG'["T" D VAL Q:$D(DIEFNG)
  1. . . . I DIEFFLD=.01,"@"[DIEFNVAL D PT01DEL Q
  1. . . . S DIEFSPOT=$P(^DD(DIEFF,DIEFFLD,0),U,4)
  1. . . . S DIEFNODE=$NA(@DIDATA@($P(DIEFSPOT,";")))
  1. . . . S DIEFSPOT=$P(DIEFSPOT,";",2)
  1. . . . I DIEFNODE'=$G(DIEFCNOD) D:DOREPL REPLACE S DIEFCNOD=DIEFNODE D RETRIEVE
  1. . . . I DIEFNVAL="@" S DIEFNVAL=""
  1. . . . D LOADFLD^DIKC1(DIEFF,DIEFFLD,"KS","",$NA(@DIEFTMP@("V")),"DIEFFXR",$NA(@DIEFTMP@("R")),.DIEFFLST,.DIEFRLST)
  1. . . . I DIEFFLAG'["T",DIEFFLAG'["U",'$$SKEYCHK^DIEF1(DIEFF,DIEFFLD,DIEFNVAL,.DA,DIEFIEN,.DIEFFXR) K DIEFFXR Q
  1. . . . D PUTDATA^DIEF1 Q:$D(DIEFNG)
  1. . . . I DIEFNVAL'=$G(DIEFOVAL) D XRFAUD,FIREFLD
  1. . . D REPLACE:DOREPL K DIEFCNOD
  1. . . D FIREREC
  1. Q
  1. PT01DEL ;
  1. N DIEFERR
  1. I DIEFNVAL="" F S DIEFERR=$O(^DD(DIEFF,.01,"DEL",$G(DIEFERR))) Q:DIEFERR="" I $D(^(DIEFERR,0)) X ^(0) I D G Q
  1. . N INT,EXT
  1. . S INT(1)=$$FLDNM^DIEFU(DIEFF,DIEFFLD),INT(2)=$$FILENM^DIEFU(DIEFF),EXT("FILE")=DIEFF,EXT("FIELD")=DIEFFLD
  1. . D BLD^DIALOG(712,.INT,.EXT) ;"CANNOT BE DELETED"
  1. S DIEFECNT=$G(DIERR)
  1. N %,DIC,DIK S DIK=$$OREF^DILF($NA(@DIEFFREF)) D ^DIK
  1. I DIEFECNT'=$G(DIERR) D HKERR^DILIBF(DIEFF,DIEFIEN,DIEFFLD,"cross reference")
  1. N SB D SUBFILES^DIKCU(DIEFF,.SB) S SB(DIEFF)=""
  1. S SB=0 F S SB=$O(SB(SB)) Q:'SB S @DIEFTMP@("DEL",SB,DIEFIEN)=""
  1. S DIEFRFLD=$C(127),DOREPL=0
  1. K @DIEFTMP@("R"),@DIEFTMP@("V")
  1. Q Q
  1. ;
  1. VAL ;
  1. N DIEFTYPE,DIEFINT
  1. D DTYP^DIOU(DIEFF,DIEFFLD,.DIEFTYPE) Q:DIEFTYPE=5
  1. D VAL^DIEV(DIEFF,DIEFIEN,DIEFFLD,"U",DIEFNVAL,.DIEFINT)
  1. I DIEFINT'=U S DIEFNVAL=DIEFINT Q
  1. S DIEFNG=1
  1. Q
  1. REPLACE ;
  1. S @DIEFCNOD=DIEFFVAL,DOREPL=0
  1. Q
  1. RETRIEVE ;
  1. S DIEFFVAL=$G(@DIEFCNOD)
  1. Q
  1. ;
  1. XRFAUD ;
  1. I $D(^DD(DIEFF,"IX",DIEFFLD)) D REPLACE:$G(DOREPL),IX,RETRIEVE:$D(DOREPL)
  1. I $D(^DD(DIEFF,"AUDIT",DIEFFLD)) D AUDIT
  1. Q
  1. IX ;
  1. N X,DIEFSORK
  1. I DIEFOVAL'="" S DIEFSORK=2 D FIRE
  1. I "@"'[DIEFNVAL S DIEFSORK=1 D FIRE
  1. Q
  1. FIRE ;
  1. N DIEFI,DICRREC
  1. S:$D(DIEFTMP) DICRREC="TRIG^DIEF"
  1. S DIEFI=0
  1. F S DIEFI=$O(^DD(DIEFF,DIEFFLD,1,DIEFI)) Q:DIEFI="" D
  1. . N I,Y,DIG,DIH,DIU,DIV,XMB,XMY
  1. . S X=$S(DIEFSORK=1:DIEFNVAL,1:DIEFOVAL)
  1. . N DIEFECNT S DIEFECNT=$G(DIERR)
  1. . X ^(DIEFI,DIEFSORK) ;Naked indicator set in For loop, FIRE+2
  1. . I DIEFECNT'=$G(DIERR) D HKERR^DILIBF(DIEFF,DIEFIEN,DIEFFLD,"cross reference")
  1. Q
  1. AUDIT ;
  1. N X,DP,DG,DIIX N DIANUM,C,Y
  1. S DP=DIEFF,DG=1
  1. I DIEFOVAL]"" S X=DIEFOVAL,DIIX="2^"_DIEFFLD D AUDIT^DIET
  1. I "@"'[DIEFNVAL,(DIEFOVAL]""!(^DD(DIEFF,DIEFFLD,"AUDIT")'="e")) S X=DIEFNVAL,DIIX="3^"_DIEFFLD_$S(DIEFFLD=.01&(DIEFOVAL=""):"^A",1:"") D AUDIT^DIET
  1. Q
  1. ;
  1. FIREFLD ;Fire field-level xrefs
  1. Q:'$D(DIEFTMP)
  1. I $G(DIEFFLST)]""!($G(DIEFRLST)]"") D
  1. . S:'$D(@DIEFTMP@("V",DIEFF,DIEFIEN,DIEFFLD,"O")) ^("O")=DIEFOVAL
  1. ;
  1. I $G(DIEFFLST)]"" D
  1. . D:$G(DOREPL) REPLACE
  1. . D FIRE^DIKC(DIEFF,.DA,"KS","DIEFFXR","O","",$E("C",$G(DIOPER)="A"))
  1. . D:$D(DOREPL) RETRIEVE
  1. K DIEFFXR,DIEFFLST
  1. Q
  1. ;
  1. FIREREC ;Fire record-level xrefs
  1. N DIKEY
  1. D FIRE^DIKC(DIEFF,.DA,"KS",$NA(@DIEFTMP@("R")),"O^"_$S(DIEFFLAG'["T"&(DIEFFLAG'["U"):"^K^N",1:""),.DIKEY,$E("C",$G(DIOPER)="A"))
  1. D:$D(DIKEY)>9 RESTORE^DIEF1(.DIKEY,DIEFTMP)
  1. K @DIEFTMP@("R"),@DIEFTMP@("V")
  1. Q
  1. ;
  1. GOODIEN(DIEFF,DIEFIEN,DIEFLEV,DA,DIEFFLG) ;
  1. N ERR,P K DA
  1. I DIEFIEN[",,"!($E(DIEFIEN)=",") D Q 0
  1. . D:$G(DIEFFLG)["D" ERR^DIKCU2(307,"",DIEFIEN)
  1. I $E(DIEFIEN,$L(DIEFIEN))'="," D Q 0
  1. . D:$G(DIEFFLG)["D" ERR^DIKCU2(304,"",DIEFIEN)
  1. I $L(DIEFIEN,",")-2'=DIEFLEV D Q 0
  1. . D:$G(DIEFFLG)["D" ERR^DIKCU2(205,"",DIEFIEN,"",DIEFF)
  1. S ERR=0 F P=1:1:$L(DIEFIEN,",")-1 D Q:ERR
  1. . S DA(P-1)=$P(DIEFIEN,",",P)
  1. . I DA(P-1)'=+$P(DA(P-1),"E")!(DA(P-1)'>0) D
  1. .. K DA S ERR=1 D:$G(DIEFFLG)["D" ERR^DIKCU2(308,"",DIEFIEN)
  1. Q:ERR 0
  1. S DA=DA(0) K DA(0)
  1. Q 1
  1. ;
  1. VENTRY(DIEFF,DIEFIEN,DIEFFLG,DIDATA,DIEFTREF) ;
  1. S DIEFFLG=$G(DIEFFLG)
  1. ;
  1. ;Get root of (sub)record and top level file
  1. I $G(DIDATA)=""!(DIEFFLG[9&($G(DIEFTREF)="")) D Q:$G(DIDATA)="" 0
  1. . N DA,DIEFD,DIEFLEV
  1. . S DIEFD=$E("D",DIEFFLG["D")
  1. . S DIDATA=$$FROOTDA^DIKCU(DIEFF,DIEFD,.DIEFLEV,.DIEFTREF) Q:DIDATA=""
  1. . I '$$GOODIEN(DIEFF,DIEFIEN,DIEFLEV,.DA,DIEFD) S DIDATA="" Q
  1. . S DIDATA=$NA(@DIDATA@(DA))
  1. ;
  1. ;Check null .01
  1. I $P($G(@DIDATA@(0)),U)="" D Q 0
  1. . D:DIEFFLG["D" ERR^DIKCU2(601,DIEFF,DIEFIEN)
  1. ;
  1. ;Check -9 node
  1. I DIEFFLG[9,$D(@DIEFTREF@($P(DIEFIEN,",",$L(DIEFIEN,",")-1),-9)) D Q 0
  1. . D:DIEFFLG["D" ERR^DIKCU2(602,DIEFF,DIEFIEN)
  1. ;
  1. Q 1
  1. ;
  1. TRIG ;Called from trigger logic (from DICR via @DICRREC)
  1. Q:'$D(DIEFTMP)
  1. N DIEFRLST
  1. D LOADFLD^DIKC1(DIH,DIG,"KS","",$NA(@DIEFTMP@("V")),"",$NA(@DIEFTMP@("R")),"",.DIEFRLST)
  1. I $G(DIEFRLST)]"",'$D(@DIEFTMP@("V",DIH,DICRIENS,DIG,"O")) S ^("O")=DIU
  1. Q