BHLU ; cmi/flag/maw - BHL Utilities ; [ 04/19/2004 10:42 AM ]
;;3.01;BHL IHS Interfaces with GIS;**2,10,11,12,13,14,15,16**;OCT 15, 2002
;
;this routine will have callable utilites by the BHL Package
;
DIE ;-- generic DIE call from BHL package
K DIE,DR
I BHLVAL="""""" S BHLVAL="@"
Q:BHLVAL="" ;don't update data with a null value
S DIE=BHLFL,DR=BHLFLD_"///"_BHLVAL,DA=BHLX
D ^DIE
I $D(Y) S BHLERCD="GEN" S BHLEFL=BHLFL X BHLERR
K DIE,DR
Q
;
DIE4 ;-- generic DIE call from BHL package
K DIE,DR
I BHLVAL="""""" S BHLVAL="@"
Q:BHLVAL="" ;don't update data with a null value
S DIE=BHLFL,DR=BHLFLD_"////"_BHLVAL,DA=BHLX
D ^DIE
I $D(Y) S BHLERCD="GEN" S BHLEFL=BHLFL X BHLERR
K DIE,DR
Q
;
DIEM ;-- generic die call for multiples
S DIE=BHLFL,DA(1)=BHLX,DA=BHLVAL,DR=BHLFLD_"///"_BHLVAL2
D ^DIE
I $D(Y) S BHLERCD="GEN",BHLEFL=BHLFL2,BHLFLD=BHLFLD X BHLERR
K DIE,DR
Q
;
DIC(BHLFL,BHLVAL) ;EP - generic dic call
S DIC=BHLFL,DIC(0)="MXZ",X=BHLVAL D ^DIC
S BHLY=+Y
Q BHLY
;
FK ;EP - kill fileman variables
K DD,DO,DIC,DIE,DR,Y,DIR
Q
;
ST(ST) ;-- transform into state
I ST="" Q ST
S NST=$$VAL^XBDIQ1(5,ST,1)
Q NST
;
CHKPAT(BHLPT,BHLDUZ) ;EP - lookup the patient
I '$G(BHLDUZ) S BHLDUZ=DUZ(2)
S BHLXDA=0 F S BHLXDA=$O(^AUPNPAT("D",BHLPT,BHLXDA)) Q:'BHLXDA!($G(BHLPAT)) D
. S BHLYDA=0 F S BHLYDA=$O(^AUPNPAT("D",BHLPT,BHLXDA,BHLYDA)) Q:'BHLYDA!($G(BHLPAT)) I BHLYDA=BHLDUZ S BHLPAT=BHLXDA
I $G(BHLPAT) Q BHLPAT
Q ""
;
CHKDOB(BHLDOBC) ;EP - check the date of birth and sex for identifier
S BHLDOB2=$P($G(^DPT(BHLDOBC,0)),U,3)
I BHLDOB2'=BHLDOB S BHLERCD="NODOBM" X BHLERR S BHLPAT="" Q BHLPAT
S BHLSEX2=$P($G(^DPT(BHLDOBC,0)),U,2)
I BHLSEX2'=BHLSEX S BHLERCD="NOSEXM" X BHLERR S BHLPAT="" Q BHLPAT
S BHLPAT=BHLDOBC
Q BHLPAT
Q
;
CHAR ;-- set field sep and encoding characters for a message
S DIC="^INTHL7M(",DIC(0)="AEMQZ"
S DIC("A")="Set Characters for which message: "
D ^DIC
Q:Y<0
S BHL("MSG")=+Y
D CHARUP(BHL("MSG"))
Q
;
CHARUP(BHLMIEN) ;EP - update field sep and enc chars for hl7
I $P($G(^INTHL7M(BHLMIEN,0)),U)["HL" D Q
. S ^INTHL7M(BHLMIEN,"FS")="|"
. S ^INTHL7M(BHLMIEN,"EC")="^~\&"
I $P($G(^INTHL7M(BHLMIEN,0)),U)="X1" S ^INTHL7M(BHLMIEN,"FS")="*"
Q
;
COMPILE(MSG) ;EP - compile a message
S Y=MSG,INGALL=1 D EN^INHSGZ
Q
;
COMPILEP(NS) ;EP - compile msgs by namespace
S BHLNDA=0 F S BHLNDA=$O(^INTHL7M("B",BHLNDA)) Q:BHLNDA="" D
. Q:BHLNDA'[NS
. S BHLNIEN=0 F S BHLNIEN=$O(^INTHL7M("B",BHLNDA,BHLNIEN)) Q:'BHLNIEN D
.. S Y=BHLNIEN,INGALL=1
.. D EN^INHSGZ
Q
;
HFS(BHLHFSN,BHLUIEN) ;EP - saves message to host file
S Y=$$OPEN^%ZISH("D:\TEMP\",BHLHFSN_"."_BHLMSTD,"W")
U IO
I BHLMSTD="X12" D
. S BHLUDA=0 F S BHLUDA=$O(^INTHU(BHLUIEN,3,BHLUDA)) Q:'BHLUDA D
.. S BHLXR=$P($G(^INTHU(BHLUIEN,3,BHLUDA,0)),"|CR|")
.. I $G(BHLXR)["~" W BHLXR Q
.. W BHLXR_"~"
I BHLMSTD'="X12" D
. S BHLUDA=0 F S BHLUDA=$O(^INTHU(BHLUIEN,3,BHLUDA)) Q:'BHLUDA D
.. W $P($G(^INTHU(BHLUIEN,3,BHLUDA,0)),"|CR|"),!
D ^%ZISC
Q
;
HFSA(DEST,BHLHDIR,BHLHFNM) ;EP - export from this destination
HFSDW ;-- callable from Data Warehouse
F BHLJOB="FORMAT CONTROLLER","OUTPUT CONTROLLER" D
. S BHLY=$$CHK^BHLBCK(BHLJOB)
Q:'$D(^INLHDEST(DEST))
S Y=$$OPEN^%ZISH(BHLHDIR,BHLHFNM,"W")
Q:Y
S BHLH=0 F S BHLH=$O(^INLHDEST(DEST,0,BHLH)) Q:'BHLH D
. S BHLU=0 F S BHLU=$O(^INLHDEST(DEST,0,BHLH,BHLU)) Q:'BHLU D
.. D LPINTHU(BHLU)
.. K ^INLHDEST(DEST,0,BHLH,BHLU)
D ^%ZISC
Q
;
HFSRL(DEST,BHLHDIR,BHLHFNM) ;EP - export from this destination
F BHLJOB="FORMAT CONTROLLER","OUTPUT CONTROLLER" D
. S BHLY=$$CHK^BHLBCK(BHLJOB)
S Y=$$OPEN^%ZISH(BHLHDIR,BHLHFNM,"W")
Q:Y
S BHLH=0 F S BHLH=$O(^INLHDEST(DEST,0,BHLH)) Q:'BHLH D
. S BHLU=0 F S BHLU=$O(^INLHDEST(DEST,0,BHLH,BHLU)) Q:'BHLU D
.. D RLINTHU(BHLU)
.. K ^INLHDEST(DEST,0,BHLH,BHLU)
D ^%ZISC
Q
;
LPINTHU(BHLUIEN) ;EP - loop through UIF and set to file
S BHLUDA=0 F S BHLUDA=$O(^INTHU(BHLUIEN,3,BHLUDA)) Q:'BHLUDA D
. U IO W $P($G(^INTHU(BHLUIEN,3,BHLUDA,0)),"|CR|"),!
Q
;
RLINTHU(BHLUIEN) ;EP - loop through UIF and set to file for ref lab
S BHLUDA=0 F S BHLUDA=$O(^INTHU(BHLUIEN,3,BHLUDA)) Q:'BHLUDA D
. ;U IO W $P($G(^INTHU(BHLUIEN,3,BHLUDA,0)),"|CR|"),$C(13,10)
. ;U IO W $P($G(^INTHU(BHLUIEN,3,BHLUDA,0)),"|CR|"),$C(10) quest old
. U IO W $P($G(^INTHU(BHLUIEN,3,BHLUDA,0)),"|CR|"),! ;quest new
Q
;
SENDFILE(FNM,SDIR,IP,PASS) ;EP - this will trigger a send via the sendto command, sendto.pl must exist
S BHLOPS=$P($G(^AUTTSITE(1,0)),U,21)
I PASS["anonymous" D Q
. S BHLSEND="sendto -i"_$S(BHLOPS=1:" ",1:" -a ")_IP_" "_SDIR_FNM
. S X=$$JOBWAIT^%HOSTCMD(BHLSEND)
S BHLSEND="sendto -i -l "_PASS_$S(BHLOPS=1:" ",1:" -a ")_IP_" "_SDIR_FNM
;S BHLSEND="sendto1 -u -l "_PASS_$S(BHLOPS=1:" ",1:" -a ")_IP_" "_SDIR_FNM ;for loinc project
S X=$$JOBWAIT^%HOSTCMD(BHLSEND)
Q
;
MPORT ;EP - run the import package utility
I $O(^INXPORT(""))="" D Q
. W !,"Global ^INXPORT missing, please restore and run MPORT^BHLU"
S BHLIT=$O(^INXPORT(""))
S BHLIST=$O(^INXPORT(BHLIT,""))
S BHLIPK=$O(^INXPORT(BHLIT,BHLIST,""))
W !,"Importing GIS "_$G(BHLIT)_" Supplement "_$G(BHLIPK)
W ", developing site "_$G(BHLIST)
D ^INMPORT
W !,"Finished Importing GIS Supplement "
K BHLIT,BHLIST,BHLIPK
Q
;
STUFFO(DEST,STOR) ;--loop through stor and stuff into ^INTHU
D NOW^%DTC S BHLXDTM=$G(%)
S BHLXH=$H
S BHLXDEST=$O(^INRHD("B","X1 IHS "_DEST,0))
S BHLXSTAT="N"
S BHLXIO="O"
S BHLXPRIO=1
K DD,DO
S DIC="^INTHU(",DIC(0)="L",X=BHLXDTM
S DIC("DR")=".02////"_BHLXDEST_";.03////"_BHLXSTAT_";.1////"_BHLXIO
S DIC("DR")=DIC("DR")_";.16///"_BHLXPRIO
D FILE^DICN
S BHLXUIF=+Y
S BHLXDA=0 F S BHLXDA=$O(@STOR@(BHLXDA)) Q:'BHLXDA D
. K DIC,DD,DO
. S DIC="^INTHU("_BHLXUIF_",3,",DIC(0)="L"
. S DIC("P")=$P(^DD(4001,3,0),"",2)
. S DA(1)=BHLXUIF,X=$G(@STOR@(BHLXDA))_"|CR|"
. Q:X=""
. D FILE^DICN
K ^INTHU(BHLXUIF,3,"B") ;don't need b index on msg multiple
S ^INLHDEST(BHLXDEST,BHLXPRIO,BHLXH,BHLXUIF)=""
Q
;
EOJ ;-- kill variables and quit
Q
;
BHLU ; cmi/flag/maw - BHL Utilities ; [ 04/19/2004 10:42 AM ]
+1 ;;3.01;BHL IHS Interfaces with GIS;**2,10,11,12,13,14,15,16**;OCT 15, 2002
+2 ;
+3 ;this routine will have callable utilites by the BHL Package
+4 ;
DIE ;-- generic DIE call from BHL package
+1 KILL DIE,DR
+2 IF BHLVAL=""""""
SET BHLVAL="@"
+3 ;don't update data with a null value
IF BHLVAL=""
QUIT
+4 SET DIE=BHLFL
SET DR=BHLFLD_"///"_BHLVAL
SET DA=BHLX
+5 DO ^DIE
+6 IF $DATA(Y)
SET BHLERCD="GEN"
SET BHLEFL=BHLFL
XECUTE BHLERR
+7 KILL DIE,DR
+8 QUIT
+9 ;
DIE4 ;-- generic DIE call from BHL package
+1 KILL DIE,DR
+2 IF BHLVAL=""""""
SET BHLVAL="@"
+3 ;don't update data with a null value
IF BHLVAL=""
QUIT
+4 SET DIE=BHLFL
SET DR=BHLFLD_"////"_BHLVAL
SET DA=BHLX
+5 DO ^DIE
+6 IF $DATA(Y)
SET BHLERCD="GEN"
SET BHLEFL=BHLFL
XECUTE BHLERR
+7 KILL DIE,DR
+8 QUIT
+9 ;
DIEM ;-- generic die call for multiples
+1 SET DIE=BHLFL
SET DA(1)=BHLX
SET DA=BHLVAL
SET DR=BHLFLD_"///"_BHLVAL2
+2 DO ^DIE
+3 IF $DATA(Y)
SET BHLERCD="GEN"
SET BHLEFL=BHLFL2
SET BHLFLD=BHLFLD
XECUTE BHLERR
+4 KILL DIE,DR
+5 QUIT
+6 ;
DIC(BHLFL,BHLVAL) ;EP - generic dic call
+1 SET DIC=BHLFL
SET DIC(0)="MXZ"
SET X=BHLVAL
DO ^DIC
+2 SET BHLY=+Y
+3 QUIT BHLY
+4 ;
FK ;EP - kill fileman variables
+1 KILL DD,DO,DIC,DIE,DR,Y,DIR
+2 QUIT
+3 ;
ST(ST) ;-- transform into state
+1 IF ST=""
QUIT ST
+2 SET NST=$$VAL^XBDIQ1(5,ST,1)
+3 QUIT NST
+4 ;
CHKPAT(BHLPT,BHLDUZ) ;EP - lookup the patient
+1 IF '$GET(BHLDUZ)
SET BHLDUZ=DUZ(2)
+2 SET BHLXDA=0
FOR
SET BHLXDA=$ORDER(^AUPNPAT("D",BHLPT,BHLXDA))
IF 'BHLXDA!($GET(BHLPAT))
QUIT
Begin DoDot:1
+3 SET BHLYDA=0
FOR
SET BHLYDA=$ORDER(^AUPNPAT("D",BHLPT,BHLXDA,BHLYDA))
IF 'BHLYDA!($GET(BHLPAT))
QUIT
IF BHLYDA=BHLDUZ
SET BHLPAT=BHLXDA
End DoDot:1
+4 IF $GET(BHLPAT)
QUIT BHLPAT
+5 QUIT ""
+6 ;
CHKDOB(BHLDOBC) ;EP - check the date of birth and sex for identifier
+1 SET BHLDOB2=$PIECE($GET(^DPT(BHLDOBC,0)),U,3)
+2 IF BHLDOB2'=BHLDOB
SET BHLERCD="NODOBM"
XECUTE BHLERR
SET BHLPAT=""
QUIT BHLPAT
+3 SET BHLSEX2=$PIECE($GET(^DPT(BHLDOBC,0)),U,2)
+4 IF BHLSEX2'=BHLSEX
SET BHLERCD="NOSEXM"
XECUTE BHLERR
SET BHLPAT=""
QUIT BHLPAT
+5 SET BHLPAT=BHLDOBC
+6 QUIT BHLPAT
+7 QUIT
+8 ;
CHAR ;-- set field sep and encoding characters for a message
+1 SET DIC="^INTHL7M("
SET DIC(0)="AEMQZ"
+2 SET DIC("A")="Set Characters for which message: "
+3 DO ^DIC
+4 IF Y<0
QUIT
+5 SET BHL("MSG")=+Y
+6 DO CHARUP(BHL("MSG"))
+7 QUIT
+8 ;
CHARUP(BHLMIEN) ;EP - update field sep and enc chars for hl7
+1 IF $PIECE($GET(^INTHL7M(BHLMIEN,0)),U)["HL"
Begin DoDot:1
+2 SET ^INTHL7M(BHLMIEN,"FS")="|"
+3 SET ^INTHL7M(BHLMIEN,"EC")="^~\&"
End DoDot:1
QUIT
+4 IF $PIECE($GET(^INTHL7M(BHLMIEN,0)),U)="X1"
SET ^INTHL7M(BHLMIEN,"FS")="*"
+5 QUIT
+6 ;
COMPILE(MSG) ;EP - compile a message
+1 SET Y=MSG
SET INGALL=1
DO EN^INHSGZ
+2 QUIT
+3 ;
COMPILEP(NS) ;EP - compile msgs by namespace
+1 SET BHLNDA=0
FOR
SET BHLNDA=$ORDER(^INTHL7M("B",BHLNDA))
IF BHLNDA=""
QUIT
Begin DoDot:1
+2 IF BHLNDA'[NS
QUIT
+3 SET BHLNIEN=0
FOR
SET BHLNIEN=$ORDER(^INTHL7M("B",BHLNDA,BHLNIEN))
IF 'BHLNIEN
QUIT
Begin DoDot:2
+4 SET Y=BHLNIEN
SET INGALL=1
+5 DO EN^INHSGZ
End DoDot:2
End DoDot:1
+6 QUIT
+7 ;
HFS(BHLHFSN,BHLUIEN) ;EP - saves message to host file
+1 SET Y=$$OPEN^%ZISH("D:\TEMP\",BHLHFSN_"."_BHLMSTD,"W")
+2 USE IO
+3 IF BHLMSTD="X12"
Begin DoDot:1
+4 SET BHLUDA=0
FOR
SET BHLUDA=$ORDER(^INTHU(BHLUIEN,3,BHLUDA))
IF 'BHLUDA
QUIT
Begin DoDot:2
+5 SET BHLXR=$PIECE($GET(^INTHU(BHLUIEN,3,BHLUDA,0)),"|CR|")
+6 IF $GET(BHLXR)["~"
WRITE BHLXR
QUIT
+7 WRITE BHLXR_"~"
End DoDot:2
End DoDot:1
+8 IF BHLMSTD'="X12"
Begin DoDot:1
+9 SET BHLUDA=0
FOR
SET BHLUDA=$ORDER(^INTHU(BHLUIEN,3,BHLUDA))
IF 'BHLUDA
QUIT
Begin DoDot:2
+10 WRITE $PIECE($GET(^INTHU(BHLUIEN,3,BHLUDA,0)),"|CR|"),!
End DoDot:2
End DoDot:1
+11 DO ^%ZISC
+12 QUIT
+13 ;
HFSA(DEST,BHLHDIR,BHLHFNM) ;EP - export from this destination
HFSDW ;-- callable from Data Warehouse
+1 FOR BHLJOB="FORMAT CONTROLLER","OUTPUT CONTROLLER"
Begin DoDot:1
+2 SET BHLY=$$CHK^BHLBCK(BHLJOB)
End DoDot:1
+3 IF '$DATA(^INLHDEST(DEST))
QUIT
+4 SET Y=$$OPEN^%ZISH(BHLHDIR,BHLHFNM,"W")
+5 IF Y
QUIT
+6 SET BHLH=0
FOR
SET BHLH=$ORDER(^INLHDEST(DEST,0,BHLH))
IF 'BHLH
QUIT
Begin DoDot:1
+7 SET BHLU=0
FOR
SET BHLU=$ORDER(^INLHDEST(DEST,0,BHLH,BHLU))
IF 'BHLU
QUIT
Begin DoDot:2
+8 DO LPINTHU(BHLU)
+9 KILL ^INLHDEST(DEST,0,BHLH,BHLU)
End DoDot:2
End DoDot:1
+10 DO ^%ZISC
+11 QUIT
+12 ;
HFSRL(DEST,BHLHDIR,BHLHFNM) ;EP - export from this destination
+1 FOR BHLJOB="FORMAT CONTROLLER","OUTPUT CONTROLLER"
Begin DoDot:1
+2 SET BHLY=$$CHK^BHLBCK(BHLJOB)
End DoDot:1
+3 SET Y=$$OPEN^%ZISH(BHLHDIR,BHLHFNM,"W")
+4 IF Y
QUIT
+5 SET BHLH=0
FOR
SET BHLH=$ORDER(^INLHDEST(DEST,0,BHLH))
IF 'BHLH
QUIT
Begin DoDot:1
+6 SET BHLU=0
FOR
SET BHLU=$ORDER(^INLHDEST(DEST,0,BHLH,BHLU))
IF 'BHLU
QUIT
Begin DoDot:2
+7 DO RLINTHU(BHLU)
+8 KILL ^INLHDEST(DEST,0,BHLH,BHLU)
End DoDot:2
End DoDot:1
+9 DO ^%ZISC
+10 QUIT
+11 ;
LPINTHU(BHLUIEN) ;EP - loop through UIF and set to file
+1 SET BHLUDA=0
FOR
SET BHLUDA=$ORDER(^INTHU(BHLUIEN,3,BHLUDA))
IF 'BHLUDA
QUIT
Begin DoDot:1
+2 USE IO
WRITE $PIECE($GET(^INTHU(BHLUIEN,3,BHLUDA,0)),"|CR|"),!
End DoDot:1
+3 QUIT
+4 ;
RLINTHU(BHLUIEN) ;EP - loop through UIF and set to file for ref lab
+1 SET BHLUDA=0
FOR
SET BHLUDA=$ORDER(^INTHU(BHLUIEN,3,BHLUDA))
IF 'BHLUDA
QUIT
Begin DoDot:1
+2 ;U IO W $P($G(^INTHU(BHLUIEN,3,BHLUDA,0)),"|CR|"),$C(13,10)
+3 ;U IO W $P($G(^INTHU(BHLUIEN,3,BHLUDA,0)),"|CR|"),$C(10) quest old
+4 ;quest new
USE IO
WRITE $PIECE($GET(^INTHU(BHLUIEN,3,BHLUDA,0)),"|CR|"),!
End DoDot:1
+5 QUIT
+6 ;
SENDFILE(FNM,SDIR,IP,PASS) ;EP - this will trigger a send via the sendto command, sendto.pl must exist
+1 SET BHLOPS=$PIECE($GET(^AUTTSITE(1,0)),U,21)
+2 IF PASS["anonymous"
Begin DoDot:1
+3 SET BHLSEND="sendto -i"_$SELECT(BHLOPS=1:" ",1:" -a ")_IP_" "_SDIR_FNM
+4 SET X=$$JOBWAIT^%HOSTCMD(BHLSEND)
End DoDot:1
QUIT
+5 SET BHLSEND="sendto -i -l "_PASS_$SELECT(BHLOPS=1:" ",1:" -a ")_IP_" "_SDIR_FNM
+6 ;S BHLSEND="sendto1 -u -l "_PASS_$S(BHLOPS=1:" ",1:" -a ")_IP_" "_SDIR_FNM ;for loinc project
+7 SET X=$$JOBWAIT^%HOSTCMD(BHLSEND)
+8 QUIT
+9 ;
MPORT ;EP - run the import package utility
+1 IF $ORDER(^INXPORT(""))=""
Begin DoDot:1
+2 WRITE !,"Global ^INXPORT missing, please restore and run MPORT^BHLU"
End DoDot:1
QUIT
+3 SET BHLIT=$ORDER(^INXPORT(""))
+4 SET BHLIST=$ORDER(^INXPORT(BHLIT,""))
+5 SET BHLIPK=$ORDER(^INXPORT(BHLIT,BHLIST,""))
+6 WRITE !,"Importing GIS "_$GET(BHLIT)_" Supplement "_$GET(BHLIPK)
+7 WRITE ", developing site "_$GET(BHLIST)
+8 DO ^INMPORT
+9 WRITE !,"Finished Importing GIS Supplement "
+10 KILL BHLIT,BHLIST,BHLIPK
+11 QUIT
+12 ;
STUFFO(DEST,STOR) ;--loop through stor and stuff into ^INTHU
+1 DO NOW^%DTC
SET BHLXDTM=$GET(%)
+2 SET BHLXH=$HOROLOG
+3 SET BHLXDEST=$ORDER(^INRHD("B","X1 IHS "_DEST,0))
+4 SET BHLXSTAT="N"
+5 SET BHLXIO="O"
+6 SET BHLXPRIO=1
+7 KILL DD,DO
+8 SET DIC="^INTHU("
SET DIC(0)="L"
SET X=BHLXDTM
+9 SET DIC("DR")=".02////"_BHLXDEST_";.03////"_BHLXSTAT_";.1////"_BHLXIO
+10 SET DIC("DR")=DIC("DR")_";.16///"_BHLXPRIO
+11 DO FILE^DICN
+12 SET BHLXUIF=+Y
+13 SET BHLXDA=0
FOR
SET BHLXDA=$ORDER(@STOR@(BHLXDA))
IF 'BHLXDA
QUIT
Begin DoDot:1
+14 KILL DIC,DD,DO
+15 SET DIC="^INTHU("_BHLXUIF_",3,"
SET DIC(0)="L"
+16 SET DIC("P")=$PIECE(^DD(4001,3,0),"",2)
+17 SET DA(1)=BHLXUIF
SET X=$GET(@STOR@(BHLXDA))_"|CR|"
+18 IF X=""
QUIT
+19 DO FILE^DICN
End DoDot:1
+20 ;don't need b index on msg multiple
KILL ^INTHU(BHLXUIF,3,"B")
+21 SET ^INLHDEST(BHLXDEST,BHLXPRIO,BHLXH,BHLXUIF)=""
+22 QUIT
+23 ;
EOJ ;-- kill variables and quit
+1 QUIT
+2 ;
