Return to DIT0.m CVS log

Up to [Coherent Logic Development] / freem_fileman / USER

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

1.1     ! snw         1: DIT0   ;SFISC/XAK-PREPARE TO XFR ;09:21 AM  Jul 19, 1988;
        !             2:        ;;21.0;VA FileMan;;Dec 28, 1994
        !             3:        ;Per VHA Directive 10-93-142, this routine should not be modified.
        !             4:        K Y,DIC S DIT=DDF(1),DIC=L,DIC(0)="EQLAM",X="DATA INTO WHICH " D LK
        !             5:        G Q:Y<0 S DFR=+Y,DTO(1)=DIC_+Y_",",DIC(0)="EQAM",X="FROM ",DIC("S")="I Y-"_+Y D LK G Q:Y<0
        !             6: S      S %=2 W !,"   WANT TO DELETE THIS ENTRY AFTER IT'S TRANSFERRED" D YN^DICN G Q:%<0 S DH=2-% I '% D F^DIT G S
        !             7:        S ^UTILITY("DIT",$J,+Y)=DFR_";"_$E(DIC,2,999)
        !             8:        S DTO=0,(D0,DA)=+Y,DIK=DIC,DFR(1)=DIC_DA_"," K DIC D WAIT^DICD
        !             9: GO     D GO^DITR
        !            10:        S DIT=DH D KL^DIT,^DIK:DH S DA=DFR K DFR D IX1^DIK
        !            11:        S DH=DIT D ASK^DITP,PTS^DITP:%=1
        !            12: Q      G Q^DIT
        !            13:        ;
        !            14: LK     S DIC("A")="TRANSFER "_X_DFL G ^DIC
        !            15:        ;
        !            16: EN     ; PROGRAMMER CALL
        !            17:        ; DIT("F") = GLOBAL ROOT OR FILE # OF FILE TO TRANSFER FROM
        !            18:        ; DIT("T") = GLOBAL ROOT OR FILE # OF FILE TO TRANSFER TO
        !            19:        ; DA("F")  = ENTRY # IN FILE TO TRANSFER FROM
        !            20:        ; DA("T")  = ENTRY # IN FILE TO TRANSFER TO
        !            21:        ;
        !            22:        I '$D(DIT("F"))!'$D(DIT("T"))!'$D(DA("F"))!'$D(DA("T")) G FIN
        !            23:        S DDF(1)=DIT("F"),DDT(0)=DIT("T")
        !            24:        I 'DDF(1) S DDF(1)=$S($D(@(DDF(1)_"0)"))#2:+$P(^(0),U,2),1:0) G FIN:'DDF(1) S DFR(1)=DIT("F")
        !            25:        I 'DDT(0) S DDT(0)=$S($D(@(DDT(0)_"0)"))#2:+$P(^(0),U,2),1:0) G FIN:'DDT(0) S DTO(1)=DIT("T") G C
        !            26:        G FIN:'$D(^DIC(+DDF(1),0,"GL")) S DFR(1)=^("GL")
        !            27:        G FIN:'$D(^DIC(+DDT(0),0,"GL")) S DTO(1)=^("GL")
        !            28: C      S DB=DA("F"),(DB1,DFR)=DA("T"),DIK=DTO(1)
        !            29:        I $D(DA(1)) F I=1:1 G:'$D(DA(I)) SET S DRF(I)=$P(DA(I),",",1)_",1,",DOT(I)=$P(DA(I),",",2)_",1,"
        !            30: DON    K DRF,DOT S DFR(1)=DFR(1)_DB_",",DTO(1)=DTO(1)_DB1_",",DKP=1,DMRG=1,DTO=0,DH=0 G GO
        !            31: SET    F I=I-1:-1 G:I'>0 DON S DFR(1)=DFR(1)_DRF(I),DTO(1)=DTO(1)_DOT(I)
        !            32: FIN    ;
        !            33:        K DDF,DFR,DDT,DTO
        !            34:        Q