XDRMRG1 ;IHS/OHPRD/JCM - ERROR TRAP FOR XDRMRG; ;07/12/93 15:53
;;7.3;TOOLKIT;;Apr 25, 1995
MERGE ;
S XDRMRG1("PKGE")=$P(^DIC(9.4,XDRMPKGE,0),U,1)
D ERROR
S X="MERGE^XDRMRG1",@^%ZOSF("TRAP")
K X,XDRMRG1
Q
;
DIT0 ;
S XDRMRG1("NODIE")="",XDRMRG1("PKGE")="DIT0-File: "_XDRMRGFL
D ERROR
S X="DIT0^XDRMRG1",@^%ZOSF("TRAP")
K X,XDRMRG1
Q
;
DITMGMRG ;
S XDRMRG1("NODIE")="",XDRMRG1("PKGE")="REPOINT-File: "_XDRMRGFL
D ERROR
S X="DITMGMRG^XDRMRG1",@^%ZOSF("TRAP")
K X,XDRMRG1
Q
;
DITM2 ;
S XDRMRG1("NODIE")="",XDRMRG1("PKGE")="DITM2-File: "_XDRMRGFL
D ERROR
S X="DITM2^XDRMRG1",@^%ZOSF("TRAP")
K X,XDRMRG1
Q
;
DIK ;
S XDRMRG1("NODIE")="",XDRMRG1("PKGE")="DIK-File: "_XDRMRGFL
D ERROR
S X="DIK^XDRMRG1",@^%ZOSF("TRAP")
K X,XDRMRG1
Q
;
ERROR ;
S XDRMRG1("SPACE")=$J(" ",25)
D:'$D(XDRMERR(1)) HEADER
S XDRMERR(XDRMRG("ERRCNT"))="Package: "_$E(XDRMRG1("PKGE")_XDRMRG1("SPACE"),1,25)_"Error: "_$$EC^%ZOSV
D:'$D(XDRMRG1("NODIE")) DIE
D @^%ZOSF("ERRTN")
S XDRMRG("ERRCNT")=XDRMRG("ERRCNT")+1
Q
F %=1:1:2 S XDRMERR(%)=" "
K %
S XDRMERR(3)="***** The following errors occured during the merge process *****"
S XDRMERR(4)=" ",XDRMRG("ERRCNT")=5,XDRQFLG=1
Q
;
DIE ;
S %=$$EC^%ZOSV
S DA(1)=XDRMPDA,DA=XDRMPKGE,DIE="^VA(15,"_DA(1)_",11,"
S DR=".03////"_$P(%,U)_"**"_$P(%,U,2)
D ^DIE K DA,DR,DIE
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXDRMRG1 1394 printed Dec 13, 2024@02:39:36 Page 2
XDRMRG1 ;IHS/OHPRD/JCM - ERROR TRAP FOR XDRMRG; ;07/12/93 15:53
+1 ;;7.3;TOOLKIT;;Apr 25, 1995
MERGE ;
+1 SET XDRMRG1("PKGE")=$PIECE(^DIC(9.4,XDRMPKGE,0),U,1)
+2 DO ERROR
+3 SET X="MERGE^XDRMRG1"
SET @^%ZOSF("TRAP")
+4 KILL X,XDRMRG1
+5 QUIT
+6 ;
DIT0 ;
+1 SET XDRMRG1("NODIE")=""
SET XDRMRG1("PKGE")="DIT0-File: "_XDRMRGFL
+2 DO ERROR
+3 SET X="DIT0^XDRMRG1"
SET @^%ZOSF("TRAP")
+4 KILL X,XDRMRG1
+5 QUIT
+6 ;
DITMGMRG ;
+1 SET XDRMRG1("NODIE")=""
SET XDRMRG1("PKGE")="REPOINT-File: "_XDRMRGFL
+2 DO ERROR
+3 SET X="DITMGMRG^XDRMRG1"
SET @^%ZOSF("TRAP")
+4 KILL X,XDRMRG1
+5 QUIT
+6 ;
DITM2 ;
+1 SET XDRMRG1("NODIE")=""
SET XDRMRG1("PKGE")="DITM2-File: "_XDRMRGFL
+2 DO ERROR
+3 SET X="DITM2^XDRMRG1"
SET @^%ZOSF("TRAP")
+4 KILL X,XDRMRG1
+5 QUIT
+6 ;
DIK ;
+1 SET XDRMRG1("NODIE")=""
SET XDRMRG1("PKGE")="DIK-File: "_XDRMRGFL
+2 DO ERROR
+3 SET X="DIK^XDRMRG1"
SET @^%ZOSF("TRAP")
+4 KILL X,XDRMRG1
+5 QUIT
+6 ;
ERROR ;
+1 SET XDRMRG1("SPACE")=$JUSTIFY(" ",25)
+2 if '$DATA(XDRMERR(1))
DO HEADER
+3 SET XDRMERR(XDRMRG("ERRCNT"))="Package: "_$EXTRACT(XDRMRG1("PKGE")_XDRMRG1("SPACE"),1,25)_"Error: "_$$EC^%ZOSV
+4 if '$DATA(XDRMRG1("NODIE"))
DO DIE
+5 DO @^%ZOSF("ERRTN")
+6 SET XDRMRG("ERRCNT")=XDRMRG("ERRCNT")+1
+7 QUIT
+1 FOR %=1:1:2
SET XDRMERR(%)=" "
+2 KILL %
+3 SET XDRMERR(3)="***** The following errors occured during the merge process *****"
+4 SET XDRMERR(4)=" "
SET XDRMRG("ERRCNT")=5
SET XDRQFLG=1
+5 QUIT
+6 ;
DIE ;
+1 SET %=$$EC^%ZOSV
+2 SET DA(1)=XDRMPDA
SET DA=XDRMPKGE
SET DIE="^VA(15,"_DA(1)_",11,"
+3 SET DR=".03////"_$PIECE(%,U)_"**"_$PIECE(%,U,2)
+4 DO ^DIE
KILL DA,DR,DIE
+5 QUIT
