Return to DDS4.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DDS4.m, revision 1.1.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