Return to DIAXU1.m CVS log

Up to [Coherent Logic Development] / freem_fileman / USER

Restructure repository

    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