DITMGM2C ;SFISC/EDE(OHPRD)TKW-CONTINUATION OF DITMGM2 ;10/7/98 10:38
;;22.2;VA FileMan;;Jan 05, 2016;Build 42
;;Per VA Directive 6402, this routine should not be modified.
;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
;;Licensed under the terms of the Apache License, Version 2.0.
;
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 IX1^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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDITMGM2C 2378 printed Nov 22, 2024@18:04:18 Page 2
DITMGM2C ;SFISC/EDE(OHPRD)TKW-CONTINUATION OF DITMGM2 ;10/7/98 10:38
+1 ;;22.2;VA FileMan;;Jan 05, 2016;Build 42
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
+4 ;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
+5 ;;Licensed under the terms of the Apache License, Version 2.0.
+6 ;
ENTRY ; PROCESS ONE FILE/SUBFILE ENTRY
+1 ;
+2 if '$DATA(DITMGM2("NOTALK"))
WRITE "."
+3 ; merge dinum entries
IF DITMGMDI
DO DINUM
QUIT
+4 ;
+5 ; ----- Transform DITMGMT
+6 SET DITMGM("DITMGMT")=DITMGMT
+7 IF 'DITMGMV
SET DITMGMT=$SELECT(DITMGMFD=.01:"`",1:"/")_DITMGMT
IF 1
+8 IF '$TEST
SET X=$PIECE(DITMGMT,";",2)
SET DITMGMT=$PIECE(DITMGMT,";",1)
SET X=+$PIECE(@("^"_X_"0)"),U,2)
Begin DoDot:1
+9 SET X=$ORDER(^DD(DITMGMFL,DITMGMFD,"V","B",X,0))
+10 if X=""
QUIT
+11 SET X=$PIECE(^DD(DITMGMFL,DITMGMFD,"V",X,0),U,4)
+12 QUIT
End DoDot:1
if X=""
QUIT
SET DITMGMT=X_".`"_DITMGMT
+13 ; -----
+14 ;
+15 IF DITMGMMU
DO ENTRYM
IF 1
+16 IF '$TEST
DO ENTRYS
+17 SET DITMGMT=DITMGM("DITMGMT")
KILL DITMGM("DITMGMT")
+18 QUIT
+19 ;
ENTRYS ;
+1 ;
+2 SET DITC=""
SET DA=DITMGMN
SET D0=DA
SET DIE=DITMGMG
SET DR=DITMGMFD_"///"_DITMGMT
+3 DO ^DIE
KILL DA,DIE,DITC,DR,D0
+4 IF $DATA(Y)
SET DITMGMEC=DITMGMEC+1
SET DITMGMRG("ERROR",DITMGMEC)="DIE"_U_DITMGMFL_U_DITMGMFD_U_DITMGMN_U_DITMGMF_U_DITMGMT
+5 QUIT
+6 ;
ENTRYM ; PROCESS ONE SUBFILE ENTRY
+1 SET DITC=""
SET DIE=DITMGMGM
SET DA=DITMGMN
SET DR=DITMGMFD_"///"_DITMGMT
+2 ; Set D0, D1, etc.
DO ^DITMU1
+3 DO ^DIE
KILL DA,DIE,DITC,DR
+4 ; Kill D0, D1, etc.
DO KILL^DITMU1
+5 IF $DATA(Y)
SET DITMGMEC=DITMGMEC+1
SET DITMGMRG("ERROR",DITMGMEC)="DIE"_U_DITMGMFL_U_DITMGMFD_U_DITMGMN_U_DITMGMF_U_DITMGMT
+6 QUIT
+7 ;
DINUM ; DINUM FILE
+1 ; Move the 'from' entry to it's new IEN location. Do a merge
+2 ; if there is already a record at that location.
+3 ;
+4 NEW DIDA,DIK,DITMFROM
SET DITMFROM=$SELECT(DITMGMMU:DITMGMGM,1:DITMGMG)
+5 SET $PIECE(@(DITMFROM_DITMGMF_",0)"),U)=DITMGMT
+6 IF '$DATA(@(DITMFROM_DITMGMT_",0)"))
Begin DoDot:1
+7 SET @(DITMFROM_DITMGMT_",0)")=DITMGMT
+8 SET $PIECE(@(DITMFROM_"0)"),U,3,4)=DITMGMT_"^"_($PIECE(@(DITMFROM_"0)"),U,4)+1)
+9 QUIT
End DoDot:1
+10 SET DIDA=$SELECT('DITMGMMU:",",1:$$IEN^DIEFU(.DA))
SET DIDA("F")=DITMGMF_DIDA
SET DIDA("T")=DITMGMT_DIDA
+11 DO TRNMRG^DIT("M",DITMGMFL,"",DIDA("F"),DIDA("T"))
+12 SET $PIECE(@(DITMFROM_DITMGMF_",0)"),U)=DITMGMF
+13 Begin DoDot:1
+14 NEW DA
DO DA^DIEFU(DIDA("T"),.DA)
if $DATA(DIERR)
QUIT
+15 KILL DIK
SET DIK=$$ROOT^DIQGU(DITMGMFL,DIDA("T"))
if $DATA(DIERR)
QUIT
+16 NEW DIDA
DO IX1^DIK
QUIT
End DoDot:1
+17 Begin DoDot:1
+18 NEW DA
DO DA^DIEFU(DIDA("F"),.DA)
if $DATA(DIERR)
QUIT
+19 KILL DIK
SET DIK=$$ROOT^DIQGU(DITMGMFL,DIDA("F"))
if $DATA(DIERR)
QUIT
+20 NEW DIDA
DO ^DIK
QUIT
End DoDot:1
+21 QUIT
