Return to DDS02.m CVS log

Up to [Coherent Logic Development] / freem_fileman / USER

Restructure repository

    1: DDS02	;SFISC/MKO-OVERFLOW FROM ^DDS01 ;07:12 AM  12 Dec 1994
    2: 	;;21.0;VA FileMan;;Dec 28, 1994
    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: 	S @DDSREFT@("F"_DDP,DDSDA,DDSFLD,"D")=DDSOLD S:$D(DDSU("X"))#2 ^("X")=DDSU("X")
    7: 	Q
    8: 	;
    9: SV	;Save
   10: 	S DDACT="N"
   11: 	I $G(DDSDN)=1,DDO D ERR3^DDS3 Q
   12: 	I DDSSC'>1,'$G(DDSSEL),'$P(DDSSC(DDSSC),U,4) D S^DDS3 Q
   13: 	N DDSEM
   14: 	S DDSEM(1)="You cannot save changes at this level."
   15: 	S DDSEM(2)="To close the current page, press <PF1>C."
   16: 	D MSG^DDSMSG(.DDSEM,1)
   17: 	Q
   18: 	;
   19: EXT	;Process external form
   20: 	I '$P($G(DDSU("DD")),U,2),$P($G(DDSU("DD")),U,2)["P" D PT
   21: 	I $P($G(DDSO(0)),U,3)=2,$E($P($G(DDSO(20)),U))="P" D PTFO
   22: 	;
   23: 	S:DDSOLD=Y DIR0N=1
   24: 	S DDSX=X,DDSY=Y
   25: 	I Y]"",$P($G(DDSU("DD")),U,2)["O",$G(^DD(DDP,DDSFLD,2))'?."^" K Y(0) X ^(2) S Y(0)=Y
   26: 	;
   27: 	S DDSEXT=$G(Y(0,0),$G(Y(0),Y)),X=DDSY
   28: 	;
   29: 	I $D(DDSO(14)) K DDSERROR X DDSO(14) I $D(DDSERROR)#2 D  Q
   30: 	. K DDSERROR,DDSY S DIR0("L")=DDSEXT,DDSCHKQ=1
   31: 	;
   32: 	I DDSY="",DDSFLD'=.01 N DDSREQ D
   33: 	. S DDSREQ=$P($G(DDSO(4)),U)
   34: 	. S:$P($G(DDSU("A")),U)]"" DDSREQ=$P(DDSU("A"),U)
   35: 	. I DDSREQ="",$P($G(DDSU("DD")),U,2)["R" S DDSREQ=1
   36: 	I DDSY="",DDSFLD'=.01,DDSREQ D  K DDSY Q
   37: 	. S DIR0("L")=DDSEXT
   38: 	. D MSG^DDSMSG("This is a required field.",1)
   39: 	. S DDSCHKQ=1
   40: 	;
   41: 	S DY=$P(DIR0,U),DX=$P(DIR0,U,2)
   42: 	I DDSEXT'=DDSX D
   43: 	. X IOXY
   44: 	. S DDSX=$E(DDSEXT,1,$P(DIR0,U,3))
   45: 	. I '$P(DIR0,U,6) S DDSX=DDSX_$J("",$P(DIR0,U,3)-$L(DDSEXT))
   46: 	. E  S DDSX=$J("",$P(DIR0,U,3)-$L(DDSEXT))_DDSX
   47: 	. W $P(DDGLVID,DDGLDEL)_DDSX_$P(DDGLVID,DDGLDEL,10)
   48: 	;
   49: 	S:$D(Y(0)) @DDSREFT@("F"_DDP,DDSDA,DDSFLD,"X")=DDSEXT
   50: 	S @DDSREFT@("F"_DDP,DDSDA,DDSFLD,"D")=DDSY I DDSY="",$D(DDSU("X")) S ^("X")=""
   51: 	K DDSY
   52: 	Q
   53: 	;
   54: PT	;Modify Y for pointer type fields
   55: 	I $P(Y,U,3)=1 D
   56: 	. S ^("ADD")=$G(@DDSREFT@("ADD"))+1,^("ADD",^("ADD"))=+Y_","_U_$P(DDSU("DD"),U,3)
   57: 	S Y=$P(Y,U)
   58: 	Q
   59: 	;
   60: PTFO	;Modify Y for pointer type form only fields
   61: 	I $P(Y,U,3)=1 D
   62: 	. N R,I S R=""
   63: 	. F I=1:1 Q:$D(DA(I))[0  S R=R_DA(I)_","
   64: 	. 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),":"))
   65: 	S Y=$S(Y=-1:"",1:$P(Y,U))
   66: 	Q