Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: XDRMRG1

XDRMRG1.m

Go to the documentation of this file.
  1. XDRMRG1 ;IHS/OHPRD/JCM - ERROR TRAP FOR XDRMRG; ;07/12/93 15:53
  1. ;;7.3;TOOLKIT;;Apr 25, 1995
  1. MERGE ;
  1. S XDRMRG1("PKGE")=$P(^DIC(9.4,XDRMPKGE,0),U,1)
  1. D ERROR
  1. S X="MERGE^XDRMRG1",@^%ZOSF("TRAP")
  1. K X,XDRMRG1
  1. Q
  1. ;
  1. DIT0 ;
  1. S XDRMRG1("NODIE")="",XDRMRG1("PKGE")="DIT0-File: "_XDRMRGFL
  1. D ERROR
  1. S X="DIT0^XDRMRG1",@^%ZOSF("TRAP")
  1. K X,XDRMRG1
  1. Q
  1. ;
  1. DITMGMRG ;
  1. S XDRMRG1("NODIE")="",XDRMRG1("PKGE")="REPOINT-File: "_XDRMRGFL
  1. D ERROR
  1. S X="DITMGMRG^XDRMRG1",@^%ZOSF("TRAP")
  1. K X,XDRMRG1
  1. Q
  1. ;
  1. DITM2 ;
  1. S XDRMRG1("NODIE")="",XDRMRG1("PKGE")="DITM2-File: "_XDRMRGFL
  1. D ERROR
  1. S X="DITM2^XDRMRG1",@^%ZOSF("TRAP")
  1. K X,XDRMRG1
  1. Q
  1. ;
  1. DIK ;
  1. S XDRMRG1("NODIE")="",XDRMRG1("PKGE")="DIK-File: "_XDRMRGFL
  1. D ERROR
  1. S X="DIK^XDRMRG1",@^%ZOSF("TRAP")
  1. K X,XDRMRG1
  1. Q
  1. ;
  1. ERROR ;
  1. S XDRMRG1("SPACE")=$J(" ",25)
  1. D:'$D(XDRMERR(1)) HEADER
  1. S XDRMERR(XDRMRG("ERRCNT"))="Package: "_$E(XDRMRG1("PKGE")_XDRMRG1("SPACE"),1,25)_"Error: "_$$EC^%ZOSV
  1. D:'$D(XDRMRG1("NODIE")) DIE
  1. D @^%ZOSF("ERRTN")
  1. S XDRMRG("ERRCNT")=XDRMRG("ERRCNT")+1
  1. Q
  1. F %=1:1:2 S XDRMERR(%)=" "
  1. K %
  1. S XDRMERR(3)="***** The following errors occured during the merge process *****"
  1. S XDRMERR(4)=" ",XDRMRG("ERRCNT")=5,XDRQFLG=1
  1. Q
  1. ;
  1. DIE ;
  1. S %=$$EC^%ZOSV
  1. S DA(1)=XDRMPDA,DA=XDRMPKGE,DIE="^VA(15,"_DA(1)_",11,"
  1. S DR=".03////"_$P(%,U)_"**"_$P(%,U,2)
  1. D ^DIE K DA,DR,DIE
  1. Q