Return to DIAXU2.m CVS log

Up to [Coherent Logic Development] / freem_fileman / USER

Restructure repository

    1: DIAXU2	;SFISC/DCM-UPDATE DESTINATION FILE (CONT) ;10/13/94  10:01 AM
    2: 	;;21.0;VA FileMan;;Dec 28, 1994
    3: 	;Per VHA Directive 10-93-142, this routine should not be modified.
    4: CALLDIC	S DIADD=1,DIC(0)="FLI",DLAYGO=DIAXFILE
    5: 	D ^DIC I Y<1 D ERR^DIAXERR(99,DIAXFN_U_DIAXFE_U_DIAX(1,.01)) D FIX
    6: 	K DLAYGO,DR,DINUM,DIADD,X
    7: 	Q
    8: 	;
    9: CALLDIE	;I DR[".01///"&($P(^DD(DIAXFILE,.01,0),U,5,99)["DINUM"!$D(^TMP("DIAX",$J,DIAXFILE,"DINUM"))) S DIAXDRVL=$P($P(DR,".01///",2),";"),DR=$P(DR,".01///"_DIAXDRVL)_$P(DR,".01///"_DIAXDRVL_";",2)
   10: 	D ^DIE I $D(Y) D ERR^DIAXERR(98,DIAXFN_U_DIAXFE_U_DIAX(1,.01)) D FIX
   11: 	Q
   12: 	;
   13: WP	S DIAX("FIELD")=0
   14: 	;
   15: WP1	S DIAX("FIELD")=$O(^TMP("DIAX",$J,DIAXFILE,"WP",DIAX("FIELD"))) Q:DIAX("FIELD")'>0
   16: 	S DKP=0
   17: 	F A9="DTL","DTO(1)","DFL","DFR(1)" S @A9=^TMP("DIAX",$J,DIAXFILE,DIAX("FIELD"),A9)
   18: 	S DTO(1)=DTO(1)_DIAXAVAL_","""_$P($P(^DD(DIAXET(DILL,"FILE"),DIAX("FIELD"),0),U,4),";")_""","
   19: 	D WORD^DITR1
   20: 	K DFR,DKP,DTO,V,A9,DFL,DTL
   21: 	G WP1
   22: 	;
   23: FIX	I $G(^TMP("DIAX",$J,DIAXFNO,"DA")) S DA=^("DA"),DIK=^("GL") D ^DIK
   24: 	Q:DIPG
   25: 	S $P(^(0),U,7)=$P(^DIAR(1.11,DIARC,0),U,7)-1
   26: 	S:$G(DIOEND)'["DIAXU3" DIOEND=DIOEND_" D ^DIAXU3"
   27: 	K ^DIBT(DIARU,1,DIAXFE),@(DIAXF_DIAXFE_",-9)")
   28: 	Q