DITMGM2.m

DITMGM2 ;SFISC/EDE(OHPRD)-GENERAL RELINK/MERGE ;2015-01-02  5:09 PM

 ;;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.

 ;

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 EN^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

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---DITMGM2   1494     printed  Apr 09, 2024@21:46:44                                                                                                                                                                                                     Page 2

DITMGM2   ;SFISC/EDE(OHPRD)-GENERAL RELINK/MERGE ;2015-01-02  5:09 PM

 +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       ;

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 EN^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