PSXAUTO ;BIR/WPB-Routine to Automatically Run CMOP Suspense ;14 DEC 2001
;;2.0;CMOP;**1,2,3,24,28,36,41**;11 Apr 97
;Reference to ^XUSEC( supported by DBIA #10076
;This routine will be called from a menu option and will allow
;the user to start or change auto-processing. The user must hold
;the PSXAUTOX security key.
G START
STARTCS ; entry from edit auto CS Schedule menu option (future - post *41))
S PSXCS=1
START ;
S PSXCS=+$G(PSXCS)
I '$D(^XUSEC("PSXAUTOX",DUZ)) W !,"You are not authorized to use this option!" Q
I '$D(^XUSEC("PSX XMIT",DUZ)) W !,"You are not authorized to use this option!" Q
I '$D(^XUSEC("PSXCMOPMGR",DUZ)) W !,"You are not authorized to use this option!" Q
D SET^PSXSYS I $G(PSXSYS)="" W !!,"The Station number is missing in the Institution file.",!,"The Station number is required for CMOP transmissions.",!,"Please contact your IRM and have this problem corrected, then try again." Q
I '$D(^PSX(550,"C")) W !,"The CMOP is not an active CMOP site and can not schedule auto transmissions." Q
I $D(^PSX(550,"TR","T")) W !,"A transmission is in progress, try later." Q
L +^PSX(550.1):5 I '$T W !,"A transmission is in progress, try later." Q
S PSXSTAT="T" D PSXSTAT^PSXRSYU I $G(PSXLOCK) G EXIT
S PSXDUZ=DUZ
F PSXCS=0,1 D GETSCH S DTTM(PSXCS)=PSXDATE ; store pre-edit schedule values
ASK D EDTBSCH ; edit both schedules
FILE ; if either schedule changed send appropriate message
F PSXCS=0,1 D GETSCH D
. I DTTM(PSXCS)=PSXDATE Q ;no change - quit
. I 'PSXDATE,DTTM(PSXCS) S (PSXAUTO,PSXHOUR)=0 D AUTOMSG^PSXMSGS,SERV^PSXMISC W !,$S(PSXCS:"",1:"NON-"),"CS Cancel Schedule Sent to CMOP" H 3 Q ; schedule deleted
. S PSXAUTO=1 D AUTOMSG^PSXMSGS,SERV^PSXMISC W !,$S(PSXCS:"",1:"NON-"),"CS New Schedule Sent to CMOP" H 3 ; new/changed schedule to send
K DTTM
G EXIT
;
ENCS ; entry from auto CS Tasking Option Schedule (future-post *41)
S PSXCS=1
EN ;Entry from Kernel Option Tasking NON-CS
S PSXCS=+$G(PSXCS)
Q:'$D(^PSX(550,"C")) ;no CMOP selected M xref
Q:'$D(^PSX(550,"ST","A")) ;no CMOP selected Regular xref
S ZTSK=$G(ZTSK),PSXZTSK=ZTSK,PSXCS=+$G(PSXCS)
; test if previous job still running
LOCK ; >>>**** LOCK OF FILE 550.1 ****<<<
L +^PSX(550.1):60 I '$T D RQUEMSG G EXIT ; no lock then reque 30 minutes later
;if a lock is obtainable , no transmission is running
TFLAG I $D(^PSX(550,"TR","T")) D G TFLAG ;clear 'T' flags
. D ^PSXRCVRY
. N PSXSYS S PSXSYS=$O(^PSX(550,"TR","T",0)) S PSXSTAT="H" D PSXSTAT^PSXRSYU
; proceeding to process files
D SET^PSXSYS Q:$P(PSXSYS,"^",2)=""
I $D(^PSX(550.2,"AQ")) D EN1^PSXRCVRY
; set running task into 550 RUNNING TASK
K DIC,DIE,DR,DA S DIE=550,DA=+PSXSYS,DR="9////"_$G(ZTSK) D ^DIE K DIC,DIE,DR,DA
; proceed tp process, setup variables, call into LOCK^PSXRSUS
S XX=$S('PSXCS:11,1:12) S THRU=+$$GET1^DIQ(550,+PSXSYS,XX)
S TPRTDT=DT S:$G(THRU)>0 TPRTDT=$$FMADD^XLFDT(DT,THRU,0,0,0)
S PSXDIVML=1,PSXFLAG=1,PSXTRANS=1,PSOINST=$P(PSXSYS,"^",2)
G LOCK^PSXRSUS
;
EDTBSCH ; display/edit both schedules as they are interactive with each other
W @IOF D DSPSCH
K DIR S DIR(0)="SO^C:Controlled Substance;N:NON-Controlled Substance;",DIR("A")="Edit CS <C> or NON-CS <N> "
D ^DIR K DIR
I Y'="C",Y'="N" Q
N PSXCS
S PSXCS=$S(Y="C":1,1:0)
D EDIT
G EDTBSCH
;
EDIT ;Edit scheduling of transmissions and parameter "Number of days to transmit"
;schedules must be separated by 2 hours
S PSXCS=+$G(PSXCS)
S XX=$S($G(PSXCS):"PSXR SCHEDULED CS TRANS",1:"PSXR SCHEDULED NON-CS TRANS")
D EDIT^XUTMOPT(XX)
I '$D(PSXSYS) D SET^PSXSYS
I +PSXSYS S DIE=550,DR="11",DA=+PSXSYS S:PSXCS DR="12" D ^DIE
;check for 2 hour difference
I $$CHKSCH() Q ; 2 hour difference satisfied
W @IOF,!,"Sorry, there has to be at least 2 hours between the daily transmission runs.",!
D DELSCH
W !! K DIR S DIR(0)="E",DIR("A")="The "_$S(PSXCS:"CS",1:"NON-CS")_" schedule has been cleared for RE-EDIT. <cr>" D ^DIR
Q
;
CHKSCH() ;CHECK Task schedules for 2 hour difference
N PSXCS,CSTSK,CSDATE,CSTHRU,CSHOUR,NCSTSK,NCSDATE,NCSTHRU,NCSHOUR,TSDIF
S PSXCS=1 D GETSCH
S CSTSK=+TSK(1),CSDATE=PSXDATE,CSHOUR=PSXHOUR,CSTHRU=THRU
S PSXCS=0 D GETSCH
S NCSTSK=+TSK(1),NCSDATE=PSXDATE,NCSHOUR=PSXHOUR,NCSTHRU=THRU
I NCSTSK,CSTSK I 1
E Q 1 ; quit test if either is not scheduled
S CSDATE=(CSDATE#1)+DT,NCSDATE=(NCSDATE#1)+DT
S X1=CSDATE,X2=NCSDATE
I CSDATE>NCSDATE S X1=NCSDATE,X2=CSDATE
S TSDIF=$$FMDIFF^XLFDT(X2,X1,2)
;W ! ZW X1,X2,XX,NCSDATE,CSDATE H 5
I TSDIF<7200 Q 0
I TSDIF>79200 Q 0
Q 1
;
DELSCH ;Delete startup time and its pending task
S PSXCS=+$G(PSXCS)
S XX=$S($G(PSXCS):"PSXR SCHEDULED CS TRANS",1:"PSXR SCHEDULED NON-CS TRANS")
D RESCH^XUTMOPT(XX,"@")
D:'+PSXSYS SET^PSXSYS
Q
;
GETSCH ; get schedule information from Kernel Option Scheduling
S PSXCS=+$G(PSXCS)
D:'$D(PSXSYS) SET^PSXSYS
S XX=$S($G(PSXCS):"PSXR SCHEDULED CS TRANS",1:"PSXR SCHEDULED NON-CS TRANS")
K TSK D OPTSTAT^XUTMOPT(XX,.TSK) S TSK(1)=$G(TSK(1))
S (PSXDATE,PSXHOUR,THRU)=""
S PSXZTSK=+TSK(1),PSXDATE=$P(TSK(1),U,2),PSXHOUR=$P(TSK(1),U,3)
S XX=$S('PSXCS:11,1:12) S THRU=$$GET1^DIQ(550,+PSXSYS,XX)
Q
;
DSPSCH ;Display schedules for transmissions
N PSXCS,CSTSK,CSDATE,CSTHRU,CSHOUR,NCSTSK,NCSDATE,NCSTHRU,NCSHOUR
S PSXCS=1 D GETSCH
S CSTSK=+TSK(1),CSDATE=PSXDATE,CSHOUR=PSXHOUR,CSTHRU=THRU
S PSXCS=0 D GETSCH
S NCSTSK=+TSK(1),NCSDATE=PSXDATE,NCSHOUR=PSXHOUR,NCSTHRU=THRU
S Y=CSDATE X ^DD("DD") S CSDATE=Y S Y=NCSDATE X ^DD("DD") S NCSDATE=Y
W !,?25,"CS Transmission",?55,"Non-CS Transmission"
W !,"Scheduled to Run",?25,CSDATE,?55,NCSDATE
W !,"Frequency (hrs)",?25,CSHOUR,?55,NCSHOUR
W !,"Thru days",?25,CSTHRU,?55,NCSTHRU
W !,"Tasking ID",?25,CSTSK,?55,NCSTSK
Q
;
RQUEMSG ; lock on 550.1 not achieved send transmission requeued message
S PSXCS=+$G(PSXCS)
S ZTSAVE("PSXCS")=""
D NOW^%DTC
S ZTDTH=$$FMADD^XLFDT(%,,,30)
S Y=% X ^DD("DD") S DTTM=Y
S ZTDESC="CMOP "_$S(PSXCS:"",1:"NON-")_"CS AUTO TRANSMISSION REQUEUE"
S ZTRTN="EN^PSXAUTO",ZTIO=""
D ^%ZTLOAD
S XMDUZ="Postmaster",XMSUB=$S($G(PSXCS):"",1:"NON-")_"CS Scheduled Transmission RE-Queued"
S XMTEXT="TXT("
S TXT(1,0)="The "_$S($G(PSXCS):"",1:"NON-")_"CS Scheduled Transmission for "_DTTM
S TXT(2,0)="was re-queued with task # "_ZTSK_" to run again in 30 minutes."
S TXT(3,0)="It could not obtain a lock on the RX QUEUE file #550.1."
S TXT(4,0)="That indicates that a transmission was in progress."
S TXT(5,0)=" "
S TXT(6,0)="If you are getting this message frequently, please contact your IRM Group"
D GRP1^PSXNOTE
;S XMY(DUZ)=""
D ^XMD
Q
EXIT ;
L -^PSX(550.1)
D:'$D(PSXSYS) SET^PSXSYS
S PSXSTAT="H" D PSXSTAT^PSXRSYU
K TIME,STDATE,NUM,X,Y,FREQ,PSXZTSK,START,ZTSK,%,%DT,DTE,LCNT,LL,N,RECD,RR,SITE,XMDUN,XMDUZ,XMSUB,XMZ,PSXDUZ,PSXAUTO,PSXDATE,PSXHOUR,DTTM
K ZTSAVE,ZTDESC,ZTRTN,ZTIO,ZTREQ,ZTDTH,SDATE,DIR,DIRUT,DUOUT,DTOUT
K PSXSYS,DIROUT,THRU,NEXT,RE,PSXLOCK,XX,PSXXDIV
S ZTREQ="@"
Q
STOPET ; set a stop auto-error-trap node
S ^XTMP("PSXAUTOERR")=DT_"^"_DT_"^AUTO ERROR TRAP STOP NODE"
Q
STARTET ; remove any stop node
K ^XTMP("PSXAUTOERR")
Q
PSXAUTO ;BIR/WPB-Routine to Automatically Run CMOP Suspense ;14 DEC 2001
+1 ;;2.0;CMOP;**1,2,3,24,28,36,41**;11 Apr 97
+2 ;Reference to ^XUSEC( supported by DBIA #10076
+3 ;This routine will be called from a menu option and will allow
+4 ;the user to start or change auto-processing. The user must hold
+5 ;the PSXAUTOX security key.
+6 GOTO START
STARTCS ; entry from edit auto CS Schedule menu option (future - post *41))
+1 SET PSXCS=1
START ;
+1 SET PSXCS=+$GET(PSXCS)
+2 IF '$DATA(^XUSEC("PSXAUTOX",DUZ))
WRITE !,"You are not authorized to use this option!"
QUIT
+3 IF '$DATA(^XUSEC("PSX XMIT",DUZ))
WRITE !,"You are not authorized to use this option!"
QUIT
+4 IF '$DATA(^XUSEC("PSXCMOPMGR",DUZ))
WRITE !,"You are not authorized to use this option!"
QUIT
+5 DO SET^PSXSYS
IF $GET(PSXSYS)=""
WRITE !!,"The Station number is missing in the Institution file.",!,"The Station number is required for CMOP transmissions.",!,"Please contact your IRM and have this problem corrected, then try again."
QUIT
+6 IF '$DATA(^PSX(550,"C"))
WRITE !,"The CMOP is not an active CMOP site and can not schedule auto transmissions."
QUIT
+7 IF $DATA(^PSX(550,"TR","T"))
WRITE !,"A transmission is in progress, try later."
QUIT
+8 LOCK +^PSX(550.1):5
IF '$TEST
WRITE !,"A transmission is in progress, try later."
QUIT
+9 SET PSXSTAT="T"
DO PSXSTAT^PSXRSYU
IF $GET(PSXLOCK)
GOTO EXIT
+10 SET PSXDUZ=DUZ
+11 ; store pre-edit schedule values
FOR PSXCS=0,1
DO GETSCH
SET DTTM(PSXCS)=PSXDATE
ASK ; edit both schedules
DO EDTBSCH
FILE ; if either schedule changed send appropriate message
+1 FOR PSXCS=0,1
DO GETSCH
Begin DoDot:1
+2 ;no change - quit
IF DTTM(PSXCS)=PSXDATE
QUIT
+3 ; schedule deleted
IF 'PSXDATE
IF DTTM(PSXCS)
SET (PSXAUTO,PSXHOUR)=0
DO AUTOMSG^PSXMSGS
DO SERV^PSXMISC
WRITE !,$SELECT(PSXCS:"",1:"NON-"),"CS Cancel Schedule Sent to CMOP"
HANG 3
QUIT
+4 ; new/changed schedule to send
SET PSXAUTO=1
DO AUTOMSG^PSXMSGS
DO SERV^PSXMISC
WRITE !,$SELECT(PSXCS:"",1:"NON-"),"CS New Schedule Sent to CMOP"
HANG 3
End DoDot:1
+5 KILL DTTM
+6 GOTO EXIT
+7 ;
ENCS ; entry from auto CS Tasking Option Schedule (future-post *41)
+1 SET PSXCS=1
EN ;Entry from Kernel Option Tasking NON-CS
+1 SET PSXCS=+$GET(PSXCS)
+2 ;no CMOP selected M xref
IF '$DATA(^PSX(550,"C"))
QUIT
+3 ;no CMOP selected Regular xref
IF '$DATA(^PSX(550,"ST","A"))
QUIT
+4 SET ZTSK=$GET(ZTSK)
SET PSXZTSK=ZTSK
SET PSXCS=+$GET(PSXCS)
+5 ; test if previous job still running
LOCK ; >>>**** LOCK OF FILE 550.1 ****<<<
+1 ; no lock then reque 30 minutes later
LOCK +^PSX(550.1):60
IF '$TEST
DO RQUEMSG
GOTO EXIT
+2 ;if a lock is obtainable , no transmission is running
TFLAG ;clear 'T' flags
IF $DATA(^PSX(550,"TR","T"))
Begin DoDot:1
+1 DO ^PSXRCVRY
+2 NEW PSXSYS
SET PSXSYS=$ORDER(^PSX(550,"TR","T",0))
SET PSXSTAT="H"
DO PSXSTAT^PSXRSYU
End DoDot:1
GOTO TFLAG
+3 ; proceeding to process files
+4 DO SET^PSXSYS
IF $PIECE(PSXSYS,"^",2)=""
QUIT
+5 IF $DATA(^PSX(550.2,"AQ"))
DO EN1^PSXRCVRY
+6 ; set running task into 550 RUNNING TASK
+7 KILL DIC,DIE,DR,DA
SET DIE=550
SET DA=+PSXSYS
SET DR="9////"_$GET(ZTSK)
DO ^DIE
KILL DIC,DIE,DR,DA
+8 ; proceed tp process, setup variables, call into LOCK^PSXRSUS
+9 SET XX=$SELECT('PSXCS:11,1:12)
SET THRU=+$$GET1^DIQ(550,+PSXSYS,XX)
+10 SET TPRTDT=DT
IF $GET(THRU)>0
SET TPRTDT=$$FMADD^XLFDT(DT,THRU,0,0,0)
+11 SET PSXDIVML=1
SET PSXFLAG=1
SET PSXTRANS=1
SET PSOINST=$PIECE(PSXSYS,"^",2)
+12 GOTO LOCK^PSXRSUS
+13 ;
EDTBSCH ; display/edit both schedules as they are interactive with each other
+1 WRITE @IOF
DO DSPSCH
+2 KILL DIR
SET DIR(0)="SO^C:Controlled Substance;N:NON-Controlled Substance;"
SET DIR("A")="Edit CS <C> or NON-CS <N> "
+3 DO ^DIR
KILL DIR
+4 IF Y'="C"
IF Y'="N"
QUIT
+5 NEW PSXCS
+6 SET PSXCS=$SELECT(Y="C":1,1:0)
+7 DO EDIT
+8 GOTO EDTBSCH
+9 ;
EDIT ;Edit scheduling of transmissions and parameter "Number of days to transmit"
+1 ;schedules must be separated by 2 hours
+2 SET PSXCS=+$GET(PSXCS)
+3 SET XX=$SELECT($GET(PSXCS):"PSXR SCHEDULED CS TRANS",1:"PSXR SCHEDULED NON-CS TRANS")
+4 DO EDIT^XUTMOPT(XX)
+5 IF '$DATA(PSXSYS)
DO SET^PSXSYS
+6 IF +PSXSYS
SET DIE=550
SET DR="11"
SET DA=+PSXSYS
IF PSXCS
SET DR="12"
DO ^DIE
+7 ;check for 2 hour difference
+8 ; 2 hour difference satisfied
IF $$CHKSCH()
QUIT
+9 WRITE @IOF,!,"Sorry, there has to be at least 2 hours between the daily transmission runs.",!
+10 DO DELSCH
+11 WRITE !!
KILL DIR
SET DIR(0)="E"
SET DIR("A")="The "_$SELECT(PSXCS:"CS",1:"NON-CS")_" schedule has been cleared for RE-EDIT. <cr>"
DO ^DIR
+12 QUIT
+13 ;
CHKSCH() ;CHECK Task schedules for 2 hour difference
+1 NEW PSXCS,CSTSK,CSDATE,CSTHRU,CSHOUR,NCSTSK,NCSDATE,NCSTHRU,NCSHOUR,TSDIF
+2 SET PSXCS=1
DO GETSCH
+3 SET CSTSK=+TSK(1)
SET CSDATE=PSXDATE
SET CSHOUR=PSXHOUR
SET CSTHRU=THRU
+4 SET PSXCS=0
DO GETSCH
+5 SET NCSTSK=+TSK(1)
SET NCSDATE=PSXDATE
SET NCSHOUR=PSXHOUR
SET NCSTHRU=THRU
+6 IF NCSTSK
IF CSTSK
IF 1
+7 ; quit test if either is not scheduled
IF '$TEST
QUIT 1
+8 SET CSDATE=(CSDATE#1)+DT
SET NCSDATE=(NCSDATE#1)+DT
+9 SET X1=CSDATE
SET X2=NCSDATE
+10 IF CSDATE>NCSDATE
SET X1=NCSDATE
SET X2=CSDATE
+11 SET TSDIF=$$FMDIFF^XLFDT(X2,X1,2)
+12 ;W ! ZW X1,X2,XX,NCSDATE,CSDATE H 5
+13 IF TSDIF<7200
QUIT 0
+14 IF TSDIF>79200
QUIT 0
+15 QUIT 1
+16 ;
DELSCH ;Delete startup time and its pending task
+1 SET PSXCS=+$GET(PSXCS)
+2 SET XX=$SELECT($GET(PSXCS):"PSXR SCHEDULED CS TRANS",1:"PSXR SCHEDULED NON-CS TRANS")
+3 DO RESCH^XUTMOPT(XX,"@")
+4 IF '+PSXSYS
DO SET^PSXSYS
+5 QUIT
+6 ;
GETSCH ; get schedule information from Kernel Option Scheduling
+1 SET PSXCS=+$GET(PSXCS)
+2 IF '$DATA(PSXSYS)
DO SET^PSXSYS
+3 SET XX=$SELECT($GET(PSXCS):"PSXR SCHEDULED CS TRANS",1:"PSXR SCHEDULED NON-CS TRANS")
+4 KILL TSK
DO OPTSTAT^XUTMOPT(XX,.TSK)
SET TSK(1)=$GET(TSK(1))
+5 SET (PSXDATE,PSXHOUR,THRU)=""
+6 SET PSXZTSK=+TSK(1)
SET PSXDATE=$PIECE(TSK(1),U,2)
SET PSXHOUR=$PIECE(TSK(1),U,3)
+7 SET XX=$SELECT('PSXCS:11,1:12)
SET THRU=$$GET1^DIQ(550,+PSXSYS,XX)
+8 QUIT
+9 ;
DSPSCH ;Display schedules for transmissions
+1 NEW PSXCS,CSTSK,CSDATE,CSTHRU,CSHOUR,NCSTSK,NCSDATE,NCSTHRU,NCSHOUR
+2 SET PSXCS=1
DO GETSCH
+3 SET CSTSK=+TSK(1)
SET CSDATE=PSXDATE
SET CSHOUR=PSXHOUR
SET CSTHRU=THRU
+4 SET PSXCS=0
DO GETSCH
+5 SET NCSTSK=+TSK(1)
SET NCSDATE=PSXDATE
SET NCSHOUR=PSXHOUR
SET NCSTHRU=THRU
+6 SET Y=CSDATE
XECUTE ^DD("DD")
SET CSDATE=Y
SET Y=NCSDATE
XECUTE ^DD("DD")
SET NCSDATE=Y
+7 WRITE !,?25,"CS Transmission",?55,"Non-CS Transmission"
+8 WRITE !,"Scheduled to Run",?25,CSDATE,?55,NCSDATE
+9 WRITE !,"Frequency (hrs)",?25,CSHOUR,?55,NCSHOUR
+10 WRITE !,"Thru days",?25,CSTHRU,?55,NCSTHRU
+11 WRITE !,"Tasking ID",?25,CSTSK,?55,NCSTSK
+12 QUIT
+13 ;
RQUEMSG ; lock on 550.1 not achieved send transmission requeued message
+1 SET PSXCS=+$GET(PSXCS)
+2 SET ZTSAVE("PSXCS")=""
+3 DO NOW^%DTC
+4 SET ZTDTH=$$FMADD^XLFDT(%,,,30)
+5 SET Y=%
XECUTE ^DD("DD")
SET DTTM=Y
+6 SET ZTDESC="CMOP "_$SELECT(PSXCS:"",1:"NON-")_"CS AUTO TRANSMISSION REQUEUE"
+7 SET ZTRTN="EN^PSXAUTO"
SET ZTIO=""
+8 DO ^%ZTLOAD
+9 SET XMDUZ="Postmaster"
SET XMSUB=$SELECT($GET(PSXCS):"",1:"NON-")_"CS Scheduled Transmission RE-Queued"
+10 SET XMTEXT="TXT("
+11 SET TXT(1,0)="The "_$SELECT($GET(PSXCS):"",1:"NON-")_"CS Scheduled Transmission for "_DTTM
+12 SET TXT(2,0)="was re-queued with task # "_ZTSK_" to run again in 30 minutes."
+13 SET TXT(3,0)="It could not obtain a lock on the RX QUEUE file #550.1."
+14 SET TXT(4,0)="That indicates that a transmission was in progress."
+15 SET TXT(5,0)=" "
+16 SET TXT(6,0)="If you are getting this message frequently, please contact your IRM Group"
+17 DO GRP1^PSXNOTE
+18 ;S XMY(DUZ)=""
+19 DO ^XMD
+20 QUIT
EXIT ;
+1 LOCK -^PSX(550.1)
+2 IF '$DATA(PSXSYS)
DO SET^PSXSYS
+3 SET PSXSTAT="H"
DO PSXSTAT^PSXRSYU
+4 KILL TIME,STDATE,NUM,X,Y,FREQ,PSXZTSK,START,ZTSK,%,%DT,DTE,LCNT,LL,N,RECD,RR,SITE,XMDUN,XMDUZ,XMSUB,XMZ,PSXDUZ,PSXAUTO,PSXDATE,PSXHOUR,DTTM
+5 KILL ZTSAVE,ZTDESC,ZTRTN,ZTIO,ZTREQ,ZTDTH,SDATE,DIR,DIRUT,DUOUT,DTOUT
+6 KILL PSXSYS,DIROUT,THRU,NEXT,RE,PSXLOCK,XX,PSXXDIV
+7 SET ZTREQ="@"
+8 QUIT
STOPET ; set a stop auto-error-trap node
+1 SET ^XTMP("PSXAUTOERR")=DT_"^"_DT_"^AUTO ERROR TRAP STOP NODE"
+2 QUIT
STARTET ; remove any stop node
+1 KILL ^XTMP("PSXAUTOERR")
+2 QUIT
