141 lines
3.7 KiB
Mathematica
141 lines
3.7 KiB
Mathematica
DDSUTL ;SFISC/MKO-PROGRAMMER UTILITIES ;11:37 AM 25 Jul 1995
|
|
;;22.0;VA FileMan;;Mar 30, 1999
|
|
;Per VHA Directive 10-93-142, this routine should not be modified.
|
|
;
|
|
MSG(TXT) ;
|
|
;Data validation messages
|
|
D PROC(.TXT,$NA(@DDSREFT@("MSG")))
|
|
Q
|
|
;
|
|
HLP(TXT) ;
|
|
;Help box messages
|
|
D PROC(.TXT,$NA(@DDSREFT@("HLP")))
|
|
Q
|
|
PROC(TXT,GLB) ;
|
|
;Put text into global
|
|
N CNT,I
|
|
S CNT=$G(@GLB)
|
|
I $D(TXT)<9 S CNT=CNT+1,@GLB@(CNT)=TXT
|
|
E S I="" F CNT=CNT:1 S I=$O(TXT(I)) Q:I="" S @GLB@(CNT+1)=TXT(I)
|
|
S @GLB=CNT
|
|
Q
|
|
;
|
|
REFRESH ;Refresh the screen
|
|
G R^DDSR
|
|
;
|
|
MLOAD(DDSIEN) ;Load subrecords for current multiple
|
|
G MLOAD^DDSM1
|
|
;
|
|
MDEL(DDSIEN) ;Delete subrecords for current multiple
|
|
G MDEL^DDSM1
|
|
;
|
|
UNED(DDSF,DDSB,DDSP,DDSVAL,DDSUDA) ;Change DISABLE EDITING attribute
|
|
S:$D(DDSVAL)[0 DDSVAL=""
|
|
D SETATT(4)
|
|
Q
|
|
;
|
|
REQ(DDSF,DDSB,DDSP,DDSVAL,DDSUDA) ;Change REQUIRED attribute
|
|
S:$D(DDSVAL)[0 DDSVAL=""
|
|
D SETATT(1)
|
|
Q
|
|
;
|
|
;
|
|
SETATT(DDSUPC) ;Set attribute node, piece DDSUPC
|
|
N DDSOVAL,DDSUDDP,DDSUFLD,DDSUTP
|
|
I $D(DDSPG)[0 N DDSPG S DDSPG=""
|
|
I $D(DDSBK)[0 N DDSBK S DDSBK=""
|
|
S DDSP=$$GETFLD^DDSLIB(DDSF,$G(DDSB),$G(DDSP),+DDS,DDSPG,DDSBK)
|
|
I $G(DIERR) D ERR^DDSMSG Q
|
|
;
|
|
S DDSF=$P(DDSP,","),DDSB=$P(DDSP,",",2),DDSP=$P(DDSP,",",3)
|
|
;
|
|
S DDSUDDP=+$P($G(^DIST(.404,DDSB,0)),U,2)
|
|
I DDSUDDP,$G(DDSUDA)]"" N DDSDA S DDSDA=DDSUDA
|
|
E I DDSUDDP,DDSB'=DDSBK N DDSDA D GL^DDS10(DDSUDDP,.DDSDAORG,"","",.DDSDA)
|
|
;
|
|
S DDSUTP=$P($G(^DIST(.404,DDSB,40,DDSF,0)),U,3) S:'DDSUTP DDSUTP=3
|
|
I DDSUTP=2 D
|
|
. S DDSUFLD=DDSF_","_DDSB
|
|
. S DDSUDDP=0
|
|
E I DDSUTP=3 D Q:'DDSUFLD
|
|
. S DDSUFLD=$P($G(^DIST(.404,DDSB,40,DDSF,1)),U)
|
|
E Q
|
|
;
|
|
S DDSOVAL=$P($G(@DDSREFT@("F"_DDSUDDP,DDSDA,DDSUFLD,"A")),U,DDSUPC)
|
|
Q:DDSVAL=DDSOVAL
|
|
S $P(@DDSREFT@("F"_DDSUDDP,DDSDA,DDSUFLD,"A"),U,DDSUPC)=DDSVAL
|
|
Q
|
|
;
|
|
ADD(DDSFIL,X,DA,DINUM,DDSDIC0,DDSDR,DDSL) ;
|
|
;Add an entry as part of a transaction
|
|
;DDSL=1 means don't lock
|
|
;
|
|
N %,%W,%Y,C,D0,DD,DO,DI,DIC,DIE,DQ,DR
|
|
N DDSDA,DDSDIC,DDSFD,DDSREQ,DDSUP,I
|
|
K DIERR,^TMP("DIERR",$J)
|
|
K:'$G(DINUM) DINUM
|
|
S:$G(DDSDIC0)="" DDSDIC0="L"
|
|
S DIC(0)=DDSDIC0,Y=-1
|
|
S:$G(DDSDR)]"" DIC("DR")=DDSDR
|
|
S DIC=$$ROOT^DILFD(DDSFIL,.DA),DDSDIC=$$CREF^DIQGU(DIC)
|
|
;
|
|
I $D(@DDSDIC@(0))[0 D Q:$G(DIC("P"))=""
|
|
. S DDSUP=$G(^DD(DDSFIL,0,"UP")) Q:'DDSUP
|
|
. S DDSFD=$O(^DD(DDSUP,"SB",DDSFIL,"")) Q:'DDSFD
|
|
. S DIC("P")=$P($G(^DD(DDSUP,DDSFD,0)),U,2)
|
|
;
|
|
I DDSDIC0'["E",$$REQID(DDSFIL,.DDSREQ) D Q:$G(DIERR)
|
|
. N F
|
|
. S F=""
|
|
. F S F=$O(DDSREQ(F)) Q:'F I $G(DIC("DR"))'[(F_"///") D BLD^DIALOG(3031,"ADD^DDSUTL") Q
|
|
;
|
|
D FILE^DICN K DTOUT,DUOUT Q:Y=-1!'$D(DDS)
|
|
;
|
|
I '$G(DDSL) D
|
|
. N I,L,R
|
|
. S L=1,R=DIC_DA_","
|
|
. F I=$L(R,",")-1:-1:1 I $D(^TMP("DDS",$J,"LOCK",$P(R,",",1,I)_")"))#2 S L=0 Q
|
|
. I L,$D(^TMP("DDS",$J,"LOCK",$P(R,"(")))#2 S L=0
|
|
. I L L +@(DIC_+Y_")"):0 S ^TMP("DDS",$J,"LOCK",DIC_+Y_")")=""
|
|
;
|
|
S DDSDA=+Y_","
|
|
F I=1:1 Q:$D(DA(I))[0 S DDSDA=DDSDA_DA(I)_","
|
|
S ^("ADD")=$G(@DDSREFT@("ADD"))+1,^("ADD",^("ADD"))=DDSDA_DIC
|
|
Q
|
|
;
|
|
REQID(FIL,REQ) ;
|
|
;Get list of required identifiers into DDSREQ
|
|
N F
|
|
K REQ
|
|
S F="" F S F=$O(^DD(FIL,0,"ID",F)) Q:F'=+$P(F,"E") D
|
|
. S:$P($G(^DD(FIL,F,0)),U,2)["R" REQ(F)=""
|
|
Q $D(REQ)>0
|
|
;
|
|
DESTROY(PG) ;Destroy all data for page PG
|
|
N P,B,F,IENS,TP,FIL,FLD
|
|
S P=$O(^DIST(.403,+DDS,40,"B",PG,"")) Q:'P
|
|
S B=0 F S B=$O(^DIST(.403,+DDS,40,P,40,B)) Q:'B D
|
|
. Q:'$D(^DIST(.403,+DDS,40,P,40,B,0))
|
|
. Q:'$D(^DIST(.404,B,0)) S FIL=$P(^(0),U,2)
|
|
. S F=0 F S F=$O(^DIST(.404,B,40,F)) Q:'F D
|
|
.. Q:'$D(^DIST(.404,B,40,F,0)) S TP=$P(^(0),U,3)
|
|
.. S:'TP TP=3
|
|
.. ;
|
|
.. I TP=3 S FF="F"_FIL,FLD=$G(^DIST(.404,B,40,F,1)) Q:FLD?."^"
|
|
.. E I TP=2 S FF="F0",FLD=F_","_B
|
|
.. E Q
|
|
.. ;
|
|
.. S IENS=" "
|
|
.. F S IENS=$O(@DDSREFT@(FF,IENS)) Q:IENS="" K ^(IENS,FLD)
|
|
;
|
|
K @DDSREFT@(P),@DDSREFT@("XCAP",P)
|
|
Q
|
|
;
|
|
;
|
|
DDSDA(DA,DL,DDSDA) ;Determine DDSDA
|
|
;
|
|
N I
|
|
I DA="" S DDSDA="" Q
|
|
S DDSDA=DA_"," F I=1:1:DL S DDSDA=DDSDA_DA(I)_","
|
|
Q
|