Return to DIAXU.m CVS log

Up to [Coherent Logic Development] / freem_fileman

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