Return to DIAXU1.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DIAXU1.m, revision 1.1

1.1     ! snw         1: DIAXU1 ;SFISC/DCM-UPDATE DESTINATION FILE (CONT) ;3/5/93  2:34 PM
        !             2:        ;;21.0;VA FileMan;;Dec 28, 1994
        !             3:        ;Per VHA Directive 10-93-142, this routine should not be modified.
        !             4: START  K DIC,DO,DA,DR,DD,X
        !             5:        D SETVAR,PROCESS,EOJ
        !             6:        Q
        !             7:        ;
        !             8: SETVAR S DIAXFILE=DIAXET(DILL,"FILE")
        !             9:        S DIAXMODE=$P(^TMP("DIAX",$J,DIAXFILE,"MODE"),U)
        !            10:        I $D(^TMP("DIAX",$J,DIAXFILE,"X")) S X=^("X")
        !            11:        I $D(^TMP("DIAX",$J,DIAXFILE,"DA(1)")) F DIAXII=1:1 Q:'$D(^("DA("_DIAXII_")"))  S @("DA("_DIAXII_")="_^("DA("_DIAXII_")"))
        !            12:        I $D(^TMP("DIAX",$J,DIAXFILE,"DIC(""P"")")) S DIC("P")=^("DIC(""P"")")
        !            13:        Q
        !            14:        ;
        !            15: PROCESS        I DIAXMODE="A" S DIC=^TMP("DIAX",$J,DIAXFILE,"GL") D CALLDIC^DIAXU2 Q:$D(DIAXMSG)  S DIAXAVAL=+Y D ADDCONT Q
        !            16:        D BUILDDR
        !            17:        S DIE=^TMP("DIAX",$J,DIAXFILE,"GL"),@("DA="_^("DA")) I $G(DR)]"" D CALLDIE^DIAXU2 Q:$D(DIAXMSG)
        !            18:        I $D(^TMP("DIAX",$J,DIAXFILE,"WP")) D WP^DIAXU2
        !            19:        Q
        !            20:        ;
        !            21: ADDCONT        S DA=DIAXAVAL,DIE=DIC
        !            22:        I $D(^TMP("DIAX",$J,DIAXFILE,"WP")) D WP^DIAXU2
        !            23:        D BUILDDR
        !            24:        I $G(DR)]"" D CALLDIE^DIAXU2 Q:$D(DIAXMSG)
        !            25:        D DA
        !            26:        Q
        !            27:        ;
        !            28: BUILDDR        I $D(^TMP("DIAX",$J,DIAXFILE,"DR")) S DR=^("DR")
        !            29:        I $D(^TMP("DIAX",$J,DIAXFILE,"DR"))=11 S DIAXZRO=0 F DIAXL=0:0 S DIAXZRO=$O(^TMP("DIAX",$J,DIAXFILE,"DR",DIAXZRO)) Q:'DIAXZRO  S DR(1,DIAXFILE,DIAXZRO)=^(DIAXZRO)
        !            30:        Q
        !            31:        ;
        !            32: DA     S (DIAXET(DIAXFILE,"DA"),^TMP("DIAX",$J,DIAXFILE,"DA"))=DIAXAVAL
        !            33:        S DIAXX=$G(DIAXET(DIAXFILE)) I DIAXX=""!(DIAXFILE=DIAXX) Q
        !            34:        I $D(DIAXET(DIAXX,"DA")) S DIAXET(DIAXFILE,"DA(1)")=DIAXET(DIAXX,"DA")
        !            35:        I $D(DIAXET(DIAXX,"DA(1)")) F DIAXII=1:1 Q:'$D(DIAXET(DIAXX,"DA("_DIAXII_")"))  S DIAXET(DIAXFILE,"DA("_(DIAXII+1)_")")=DIAXET(DIAXX,"DA("_DIAXII_")")
        !            36:        Q
        !            37:        ;
        !            38: EOJ    K DIC,DIE,DIK,DA,DR,DIAXAVAL,X,Y
        !            39:        K:$D(DIAXMSG) ^TMP("DIAX",$J)
        !            40:        K ^TMP("DIAX",$J,DIAXFILE,"DR"),^("WP")
        !            41:        K DIAXII,DIAXFILE,DIAXMODE,DIAXDRVL,DIAXZRO,DIAXX,DIAXL,DIAX("FIELD")
        !            42:        Q