File:  [Coherent Logic Development] / freem_fileman / USER / DITMGM2C.m
Revision 1.1: download - view: text, annotated - select for diffs
Mon Apr 28 14:13:21 2025 UTC (3 months ago) by snw
Branches: MAIN
CVS tags: HEAD
Restructure repository

    1: DITMGM2C	;SFISC/EDE(OHPRD)TKW-CONTINUATION OF DITMGM2 ;5/11/94  15:16
    2: 	;;21.0;VA FileMan;;Dec 28, 1994
    3: 	;Per VHA Directive 10-93-142, this routine should not be modified.
    4: 	;
    5: ENTRY	; PROCESS ONE FILE/SUBFILE ENTRY
    6: 	;
    7: 	W:'$D(DITMGM2("NOTALK")) "."
    8: 	I DITMGMDI D DINUM Q  ; merge dinum entries
    9: 	;
   10: 	; ----- Transform DITMGMT
   11: 	S DITMGM("DITMGMT")=DITMGMT
   12: 	I 'DITMGMV S DITMGMT=$S(DITMGMFD=.01:"`",1:"/")_DITMGMT I 1
   13: 	E  S X=$P(DITMGMT,";",2),DITMGMT=$P(DITMGMT,";",1),X=+$P(@("^"_X_"0)"),U,2) D  Q:X=""  S DITMGMT=X_".`"_DITMGMT
   14: 	. S X=$O(^DD(DITMGMFL,DITMGMFD,"V","B",X,0))
   15: 	. Q:X=""
   16: 	. S X=$P(^DD(DITMGMFL,DITMGMFD,"V",X,0),U,4)
   17: 	. Q
   18: 	; -----
   19: 	;
   20: 	I DITMGMMU D ENTRYM I 1
   21: 	E  D ENTRYS
   22: 	S DITMGMT=DITMGM("DITMGMT") K DITMGM("DITMGMT")
   23: 	Q
   24: 	;
   25: ENTRYS	;
   26: 	;
   27: 	S DITC="",DA=DITMGMN,D0=DA,DIE=DITMGMG,DR=DITMGMFD_"///"_DITMGMT
   28: 	D ^DIE K DA,DIE,DITC,DR,D0
   29: 	I $D(Y) S DITMGMEC=DITMGMEC+1,DITMGMRG("ERROR",DITMGMEC)="DIE"_U_DITMGMFL_U_DITMGMFD_U_DITMGMN_U_DITMGMF_U_DITMGMT
   30: 	Q
   31: 	;
   32: ENTRYM	; PROCESS ONE SUBFILE ENTRY
   33: 	S DITC="",DIE=DITMGMGM,DA=DITMGMN,DR=DITMGMFD_"///"_DITMGMT
   34: 	D ^DITMU1 ; Set D0, D1, etc.
   35: 	D ^DIE K DA,DIE,DITC,DR
   36: 	D KILL^DITMU1 ; Kill D0, D1, etc.
   37: 	I $D(Y) S DITMGMEC=DITMGMEC+1,DITMGMRG("ERROR",DITMGMEC)="DIE"_U_DITMGMFL_U_DITMGMFD_U_DITMGMN_U_DITMGMF_U_DITMGMT
   38: 	Q
   39: 	;
   40: DINUM	; DINUM FILE
   41: 	; Move the 'from' entry to it's new IEN location.  Do a merge
   42: 	; if there is already a record at that location.
   43: 	;
   44: 	N DIDA,DIK,DITMFROM S DITMFROM=$S(DITMGMMU:DITMGMGM,1:DITMGMG)
   45: 	S $P(@(DITMFROM_DITMGMF_",0)"),U)=DITMGMT
   46: 	I '$D(@(DITMFROM_DITMGMT_",0)")) D
   47: 	. S @(DITMFROM_DITMGMT_",0)")=DITMGMT
   48: 	. S $P(@(DITMFROM_"0)"),U,3,4)=DITMGMT_"^"_($P(@(DITMFROM_"0)"),U,4)+1)
   49: 	. Q
   50: 	S DIDA=$S('DITMGMMU:",",1:$$IEN^DIEFU(.DA)),DIDA("F")=DITMGMF_DIDA,DIDA("T")=DITMGMT_DIDA
   51: 	D TRNMRG^DIT("M",DITMGMFL,"",DIDA("F"),DIDA("T"))
   52: 	S $P(@(DITMFROM_DITMGMF_",0)"),U)=DITMGMF
   53: 	D
   54: 	. N DA D DA^DIEFU(DIDA("T"),.DA) Q:$D(DIERR) 
   55: 	. K DIK S DIK=$$ROOT^DIQGU(DITMGMFL,DIDA("T")) Q:$D(DIERR)
   56: 	. N DIDA D IXALL^DIK Q
   57: 	D
   58: 	. N DA D DA^DIEFU(DIDA("F"),.DA) Q:$D(DIERR)
   59: 	. K DIK S DIK=$$ROOT^DIQGU(DITMGMFL,DIDA("F")) Q:$D(DIERR)
   60: 	. N DIDA D ^DIK Q
   61: 	Q

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