Return to DDS6.m CVS log

Up to [Coherent Logic Development] / freem_fileman / USER

Restructure repository

DDS6	;SFISC/MKO-DELETIONS ;02:49 PM  9 Nov 1994
	;;21.0;VA FileMan;;Dec 28, 1994
	;Per VHA Directive 10-93-142, this routine should not be modified.
	;Enter here if user deleted record from the .01 of the (sub)record
	;(called from DDS01)
	;In:  DDSU array, DDSOLD, DDSFLD
	D D
	I 'Y D
	. S @DDSREFT@("F"_DDP,DDSDA,DDSFLD,"D")=DDSOLD
	. S:$D(DDSU("X"))#2 @DDSREFT@("F"_DDP,DDSDA,DDSFLD,"X")=DDSU("X")
	E  D
	. I $D(DDSREP) D
	.. D DEL^DDSM1(DDSDA)
	. E  D K I $D(DDSPTB) D
	.. S DDACT="NB"
	.. S $P(@DDSREFT@(DDSPG,DDSBK),U)=""
	.. D DB^DDSR(DDSPG,DDSBK)
	.. D RPF^DDS7
	. E  S DDACT="Q",DA=""
	;
	I '$P(DDSSC(DDSSC),U,4),'$D(DDSREP) D
	. D PG^DDSRSEL
	. D:$G(DDSSEL) PUT^DDSVALF(1,1,$P(^DIST(.403,+DDS,21),U),"")
	Q
	;
DM	;Enter here if user deleted record from the Select prompt
	;(called from DDS5)
	;In:  DDSU array, DDSOLD, DDSFLD
	;
	;Get DA and DIE for subfile level and delete
	D DDA^DDS5(DDSOLD,.DA,.DDSDL)
	D
	. N DIE,DDSDA
	. S DIE=U_$P(DDSU("M"),U,2)
	. S DDSDA=DA_"," F DDSI=1:1:DDSDL S DDSDA=DDSDA_DA(DDSI)_","
	. K DDSI
	. D D
	. D:Y K
	;
	I 'Y D
	. S @DDSREFT@("F"_DDP,DDSDA,DDSFLD,"D")=DDSOLD
	. S:$D(DDSU("X"))#2 @DDSREFT@("F"_DDP,DDSDA,DDSFLD,"X")=DDSU("X")
	. D UDA^DDS5(.DA,.DDSDL)
	E  D
	. D LST^DDS5(.DA,.DDSDL,DDP,DDSDA,DDSFLD)
	. D UDA^DDS5(.DA,.DDSDL)
	Q
	;
D	;Delete the subrecord
	;In: DA array, DIE, DDSDL; Out: Y=1 if successful
	N DR,DDS6DA,DDSI
	D:DDM CLRMSG^DDS
	S DDM=1
	;
	K DIR S DIR(0)="YO"
	D BLD^DIALOG(8080,$$EZBLD^DIALOG(8078+(DDSDL>0)),"","DIR(""A"")")
	D BLD^DIALOG(9038,"","","DIR(""?"")")
	;
	S DIR0=IOSL-1_U_($L(DIR("A"))+1)_"^3^"_(IOSL-3)_"^0"
	D ^DIR K DIR
	D CLRMSG^DDS
	I X=""!$D(DIRUT)!'Y S Y=0 K DIRUT,DUOUT,DIROUT,DTOUT Q
	;
	S DDS6DA=DA N D0
	F DDSI=1:1 Q:$D(DA(DDSI))[0  S DDS6DA(DDSI)=DA(DDSI) N @("D"_DDSI)
	W $P(DDGLVID,DDGLDEL,9) S X=IOM X $G(^%ZOSF("RM"))
	S DR=".01///@" D ^DIE K DI
	W $P(DDGLVID,DDGLDEL,8) S X=0 X ^%ZOSF("RM")
	;
	;I $D(DA) H 2 W $P(DDGLCLR,DDGLDEL,2) D R^DDSR S Y=0 Q
	I $D(DA) S:$Y>(DDSHBX+1) DDSKM=1,DDM=1 S Y=0 Q
	;
	S Y=1,DA=DDS6DA
	I '$G(DDSCHANG),$G(DDSPARM)["C" S DDSCHANG=1
	F DDSI=1:1 Q:$D(DDS6DA(DDSI))[0  S DA(DDSI)=DDS6DA(DDSI)
	Q
	;
K	;Remove all data pertaining to the (sub)record from DDSREFT
	;In: DDSDA, DIE at subfile level
	;
	N B,P,FN,PAT,PDA
	S PAT=".E1"""_DDSDA_""""
	S PDA=$P(DDSDA,",",2,999)
	S P=0
	F  S P=$O(@DDSREFT@(P)) Q:'P  D
	. S B=0 F  S B=$O(@DDSREFT@(P,B)) Q:'B  D
	.. S FN="F"_$P(@DDSREFS@(P,B),U,3),DDS6DA=" "
	.. F  S DDS6DA=$O(@DDSREFT@(P,B,DDS6DA)) Q:'DDS6DA  D
	... I DDS6DA?@PAT,$P(@DDSREFT@(P,B,DDS6DA,"GL"),DIE)="" D
	.... K @DDSREFT@(P,B,DDS6DA)
	.... K @DDSREFT@(FN,DDS6DA)
	... E  I DDS6DA=PDA,DIE=@DDSREFT@(P,B,PDA,"GL") D DELP
	K DDS6DA
	Q
	;
DELP	;Delete subrecord from parent's list
	N R,S
	S S=$G(@DDSREFT@(P,B,PDA,"B",DDSDA)) Q:'S
	K @DDSREFT@(P,B,PDA,"B",DDSDA)
	;
	F S=S:1 Q:$D(@DDSREFT@(P,B,PDA,S+1))[0  D
	. S R=@DDSREFT@(P,B,PDA,S+1)
	. S @DDSREFT@(P,B,PDA,S)=R
	. S @DDSREFT@(P,B,PDA,"B",R)=S
	K @DDSREFT@(P,B,PDA,S)
	Q
	;
DEL	;Delete (sub)records added between saves
	;(user quit without saving)
	N DA,DIK
	S DDSI=0
	F  S DDSI=$O(@DDSREFT@("ADD",DDSI)) Q:'DDSI  D
	. K DA
	. S DA=$P(@DDSREFT@("ADD",DDSI),U),DIK=U_$P(^(DDSI),U,2)
	. F DDSX=2:1:$L(DA,",")-1 S DA(DDSX-1)=$P(DA,",",DDSX)
	. S DA=+DA
	. D ^DIK
	K DDSI,DDSX
	Q
	;#8078  record
	;#8079  subrecord
	;#8080  WARNING: DELETIONS ARE DONE...
	;#9038  Enter 'Y' to delete...