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

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

initial load of WorldVistAEHR
File size: 2.9 KB
Line 
1DDS02 ;SFISC/MKO-OVERFLOW FROM ^DDS01 ;1:50 PM 16 Jul 1999
2 ;;22.0;VA FileMan;**8,11**;Mar 30, 1999
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4UNED ;Change was made to uneditable field
5 D MSG^DDSMSG("No editing allowed.",1)
6 I $P($G(DDSO(0)),U,3)=2 N DDP S DDP=0
7 S @DDSREFT@("F"_DDP,DDSDA,DDSFLD,"D")=DDSOLD S:$D(DDSU("X"))#2 ^("X")=DDSU("X")
8 Q
9 ;
10SV ;Save
11 S DDACT="N"
12 I $G(DDSDN)=1,DDO D ERR3^DDS3 Q
13 I DDSSC'>1,'$G(DDSSEL),'$P(DDSSC(DDSSC),U,4) D S^DDS3 Q
14 N DDSEM
15 S DDSEM(1)="You cannot save changes at this level."
16 S DDSEM(2)="To close the current page, press <PF1>C."
17 D MSG^DDSMSG(.DDSEM,1)
18 Q
19 ;
20EXT ;Process external form
21 I '$P($G(DDSU("DD")),U,2),$P($G(DDSU("DD")),U,2)["P" D PT
22 I $P($G(DDSO(0)),U,3)=2,$E($P($G(DDSO(20)),U))="P" D PTFO
23 ;
24 S:DDSOLD=Y DIR0N=1
25 S DDSX=X,DDSY=Y
26 I Y]"",$P($G(DDSU("DD")),U,2)["O",$G(^DD(DDP,DDSFLD,2))'?."^" K Y(0) X ^(2) S Y(0)=Y
27 ;
28 S DDSEXT=$G(Y(0,0),$G(Y(0),Y)),X=DDSY
29 ;
30 I $D(DDSO(14)) K DDSERROR X DDSO(14) I $D(DDSERROR)#2 D Q
31 . K DDSERROR,DDSY S DIR0("L")=DDSEXT,DDSCHKQ=1
32 ;
33 I DDSY="",DDSFLD'=.01 D Q:'$D(DDSY)
34 . N DDSREQ,DDSKEY
35 . S DDSREQ=$P($G(DDSU("A")),U)
36 . S:DDSREQ="" DDSREQ=$P($G(DDSO(4)),U)
37 . S:DDSREQ="" DDSREQ=$P($G(DDSU("DD")),U,2)["R"
38 . S DDSKEY=$D(^DD("KEY","F",DDP,DDSFLD))>0
39 . I 'DDSREQ,'DDSKEY Q
40 . K DDSY
41 . S DDSCHKQ=1,DIR0("L")=DDSEXT
42 . D MSG^DDSMSG("This is a required "_$S(DDSKEY:"key ",1:"")_"field.",1)
43 ;
44 S DY=$P(DIR0,U),DX=$P(DIR0,U,2)
45 I DDSEXT'=DDSX D
46 . X IOXY
47 . S DDSX=$E(DDSEXT,1,$P(DIR0,U,3))
48 . I '$P(DIR0,U,6) S DDSX=DDSX_$J("",$P(DIR0,U,3)-$L(DDSEXT))
49 . E S DDSX=$J("",$P(DIR0,U,3)-$L(DDSEXT))_DDSX
50 . W $P(DDGLVID,DDGLDEL)_DDSX_$P(DDGLVID,DDGLDEL,10)
51 ;
52 I $G(DDSU("K")),DDSY]""!(DDSFLD'=.01) D Q:'$D(DDSY)
53 . N DDSFXR,DDSUI,DDSUNIQ,DDSVSV,DIIENS
54 . D LOADXREF^DIKC1(DDP,"","",DDSU("K"),$NA(@DDSREFT@("F"))_"_","DDSFXR")
55 . S:$D(@DDSREFT@("F"_DDP,DDSDA,DDSFLD,"D"))#2 DDSVSV=^("D") S ^("D")=DDSY
56 . S DDSUNIQ=1,DDSUI=0
57 . F S DDSUI=$O(DDSFXR(DDP,DDSUI)) Q:'DDSUI D Q:'DDSUNIQ
58 .. S DIIENS=DDSDA
59 .. D SETXARR^DIKC(DDP,DDSUI,"DDSFXR","","D")
60 .. S DDSUNIQ=$$UNIQUE^DIKK2(DDP,DDSUI,.X,.DA,"DDSFXR")
61 . I 'DDSUNIQ D
62 .. K DDSY
63 .. S DDSCHKQ=1,DIR0("L")=DDSEXT
64 .. D MSG^DDSMSG("Another entry already exists with this key value.",1)
65 .. K @DDSREFT@("F"_DDP,DDSDA,DDSFLD,"D") S:$D(DDSVSV)#2 ^("D")=DDSVSV
66 ;
67 D:$G(DDSDA)!'$D(DDSREP)
68 . S:$D(Y(0)) @DDSREFT@("F"_DDP,DDSDA,DDSFLD,"X")=DDSEXT
69 . S @DDSREFT@("F"_DDP,DDSDA,DDSFLD,"D")=DDSY I DDSY="",$D(DDSU("X")) S ^("X")=""
70 K DDSY
71 Q
72 ;
73PT ;Modify Y for pointer type fields
74 I $P(Y,U,3)=1 D
75 . S ^("ADD")=$G(@DDSREFT@("ADD"))+1,^("ADD",^("ADD"))=+Y_","_U_$P(DDSU("DD"),U,3)
76 S Y=$P(Y,U)
77 Q
78 ;
79PTFO ;Modify Y for pointer type form only fields
80 I $P(Y,U,3)=1 D
81 . N R,I S R=""
82 . F I=1:1 Q:$D(DA(I))[0 S R=R_DA(I)_","
83 . S ^("ADD")=$G(@DDSREFT@("ADD"))+1,@DDSREFT@("ADD",@DDSREFT@("ADD"))=+Y_","_R_$S($P(DDSO(20),U,3):^DIC(+$P(DDSO(20),U,3),0,"GL"),1:U_$P($P(DDSO(20),U,3),":"))
84 S Y=$S(Y=-1:"",1:$P(Y,U))
85 Q
Note: See TracBrowser for help on using the repository browser.