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>