source: WorldVistAEHR/trunk/r/TOOLKIT-AWCM-XD-XIN-XPAR-XQAB-XT-XUC-XUR-ZIN-ZTED/XDRMRG1.m@ 703

Last change on this file since 703 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.3 KB
RevLine 
[613]1XDRMRG1 ;IHS/OHPRD/JCM - ERROR TRAP FOR XDRMRG; ;07/12/93 15:53
2 ;;7.3;TOOLKIT;;Apr 25, 1995
3MERGE ;
4 S XDRMRG1("PKGE")=$P(^DIC(9.4,XDRMPKGE,0),U,1)
5 D ERROR
6 S X="MERGE^XDRMRG1",@^%ZOSF("TRAP")
7 K X,XDRMRG1
8 Q
9 ;
10DIT0 ;
11 S XDRMRG1("NODIE")="",XDRMRG1("PKGE")="DIT0-File: "_XDRMRGFL
12 D ERROR
13 S X="DIT0^XDRMRG1",@^%ZOSF("TRAP")
14 K X,XDRMRG1
15 Q
16 ;
17DITMGMRG ;
18 S XDRMRG1("NODIE")="",XDRMRG1("PKGE")="REPOINT-File: "_XDRMRGFL
19 D ERROR
20 S X="DITMGMRG^XDRMRG1",@^%ZOSF("TRAP")
21 K X,XDRMRG1
22 Q
23 ;
24DITM2 ;
25 S XDRMRG1("NODIE")="",XDRMRG1("PKGE")="DITM2-File: "_XDRMRGFL
26 D ERROR
27 S X="DITM2^XDRMRG1",@^%ZOSF("TRAP")
28 K X,XDRMRG1
29 Q
30 ;
31DIK ;
32 S XDRMRG1("NODIE")="",XDRMRG1("PKGE")="DIK-File: "_XDRMRGFL
33 D ERROR
34 S X="DIK^XDRMRG1",@^%ZOSF("TRAP")
35 K X,XDRMRG1
36 Q
37 ;
38ERROR ;
39 S XDRMRG1("SPACE")=$J(" ",25)
40 D:'$D(XDRMERR(1)) HEADER
41 S XDRMERR(XDRMRG("ERRCNT"))="Package: "_$E(XDRMRG1("PKGE")_XDRMRG1("SPACE"),1,25)_"Error: "_$$EC^%ZOSV
42 D:'$D(XDRMRG1("NODIE")) DIE
43 D @^%ZOSF("ERRTN")
44 S XDRMRG("ERRCNT")=XDRMRG("ERRCNT")+1
45 Q
46HEADER ;
47 F %=1:1:2 S XDRMERR(%)=" "
48 K %
49 S XDRMERR(3)="***** The following errors occured during the merge process *****"
50 S XDRMERR(4)=" ",XDRMRG("ERRCNT")=5,XDRQFLG=1
51 Q
52 ;
53DIE ;
54 S %=$$EC^%ZOSV
55 S DA(1)=XDRMPDA,DA=XDRMPKGE,DIE="^VA(15,"_DA(1)_",11,"
56 S DR=".03////"_$P(%,U)_"**"_$P(%,U,2)
57 D ^DIE K DA,DR,DIE
58 Q
Note: See TracBrowser for help on using the repository browser.