Return to DIAXU1.m CVS log

Up to [Coherent Logic Development] / freem_fileman

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