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

1.1     ! snw         1: DIA2   ;SFISC/GFT-SELECT ENTRY TO EDIT, ^LOOP ;9/7/94  09:28 ;
        !             2:        ;;21.0;VA FileMan;;Dec 28, 1994
        !             3:        ;Per VHA Directive 10-93-142, this routine should not be modified.
        !             4:        K ^UTILITY("DIT",$J),DA,DRS,DW,DIAP,DI I '$D(DR(1,J(0))) S DR(1,J(0))=".01:99999999"
        !             5:        I $L(DR(1,J(0)))+$L(DIA)<216,+DR(1,J(0))=.01 S DR(1,J(0))="S:DIA(9) DQ=2,X=$P("_DIA_"DA,0),U,1);"_DR(1,J(0))
        !             6: DIC    W !! G Q^DIB:$D(DTOUT) D L S DIA(1)=+Y,DIA(9)=$P(Y,U,3) I Y>0 D DIE,^DIA3:'$D(DA) G DIC
        !             7:        I X'["LOOP",X'["loop" D PTS^DITP:$O(^UTILITY("DIT",$J,0))>0 K ^UTILITY("DIT",$J) G Q^DIB
        !             8:        S L="EDIT ENTRIES",DHD="@",IOP="HOME",FLDS="",DHIT="D LOOP^DIA2 S:'$D(DCC) DN=0" D EN1^DIP W !!?4,"LOOP ENDED!" Q:$D(DTOUT)  G DIC
        !             9:        ;
        !            10: L      K Y,I,J,F,DIC S (DIC,DIE)=DIA,DIC(0)="QEALM" G ^DIC
        !            11:        ;
        !            12: DIE    S DP=DIA("P"),DA=+Y,DR=DR(1,DP)
        !            13:        K DIC,Y,C,DB S DIC=DIE,DILK=DIE_DA_")" L @("+"_DILK_":0")
        !            14:        E  W $C(7),!,"ANOTHER TERMINAL IS EDITING THIS ENTRY!" K DILK Q
        !            15:        I DR?1"^".AN D @DR L @("-"_DILK) K DILK Q
        !            16:        E  D GO^DIE L @("-"_DILK) K DILK Q
        !            17:        ;
        !            18: LOOP   ;DELETE OR REPLACE POINTERS
        !            19:        G NUL:$D(@(DCC_D0_",-9)")) I '($G(DIFIXPT)=1) W !!,?3
        !            20:        S X=$P(@(DCC_"0)"),U,2) G NUL:'$D(^(D0,0)) S (DI,Y)=$P(^(0),U,1),C=$P(^DD(+X,.01,0),U,2) D Y^DIQ
        !            21:        I $G(DIFIXPT)=1 D
        !            22:        . I $D(DIFIXPTH) S ^TMP("DIFIXPT",$J,DIFIXPTC)=DIFIXPTH,DIFIXPTC=DIFIXPTC+1 K DIFIXPTH
        !            23:        . S ^TMP("DIFIXPT",$J,DIFIXPTC)=" Entry:"_D0_"-"_$E(Y,1,20)_"     "
        !            24:        . Q
        !            25:        I '($G(DIFIXPT)=1) W Y
        !            26:        S Y=D0,(DIE,DIC)=DCC,%C=0 I X["I",'($G(DIFIXPT)=1) S %Y=0 F  S %C=$O(^DD(+X,0,"ID",%C)) Q:%C=""  S %=^(%C) W "  ",$E(@(DCC_"Y,0)"),0) X %
        !            27:        K DO S %C=-1,DO(2)=X,Y=Y_U_DI,DIC(0)=$P("E^",U,('($G(DIFIXPT)=1))) D ACT^DICM1 S DI=99 K DO,DIY Q:Y<0
        !            28:        S Y=D0 D DIE S:$G(DIFIXPT) DIFIXPTC=DIFIXPTC+1 I $D(DTOUT) K DCC,Y
        !            29:        I $D(Y) K Y I '($G(DIFIXPT)=1) S %=1 W $C(7),!!,"WANT TO STOP LOOPING" D YN^DICN I %-2 K DCC
        !            30: NUL    S DI=99,(^UTILITY($J,99,0),DX(0))="Q" K D1,D2,D3,D4,D5
        !            31:        Q

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>