Return to DIAXU.m CVS log

Up to [Coherent Logic Development] / freem_fileman / USER

Restructure repository

DIAXU	;SFISC/DCM-UPDATE DESTINATION FILE ;9/2/94  06:44
	;;21.0;VA FileMan;;Dec 28, 1994
	;Per VHA Directive 10-93-142, this routine should not be modified.
	Q:D0'=+D0  S DIAXFE=D0
	D IN I $D(DIAXMSG) G Q1
	S @(DIAXF_"D0,-9)")=DIARC
	N D0,DN,DC
	D EN1^DIAXG
	I '$G(DIAXFE) K DIC,DD,DO S X=DIAXDA,DINUM=X,DIC="^DIAR(1.11,"_DIARC_",""EX"",",DIC(0)="L",DA(1)=DIARC,DIC("P")=1.14 D FILE^DICN
	D Q1
	K DIAXDA,DIAXF
	Q
EN	;
	Q:$D(DIAXMSG)  S DIPG=1,DIAR=6,DIERR=0
	K ^TMP("DIERR",$J)
	I ('$D(DIAXFE)&'$D(DIAXST))!'$D(DIAXT)!'$D(DIAXF) D ERR^DIAXERR(1) G Q
	I $D(DIAXFE),+DIAXFE'=DIAXFE D ERR^DIAXERR(2) G Q
	D IN G Q:$D(DIAXMSG)
	K DIC S X=$S(DIAXT:DIAXT,1:$P($P(DIAXT,"[",2),"]")),DIC="^DIPT(",DIC(0)="NXZ",D="EX",DIC("S")="I $P(^(0),U,4)="_DIAXFN_",$P(^(0),U,8)=2"
	D IX^DIC K DIC I Y<0 D ERR^DIAXERR(3) G Q
	S DIARP=+Y,DIAXFNO=$P(Y(0),U,9)
	I $D(DIAXST) G ST
	S DIAXD0=DIAXFE
	D EN^DIAXG G Q:$D(DIAXMSG)
	D:$D(DIAXDEL) DEL
	G Q
DEL	;
	S DIK=DIAXF,DA=DIAXD0
	D ^DIK
	Q
	;
IN	S DIOVRD=1,DIPG=+$G(DIPG),DIAXF=$S(+$G(DIAXF):^DIC(DIAXF,0,"GL"),$G(DIARP):^DIC($P(^DIPT(DIARP,0),U,4),0,"GL"),1:DIAXF),DIAXFN=+$P(@(DIAXF_"0)"),U,2)
	Q:$D(DIAXST)
	I '$D(@(DIAXF_DIAXFE_")")) D ERR^DIAXERR(4) S:$G(DIARC) $P(^(0),U,7)=+$P(^DIAR(1.11,DIARC,0),U,7)-1
	Q
	;
ST	K DIC S X=$S(DIAXST:DIAXST,1:$P($P(DIAXST,"[",2),"]")),DIC="^DIBT(",DIC(0)="NXZ",D="F"_DIAXFN,DIC("S")="I $P(^(0),U,4)="_DIAXFN D IX^DIC K DIC I Y<0 D ERR^DIAXERR(3) G Q
	S DIAXST=+Y I '$D(^DIBT(DIAXST,1)) D ERR^DIAXERR(10) G Q
	I $D(DIAXGR) I $E(DIAXGR,1,3)="^DI"!(",("'[$E(DIAXGR,$L(DIAXGR))) D ERR^DIAXERR(11) G Q
	I '$D(DIAXGR) K ^TMP("DIAX1",$J) S DIAXGR="^TMP(""DIAX1"",$J,"
	S DIAXSTZ=0 F  S DIAXSTZ=$O(^DIBT(DIAXST,1,DIAXSTZ)) Q:DIAXSTZ'>0  D
	. S (DIAXFE,DIAXD0)=DIAXSTZ Q:'$D(@(DIAXF_DIAXD0_")"))  D EN^DIAXG
	. I '$D(DIAXMSG) S @(DIAXGR_"1,DIAXD0)")=DIAXDA D:$D(DIAXDEL) DEL K ^DIBT(DIAXST,1,DIAXSTZ)
	. K DIAXDA,DIAXMSG
Q	K DIAR,DIARP,DIAXFNO
Q1	K DIAXFN,DIOVRD,DIC,DD,DO,DIK,DIAXD0,DINUM,X,Y,DA K:$D(DIAXMSG) DIAXDA
	K DIPG,DIAXSTZ,DIAXMSG
	Q