Annotation of freem_fileman/DIAXU2.m, revision 1.1

1.1     ! snw         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

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>