source: WorldVistAEHR/trunk/r/VA_FILEMAN-ARJT-DI-DD-DM-DT-%DT-%RCR/DDSVALM.m@ 789

Last change on this file since 789 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.9 KB
Line 
1DDSVALM ;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 ;
5MULT ;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 ;
16PUTMULT ;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 ;
30PUTWP ;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 ;
43GETWP ;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 ;
52REL(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 ;
58ERR(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
Note: See TracBrowser for help on using the repository browser.