Return to DDS02.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DDS02.m, revision 1.1

1.1     ! snw         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