- LEXWUL ;ISL/KER - Lexicon Keywords - Update (Lexicon) ;05/23/2017
- ;;2.0;LEXICON UTILITY;**103**;Sep 23, 1996;Build 2
- ;
- ; Global Variables
- ; ^LEX(757 SACC 1.3
- ; ^LEX(757.01 SACC 1.3
- ; ^LEX(757.02 SACC 1.3
- ; ^TMP("LEXWU",$J) SACC 2.3.2.5.1
- ;
- ; External References
- ; HOME^%ZIS ICR 10086
- ; IX1^DIK ICR 10013
- ; $$GET1^DIQ ICR 2056
- ; $$DT^XLFDT ICR 10103
- ; $$UP^XLFSTR ICR 10011
- ;
- ; Local Variables NEWed or KILLed Elsewhere (LEXWUS)
- ; Control
- ; LEXEXC Exclude String
- ; LEXINC Include String
- ; LEXCHK Index node being checked
- ; LEXKEY Keyword being processed
- ; LEXQUIET Suppress Display
- ; LEXTEST Test Flag
- ; LEXCOM Commit Flag
- ; Counters
- ; LEXL01C ICD-9 Diagnosis Counter
- ; LEXL02C ICD-9 Procedure Counter
- ; LEXL03C CPT-4 Procedure Counter
- ; LEXL04C HCPCS Procedure Counter
- ; LEXL17C Title 38 Counter
- ; LEXL30C ICD-10 Diagnosis Counter
- ; LEXL31C ICD-10 Procedure Counter
- ; LEXL56C SNOMED CT Counter
- ;
- Q
- LEX ; Lexicon Expressions
- Q:'$L($G(LEXKEY)) Q:'$L($G(LEXCHK)) Q:'$L($G(LEXINC)) Q:'$L(LEXKEY) K ^LEX("LEXWU",$J,"IEN"),^LEX("LEXWU",$J,"OUT")
- N LEXSRC,LEXSAB,LEXPRI,LEXALT S LEXPRI=$G(LEXCHK),LEXALT="" D SPC K:$D(LEXTEST) LEXCOM I $L(LEXPRI) D
- . N LEXCHK F LEXCHK=LEXPRI,LEXALT D:$L($G(LEXCHK)) LCHK
- Q
- LCHK ; Lexicon Check
- Q:'$L(LEXCHK) N LEXCIEN,LEXEIEN,LEXCCTR,LEXICTR,LEXSRCA,LEXIENA S (LEXCCTR,LEXICTR,LEXCIEN)=0 K LEXIENA
- F S LEXCIEN=$O(^LEX(757.01,"AWRD",LEXCHK,LEXCIEN)) Q:+LEXCIEN'>0 D
- . S LEXIENA(+LEXCIEN)="" N LEXIIEN S LEXIIEN=0
- . F S LEXIIEN=$O(^LEX(757.01,"AWRD",LEXCHK,LEXCIEN,LEXIIEN)) Q:+LEXIIEN'>0 S LEXIENA(+LEXIIEN)=""
- S LEXEIEN=0 F S LEXEIEN=$O(LEXIENA(LEXEIEN)) Q:+LEXEIEN'>0 D LEXP
- Q
- LEXP ; Lexicon Expression
- Q:+($G(LEXEIEN))'>0 N LEXCIEN,LEXCT,LEXEXP,LEXI,LEXIN,LEXND,LEXS,LEXSIEN,LEXSRC,LEXSRCA,LEXTMP,LEXTIEN K LEXSRCA
- S LEXCIEN=LEXEIEN Q:'$D(^LEX(757.01,+LEXCIEN,0)) Q:$P($G(^LEX(757.01,+LEXCIEN,1)),"^",5)>0
- Q:$D(^LEX(757.01,+LEXCIEN,5,"B",LEXKEY)) Q:$D(^LEX("LEXWU",$J,"IEN",+LEXCIEN)) S ^LEX("LEXWU",$J,"IEN",+LEXCIEN)=""
- S LEXSIEN=0 F S LEXSIEN=$O(^LEX(757.02,"B",+LEXCIEN,LEXSIEN)) Q:+LEXSIEN'>0 D
- . N LEXS,LEXND,LEXSRC S LEXND=$G(^LEX(757.02,+LEXSIEN,0)) Q:$P(LEXND,"^",5)'>0
- . F LEXSRC=1,2,3,4,17,30,31,56 S:$P(LEXND,"^",3)=LEXSRC LEXSRCA(LEXSRC)=""
- Q:'$D(LEXSRCA) Q:$O(LEXSRCA(0))'>0 S LEXEIEN=LEXCIEN,LEXEXP=$$UP^XLFSTR($G(^LEX(757.01,+LEXEIEN,0))) Q:'$L(LEXEXP)
- ; Term contains ALL Includes
- S (LEXCT,LEXIN)=0 D Q:LEXIN'>0 Q:LEXCT'=LEXIN
- . F LEXI=1:1 S LEXTMP=$$TM($P(LEXINC,";",LEXI)) Q:'$L(LEXTMP) S LEXCT=LEXCT+1 S:$$IN(LEXTMP,LEXEXP)>0 LEXIN=LEXIN+1
- ; Term contains Excludes
- I $L($G(LEXEXC)) S LEXIN=0 D Q:LEXIN>0
- . S LEXIN=0 I $L($G(LEXEXC)) F LEXI=1:1 S LEXTMP=$P(LEXEXC,";",LEXI) Q:'$L(LEXTMP) S:LEXEXP[LEXTMP LEXIN=1
- D LSET
- Q
- LSET ; Lexicon Set Keyword
- Q:+($G(LEXEIEN))'>0 Q:'$D(^LEX(757.01,+($G(LEXEIEN)),0)) Q:'$L(LEXEXP) Q:'$L(LEXKEY) Q:'$D(LEXSRCA)
- N DA,DIK,LEXCT,LEXI,LEXIEN,LEXIN,LEXP3,LEXP4,LEXSYS
- S:$D(LEXSRCA(1)) LEXL01C=+($G(LEXL01C))+1,LEXSYS=$$SYS(1) S:$D(LEXSRCA(2)) LEXL02C=+($G(LEXL02C))+1,LEXSYS=$$SYS(2)
- S:$D(LEXSRCA(3)) LEXL03C=+($G(LEXL03C))+1,LEXSYS=$$SYS(3) S:$D(LEXSRCA(4)) LEXL04C=+($G(LEXL04C))+1,LEXSYS=$$SYS(4)
- S:$D(LEXSRCA(17)) LEXL17C=+($G(LEXL17C))+1,LEXSYS=$$SYS(17) S:$D(LEXSRCA(30)) LEXL30C=+($G(LEXL30C))+1,LEXSYS=$$SYS(30)
- S:$D(LEXSRCA(31)) LEXL31C=+($G(LEXL31C))+1,LEXSYS=$$SYS(31) S:$D(LEXSRCA(56)) LEXL56C=+($G(LEXL56C))+1,LEXSYS=$$SYS(56)
- D DEXP I $D(LEXCOM) D
- . N DA,DIK,LEXIEN,LEXP3,LEXP4 S LEXIEN=$O(^LEX(757.01,+LEXEIEN,5," "),-1)+1,^LEX(757.01,+LEXEIEN,5,LEXIEN,0)=LEXKEY
- . S DA=LEXIEN,DA(1)=LEXEIEN,DIK="^LEX(757.01,"_DA(1)_",5," D IX1^DIK
- . S LEXP3="",(LEXP4,LEXI)=0 F S LEXI=$O(^LEX(757.01,LEXEIEN,5,LEXI)) Q:+LEXI'>0 D
- . . S LEXP3=LEXI,LEXP4=LEXP4+1 N DA,DIK S DA(1)=LEXEIEN,DA=LEXI,DIK="^LEX(757.01,"_DA(1)_",5," D IX1^DIK
- . S:+LEXP3'>0 LEXP3="" S ^LEX(757.01,+LEXEIEN,5,0)="^757.18^"_+LEXP3_"^"_+LEXP4
- Q
- ;
- ; Miscellaneous
- DEXP ; Display Expression
- Q:$D(LEXQUIET) Q:$D(ZTQUEUED) Q:'$L(LEXEXP) Q:'$L(LEXINC) Q:'$L(LEXKEY)
- W !,"Type: Lexicon Expression (757.01)" W:$D(LEXSYS) !,"System: ",$G(LEXSYS)
- W !,"Expression: ",$G(LEXEXP),!,"Include/Keyword: ",$G(LEXINC),"/",$G(LEXKEY)
- I +($G(LEXEIEN))>0 W !,"IEN: ^LEX(757.01,",+($G(LEXEIEN)),","
- W !
- Q
- CIEN(X) ; Concept IEN
- N LEXEIEN,LEXMIEN,LEXCIEN
- S LEXEIEN=+($G(X)),LEXMIEN=+($G(^LEX(757.01,+LEXEIEN,1))),LEXCIEN=+($G(^LEX(757,+LEXMIEN,0))) S X=LEXCIEN
- Q X
- IN(X,Y) ; Is X in Y
- N LEXC,LEXE,LEXP,LEXO S LEXO=0 S LEXC=$G(X),LEXE=$G(Y) Q:$E(LEXE,1,$L(LEXC))=LEXC 1
- F LEXP=" ","-","[","(","&","+","/","," S:LEXE[(LEXP_LEXC) LEXO=1
- S X=LEXO
- Q X
- SPC ; Special Cases
- S LEXALT="" S:LEXKEY="XRAY" LEXALT=LEXKEY S:LEXKEY="ECOLI" LEXALT=LEXKEY
- Q
- SYS(X) ; System
- N LEXSRC S LEXSRC=$G(X) S X="" S:LEXSRC=1 X="ICD-9-CM" S:LEXSRC=2 X="ICD-9 Proc"
- S:LEXSRC=30 X="ICD-10-CM" S:LEXSRC=31 X="ICD-10-PCS"
- S:LEXSRC=3 X="CPT-4" S:LEXSRC=4 X="HCPCS"
- S:LEXSRC=17 X="Title 38" S:LEXSRC=56 X="SNOMED CT"
- Q X
- TM(X,Y) ; Trim Character Y - Default " "
- S X=$G(X) Q:X="" X S Y=$G(Y) S:'$L(Y) Y=" "
- F Q:$E(X,1)'=Y S X=$E(X,2,$L(X))
- F Q:$E(X,$L(X))'=Y S X=$E(X,1,($L(X)-1))
- Q X
- ABT(X) ; Abort
- Q:$D(^TMP("LEXWU",$J,"STOP")) 1
- Q 0
- ENV(X) ; Environment
- D HOME^%ZIS S U="^",DT=$$DT^XLFDT,DTIME=300 K POP
- N LEXNM,ZTQUEUED,ZTREQ S LEXNM=$$GET1^DIQ(200,(DUZ_","),.01)
- I '$L(LEXNM) W !!,?5,"Invalid/Missing DUZ" Q 0
- Q 1
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLEXWUL 5949 printed Feb 18, 2025@23:36:03 Page 2
- LEXWUL ;ISL/KER - Lexicon Keywords - Update (Lexicon) ;05/23/2017
- +1 ;;2.0;LEXICON UTILITY;**103**;Sep 23, 1996;Build 2
- +2 ;
- +3 ; Global Variables
- +4 ; ^LEX(757 SACC 1.3
- +5 ; ^LEX(757.01 SACC 1.3
- +6 ; ^LEX(757.02 SACC 1.3
- +7 ; ^TMP("LEXWU",$J) SACC 2.3.2.5.1
- +8 ;
- +9 ; External References
- +10 ; HOME^%ZIS ICR 10086
- +11 ; IX1^DIK ICR 10013
- +12 ; $$GET1^DIQ ICR 2056
- +13 ; $$DT^XLFDT ICR 10103
- +14 ; $$UP^XLFSTR ICR 10011
- +15 ;
- +16 ; Local Variables NEWed or KILLed Elsewhere (LEXWUS)
- +17 ; Control
- +18 ; LEXEXC Exclude String
- +19 ; LEXINC Include String
- +20 ; LEXCHK Index node being checked
- +21 ; LEXKEY Keyword being processed
- +22 ; LEXQUIET Suppress Display
- +23 ; LEXTEST Test Flag
- +24 ; LEXCOM Commit Flag
- +25 ; Counters
- +26 ; LEXL01C ICD-9 Diagnosis Counter
- +27 ; LEXL02C ICD-9 Procedure Counter
- +28 ; LEXL03C CPT-4 Procedure Counter
- +29 ; LEXL04C HCPCS Procedure Counter
- +30 ; LEXL17C Title 38 Counter
- +31 ; LEXL30C ICD-10 Diagnosis Counter
- +32 ; LEXL31C ICD-10 Procedure Counter
- +33 ; LEXL56C SNOMED CT Counter
- +34 ;
- +35 QUIT
- LEX ; Lexicon Expressions
- +1 if '$LENGTH($GET(LEXKEY))
- QUIT
- if '$LENGTH($GET(LEXCHK))
- QUIT
- if '$LENGTH($GET(LEXINC))
- QUIT
- if '$LENGTH(LEXKEY)
- QUIT
- KILL ^LEX("LEXWU",$JOB,"IEN"),^LEX("LEXWU",$JOB,"OUT")
- +2 NEW LEXSRC,LEXSAB,LEXPRI,LEXALT
- SET LEXPRI=$GET(LEXCHK)
- SET LEXALT=""
- DO SPC
- if $DATA(LEXTEST)
- KILL LEXCOM
- IF $LENGTH(LEXPRI)
- Begin DoDot:1
- +3 NEW LEXCHK
- FOR LEXCHK=LEXPRI,LEXALT
- if $LENGTH($GET(LEXCHK))
- DO LCHK
- End DoDot:1
- +4 QUIT
- LCHK ; Lexicon Check
- +1 if '$LENGTH(LEXCHK)
- QUIT
- NEW LEXCIEN,LEXEIEN,LEXCCTR,LEXICTR,LEXSRCA,LEXIENA
- SET (LEXCCTR,LEXICTR,LEXCIEN)=0
- KILL LEXIENA
- +2 FOR
- SET LEXCIEN=$ORDER(^LEX(757.01,"AWRD",LEXCHK,LEXCIEN))
- if +LEXCIEN'>0
- QUIT
- Begin DoDot:1
- +3 SET LEXIENA(+LEXCIEN)=""
- NEW LEXIIEN
- SET LEXIIEN=0
- +4 FOR
- SET LEXIIEN=$ORDER(^LEX(757.01,"AWRD",LEXCHK,LEXCIEN,LEXIIEN))
- if +LEXIIEN'>0
- QUIT
- SET LEXIENA(+LEXIIEN)=""
- End DoDot:1
- +5 SET LEXEIEN=0
- FOR
- SET LEXEIEN=$ORDER(LEXIENA(LEXEIEN))
- if +LEXEIEN'>0
- QUIT
- DO LEXP
- +6 QUIT
- LEXP ; Lexicon Expression
- +1 if +($GET(LEXEIEN))'>0
- QUIT
- NEW LEXCIEN,LEXCT,LEXEXP,LEXI,LEXIN,LEXND,LEXS,LEXSIEN,LEXSRC,LEXSRCA,LEXTMP,LEXTIEN
- KILL LEXSRCA
- +2 SET LEXCIEN=LEXEIEN
- if '$DATA(^LEX(757.01,+LEXCIEN,0))
- QUIT
- if $PIECE($GET(^LEX(757.01,+LEXCIEN,1)),"^",5)>0
- QUIT
- +3 if $DATA(^LEX(757.01,+LEXCIEN,5,"B",LEXKEY))
- QUIT
- if $DATA(^LEX("LEXWU",$JOB,"IEN",+LEXCIEN))
- QUIT
- SET ^LEX("LEXWU",$JOB,"IEN",+LEXCIEN)=""
- +4 SET LEXSIEN=0
- FOR
- SET LEXSIEN=$ORDER(^LEX(757.02,"B",+LEXCIEN,LEXSIEN))
- if +LEXSIEN'>0
- QUIT
- Begin DoDot:1
- +5 NEW LEXS,LEXND,LEXSRC
- SET LEXND=$GET(^LEX(757.02,+LEXSIEN,0))
- if $PIECE(LEXND,"^",5)'>0
- QUIT
- +6 FOR LEXSRC=1,2,3,4,17,30,31,56
- if $PIECE(LEXND,"^",3)=LEXSRC
- SET LEXSRCA(LEXSRC)=""
- End DoDot:1
- +7 if '$DATA(LEXSRCA)
- QUIT
- if $ORDER(LEXSRCA(0))'>0
- QUIT
- SET LEXEIEN=LEXCIEN
- SET LEXEXP=$$UP^XLFSTR($GET(^LEX(757.01,+LEXEIEN,0)))
- if '$LENGTH(LEXEXP)
- QUIT
- +8 ; Term contains ALL Includes
- +9 SET (LEXCT,LEXIN)=0
- Begin DoDot:1
- +10 FOR LEXI=1:1
- SET LEXTMP=$$TM($PIECE(LEXINC,";",LEXI))
- if '$LENGTH(LEXTMP)
- QUIT
- SET LEXCT=LEXCT+1
- if $$IN(LEXTMP,LEXEXP)>0
- SET LEXIN=LEXIN+1
- End DoDot:1
- if LEXIN'>0
- QUIT
- if LEXCT'=LEXIN
- QUIT
- +11 ; Term contains Excludes
- +12 IF $LENGTH($GET(LEXEXC))
- SET LEXIN=0
- Begin DoDot:1
- +13 SET LEXIN=0
- IF $LENGTH($GET(LEXEXC))
- FOR LEXI=1:1
- SET LEXTMP=$PIECE(LEXEXC,";",LEXI)
- if '$LENGTH(LEXTMP)
- QUIT
- if LEXEXP[LEXTMP
- SET LEXIN=1
- End DoDot:1
- if LEXIN>0
- QUIT
- +14 DO LSET
- +15 QUIT
- LSET ; Lexicon Set Keyword
- +1 if +($GET(LEXEIEN))'>0
- QUIT
- if '$DATA(^LEX(757.01,+($GET(LEXEIEN)),0))
- QUIT
- if '$LENGTH(LEXEXP)
- QUIT
- if '$LENGTH(LEXKEY)
- QUIT
- if '$DATA(LEXSRCA)
- QUIT
- +2 NEW DA,DIK,LEXCT,LEXI,LEXIEN,LEXIN,LEXP3,LEXP4,LEXSYS
- +3 if $DATA(LEXSRCA(1))
- SET LEXL01C=+($GET(LEXL01C))+1
- SET LEXSYS=$$SYS(1)
- if $DATA(LEXSRCA(2))
- SET LEXL02C=+($GET(LEXL02C))+1
- SET LEXSYS=$$SYS(2)
- +4 if $DATA(LEXSRCA(3))
- SET LEXL03C=+($GET(LEXL03C))+1
- SET LEXSYS=$$SYS(3)
- if $DATA(LEXSRCA(4))
- SET LEXL04C=+($GET(LEXL04C))+1
- SET LEXSYS=$$SYS(4)
- +5 if $DATA(LEXSRCA(17))
- SET LEXL17C=+($GET(LEXL17C))+1
- SET LEXSYS=$$SYS(17)
- if $DATA(LEXSRCA(30))
- SET LEXL30C=+($GET(LEXL30C))+1
- SET LEXSYS=$$SYS(30)
- +6 if $DATA(LEXSRCA(31))
- SET LEXL31C=+($GET(LEXL31C))+1
- SET LEXSYS=$$SYS(31)
- if $DATA(LEXSRCA(56))
- SET LEXL56C=+($GET(LEXL56C))+1
- SET LEXSYS=$$SYS(56)
- +7 DO DEXP
- IF $DATA(LEXCOM)
- Begin DoDot:1
- +8 NEW DA,DIK,LEXIEN,LEXP3,LEXP4
- SET LEXIEN=$ORDER(^LEX(757.01,+LEXEIEN,5," "),-1)+1
- SET ^LEX(757.01,+LEXEIEN,5,LEXIEN,0)=LEXKEY
- +9 SET DA=LEXIEN
- SET DA(1)=LEXEIEN
- SET DIK="^LEX(757.01,"_DA(1)_",5,"
- DO IX1^DIK
- +10 SET LEXP3=""
- SET (LEXP4,LEXI)=0
- FOR
- SET LEXI=$ORDER(^LEX(757.01,LEXEIEN,5,LEXI))
- if +LEXI'>0
- QUIT
- Begin DoDot:2
- +11 SET LEXP3=LEXI
- SET LEXP4=LEXP4+1
- NEW DA,DIK
- SET DA(1)=LEXEIEN
- SET DA=LEXI
- SET DIK="^LEX(757.01,"_DA(1)_",5,"
- DO IX1^DIK
- End DoDot:2
- +12 if +LEXP3'>0
- SET LEXP3=""
- SET ^LEX(757.01,+LEXEIEN,5,0)="^757.18^"_+LEXP3_"^"_+LEXP4
- End DoDot:1
- +13 QUIT
- +14 ;
- +15 ; Miscellaneous
- DEXP ; Display Expression
- +1 if $DATA(LEXQUIET)
- QUIT
- if $DATA(ZTQUEUED)
- QUIT
- if '$LENGTH(LEXEXP)
- QUIT
- if '$LENGTH(LEXINC)
- QUIT
- if '$LENGTH(LEXKEY)
- QUIT
- +2 WRITE !,"Type: Lexicon Expression (757.01)"
- if $DATA(LEXSYS)
- WRITE !,"System: ",$GET(LEXSYS)
- +3 WRITE !,"Expression: ",$GET(LEXEXP),!,"Include/Keyword: ",$GET(LEXINC),"/",$GET(LEXKEY)
- +4 IF +($GET(LEXEIEN))>0
- WRITE !,"IEN: ^LEX(757.01,",+($GET(LEXEIEN)),","
- +5 WRITE !
- +6 QUIT
- CIEN(X) ; Concept IEN
- +1 NEW LEXEIEN,LEXMIEN,LEXCIEN
- +2 SET LEXEIEN=+($GET(X))
- SET LEXMIEN=+($GET(^LEX(757.01,+LEXEIEN,1)))
- SET LEXCIEN=+($GET(^LEX(757,+LEXMIEN,0)))
- SET X=LEXCIEN
- +3 QUIT X
- IN(X,Y) ; Is X in Y
- +1 NEW LEXC,LEXE,LEXP,LEXO
- SET LEXO=0
- SET LEXC=$GET(X)
- SET LEXE=$GET(Y)
- if $EXTRACT(LEXE,1,$LENGTH(LEXC))=LEXC
- QUIT 1
- +2 FOR LEXP=" ","-","[","(","&","+","/",","
- if LEXE[(LEXP_LEXC)
- SET LEXO=1
- +3 SET X=LEXO
- +4 QUIT X
- SPC ; Special Cases
- +1 SET LEXALT=""
- if LEXKEY="XRAY"
- SET LEXALT=LEXKEY
- if LEXKEY="ECOLI"
- SET LEXALT=LEXKEY
- +2 QUIT
- SYS(X) ; System
- +1 NEW LEXSRC
- SET LEXSRC=$GET(X)
- SET X=""
- if LEXSRC=1
- SET X="ICD-9-CM"
- if LEXSRC=2
- SET X="ICD-9 Proc"
- +2 if LEXSRC=30
- SET X="ICD-10-CM"
- if LEXSRC=31
- SET X="ICD-10-PCS"
- +3 if LEXSRC=3
- SET X="CPT-4"
- if LEXSRC=4
- SET X="HCPCS"
- +4 if LEXSRC=17
- SET X="Title 38"
- if LEXSRC=56
- SET X="SNOMED CT"
- +5 QUIT X
- TM(X,Y) ; Trim Character Y - Default " "
- +1 SET X=$GET(X)
- if X=""
- QUIT X
- SET Y=$GET(Y)
- if '$LENGTH(Y)
- SET Y=" "
- +2 FOR
- if $EXTRACT(X,1)'=Y
- QUIT
- SET X=$EXTRACT(X,2,$LENGTH(X))
- +3 FOR
- if $EXTRACT(X,$LENGTH(X))'=Y
- QUIT
- SET X=$EXTRACT(X,1,($LENGTH(X)-1))
- +4 QUIT X
- ABT(X) ; Abort
- +1 if $DATA(^TMP("LEXWU",$JOB,"STOP"))
- QUIT 1
- +2 QUIT 0
- ENV(X) ; Environment
- +1 DO HOME^%ZIS
- SET U="^"
- SET DT=$$DT^XLFDT
- SET DTIME=300
- KILL POP
- +2 NEW LEXNM,ZTQUEUED,ZTREQ
- SET LEXNM=$$GET1^DIQ(200,(DUZ_","),.01)
- +3 IF '$LENGTH(LEXNM)
- WRITE !!,?5,"Invalid/Missing DUZ"
- QUIT 0
- +4 QUIT 1