HLCSRPT ;ISC-SF/RAH-TRANS LOG CONTROL & MISC ;06/23/99 11:10 AM [ 04/02/2003 8:38 AM ]
;;1.6;HEALTH LEVEL SEVEN;**1004**;APR 1, 2003
;;1.6;HEALTH LEVEL SEVEN;**19,50**;Oct 13, 1995
;
Q
;
EN ; Entry Point
I '$$TEST^DDBRT S IOP="HOME" D ^%ZIS I '$$TEST^DDBRT W !!," ===>> Screen Attributes NOT Defined. Use ^ZU or ^XUP before invoking.",!! D EXIT H 3 Q
D SCREEN
S HLCSNREC=BLDON_" ===>>> NO MATCHING RECORDS <<<=== "_BLDOFF
S HLCSPTR=1,HLCSRNO=1
S VERS22=""
I 22=+$$VERSION^XPDUTL("DI")!($$PATCH^XPDUTL("DI*21.0*32")) S VERS22="YES"
I VERS22'="YES" S ^TMP("DDBPF1Z",$J)="D SHOWMSG^HLCSRPT Q"
S ^TMP($J,"LIST","MESSAGE TEXT")="^TMP($J,""MESSAGE"",HLCSRNO)"
S ^TMP($J,"LIST","IEN RECORD # MESSAGE ID # Log Link Msg:Evn IO Sndg Apl Rcvr Apl HDR")="^TMP(""TLOG"",$J)"
;
REEN ; Internal Re-entry Point
W @IOF,! S HLCSHDR="Search Transmission Log" D HLCSBAR
K DIR,OUT,DIC,STOP,Y W !!
S DIR("A")="Selection"
S DIR(0)="SO^M:Message Search;P:Pending Transmissions;E:Error Listing;Q:Quit (also uparrow, or <RETURN>)"
D ^DIR G:$D(DIRUT)!(X="") EXIT S ACTION=X,ACTION=$TR(ACTION,"mpeq","MPEQ")
K DIR,X,Y
S (HLCSAL,HLCSLS,HLCSES)=0
I ACTION="Q" G EXIT
I "MPE"'[ACTION G ENEND
I ACTION="P" S HLCSPS=1 D EN^HLCSRPT1 G REEN
I ACTION="E" S HLCSERR=1 D EN^HLCSRPT2 G REEN
I ACTION="M" D ADVSRCH^HLCSRPT3 G REEN
;
ENEND ;
K DIR,OUT,DIC,STOP,X,Y,ACTION
G REEN
;
GETTIME ;
W @IOF,! S HLCSHDR="Start/Stop Time Selection" D HLCSBAR
GETSTART ;
W !!," Enter START Date and Time. Date is required.",!
S DIR(0)="D^::AEPSTX",DIR("?")="^D HELP^%DTC",DIR("B")="T"
D ^DIR S:$D(DIRUT)!(X="") STOP=1 I $D(STOP) K DIR,X,Y Q
I Y'["." S Y=Y_".000001"
S HLCSST=Y K DIR,X,Y
GETEND ;
W !!," Enter END Date and Time. Date is required.",!
S DIR(0)="D^::AESTX",DIR("?")="^D HELP^%DTC",DIR("B")="NOW"
D ^DIR S:$D(DIRUT)!(X="") STOP=1 I $D(STOP) K DIR,X,Y Q
I Y'["." S Y=Y_".235959"
S HLCSET=Y K DIR,X,Y
Q
;
DISPLAY ; common display method
; clean-up here
S HLCSPTR=$P(^TMP("TLOG",$J,1)," "),HLCSK=$O(^HLMA("C",HLCSPTR,0))
S HLCSPTR=+$P($G(^HLMA(+HLCSK,0)),U)
I VERS22'="YES" D DOCLIST^DDBR("^TMP($J,""LIST"")","NR")
E D BROWSE^DDBR("^TMP(""TLOG"",$J)","NA",HLCSTITL)
Q
;
FORMAT ; Format a report line
S HLCSY=""
S HLCSRNO=HLCSJ,SPACE20=" "
I VERS22'="YES" D
. S HLCSRNO=HLCSRNO_SPACE20 S HLCSRNO=$E(HLCSRNO,1,14) S HLCSY=HLCSRNO_" "
. S HLCSMID=$P(HLCSX,U,2),HLCSMX=HLCSMID,HLCSPTR=$P(HLCSX,U,1)
. S HLCSMID=HLCSMID_SPACE20 S HLCSMID=$E(HLCSMID,1,20)
. S HLCSY=HLCSY_HLCSMID_" "
I VERS22="YES" D
. S HLCSMID=$P(HLCSX,U,2),HLCSMX=HLCSMID,HLCSPTR=$P(HLCSX,U,1)
. S HLCSMID="$.%$CREF$^TMP($J,""MESSAGE"","_HLCSRNO_")$CREF$^"_HLCSMX_"$.%"
. S Y=$L(HLCSMX),X=$E(SPACE20,1,20-Y) S HLCSMID=HLCSMID_X K X,Y
. S HLCSY=HLCSMID_" "
. S HLCSDTE=$P(HLCSX,U,1)
. S HLCSDTE=$P(^HL(772,HLCSDTE,0),U,1)
. S YR=$E(HLCSDTE,2,3),MO=$E(HLCSDTE,4,5),DAY=$E(HLCSDTE,6,7)
. S HLCSDTE=MO_DAY_YR_"."_$P(HLCSDTE,".",2)
. S HLCSDTE=HLCSDTE_SPACE20,HLCSDTE=$E(HLCSDTE,1,14)
. S HLCSY=HLCSY_HLCSDTE_" "
S HLCSY=HLCSY_$E(HLCSLNK_SPACE20,1,10)_" "
S HLCSY=HLCSY_HLCSEVN_" "
S HLCSTYP=$P(HLCSX,U,3) S:HLCSTYP="O" HLCSTYP="OT" S:HLCSTYP="I" HLCSTYP="IN"
S HLCSY=HLCSY_$E(HLCSTYP_SPACE20,1,2)_" "
S HLCSSRVR=$P(HLCSX,U,11) I HLCSSRVR'="",($D(^HL(771,HLCSSRVR,0))) S HLCSSRVR=$P(^HL(771,HLCSSRVR,0),U,1)
S HLCSY=HLCSY_$E(HLCSSRVR_SPACE20,1,8)_" "
S HLCSCLNT=$P(HLCSX,U,12) I HLCSCLNT'="",($D(^HL(771,HLCSCLNT,0))) S HLCSCLNT=$P(^HL(771,HLCSCLNT,0),U,1)
S HLCSY=HLCSY_$E(HLCSCLNT_SPACE20,1,8)
S HLCSLN=HLCSLN+1
I VERS22'="YES" S HLCSY=HLCSY_" " I $D(^HLMA(HLCSJ,"MSH",1,0)) S HLCSY=HLCSY_^HLMA(HLCSJ,"MSH",1,0)
S ^TMP("TLOG",$J,HLCSLN)=HLCSY
I VERS22="YES" S ^TMP($J,"MESSAGE",HLCSJ)="$XC$^D SHOWMSG^HLCSRPT1("_HLCSJ_","_HLCSPTR_")$XC$^MESSAGE"
Q
;
HLCSBAR ; Center Title on Top Line of Screen
W RVON,?(80-$L(HLCSHDR)\2),HLCSHDR,$E(SPACE,$X,77),RVOFF,!
Q
;
EXIT ;
K DIR,OUT,DIC,STOP,I,X,Y,ACTION,DIRUT,DTOUT,DUOUT
K HLCSHDR,HLCSLN,HLCSI,HLCSJ,HLCSY,HLCSX,HLCSRNO
K HLCSLINK,HLCSLNK,HLCSEVNT,HLCSEVN,HLCSMID,HLCSTYP,HLCSSRVR,HLCSCLNT
K RVON,RVOFF,CEOP,BLDON,BLDOFF,SPACE,SPACE20
K HLCSTEVN,HLCSTEV1,HLCSTEV2,HLCSEVN1,HLCSEVN2
K HLCSTLNK,HLCSDTP,HLCSDTE,HLCSET,HLCSN,HLCSNREC,HLCSST
K HLCSTITL,HLCSPTR,HLCSK,SPACE25,SPACE30,SPACE80
K HLCSAL,HLCSLS,HLCSES,HLCSES1,HLCSES2,HLCSIO,HLCSPS
K YR,MO,DAY,VERS22,XXY,XXZ,YY1,YY2,Y1Y2,HLCSMX
K ^TMP($J,"LIST"),^TMP("DDBPF1Z",$J),^TMP("TLOG",$J)
K ^TMP($J,"MESSAGE")
Q
;
SHOWMSG ; Enable switching to specific message (used by PF1Z).
; If VERS22 installed, won't get here.
W @IOF
S DIR(0)="F:AE",DIR("A")="Enter Record Number: "
D ^DIR Q:$D(DIRUT)
I Y=-1!(X="") Q
S HLCSRNO=X I '$D(^HLMA(HLCSRNO,0)) D Q
. W !!,BLDON," ==> NO SUCH RECORD NUMBER <== ",BLDOFF H 3
S HLCSPTR=$P(^HLMA(HLCSRNO,0),"^",1)
S XXY=HLCSRNO,XXZ=HLCSPTR D SHOWMSG^HLCSRPT1(XXY,XXZ)
D SWITCH
Q
SWITCH ; per interim DBIA, until VA Fileman v22.0 released.
N DDBLN,DDBZ,DIC,DIR,X,Y,DIRUT,DIROUT,DUOUT,DILN
S DILN=DDBRSA(DDBRSA,"DDBSRL")-2
S:$G(DDBLST)="" DDBLST="^TMP(""DDBLST"",$J)" S DDBLN=$S($D(@DDBLST@("A",DDBSA)):^(DDBSA),1:$O(@DDBLST@(" "),-1)+1)
I $D(@DDBLST) D
.I $O(@DDBLST@(" "),-1)=1,$G(@DDBLST@(1,"DDBSA"))=DDBSA Q
.S DDBZ=$G(@DDBLST@("A",DDBSA),0)
.S Y=2
.D SAVEDDB^DDBR2(DDBLST,DDBLN),USAVEDDB^DDBR2(DDBLST,+Y)
.S DIROUT=1
N DDBLNA
I $G(DDBLNA,-1)=-1 G PS
I $G(DDBLNA(6))=DDBSA G PS ;if current doc re-selected
I $G(DDBLNA(6))]"",$D(@DDBLST@("APSA",DDBSA)) G PS ;on list
D:DDBLNA>0 SAVEDDB^DDBR2(DDBLST,DDBLN),WP^DDBR2(.DDBLNA)
PS D PSR^DDBR0(1)
Q
;
HELP ;
W !,"DATE AND TIME ARE BOTH REQUIRED"
Q
;
SCREEN ;screen I/O parameteters
S SPACE80=" "
F I=1:1:80 S SPACE80=SPACE80_" "
S SPACE=SPACE80
S SPACE20=$E(SPACE,1,20),SPACE25=$E(SPACE,1,25),SPACE30=$E(SPACE,1,30)
S X="IORVON;IORVOFF;IOINHI;IOINLOW" D ENDR^%ZISS
S RVON=IORVON,RVOFF=IORVOFF,BLDON=IOINHI,BLDOFF=IOINLOW
D KILL^%ZISS
Q
HLCSRPT ;ISC-SF/RAH-TRANS LOG CONTROL & MISC ;06/23/99 11:10 AM [ 04/02/2003 8:38 AM ]
+1 ;;1.6;HEALTH LEVEL SEVEN;**1004**;APR 1, 2003
+2 ;;1.6;HEALTH LEVEL SEVEN;**19,50**;Oct 13, 1995
+3 ;
+4 QUIT
+5 ;
EN ; Entry Point
+1 IF '$$TEST^DDBRT
SET IOP="HOME"
DO ^%ZIS
IF '$$TEST^DDBRT
WRITE !!," ===>> Screen Attributes NOT Defined. Use ^ZU or ^XUP before invoking.",!!
DO EXIT
HANG 3
QUIT
+2 DO SCREEN
+3 SET HLCSNREC=BLDON_" ===>>> NO MATCHING RECORDS <<<=== "_BLDOFF
+4 SET HLCSPTR=1
SET HLCSRNO=1
+5 SET VERS22=""
+6 IF 22=+$$VERSION^XPDUTL("DI")!($$PATCH^XPDUTL("DI*21.0*32"))
SET VERS22="YES"
+7 IF VERS22'="YES"
SET ^TMP("DDBPF1Z",$JOB)="D SHOWMSG^HLCSRPT Q"
+8 SET ^TMP($JOB,"LIST","MESSAGE TEXT")="^TMP($J,""MESSAGE"",HLCSRNO)"
+9 SET ^TMP($JOB,"LIST","IEN RECORD # MESSAGE ID # Log Link Msg:Evn IO Sndg Apl Rcvr Apl HDR")="^TMP(""TLOG"",$J)"
+10 ;
REEN ; Internal Re-entry Point
+1 WRITE @IOF,!
SET HLCSHDR="Search Transmission Log"
DO HLCSBAR
+2 KILL DIR,OUT,DIC,STOP,Y
WRITE !!
+3 SET DIR("A")="Selection"
+4 SET DIR(0)="SO^M:Message Search;P:Pending Transmissions;E:Error Listing;Q:Quit (also uparrow, or <RETURN>)"
+5 DO ^DIR
IF $DATA(DIRUT)!(X="")
GOTO EXIT
SET ACTION=X
SET ACTION=$TRANSLATE(ACTION,"mpeq","MPEQ")
+6 KILL DIR,X,Y
+7 SET (HLCSAL,HLCSLS,HLCSES)=0
+8 IF ACTION="Q"
GOTO EXIT
+9 IF "MPE"'[ACTION
GOTO ENEND
+10 IF ACTION="P"
SET HLCSPS=1
DO EN^HLCSRPT1
GOTO REEN
+11 IF ACTION="E"
SET HLCSERR=1
DO EN^HLCSRPT2
GOTO REEN
+12 IF ACTION="M"
DO ADVSRCH^HLCSRPT3
GOTO REEN
+13 ;
ENEND ;
+1 KILL DIR,OUT,DIC,STOP,X,Y,ACTION
+2 GOTO REEN
+3 ;
GETTIME ;
+1 WRITE @IOF,!
SET HLCSHDR="Start/Stop Time Selection"
DO HLCSBAR
GETSTART ;
+1 WRITE !!," Enter START Date and Time. Date is required.",!
+2 SET DIR(0)="D^::AEPSTX"
SET DIR("?")="^D HELP^%DTC"
SET DIR("B")="T"
+3 DO ^DIR
IF $DATA(DIRUT)!(X="")
SET STOP=1
IF $DATA(STOP)
KILL DIR,X,Y
QUIT
+4 IF Y'["."
SET Y=Y_".000001"
+5 SET HLCSST=Y
KILL DIR,X,Y
GETEND ;
+1 WRITE !!," Enter END Date and Time. Date is required.",!
+2 SET DIR(0)="D^::AESTX"
SET DIR("?")="^D HELP^%DTC"
SET DIR("B")="NOW"
+3 DO ^DIR
IF $DATA(DIRUT)!(X="")
SET STOP=1
IF $DATA(STOP)
KILL DIR,X,Y
QUIT
+4 IF Y'["."
SET Y=Y_".235959"
+5 SET HLCSET=Y
KILL DIR,X,Y
+6 QUIT
+7 ;
DISPLAY ; common display method
+1 ; clean-up here
+2 SET HLCSPTR=$PIECE(^TMP("TLOG",$JOB,1)," ")
SET HLCSK=$ORDER(^HLMA("C",HLCSPTR,0))
+3 SET HLCSPTR=+$PIECE($GET(^HLMA(+HLCSK,0)),U)
+4 IF VERS22'="YES"
DO DOCLIST^DDBR("^TMP($J,""LIST"")","NR")
+5 IF '$TEST
DO BROWSE^DDBR("^TMP(""TLOG"",$J)","NA",HLCSTITL)
+6 QUIT
+7 ;
FORMAT ; Format a report line
+1 SET HLCSY=""
+2 SET HLCSRNO=HLCSJ
SET SPACE20=" "
+3 IF VERS22'="YES"
Begin DoDot:1
+4 SET HLCSRNO=HLCSRNO_SPACE20
SET HLCSRNO=$EXTRACT(HLCSRNO,1,14)
SET HLCSY=HLCSRNO_" "
+5 SET HLCSMID=$PIECE(HLCSX,U,2)
SET HLCSMX=HLCSMID
SET HLCSPTR=$PIECE(HLCSX,U,1)
+6 SET HLCSMID=HLCSMID_SPACE20
SET HLCSMID=$EXTRACT(HLCSMID,1,20)
+7 SET HLCSY=HLCSY_HLCSMID_" "
End DoDot:1
+8 IF VERS22="YES"
Begin DoDot:1
+9 SET HLCSMID=$PIECE(HLCSX,U,2)
SET HLCSMX=HLCSMID
SET HLCSPTR=$PIECE(HLCSX,U,1)
+10 SET HLCSMID="$.%$CREF$^TMP($J,""MESSAGE"","_HLCSRNO_")$CREF$^"_HLCSMX_"$.%"
+11 SET Y=$LENGTH(HLCSMX)
SET X=$EXTRACT(SPACE20,1,20-Y)
SET HLCSMID=HLCSMID_X
KILL X,Y
+12 SET HLCSY=HLCSMID_" "
+13 SET HLCSDTE=$PIECE(HLCSX,U,1)
+14 SET HLCSDTE=$PIECE(^HL(772,HLCSDTE,0),U,1)
+15 SET YR=$EXTRACT(HLCSDTE,2,3)
SET MO=$EXTRACT(HLCSDTE,4,5)
SET DAY=$EXTRACT(HLCSDTE,6,7)
+16 SET HLCSDTE=MO_DAY_YR_"."_$PIECE(HLCSDTE,".",2)
+17 SET HLCSDTE=HLCSDTE_SPACE20
SET HLCSDTE=$EXTRACT(HLCSDTE,1,14)
+18 SET HLCSY=HLCSY_HLCSDTE_" "
End DoDot:1
+19 SET HLCSY=HLCSY_$EXTRACT(HLCSLNK_SPACE20,1,10)_" "
+20 SET HLCSY=HLCSY_HLCSEVN_" "
+21 SET HLCSTYP=$PIECE(HLCSX,U,3)
IF HLCSTYP="O"
SET HLCSTYP="OT"
IF HLCSTYP="I"
SET HLCSTYP="IN"
+22 SET HLCSY=HLCSY_$EXTRACT(HLCSTYP_SPACE20,1,2)_" "
+23 SET HLCSSRVR=$PIECE(HLCSX,U,11)
IF HLCSSRVR'=""
IF ($DATA(^HL(771,HLCSSRVR,0)))
SET HLCSSRVR=$PIECE(^HL(771,HLCSSRVR,0),U,1)
+24 SET HLCSY=HLCSY_$EXTRACT(HLCSSRVR_SPACE20,1,8)_" "
+25 SET HLCSCLNT=$PIECE(HLCSX,U,12)
IF HLCSCLNT'=""
IF ($DATA(^HL(771,HLCSCLNT,0)))
SET HLCSCLNT=$PIECE(^HL(771,HLCSCLNT,0),U,1)
+26 SET HLCSY=HLCSY_$EXTRACT(HLCSCLNT_SPACE20,1,8)
+27 SET HLCSLN=HLCSLN+1
+28 IF VERS22'="YES"
SET HLCSY=HLCSY_" "
IF $DATA(^HLMA(HLCSJ,"MSH",1,0))
SET HLCSY=HLCSY_^HLMA(HLCSJ,"MSH",1,0)
+29 SET ^TMP("TLOG",$JOB,HLCSLN)=HLCSY
+30 IF VERS22="YES"
SET ^TMP($JOB,"MESSAGE",HLCSJ)="$XC$^D SHOWMSG^HLCSRPT1("_HLCSJ_","_HLCSPTR_")$XC$^MESSAGE"
+31 QUIT
+32 ;
HLCSBAR ; Center Title on Top Line of Screen
+1 WRITE RVON,?(80-$LENGTH(HLCSHDR)\2),HLCSHDR,$EXTRACT(SPACE,$X,77),RVOFF,!
+2 QUIT
+3 ;
EXIT ;
+1 KILL DIR,OUT,DIC,STOP,I,X,Y,ACTION,DIRUT,DTOUT,DUOUT
+2 KILL HLCSHDR,HLCSLN,HLCSI,HLCSJ,HLCSY,HLCSX,HLCSRNO
+3 KILL HLCSLINK,HLCSLNK,HLCSEVNT,HLCSEVN,HLCSMID,HLCSTYP,HLCSSRVR,HLCSCLNT
+4 KILL RVON,RVOFF,CEOP,BLDON,BLDOFF,SPACE,SPACE20
+5 KILL HLCSTEVN,HLCSTEV1,HLCSTEV2,HLCSEVN1,HLCSEVN2
+6 KILL HLCSTLNK,HLCSDTP,HLCSDTE,HLCSET,HLCSN,HLCSNREC,HLCSST
+7 KILL HLCSTITL,HLCSPTR,HLCSK,SPACE25,SPACE30,SPACE80
+8 KILL HLCSAL,HLCSLS,HLCSES,HLCSES1,HLCSES2,HLCSIO,HLCSPS
+9 KILL YR,MO,DAY,VERS22,XXY,XXZ,YY1,YY2,Y1Y2,HLCSMX
+10 KILL ^TMP($JOB,"LIST"),^TMP("DDBPF1Z",$JOB),^TMP("TLOG",$JOB)
+11 KILL ^TMP($JOB,"MESSAGE")
+12 QUIT
+13 ;
SHOWMSG ; Enable switching to specific message (used by PF1Z).
+1 ; If VERS22 installed, won't get here.
+2 WRITE @IOF
+3 SET DIR(0)="F:AE"
SET DIR("A")="Enter Record Number: "
+4 DO ^DIR
IF $DATA(DIRUT)
QUIT
+5 IF Y=-1!(X="")
QUIT
+6 SET HLCSRNO=X
IF '$DATA(^HLMA(HLCSRNO,0))
Begin DoDot:1
+7 WRITE !!,BLDON," ==> NO SUCH RECORD NUMBER <== ",BLDOFF
HANG 3
End DoDot:1
QUIT
+8 SET HLCSPTR=$PIECE(^HLMA(HLCSRNO,0),"^",1)
+9 SET XXY=HLCSRNO
SET XXZ=HLCSPTR
DO SHOWMSG^HLCSRPT1(XXY,XXZ)
+10 DO SWITCH
+11 QUIT
SWITCH ; per interim DBIA, until VA Fileman v22.0 released.
+1 NEW DDBLN,DDBZ,DIC,DIR,X,Y,DIRUT,DIROUT,DUOUT,DILN
+2 SET DILN=DDBRSA(DDBRSA,"DDBSRL")-2
+3 IF $GET(DDBLST)=""
SET DDBLST="^TMP(""DDBLST"",$J)"
SET DDBLN=$SELECT($DATA(@DDBLST@("A",DDBSA)):^(DDBSA),1:$ORDER(@DDBLST@(" "),-1)+1)
+4 IF $DATA(@DDBLST)
Begin DoDot:1
+5 IF $ORDER(@DDBLST@(" "),-1)=1
IF $GET(@DDBLST@(1,"DDBSA"))=DDBSA
QUIT
+6 SET DDBZ=$GET(@DDBLST@("A",DDBSA),0)
+7 SET Y=2
+8 DO SAVEDDB^DDBR2(DDBLST,DDBLN)
DO USAVEDDB^DDBR2(DDBLST,+Y)
+9 SET DIROUT=1
End DoDot:1
+10 NEW DDBLNA
+11 IF $GET(DDBLNA,-1)=-1
GOTO PS
+12 ;if current doc re-selected
IF $GET(DDBLNA(6))=DDBSA
GOTO PS
+13 ;on list
IF $GET(DDBLNA(6))]""
IF $DATA(@DDBLST@("APSA",DDBSA))
GOTO PS
+14 IF DDBLNA>0
DO SAVEDDB^DDBR2(DDBLST,DDBLN)
DO WP^DDBR2(.DDBLNA)
PS DO PSR^DDBR0(1)
+1 QUIT
+2 ;
HELP ;
+1 WRITE !,"DATE AND TIME ARE BOTH REQUIRED"
+2 QUIT
+3 ;
SCREEN ;screen I/O parameteters
+1 SET SPACE80=" "
+2 FOR I=1:1:80
SET SPACE80=SPACE80_" "
+3 SET SPACE=SPACE80
+4 SET SPACE20=$EXTRACT(SPACE,1,20)
SET SPACE25=$EXTRACT(SPACE,1,25)
SET SPACE30=$EXTRACT(SPACE,1,30)
+5 SET X="IORVON;IORVOFF;IOINHI;IOINLOW"
DO ENDR^%ZISS
+6 SET RVON=IORVON
SET RVOFF=IORVOFF
SET BLDON=IOINHI
SET BLDOFF=IOINLOW
+7 DO KILL^%ZISS
+8 QUIT
