Return to DDGFSV.m CVS log

Up to [Coherent Logic Development] / freem_fileman / USER

Annotation of freem_fileman/USER/DDGFSV.m, revision 1.1

1.1     ! snw         1: DDGFSV ;SFISC/MKO- SAVE DATA ;02:58 PM  18 May 1994
        !             2:        ;;21.0;VA FileMan;;Dec 28, 1994
        !             3:        ;Per VHA Directive 10-93-142, this routine should not be modified.
        !             4: SAVE   ;Save in form/block files data in DDGFREF
        !             5:        N P,B,F,P1,B1,F1,N
        !             6:        ;
        !             7:        I '$G(DDGFCHG) D MSG^DDGF("Nothing to save.") H 1 D MSG^DDGF() Q
        !             8:        D MSG^DDGF("Saving data ...")
        !             9:        ;
        !            10:        ;Loop through all pages in DDGFREF
        !            11:        S P="" F  S P=$O(@DDGFREF@("F",P)) Q:P=""  D PG
        !            12:        ;
        !            13:        D MSG^DDGF("Data saved.") H 1 D MSG^DDGF()
        !            14:        S DDGFCHG=0
        !            15:        Q
        !            16:        ;
        !            17: PG     ;Save page data
        !            18:        S P1=@DDGFREF@("F",P)
        !            19:        I $P(P1,U,7),$D(^DIST(.403,+DDGFFM,40,P,0))#2 D
        !            20:        . S N=^DIST(.403,+DDGFFM,40,P,0)
        !            21:        . S $P(N,U,3)=$P(P1,U)+1_","_($P(P1,U,2)+1)
        !            22:        . S $P(N,U,6,7)=$S($P(P1,U,3)="":U,1:1_U_($P(P1,U,3)+1)_","_($P(P1,U,4)+1))
        !            23:        . S ^DIST(.403,+DDGFFM,40,P,0)=$$STPU(N)
        !            24:        . ;
        !            25:        . S N=$G(^DIST(.403,+DDGFFM,40,P,1))
        !            26:        . I $P(N,U)'=$P(P1,U,5) D
        !            27:        .. S DIE="^DIST(.403,"_+DDGFFM_",40,"
        !            28:        .. S DR="7////"_$P(P1,U,5),DA(1)=+DDGFFM,DA=P
        !            29:        .. N P D ^DIE K DIE,DR,DA
        !            30:        ;
        !            31:        ;Loop through all blocks
        !            32:        S B="" F  S B=$O(@DDGFREF@("F",P,B)) Q:B=""  D BK
        !            33:        Q
        !            34:        ;
        !            35: BK     ;Save block data
        !            36:        S B1=@DDGFREF@("F",P,B)
        !            37:        I $P(B1,U,5),$D(^DIST(.403,+DDGFFM,40,P,40,B,0))#2 D
        !            38:        . S $P(^DIST(.403,+DDGFFM,40,P,40,B,0),U,3)=$P(B1,U)-$P(P1,U)+1_","_($P(B1,U,2)-$P(P1,U,2)+1)
        !            39:        . I $P(^DIST(.404,B,0),U)'=$P(B1,U,4) D
        !            40:        .. S DIE="^DIST(.404,",DR=".01////"_$P(B1,U,4),DA=B
        !            41:        .. N B,P D ^DIE K DIE,DR,DA
        !            42:        ;
        !            43:        ;Loop through all fields
        !            44:        S F="" F  S F=$O(@DDGFREF@("F",P,B,F)) Q:F=""  D FD
        !            45:        Q
        !            46:        ;
        !            47: FD     ;Save field data
        !            48:        S F1=@DDGFREF@("F",P,B,F)
        !            49:        I $P(F1,U,9),$D(^DIST(.404,B,40,F,0))#2 D
        !            50:        . S N=""
        !            51:        . S $P(N,U,1,2)=$S($P(F1,U,8):$S($P(F1,U,5)]""&($P(F1,U,6)]""):$P(F1,U,5)-$P(B1,U)+1_","_($P(F1,U,6)-$P(B1,U,2)+1),1:"")_U_$P(F1,U,8),1:U)
        !            52:        . S $P(N,U,3,4)=$S($L($P(F1,U,4)):$S($P(F1,U)]""&($P(F1,U,2)]""):$P(F1,U)-$P(B1,U)+1_","_($P(F1,U,2)-$P(B1,U,2)+1),1:"")_U_$S($P(F1,U,4)?.E1":":"",1:1),1:U)
        !            53:        . S ^DIST(.404,B,40,F,2)=$$STPU(N)
        !            54:        . ;
        !            55:        . ;Use DIE to stuff in new caption
        !            56:        . I $P(^DIST(.404,B,40,F,0),U,2)'=$P(F1,U,4) D
        !            57:        .. S DIE="^DIST(.404,"_B_",40,"
        !            58:        .. S DR="1////"_$S($P(F1,U,4)?.1":":"@",$P(F1,U,4)?1.E1":":$E($P(F1,U,4),1,$L($P(F1,U,4))-1),1:$P(F1,U,4))
        !            59:        .. S DA(1)=B,DA=F
        !            60:        .. N P,B,F D ^DIE K DIE,DR,DA
        !            61:        Q
        !            62:        ;
        !            63: STPU(X)        ;Strip trailing up-arrows from X
        !            64:        N I
        !            65:        F I=$L(X):-1:0 Q:$E(X,I)'="^"
        !            66:        Q $E(X,1,I)