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 ---[H[J[2J[HDITMGM2 1494 printed Nov 22, 2024@18:04:16 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
