142 lines
4.6 KiB
Mathematica
142 lines
4.6 KiB
Mathematica
DDS4 ;SFISC/MKO-FILE AND RELOAD ;21SEP2006
|
|
;;22.0;VA FileMan;**11,151**;Mar 30, 1999;Build 10
|
|
;Per VHA Directive 2004-038, this routine should not be modified.
|
|
D ^DDS41 Q:Y'=1
|
|
N DA,DDO,DIE,DDP,DDSDA
|
|
;
|
|
S DX=0,DY=IOSL-1 X IOXY W "Filing form"_$P(DDGLCLR,DDGLDEL)
|
|
;
|
|
;File data
|
|
S DDS4FI="F"
|
|
F S DDS4FI=$O(@DDSREFT@(DDS4FI)) Q:DDS4FI'?1"F".E D
|
|
. S DDP=$E(DDS4FI,2,999),DDS4DA=" "
|
|
. F S DDS4DA=$O(@DDSREFT@(DDS4FI,DDS4DA)) Q:DDS4DA="" D REC
|
|
;
|
|
;Reload all pages on form
|
|
S DDS4P=0
|
|
F S DDS4P=$O(@DDSREFT@(DDS4P)) Q:'DDS4P D
|
|
. S DDS4B=0
|
|
. F S DDS4B=$O(@DDSREFT@(DDS4P,DDS4B)) Q:'DDS4B D
|
|
.. S DDP=$P(@DDSREFS@(DDS4P,DDS4B),U,3),DDSDA=" "
|
|
.. F S DDSDA=$O(@DDSREFT@(DDS4P,DDS4B,DDSDA)) Q:'DDSDA D
|
|
... S $P(@DDSREFT@(DDS4P,DDS4B,DDSDA),U)=1,DIE=^(DDSDA,"GL")
|
|
... Q:$P(@DDSREFT@(DDS4P,DDS4B,DDSDA),U,6)>1
|
|
... D GDA(DDSDA)
|
|
... D ^DDS11(DDS4B,1)
|
|
;
|
|
I $G(^DIST(.403,+DDS,14))'?."^" D
|
|
. I $G(DDSPTB)_$G(DDSREP)]"" N DIE,DDP,DDSDA,DA,DDSDL D
|
|
.. S DA=DDSDAORG,DDSDL=DDSDLORG,DDSDA=DA_","
|
|
.. F DDSI=1:1:DDSDL S DA(DDSI)=DDSDAORG(DDSI),DDSDA=DDSDA_DA(DDSI)_","
|
|
.. S DDP=$P($G(DDSFLORG),U),DIE=U_$P($G(DDSFLORG),U,2) S:DIE=U DIE=""
|
|
. X ^DIST(.403,+DDS,14)
|
|
I '$G(DDSSAVE),$G(DDSPARM)["S" S DDSSAVE=1
|
|
S (Y,DDSH)=1,(DDSCHG,DX)=0,DY=IOSL-1 X IOXY W $P(DDGLCLR,DDGLDEL)
|
|
K @DDSREFT@("ADD"),@DDSREFT@("RXR")
|
|
K DIC,DDS1B,DDS1DA,DDS4B,DDS4DA,DDS4FI,DDS4FLD,DDS4FO,DDS4P
|
|
K DDSEXT,DDSI,DDSINT,DDSLC,DDSLN,DDSND,DDSOND,DDSOLD,DDSP,DDSPC
|
|
K DDSW,DDSX,DV
|
|
Q
|
|
REC ;
|
|
G:DDS4FI="F0" FORMONLY
|
|
;
|
|
S DIE=$G(@DDSREFT@(DDS4FI,DDS4DA,"GL")) I DIE="" Q ;JUST TO BE SAFE!
|
|
D GDA(DDS4DA)
|
|
S DDSOND=-1 K DDSLN
|
|
S DDS4FLD=""
|
|
F S DDS4FLD=$O(@DDSREFT@(DDS4FI,DDS4DA,DDS4FLD)) Q:DDS4FLD="" D FLD
|
|
S:$D(DDSLN)#2 @(DIE_"DA,DDSND)")=DDSLN
|
|
;
|
|
I $D(@DDSREFT@("RXR")) D
|
|
. D FIRE^DIKC(DDP,.DA,"KS",$NA(@DDSREFT@("RXR")),"O^")
|
|
. K @DDSREFT@("RXR")
|
|
Q
|
|
FLD ;
|
|
Q:'$G(@DDSREFT@(DDS4FI,DDS4DA,DDS4FLD,"F")) S ^("F")=""
|
|
I '$G(DDSCHANG),$G(DDSPARM)["C" S DDSCHANG=1
|
|
S DDSINT=$G(@DDSREFT@(DDS4FI,DDS4DA,DDS4FLD,"D"))
|
|
;
|
|
;Word processing fields (quit if multiple)
|
|
I $D(@DDSREFT@(DDS4FI,DDS4DA,DDS4FLD,"M"))#2 D:'$P(^("M"),U) Q
|
|
. N FR,TO
|
|
. S FR=$NA(@DDSREFT@(DDS4FI,DDS4DA,DDS4FLD,"D"))
|
|
. S TO=U_$$CREF^DILF($P(@DDSREFT@(DDS4FI,DDS4DA,DDS4FLD,"M"),U,2))
|
|
. K @TO
|
|
. M @TO=@FR
|
|
. K @FR,@DDSREFT@(DDS4FI,DDS4DA,DDS4FLD,"F")
|
|
;
|
|
Q:$G(^DD(DDP,DDS4FLD,0))?."^" S DDSND=$P(^(0),U,4)
|
|
S DDSPC=$P(DDSND,";",2) Q:"0 "[DDSPC
|
|
S DDSND=$P(DDSND,";")
|
|
;
|
|
I DDSOND'=DDSND D
|
|
. S:$D(DDSLN)#2 @(DIE_"DA,DDSOND)")=DDSLN
|
|
. S DDSLN=$G(@(DIE_"DA,DDSND)"))
|
|
. S DDSOND=DDSND
|
|
;
|
|
I DDSPC D
|
|
. S DDSOLD=$P(DDSLN,U,DDSPC)
|
|
. S $P(DDSLN,U,DDSPC)=DDSINT
|
|
E D
|
|
. S DDSW=$E(DDSPC,2,999),DDSP=$P(DDSW,",",2)+1
|
|
. S DDSOLD=$E(DDSLN,+DDSW,DDSP-1)
|
|
. S DDSX=$E(DDSLN,DDSP,999)
|
|
. S DDSLN=$E(DDSLN,1,DDSW-1)_$J("",DDSW-1-$L(DDSLN))_DDSINT
|
|
. S:DDSX'?." " DDSLN=DDSLN_$J("",DDSP-DDSW-$L(DDSINT))_DDSX
|
|
;
|
|
I $D(^DD(DDP,DDS4FLD,1))!($P(^(0),U,2)["a")!$D(^DD("IX","F",DDP,DDS4FLD)) D XR
|
|
Q
|
|
XR ;
|
|
N DICRREC,DG,DP,DDS4AUD1,DDS4AUD2,DIANUM,DIIX,C,Y
|
|
S DP=DDP,DDSOND=-1
|
|
I $D(DDSLN)#2 S @(DIE_"DA,DDSND)")=DDSLN K DDSLN
|
|
S DICRREC="TRIG^DDS4"
|
|
;
|
|
I $P(^DD(DDP,DDS4FLD,0),U,2)["a" D
|
|
. S (DDS4AUD1,DDS4AUD2)=1
|
|
. I $G(^DD(DDP,DDS4FLD,"AUDIT"))["e",DDSOLD="" S DDS4AUD1=0
|
|
;
|
|
I DDSOLD]"" D
|
|
. S DG=0 F S DG=$O(^DD(DDP,DDS4FLD,1,DG)) Q:DG<1 D
|
|
.. S DIC=DIE,X=DDSOLD
|
|
.. X:$D(^DD(DDP,DDS4FLD,1,DG,2))#2 ^(2)
|
|
. I $G(DDS4AUD2) S DG=1,X=DDSOLD,DIIX="2^"_DDS4FLD D AUDIT^DIET
|
|
;
|
|
I DDSINT]"" D
|
|
. S DG=0 F S DG=$O(^DD(DDP,DDS4FLD,1,DG)) Q:DG<1 D
|
|
.. S DIC=DIE,X=DDSINT
|
|
.. X:$D(^DD(DDP,DDS4FLD,1,DG,1))#2 ^(1)
|
|
. I $G(DDS4AUD1) S DG=1,X=DDSINT,DIIX="3^"_DDS4FLD D AUDIT^DIET
|
|
Q:'$D(^DD("IX","F",DDP,DDS4FLD))
|
|
;
|
|
;Process index file xrefs
|
|
N DDSFXR,DDSFXREF,DDSRXREF
|
|
D LOADFLD^DIKC1(DDP,DDS4FLD,"KS","",$NA(@DDSREFT@("F"))_"_","DDSFXR",$NA(@DDSREFT@("RXR")),.DDSFXREF,.DDSRXREF)
|
|
I $G(DDSRXREF)]""!($G(DDSFXREF)]"") D
|
|
. S @DDSREFT@("F"_DDP,DDS4DA,DDS4FLD,"O")=DDSOLD ;BRX-0404-11337
|
|
D:$G(DDSFXREF)]"" FIRE^DIKC(DDP,.DA,"KS","DDSFXR","O^")
|
|
Q
|
|
GDA(DDSDA) ;
|
|
N I
|
|
K DA S DA=$P(DDSDA,",")
|
|
F I=2:1:$L(DDSDA,",")-1 S DA(I-1)=$P(DDSDA,",",I)
|
|
Q
|
|
;
|
|
FORMONLY ;
|
|
N X
|
|
D GDA(DDS4DA)
|
|
S DDS4FLD=""
|
|
F S DDS4FLD=$O(@DDSREFT@("F0",DDS4DA,DDS4FLD)) Q:DDS4FLD="" D
|
|
. Q:'$G(@DDSREFT@("F0",DDS4DA,DDS4FLD,"F"))
|
|
. S DDS4FO=$P(DDS4FLD,","),DDS4B=$P(DDS4FLD,",",2)
|
|
. S DDSOLD=$G(@DDSREFT@("F0",DDS4DA,DDS4FLD,"O")),X=$G(^("D")),DDSEXT=$G(^("X"),X)
|
|
. X:$G(^DIST(.404,DDS4B,40,DDS4FO,23))'?."^" ^(23)
|
|
. S ^("O")=@DDSREFT@("F0",DDS4DA,DDS4FLD,"D"),^("F")=""
|
|
Q
|
|
;
|
|
TRIG ;Called from trigger logic (from DICR via DICRREC)
|
|
N DDSRXREF
|
|
D LOADFLD^DIKC1(DIH,DIG,"KS","",$NA(@DDSREFT@("F"))_"_","",$NA(@DDSREFT@("RXR")),"",.DDSRXREF)
|
|
I $G(DDSRXREF)]"",'$D(@DDSREFT@("F"_DIH,DICRIENS,DIG,"O")) S ^("O")=DIU
|
|
Q
|