Return to DIAXU.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DIAXU.m, revision 1.1

1.1     ! snw         1: DIAXU  ;SFISC/DCM-UPDATE DESTINATION FILE ;9/2/94  06:44
        !             2:        ;;21.0;VA FileMan;;Dec 28, 1994
        !             3:        ;Per VHA Directive 10-93-142, this routine should not be modified.
        !             4:        Q:D0'=+D0  S DIAXFE=D0
        !             5:        D IN I $D(DIAXMSG) G Q1
        !             6:        S @(DIAXF_"D0,-9)")=DIARC
        !             7:        N D0,DN,DC
        !             8:        D EN1^DIAXG
        !             9:        I '$G(DIAXFE) K DIC,DD,DO S X=DIAXDA,DINUM=X,DIC="^DIAR(1.11,"_DIARC_",""EX"",",DIC(0)="L",DA(1)=DIARC,DIC("P")=1.14 D FILE^DICN
        !            10:        D Q1
        !            11:        K DIAXDA,DIAXF
        !            12:        Q
        !            13: EN     ;
        !            14:        Q:$D(DIAXMSG)  S DIPG=1,DIAR=6,DIERR=0
        !            15:        K ^TMP("DIERR",$J)
        !            16:        I ('$D(DIAXFE)&'$D(DIAXST))!'$D(DIAXT)!'$D(DIAXF) D ERR^DIAXERR(1) G Q
        !            17:        I $D(DIAXFE),+DIAXFE'=DIAXFE D ERR^DIAXERR(2) G Q
        !            18:        D IN G Q:$D(DIAXMSG)
        !            19:        K DIC S X=$S(DIAXT:DIAXT,1:$P($P(DIAXT,"[",2),"]")),DIC="^DIPT(",DIC(0)="NXZ",D="EX",DIC("S")="I $P(^(0),U,4)="_DIAXFN_",$P(^(0),U,8)=2"
        !            20:        D IX^DIC K DIC I Y<0 D ERR^DIAXERR(3) G Q
        !            21:        S DIARP=+Y,DIAXFNO=$P(Y(0),U,9)
        !            22:        I $D(DIAXST) G ST
        !            23:        S DIAXD0=DIAXFE
        !            24:        D EN^DIAXG G Q:$D(DIAXMSG)
        !            25:        D:$D(DIAXDEL) DEL
        !            26:        G Q
        !            27: DEL    ;
        !            28:        S DIK=DIAXF,DA=DIAXD0
        !            29:        D ^DIK
        !            30:        Q
        !            31:        ;
        !            32: IN     S DIOVRD=1,DIPG=+$G(DIPG),DIAXF=$S(+$G(DIAXF):^DIC(DIAXF,0,"GL"),$G(DIARP):^DIC($P(^DIPT(DIARP,0),U,4),0,"GL"),1:DIAXF),DIAXFN=+$P(@(DIAXF_"0)"),U,2)
        !            33:        Q:$D(DIAXST)
        !            34:        I '$D(@(DIAXF_DIAXFE_")")) D ERR^DIAXERR(4) S:$G(DIARC) $P(^(0),U,7)=+$P(^DIAR(1.11,DIARC,0),U,7)-1
        !            35:        Q
        !            36:        ;
        !            37: ST     K DIC S X=$S(DIAXST:DIAXST,1:$P($P(DIAXST,"[",2),"]")),DIC="^DIBT(",DIC(0)="NXZ",D="F"_DIAXFN,DIC("S")="I $P(^(0),U,4)="_DIAXFN D IX^DIC K DIC I Y<0 D ERR^DIAXERR(3) G Q
        !            38:        S DIAXST=+Y I '$D(^DIBT(DIAXST,1)) D ERR^DIAXERR(10) G Q
        !            39:        I $D(DIAXGR) I $E(DIAXGR,1,3)="^DI"!(",("'[$E(DIAXGR,$L(DIAXGR))) D ERR^DIAXERR(11) G Q
        !            40:        I '$D(DIAXGR) K ^TMP("DIAX1",$J) S DIAXGR="^TMP(""DIAX1"",$J,"
        !            41:        S DIAXSTZ=0 F  S DIAXSTZ=$O(^DIBT(DIAXST,1,DIAXSTZ)) Q:DIAXSTZ'>0  D
        !            42:        . S (DIAXFE,DIAXD0)=DIAXSTZ Q:'$D(@(DIAXF_DIAXD0_")"))  D EN^DIAXG
        !            43:        . I '$D(DIAXMSG) S @(DIAXGR_"1,DIAXD0)")=DIAXDA D:$D(DIAXDEL) DEL K ^DIBT(DIAXST,1,DIAXSTZ)
        !            44:        . K DIAXDA,DIAXMSG
        !            45: Q      K DIAR,DIARP,DIAXFNO
        !            46: Q1     K DIAXFN,DIOVRD,DIC,DD,DO,DIK,DIAXD0,DINUM,X,Y,DA K:$D(DIAXMSG) DIAXDA
        !            47:        K DIPG,DIAXSTZ,DIAXMSG
        !            48:        Q