Return to DDS4.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DDS4.m, revision 1.1

1.1     ! snw         1: DDS4   ;SFISC/MKO-FILE AND RELOAD ;08:31 AM  24 Oct 1994
        !             2:        ;;21.0;VA FileMan;;Dec 28, 1994
        !             3:        ;Per VHA Directive 10-93-142, this routine should not be modified.
        !             4:        D ^DDS41 Q:Y'=1
        !             5:        N DA,DDO,DIE,DDP,DDSDA
        !             6:        ;
        !             7:        S DX=0,DY=IOSL-1 X IOXY W "Filing form"_$P(DDGLCLR,DDGLDEL)
        !             8:        ;
        !             9:        ;File data
        !            10:        S DDS4FI="F"
        !            11:        F  S DDS4FI=$O(@DDSREFT@(DDS4FI)) Q:DDS4FI'?1"F".E  D
        !            12:        . S DDP=$E(DDS4FI,2,999)
        !            13:        . S DDS4DA=" "
        !            14:        . F  S DDS4DA=$O(@DDSREFT@(DDS4FI,DDS4DA)) Q:DDS4DA=""  D REC
        !            15:        ;
        !            16:        ;Reload all pages on form
        !            17:        S DDS4P=0
        !            18:        F  S DDS4P=$O(@DDSREFT@(DDS4P)) Q:'DDS4P  D
        !            19:        . S DDS4B=0
        !            20:        . F  S DDS4B=$O(@DDSREFT@(DDS4P,DDS4B)) Q:'DDS4B  D
        !            21:        .. S DDP=$P(@DDSREFS@(DDS4P,DDS4B),U,3),DDSDA=" "
        !            22:        .. F  S DDSDA=$O(@DDSREFT@(DDS4P,DDS4B,DDSDA)) Q:'DDSDA  D
        !            23:        ... S $P(@DDSREFT@(DDS4P,DDS4B,DDSDA),U)=1,DIE=^(DDSDA,"GL")
        !            24:        ... Q:$P(@DDSREFT@(DDS4P,DDS4B,DDSDA),U,6)>1
        !            25:        ... D GDA(DDSDA)
        !            26:        ... D ^DDS11(DDS4B,1)
        !            27:        ;
        !            28:        X:$G(^DIST(.403,+DDS,14))'?."^" ^(14)
        !            29:        I '$G(DDSSAVE),$G(DDSPARM)["S" S DDSSAVE=1
        !            30:        S (Y,DDSH)=1,(DDSCHG,DX)=0,DY=IOSL-1 X IOXY W $P(DDGLCLR,DDGLDEL)
        !            31:        K @DDSREFT@("ADD")
        !            32:        K DIC,DDS1B,DDS1DA,DDS4B,DDS4DA,DDS4FI,DDS4FLD,DDS4FO,DDS4P
        !            33:        K DDSEXT,DDSI,DDSINT,DDSLC,DDSLN,DDSND,DDSOND,DDSOLD,DDSP,DDSPC
        !            34:        K DDSW,DDSX,DV
        !            35:        Q
        !            36: REC    ;
        !            37:        G:DDS4FI="F0" FORMONLY
        !            38:        ;
        !            39:        S DIE=@DDSREFT@(DDS4FI,DDS4DA,"GL")
        !            40:        D GDA(DDS4DA)
        !            41:        S DDSOND=-1 K DDSLN
        !            42:        S DDS4FLD=""
        !            43:        F  S DDS4FLD=$O(@DDSREFT@(DDS4FI,DDS4DA,DDS4FLD)) Q:DDS4FLD=""  D FLD
        !            44:        S:$D(DDSLN)#2 @(DIE_"DA,DDSND)")=DDSLN
        !            45:        Q
        !            46: FLD    ;
        !            47:        Q:'$G(@DDSREFT@(DDS4FI,DDS4DA,DDS4FLD,"F"))  S ^("F")=""
        !            48:        I '$G(DDSCHANG),$G(DDSPARM)["C" S DDSCHANG=1
        !            49:        S DDSINT=$G(@DDSREFT@(DDS4FI,DDS4DA,DDS4FLD,"D"))
        !            50:        ;
        !            51:        ;Word processing fields (quit if multiple)
        !            52:        I $D(@DDSREFT@(DDS4FI,DDS4DA,DDS4FLD,"M"))#2 D:'$P(^("M"),U)  Q
        !            53:        . N FR,TO
        !            54:        . S FR=$NA(@DDSREFT@(DDS4FI,DDS4DA,DDS4FLD,"D"))
        !            55:        . S TO=U_$$CREF^DILF($P(@DDSREFT@(DDS4FI,DDS4DA,DDS4FLD,"M"),U,2))
        !            56:        . K @TO
        !            57:        . M @TO=@FR
        !            58:        . K @FR,@DDSREFT@(DDS4FI,DDS4DA,DDS4FLD,"F")
        !            59:        ;
        !            60:        Q:$G(^DD(DDP,DDS4FLD,0))?."^"  S DDSND=$P(^(0),U,4)
        !            61:        S DDSPC=$P(DDSND,";",2) Q:"0 "[DDSPC
        !            62:        S DDSND=$P(DDSND,";")
        !            63:        ;
        !            64:        I DDSOND'=DDSND D
        !            65:        . S:$D(DDSLN)#2 @(DIE_"DA,DDSOND)")=DDSLN
        !            66:        . S DDSLN=$G(@(DIE_"DA,DDSND)"))
        !            67:        . S DDSOND=DDSND
        !            68:        ;
        !            69:        I DDSPC D
        !            70:        . S DDSOLD=$P(DDSLN,U,DDSPC)
        !            71:        . S $P(DDSLN,U,DDSPC)=DDSINT
        !            72:        E  D
        !            73:        . S DDSW=$E(DDSPC,2,999),DDSP=$P(DDSW,",",2)+1
        !            74:        . S DDSOLD=$E(DDSLN,+DDSW,DDSP-1)
        !            75:        . S DDSX=$E(DDSLN,DDSP,999)
        !            76:        . S DDSLN=$E(DDSLN,1,DDSW-1)_$J("",DDSW-1-$L(DDSLN))_DDSINT
        !            77:        . S:DDSX'?." " DDSLN=DDSLN_$J("",DDSP-DDSW-$L(DDSINT))_DDSX
        !            78:        ;
        !            79:        I $D(^DD(DDP,DDS4FLD,1))!($P(^(0),U,2)["a") D XR
        !            80:        ;
        !            81:        Q
        !            82: XR     ;
        !            83:        N DG,DP,DDS4AUD1,DDS4AUD2,DIIX
        !            84:        S DP=DDP,DDSOND=-1
        !            85:        I $D(DDSLN)#2 S @(DIE_"DA,DDSND)")=DDSLN K DDSLN
        !            86:        ;
        !            87:        I $P(^DD(DDP,DDS4FLD,0),U,2)["a" D
        !            88:        . S (DDS4AUD1,DDS4AUD2)=1
        !            89:        . I $G(^DD(DDP,DDS4FLD,"AUDIT"))["e",DDSOLD="" S DDS4AUD1=0
        !            90:        ;
        !            91:        I DDSOLD]"" D
        !            92:        . S DG=0 F  S DG=$O(^DD(DDP,DDS4FLD,1,DG)) Q:DG<1  D
        !            93:        .. S DIC=DIE,X=DDSOLD
        !            94:        .. X:$D(^DD(DDP,DDS4FLD,1,DG,2))#2 ^(2)
        !            95:        . I $G(DDS4AUD2) S DG=1,X=DDSOLD,DIIX="2^"_DDS4FLD D AUDIT^DIET
        !            96:        ;
        !            97:        I DDSINT]"" D
        !            98:        . S DG=0 F  S DG=$O(^DD(DDP,DDS4FLD,1,DG)) Q:DG<1  D
        !            99:        .. S DIC=DIE,X=DDSINT
        !           100:        .. X:$D(^DD(DDP,DDS4FLD,1,DG,1))#2 ^(1)
        !           101:        . I $G(DDS4AUD1) S DG=1,X=DDSINT,DIIX="3^"_DDS4FLD D AUDIT^DIET
        !           102:        Q
        !           103: GDA(DDSDA)     ;
        !           104:        N I
        !           105:        K DA S DA=$P(DDSDA,",")
        !           106:        F I=2:1:$L(DDSDA,",")-1 S DA(I-1)=$P(DDSDA,",",I)
        !           107:        Q
        !           108:        ;
        !           109: FORMONLY       ;
        !           110:        N X
        !           111:        D GDA(DDS4DA)
        !           112:        S DDS4FLD=""
        !           113:        F  S DDS4FLD=$O(@DDSREFT@("F0",DDS4DA,DDS4FLD)) Q:DDS4FLD=""  D
        !           114:        . Q:'$G(@DDSREFT@("F0",DDS4DA,DDS4FLD,"F"))
        !           115:        . S DDS4FO=$P(DDS4FLD,","),DDS4B=$P(DDS4FLD,",",2)
        !           116:        . S DDSOLD=$G(@DDSREFT@("F0",DDS4DA,DDS4FLD,"O")),X=$G(^("D")),DDSEXT=$G(^("X"),X)
        !           117:        . X:$G(^DIST(.404,DDS4B,40,DDS4FO,23))'?."^" ^(23)
        !           118:        . S ^("O")=@DDSREFT@("F0",DDS4DA,DDS4FLD,"D"),^("F")=""
        !           119:        Q