Return to DDSUTL.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Initial revision

DDSUTL	;SFISC/MKO-PROGRAMMER UTILITIES ;03:36 PM  7 Dec 1994
	;;21.0;VA FileMan;;Dec 28, 1994
	;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)
	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
	;
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