Routine: DITMGM2C

DITMGM2C ;SFISC/EDE(OHPRD)TKW-CONTINUATION OF DITMGM2 ;10/7/98  10:38

 ;;22.0;VA FileMan;;Mar 30, 1999

 ;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")

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

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

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

 . 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

 . 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

DITMGM2C  ;SFISC/EDE(OHPRD)TKW-CONTINUATION OF DITMGM2 ;10/7/98  10:38

 +1       ;;22.0;VA FileMan;;Mar 30, 1999

 +2       ;Per VHA Directive 10-93-142, this routine should not be modified.

 +3       ;

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

DITMGM2C.m