Return to DDSVALM.m CVS log

Up to [Coherent Logic Development] / freem_fileman / USER

Restructure repository

    1: DDSVALM	;SFISC/MKO-PUT FOR MULTIPLES (SELECT PROMPT) ;10:45 AM  9 Sep 1994
    2: 	;;21.0;VA FileMan;;Dec 28, 1994
    3: 	;Per VHA Directive 10-93-142, this routine should not be modified.
    4: 	;
    5: MULT	;Put multiple or wp field
    6: 	N DDSVDIC,DDSVDV,DDSVND,DDSVPC,DDSVSUB
    7: 	S DDSVPC=$P(DDSV0,U,4),DDSVND=$P(DDSVPC,";"),DDSVPC=$P(DDSVPC,";",2)
    8: 	S DDSVSUB=+DDSV02 Q:$D(^DD(DDSVSUB,.01,0))[0
    9: 	S DDSVDV=DDSVSUB_$P(^DD(DDSVSUB,.01,0),U,2),X=$P(^(0),U,3)
   10: 	S DDSVDIC=DIE_DA_","""_DDSVND_""","
   11: 	;
   12: 	I DDSVDV["W" D PUTWP
   13: 	I DDSVDV'["W" D PUTMULT
   14: 	Q
   15: 	;
   16: PUTMULT	;Put for multiples
   17: 	N DDSVRN
   18: 	S DDSVRN=$S(DDSVAL="FIRST":$O(@(DDSVDIC_"0)")),DDSVAL="LAST":$O(@(DDSVDIC_""" "")"),-1),1:+$G(DDSVAL))
   19: 	;
   20: 	K Y S Y="",Y(0)=""
   21: 	I DDSVRN>0,$D(@(DDSVDIC_+DDSVRN_",0)"))#2 S Y(0)=$P(^(0),U) D
   22: 	. I DDSVDV["O"!(DDSVDV["P")!(DDSVDV["V")!(DDSVDV["D")!(DDSVDV["S") D
   23: 	.. S Y(0)=$$EXTERNAL^DILFD(DDSVSUB,.01,"",DDSVRN)
   24: 	. S Y=DDSVRN
   25: 	;
   26: 	S:'$D(@DDSREFT@("F"_DDP,DDSVDA,DDSFLD,"M")) ^("M")=1_DDSVDIC_U_DDSVSUB
   27: 	D UPDATE^DDSVAL(DDP,DDSVDA,.DA,DDSFLD,DDSPG,.Y)
   28: 	Q
   29: 	;
   30: PUTWP	;File wp field from @DDSVAL into @DDSREFT
   31: 	N DDSTMP
   32: 	S DDSTMP=$NA(@DDSREFT@("F"_DDP,DDSDA))
   33: 	;
   34: 	I DDSVAL]"",$D(@DDSVAL) D  Q:$G(DIERR)
   35: 	. D PUTWP^DIEFW($E("A",DDSPARM["A"),DDSVAL,$NA(@DDSTMP@(DDSFLD,"D")))
   36: 	E  K @DDSTMP@(DDSFLD,"D")
   37: 	;
   38: 	S:$D(@DDSTMP@(DDSFLD,"M"))[0 ^("M")="0"_DDSVDIC_U_DDSVSUB
   39: 	S:$D(@DDSTMP@("GL"))[0 ^("GL")=DIE
   40: 	S (DDSCHG,@DDSTMP@(DDSFLD,"F"))=3
   41: 	Q
   42: 	;
   43: GETWP	;Merge wp field into ^TMP, return root in DDSANS
   44: 	N DDSGL
   45: 	S DDSGL=DIE_DA_","""_DDSVND_""","
   46: 	S DDSANS=$NA(^TMP("DDSWP",$J,DDP,DDSDA,DDSFLD))
   47: 	;
   48: 	K @DDSANS
   49: 	M:$D(@(DDSGL_"0)"))#2 @DDSANS=@($E(DDSGL,1,$L(DDSGL)-1)_")")
   50: 	Q
   51: 	;
   52: REL(DDP,DA,DDSFLD,DDSPARM)	;Relational syntax
   53: 	N DDSCD,DDSI,X
   54: 	D DD^DDSPTR(DDP,DDSFLD,"",.DDSCD,"",DDSPARM["I"+1)
   55: 	F DDSI=1:1:DDSCD X DDSCD(DDSI)
   56: 	Q X
   57: 	;
   58: ERR(DDSVEP)	;Print error messages
   59: 	Q:'$G(DIERR)
   60: 	I '$D(DDS) D MSG^DIALOG("BW") Q
   61: 	N DDSVMSG
   62: 	S DDSER=DIERR
   63: 	D BLD^DIALOG(3031,DDSVEP,"","DDSVMSG")
   64: 	D MSG^DDSMSG(DDSVMSG(1)),ERR^DDSMSG
   65: 	Q