| [613] | 1 | DDS02 ;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.
|
|---|
| 4 | UNED ;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 | ;
|
|---|
| 10 | SV ;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 | ;
|
|---|
| 20 | EXT ;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 | ;
|
|---|
| 73 | PT ;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 | ;
|
|---|
| 79 | PTFO ;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
|
|---|
