| 1 | DDSVALM ;SFISC/MKO-PUT FOR MULTIPLES (SELECT PROMPT) ;10:45 AM 9 Sep 1994
|
|---|
| 2 | ;;22.0;VA FileMan;;Mar 30, 1999
|
|---|
| 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
|
|---|
