XDRMRG1.m

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

HEADER ;

 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

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 

HEADER    ;

 +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