DITMGM2.m

DITMGM2 ;SFISC/EDE(OHPRD)-GENERAL RELINK/MERGE ;

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

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

 ;

START ;

 D INIT^DITMGM2B

 I $D(DITMGMQF) D EOJ Q

 D FILES

 D EOJ

 Q

 ;

FILES ; PROCESS ALL FILES/SUBFILES

 W:'$D(DITMGM2("NOTALK")) !!,"Merging entries",!

 F DITMGMFL=0:0 S DITMGMFL=$O(^UTILITY("DITMGMRG",$J,DITMGMFL)) Q:DITMGMFL=""  D FILE

 Q

 ;

FILE ; PROCESS ONE FILE/SUBFILE

 K DITMGMGM

 I $D(^DD(DITMGMFL,0,"UP")) S DITMGMMU=1 D ^DITMU2(DITMGMFL,.DITMGMGM,1) S DITMGMG=$P(DITMGMGM,"DA(",1),DITMGMGM=$P(DITMGMGM,"DA,",1) I 1

 E  S DITMGMMU=0,DITMGMG=^DIC(DITMGMFL,0,"GL")

 F DITMGMFD=0:0 S DITMGMFD=$O(^UTILITY("DITMGMRG",$J,DITMGMFL,DITMGMFD)) Q:DITMGMFD'=+DITMGMFD  S DITMGMFS=DITMGMF,DITMGMTS=DITMGMT D FIELD^DITMGM2A S DITMGMF=DITMGMFS,DITMGMT=DITMGMTS

 Q

 ;

ZTM ; ENTRY POINT FOR TASKMAN

 S DITMGM2("NOTALK")=1

 D SEARCH^DITMGM2B

 D EOJ

 Q

 ;

EOJ ;

 K %K,D1,D2,DA,DIC,DI,DIPGM,DQ,I,V

 K DITMGDA,DITMGMDI,DITMGMDN,DITMGMEC,DITMGMFD,DITMGMFL,DITMGMFG,DITMGMFS,DITMGMG,DITMGMGG,DITMGMI,DITMGML,DITMGMGM,DITMGMN,DITMGMNO,DITMGMPC,DITMGMTS,DITMGMTY,DITMGMTZ,DITMGMMU,DITMGMPF,DITMGMV,DITMGMX,DITMGMXR

 I $D(ZTQUEUED) S ZTREQ="@"

 E  K:$D(ZTSK) ^%ZTSK(ZTSK),ZTSK ; old Kernel

 Q

DITMGM2   ;SFISC/EDE(OHPRD)-GENERAL RELINK/MERGE ;

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

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

 +3       ;

START     ;

 +1        DO INIT^DITMGM2B

 +2        IF $DATA(DITMGMQF)

               DO EOJ

               QUIT 

 +3        DO FILES

 +4        DO EOJ

 +5        QUIT 

 +6       ;

FILES     ; PROCESS ALL FILES/SUBFILES

 +1        IF '$DATA(DITMGM2("NOTALK"))

               WRITE !!,"Merging entries",!

 +2        FOR DITMGMFL=0:0

               SET DITMGMFL=$ORDER(^UTILITY("DITMGMRG",$JOB,DITMGMFL))

               IF DITMGMFL=""

                   QUIT 

               DO FILE

 +3        QUIT 

 +4       ;

FILE      ; PROCESS ONE FILE/SUBFILE

 +1        KILL DITMGMGM

 +2        IF $DATA(^DD(DITMGMFL,0,"UP"))

               SET DITMGMMU=1

               DO ^DITMU2(DITMGMFL,.DITMGMGM,1)

               SET DITMGMG=$PIECE(DITMGMGM,"DA(",1)

               SET DITMGMGM=$PIECE(DITMGMGM,"DA,",1)

               IF 1

 +3       IF '$TEST

               SET DITMGMMU=0

               SET DITMGMG=^DIC(DITMGMFL,0,"GL")

 +4        FOR DITMGMFD=0:0

               SET DITMGMFD=$ORDER(^UTILITY("DITMGMRG",$JOB,DITMGMFL,DITMGMFD))

               IF DITMGMFD'=+DITMGMFD

                   QUIT 

               SET DITMGMFS=DITMGMF

               SET DITMGMTS=DITMGMT

               DO FIELD^DITMGM2A

               SET DITMGMF=DITMGMFS

               SET DITMGMT=DITMGMTS

 +5        QUIT 

 +6       ;

ZTM       ; ENTRY POINT FOR TASKMAN

 +1        SET DITMGM2("NOTALK")=1

 +2        DO SEARCH^DITMGM2B

 +3        DO EOJ

 +4        QUIT 

 +5       ;

EOJ       ;

 +1        KILL %K,D1,D2,DA,DIC,DI,DIPGM,DQ,I,V

 +2        KILL DITMGDA,DITMGMDI,DITMGMDN,DITMGMEC,DITMGMFD,DITMGMFL,DITMGMFG,DITMGMFS,DITMGMG,DITMGMGG,DITMGMI,DITMGML,DITMGMGM,DITMGMN,DITMGMNO,DITMGMPC,DITMGMTS,DITMGMTY,DITMGMTZ,DITMGMMU,DITMGMPF,DITMGMV,DITMGMX,DITMGMXR

 +3        IF $DATA(ZTQUEUED)

               SET ZTREQ="@"

 +4       ; old Kernel

          IF '$TEST

               IF $DATA(ZTSK)

                   KILL ^%ZTSK(ZTSK),ZTSK

 +5        QUIT