File:  [Coherent Logic Development] / freem_fileman / Attic / DITMGM2C.m
Revision 1.1.1.1 (vendor branch): download - view: text, annotated - select for diffs
Mon Apr 28 14:10:44 2025 UTC (5 weeks, 4 days ago) by snw
Branches: CoherentLogicDevelopment
CVS tags: start
Initial commit

DITMGM2C	;SFISC/EDE(OHPRD)TKW-CONTINUATION OF DITMGM2 ;5/11/94  15:16
	;;21.0;VA FileMan;;Dec 28, 1994
	;Per VHA Directive 10-93-142, this routine should not be modified.
	;
ENTRY	; PROCESS ONE FILE/SUBFILE ENTRY
	;
	W:'$D(DITMGM2("NOTALK")) "."
	I DITMGMDI D DINUM Q  ; merge dinum entries
	;
	; ----- Transform DITMGMT
	S DITMGM("DITMGMT")=DITMGMT
	I 'DITMGMV S DITMGMT=$S(DITMGMFD=.01:"`",1:"/")_DITMGMT I 1
	E  S X=$P(DITMGMT,";",2),DITMGMT=$P(DITMGMT,";",1),X=+$P(@("^"_X_"0)"),U,2) D  Q:X=""  S DITMGMT=X_".`"_DITMGMT
	. S X=$O(^DD(DITMGMFL,DITMGMFD,"V","B",X,0))
	. Q:X=""
	. S X=$P(^DD(DITMGMFL,DITMGMFD,"V",X,0),U,4)
	. Q
	; -----
	;
	I DITMGMMU D ENTRYM I 1
	E  D ENTRYS
	S DITMGMT=DITMGM("DITMGMT") K DITMGM("DITMGMT")
	Q
	;
ENTRYS	;
	;
	S DITC="",DA=DITMGMN,D0=DA,DIE=DITMGMG,DR=DITMGMFD_"///"_DITMGMT
	D ^DIE K DA,DIE,DITC,DR,D0
	I $D(Y) S DITMGMEC=DITMGMEC+1,DITMGMRG("ERROR",DITMGMEC)="DIE"_U_DITMGMFL_U_DITMGMFD_U_DITMGMN_U_DITMGMF_U_DITMGMT
	Q
	;
ENTRYM	; PROCESS ONE SUBFILE ENTRY
	S DITC="",DIE=DITMGMGM,DA=DITMGMN,DR=DITMGMFD_"///"_DITMGMT
	D ^DITMU1 ; Set D0, D1, etc.
	D ^DIE K DA,DIE,DITC,DR
	D KILL^DITMU1 ; Kill D0, D1, etc.
	I $D(Y) S DITMGMEC=DITMGMEC+1,DITMGMRG("ERROR",DITMGMEC)="DIE"_U_DITMGMFL_U_DITMGMFD_U_DITMGMN_U_DITMGMF_U_DITMGMT
	Q
	;
DINUM	; DINUM FILE
	; Move the 'from' entry to it's new IEN location.  Do a merge
	; if there is already a record at that location.
	;
	N DIDA,DIK,DITMFROM S DITMFROM=$S(DITMGMMU:DITMGMGM,1:DITMGMG)
	S $P(@(DITMFROM_DITMGMF_",0)"),U)=DITMGMT
	I '$D(@(DITMFROM_DITMGMT_",0)")) D
	. S @(DITMFROM_DITMGMT_",0)")=DITMGMT
	. S $P(@(DITMFROM_"0)"),U,3,4)=DITMGMT_"^"_($P(@(DITMFROM_"0)"),U,4)+1)
	. Q
	S DIDA=$S('DITMGMMU:",",1:$$IEN^DIEFU(.DA)),DIDA("F")=DITMGMF_DIDA,DIDA("T")=DITMGMT_DIDA
	D TRNMRG^DIT("M",DITMGMFL,"",DIDA("F"),DIDA("T"))
	S $P(@(DITMFROM_DITMGMF_",0)"),U)=DITMGMF
	D
	. N DA D DA^DIEFU(DIDA("T"),.DA) Q:$D(DIERR) 
	. K DIK S DIK=$$ROOT^DIQGU(DITMGMFL,DIDA("T")) Q:$D(DIERR)
	. N DIDA D IXALL^DIK Q
	D
	. N DA D DA^DIEFU(DIDA("F"),.DA) Q:$D(DIERR)
	. K DIK S DIK=$$ROOT^DIQGU(DITMGMFL,DIDA("F")) Q:$D(DIERR)
	. N DIDA D ^DIK Q
	Q

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