Return to DIAXU2.m CVS log

Up to [Coherent Logic Development] / freem_fileman

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