- 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 Jan 18, 2025@03:40:43 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