LEXAR6.m

LEXAR6 ;ISL/KER - Look-up Response (Unresolved Narr) ;04/21/2014

 ;;2.0;LEXICON UTILITY;**3,9,11,80**;Sep 23, 1996;Build 1

 ;               

 ; Global Variables

 ;    ^TMP("LEXSCH")      SACC 2.3.2.5.1

 ;               

 ; External References

 ;    NOW^%DTC            ICR  10000

 ;    HOME^%ZIS           ICR  10086

 ;    ^%ZTLOAD            ICR  10063

 ;    FILE^DICN           ICR  10009

 ;    ^DIE                ICR  10018

 ;    ^DIM                ICR  10016

 ;    $$UP^XLFSTR         ICR  10103

 ;               

 Q

 ;  This routines saves Unresolved Narratives (terms not found

 ;  in the Lexicon) in file 757.06.  It also saves comments about

 ;  a term.  Both the Unresolved Narratives and comments are used

 ;  as a tool to update the Lexicon Utility.

 ;

SAVE ; Save Unresolved Narrative

 ; Quit saving Unresolved Narratives pch 80

 G SAVEQ

 G:'$L($G(^TMP("LEXSCH",$J,"NAR",0))) SAVEQ

 N Y,DIC,DO,D0,DA,ZTQUEUED,ZTREQ,ZTSAVE,ZTSK,ZTDESC,ZTDTH,ZTIO,ZTRTN,%

 N LEXUNR S LEXUNR=$$UNR($G(^TMP("LEXSCH",$J,"NAR",0))) G:LEXUNR>0 SAVEQ

 S ZTSAVE("^TMP(""LEXSCH"",$J,")="",ZTRTN="SV^LEXAR6",ZTDESC="Saving Unresolved Narrative",ZTIO="",ZTDTH=$H

 D ^%ZTLOAD,HOME^%ZIS K ZTSAVE,ZTSK,ZTDESC,ZTDTH,ZTIO,ZTRTN

 D:+($G(^TMP("LEXSCH",$J,"NUM",0)))>0 SET^LEXAR4(1)

 G SAVEQ

COM(LEXX) ; Save a comment as a Unresolved Narative

 D:+($G(LEX))'=0 KSCH^LEXAR K:+($G(LEX))=0 LEX N Y,DIC,DO,D0,DA,LEXCMT,LEXOK,LEXDUP,%,%X,%Y S LEXCMT=$G(LEXX)

 ; Internal Entry Number

 S ^TMP("LEXSCH",$J,"IEN",0)=+($P(LEXX,"^",1)) G:+($G(^TMP("LEXSCH",$J,"IEN",0)))=0 COMQ G:'$D(^LEX(757.01,+($G(^TMP("LEXSCH",$J,"IEN",0))),0)) COMQ

 ; Expression

 S ^TMP("LEXSCH",$J,"EXP",0)=$G(^LEX(757.01,+($G(^TMP("LEXSCH",$J,"IEN",0))),0)) G:'$L(^TMP("LEXSCH",$J,"EXP",0)) COMQ

 ; Duplicate Comment

 S LEXDUP=$$DUP($$UP^XLFSTR($G(^TMP("LEXSCH",$J,"EXP",0)))),LEXOK=$$OK(LEXCMT) G:'LEXOK COMQ

 ; Comment

 S ^TMP("LEXSCH",$J,"COM",0)=$P(LEXX,"^",2) G:'$L(^TMP("LEXSCH",$J,"COM",0)) COMQ

 K LEXCMT,LEXDUP,LEXOK S ZTSAVE("^TMP(""LEXSCH"",$J,")="",ZTRTN="SV^LEXAR6",ZTDESC="Saving Unresolved Narrative Comment",ZTIO="",ZTDTH=$H D ^%ZTLOAD,HOME^%ZIS

COMQ ; End of Comment

 K Y,ZTSAVE,ZTSK,ZTDESC,ZTDTH,ZTIO,ZTRTN

 ;

SAVEQ ; End of Save

 ;

 ; End Dialog with the Application (Unresolved Narrative)

 ;    Kill LEX, ^TMP("LEXFND",$J), ^TMP("LEXHIT",$J), ^TMP("LEXSCH",$J)

 I +($G(LEX))'=0 D EDA^LEXAR

 ;

 ; End Dialog with the User

 ;    Set LEX("NAR"), LEX("EXM") and LEX=0

 ;    Kill ^TMP("LEXFND",$J), ^TMP("LEXHIT",$J)

 ;    Kill LEX("LIST"),LEX("MAT"),LEX("MIN"),LEX("MAX")

 I +($G(LEX))=0 D EDU^LEXAR

 ;

 ; End Dialog with the Application (Comment)

 I $D(^TMP("LEXSCH",$J,"COM")) K ^TMP("LEXSCH",$J,"COM"),^TMP("LEXSCH",$J,"EXP"),^TMP("LEXSCH",$J,"IEN") K:+($G(LEX))=0 LEX

 Q

SV ; Save an unresolved narrative (tasked) in file 757.06

 ; Quit saving Unresolved Narratives pch 80

 Q

 N X,Y,DA,DD,DO,D0,DIC,DLAYGO,DI,DIE,DIK,DQ,DR,LEXADD,LEXNAR,LEXDTG,LEXSCH,LEXNUM,LEXAPP,LEXCOM,LEXIEN,LEXSVC,LEXLOC,LEXFLN,LEXIDX,LEXSCT,LEXFIL

 S LEXDTG=$$DTG,LEXADD=0

 I '$D(^TMP("LEXSCH",$J,"COM",0)) D

 . S LEXNAR=$$NAR,LEXSCH=$$SCH,LEXNUM=$$NUM,LEXAPP=$$APP,LEXSVC=$$SVC

 . S LEXLOC=$$LOC,LEXFLN=$$FLN,LEXIDX=$$IDX,LEXSCT=$$SCT,LEXFIL=$$FIL

 . S (DR,DIC("DR"))=".01////^S X=LEXNAR;1////^S X=LEXDTG;2////^S X=LEXSCH;3////^S X=LEXNUM;4////^S X=LEXAPP;5////^S X=LEXSVC;6////^S X=LEXLOC;7////^S X=LEXFLN;8////^S X=LEXIDX;9////^S X=LEXSCT;10////^S X=LEXFIL"

 I $D(^TMP("LEXSCH",$J,"COM",0)) D

 . S (X,LEXNAR)=$$EXP,LEXIEN=$$IEN,LEXCOM=$$CMT S:'$L(LEXCOM)!(+LEXIEN=0) LEXNAR=""

 . S (DR,DIC("DR"))=".01///^S X=LEXNAR;1///^S X=LEXDTG;11////^S X=LEXIEN;12///^S X=LEXCOM"

 I $L($G(LEXNAR)) D

 . N X,DIC K DD,DO S DIC="^LEX(757.06,",DIC(0)="L",DLAYGO=757.06,X=LEXNAR

 . D FILE^DICN S LEXADD=+($P($G(Y),"^",3)) D:LEXADD ED,SF D:'LEXADD KF K DLAYGO

 S:$D(ZTQUEUED) ZTREQ="@" K:+($G(LEX))'=0 ^TMP("LEXSCH",$J) G:'LEXADD SVQ

 D:+($$TOT)>49 SEND^LEXAR7

SVQ ; End of Narrative Save

 Q

ED ; Edit fields  PCH 11

 S DR=$G(DR),DIE="^LEX(757.06,",DA=+($G(Y)) Q:+DA'>0  Q:'$L(DR)  D ^DIE

 Q

DTG(LEXX) ; FM Day-Time-Group

 N %,%H,%I D NOW^%DTC S LEXX=% Q LEXX

NAR(LEXX) ; Narrative (provided by user)

 S LEXX=$TR($$UP^XLFSTR($E($G(^TMP("LEXSCH",$J,"NAR",0)),1,99)),";"," ") S:$L(LEXX)'>0 LEXX="UNKNOWN" Q LEXX

EXP(LEXX) ; Narrative (provided by user)

 S LEXX=$TR($$UP^XLFSTR($E($G(^TMP("LEXSCH",$J,"EXP",0)),1,99)),";"," ") S:$L(LEXX)'>0 LEXX="UNKNOWN" Q LEXX

SCH(LEXX) ; String searched for (provided by LEX)

 S LEXX=$$UP^XLFSTR($E($G(^TMP("LEXSCH",$J,"SCH",0)),1,100)) S:'$L(LEXX) LEXX="UNKNOWN" Q LEXX

NUM(LEXX) ; Number of terms found in search

 Q +($G(^TMP("LEXSCH",$J,"NUM",0)))

APP(LEXX) ; Application conducting the search

 S LEXX=$$UP^XLFSTR($E($G(^TMP("LEXSCH",$J,"APP",1)),1,63)) S:'$L(LEXX) LEXX="UNKNOWN" Q LEXX

IEN(LEXX) ; Internal Entry Number of term found (Comments only)

 Q +($G(^TMP("LEXSCH",$J,"IEN",0)))

SVC(LEXX) ; User's Service

 S LEXX=$$UP^XLFSTR($E($G(^TMP("LEXSCH",$J,"SVC",0)),1,63)) S:'$L(LEXX) LEXX="UNKNOWN" Q LEXX

LOC(LEXX) ; User's Hospital Location

 S LEXX=$$UP^XLFSTR($E($G(^TMP("LEXSCH",$J,"LOC",0)),1,63)) S:'$L(LEXX) LEXX="UNKNOWN" Q LEXX

FLN(LEXX) ; File number where search was conducted

 S LEXX=$E($G(^TMP("LEXSCH",$J,"FLN",0)),1,7) S:'$L(LEXX)!($E(LEXX,1,3)'="757") LEXX="UNKNOWN" Q LEXX

IDX(LEXX) ; Index used during the search

 S LEXX=$E($$UP^XLFSTR($G(^TMP("LEXSCH",$J,"IDX",0))),1,8) S:'$L(LEXX) LEXX="UNKNONWN" Q LEXX

SCT(LEXX) ; Shortcuts used during the search

 S LEXX=$$UP^XLFSTR($E($G(^TMP("LEXSCH",$J,"SCT",1)),1,63)) S:'$L(LEXX) LEXX="NONE" Q LEXX

FIL(LEXX) ; Filter used during the search - DIC("S")

 N X S X=$G(^TMP("LEXSCH",$J,"FIL",0)) D ^DIM S:$L($G(X))>244 X="" S LEXX=$G(X) Q LEXX

CMT(LEXX) ; Comment

 S LEXX=$$UP^XLFSTR($E($G(^TMP("LEXSCH",$J,"COM",0)),1,199)) Q LEXX

TOT(LEXX) ; Total # of narratives to send

 N DA S (DA,LEXX)=0 D SF,KF F  S DA=$O(^LEX(757.06,DA)) Q:+DA=0  K:'$D(^LEX(757.06,DA,0)) ^LEX(757.06,DA,99) S:+($G(^LEX(757.06,DA,99)))>0 LEXX=LEXX+1

 Q LEXX

SF ; Set Send flag

 N DA S DA=0 F  S DA=$O(^LEX(757.06,DA)) Q:+DA=0  S:$D(^LEX(757.06,DA,0)) ^LEX(757.06,DA,99)=1

 Q

KF ; Kill Send flag

 N DA S DA=0 F  S DA=$O(^LEX(757.06,DA)) Q:+DA=0  K:'$D(^LEX(757.06,DA,0)) ^LEX(757.06,DA,99)

 Q

UNR(LEXX) ; Is the narrative in file 757.06

 S LEXX=$G(LEXX) Q:LEXX="" 0

 N LEXIN,DA S LEXIN=0,DA=0 F  S DA=$O(^LEX(757.06,"B",$E(LEXX,1,30),DA)) Q:+DA=0  S:$P($G(^LEX(757.06,+DA,0)),"^",1)=LEXX LEXIN=1

 S LEXX=LEXIN Q LEXX

DUP(LEXX) ; Is the comment narrative a duplicate 

 S LEXX=$G(LEXX) Q:LEXX="" 0

 N LEXIN,DA S LEXIN=0,DA=0

 F  S DA=$O(^LEX(757.06,"B",$E(LEXX,1,30),DA)) Q:+DA=0  D

 . S:$E($P($G(^LEX(757.06,+DA,0)),"^",1),1,$L(LEXX))=LEXX LEXIN=LEXIN+1

 S LEXX=LEXIN Q LEXX

OK(LEXX) ; Ok to process

 S LEXX=$G(LEXX) N LEXI,LEXN,LEXC,LEXOK S LEXOK=1,LEXC=$E($$UP^XLFSTR($G(^TMP("LEXSCH",$J,"EXP",0))),1,30)

 S LEXN=$E(LEXC,1,($L(LEXC)-1))_$C($A($E(LEXC,$L(LEXC)))-1)_"~"

 F  S LEXN=$O(^LEX(757.06,"B",LEXN)) Q:LEXN=""!($E(LEXN,1,$L(LEXC))'=LEXC)  D

 . S LEXI=0 F  S LEXI=$O(^LEX(757.06,"B",LEXN,LEXI)) Q:+LEXI=0  D

 . . S:$G(^LEX(757.06,LEXI,4))=LEXX LEXOK=0

 S LEXX=LEXOK Q LEXX

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---LEXAR6   7206     printed  Feb 18, 2025@23:33:09                                                                                                                                                                                                      Page 2

LEXAR6    ;ISL/KER - Look-up Response (Unresolved Narr) ;04/21/2014

 +1       ;;2.0;LEXICON UTILITY;**3,9,11,80**;Sep 23, 1996;Build 1

 +2       ;               

 +3       ; Global Variables

 +4       ;    ^TMP("LEXSCH")      SACC 2.3.2.5.1

 +5       ;               

 +6       ; External References

 +7       ;    NOW^%DTC            ICR  10000

 +8       ;    HOME^%ZIS           ICR  10086

 +9       ;    ^%ZTLOAD            ICR  10063

 +10      ;    FILE^DICN           ICR  10009

 +11      ;    ^DIE                ICR  10018

 +12      ;    ^DIM                ICR  10016

 +13      ;    $$UP^XLFSTR         ICR  10103

 +14      ;               

 +15       QUIT 

 +16      ;  This routines saves Unresolved Narratives (terms not found

 +17      ;  in the Lexicon) in file 757.06.  It also saves comments about

 +18      ;  a term.  Both the Unresolved Narratives and comments are used

 +19      ;  as a tool to update the Lexicon Utility.

 +20      ;

SAVE      ; Save Unresolved Narrative

 +1       ; Quit saving Unresolved Narratives pch 80

 +2        GOTO SAVEQ

 +3        if '$LENGTH($GET(^TMP("LEXSCH",$JOB,"NAR",0)))

               GOTO SAVEQ

 +4        NEW Y,DIC,DO,D0,DA,ZTQUEUED,ZTREQ,ZTSAVE,ZTSK,ZTDESC,ZTDTH,ZTIO,ZTRTN,%

 +5        NEW LEXUNR

           SET LEXUNR=$$UNR($GET(^TMP("LEXSCH",$JOB,"NAR",0)))

           if LEXUNR>0

               GOTO SAVEQ

 +6        SET ZTSAVE("^TMP(""LEXSCH"",$J,")=""

           SET ZTRTN="SV^LEXAR6"

           SET ZTDESC="Saving Unresolved Narrative"

           SET ZTIO=""

           SET ZTDTH=$HOROLOG

 +7        DO ^%ZTLOAD

           DO HOME^%ZIS

           KILL ZTSAVE,ZTSK,ZTDESC,ZTDTH,ZTIO,ZTRTN

 +8        if +($GET(^TMP("LEXSCH",$JOB,"NUM",0)))>0

               DO SET^LEXAR4(1)

 +9        GOTO SAVEQ

COM(LEXX) ; Save a comment as a Unresolved Narative

 +1        if +($GET(LEX))'=0

               DO KSCH^LEXAR

           if +($GET(LEX))=0

               KILL LEX

           NEW Y,DIC,DO,D0,DA,LEXCMT,LEXOK,LEXDUP,%,%X,%Y

           SET LEXCMT=$GET(LEXX)

 +2       ; Internal Entry Number

 +3        SET ^TMP("LEXSCH",$JOB,"IEN",0)=+($PIECE(LEXX,"^",1))

           if +($GET(^TMP("LEXSCH",$JOB,"IEN",0)))=0

               GOTO COMQ

           if '$DATA(^LEX(757.01,+($GET(^TMP("LEXSCH",$JOB,"IEN",0))),0))

               GOTO COMQ

 +4       ; Expression

 +5        SET ^TMP("LEXSCH",$JOB,"EXP",0)=$GET(^LEX(757.01,+($GET(^TMP("LEXSCH",$JOB,"IEN",0))),0))

           if '$LENGTH(^TMP("LEXSCH",$JOB,"EXP",0))

               GOTO COMQ

 +6       ; Duplicate Comment

 +7        SET LEXDUP=$$DUP($$UP^XLFSTR($GET(^TMP("LEXSCH",$JOB,"EXP",0))))

           SET LEXOK=$$OK(LEXCMT)

           if 'LEXOK

               GOTO COMQ

 +8       ; Comment

 +9        SET ^TMP("LEXSCH",$JOB,"COM",0)=$PIECE(LEXX,"^",2)

           if '$LENGTH(^TMP("LEXSCH",$JOB,"COM",0))

               GOTO COMQ

 +10       KILL LEXCMT,LEXDUP,LEXOK

           SET ZTSAVE("^TMP(""LEXSCH"",$J,")=""

           SET ZTRTN="SV^LEXAR6"

           SET ZTDESC="Saving Unresolved Narrative Comment"

           SET ZTIO=""

           SET ZTDTH=$HOROLOG

           DO ^%ZTLOAD

           DO HOME^%ZIS

COMQ      ; End of Comment

 +1        KILL Y,ZTSAVE,ZTSK,ZTDESC,ZTDTH,ZTIO,ZTRTN

 +2       ;

SAVEQ     ; End of Save

 +1       ;

 +2       ; End Dialog with the Application (Unresolved Narrative)

 +3       ;    Kill LEX, ^TMP("LEXFND",$J), ^TMP("LEXHIT",$J), ^TMP("LEXSCH",$J)

 +4        IF +($GET(LEX))'=0

               DO EDA^LEXAR

 +5       ;

 +6       ; End Dialog with the User

 +7       ;    Set LEX("NAR"), LEX("EXM") and LEX=0

 +8       ;    Kill ^TMP("LEXFND",$J), ^TMP("LEXHIT",$J)

 +9       ;    Kill LEX("LIST"),LEX("MAT"),LEX("MIN"),LEX("MAX")

 +10       IF +($GET(LEX))=0

               DO EDU^LEXAR

 +11      ;

 +12      ; End Dialog with the Application (Comment)

 +13       IF $DATA(^TMP("LEXSCH",$JOB,"COM"))

               KILL ^TMP("LEXSCH",$JOB,"COM"),^TMP("LEXSCH",$JOB,"EXP"),^TMP("LEXSCH",$JOB,"IEN")

               if +($GET(LEX))=0

                   KILL LEX

 +14       QUIT 

SV        ; Save an unresolved narrative (tasked) in file 757.06

 +1       ; Quit saving Unresolved Narratives pch 80

 +2        QUIT 

 +3        NEW X,Y,DA,DD,DO,D0,DIC,DLAYGO,DI,DIE,DIK,DQ,DR,LEXADD,LEXNAR,LEXDTG,LEXSCH,LEXNUM,LEXAPP,LEXCOM,LEXIEN,LEXSVC,LEXLOC,LEXFLN,LEXIDX,LEXSCT,LEXFIL

 +4        SET LEXDTG=$$DTG

           SET LEXADD=0

 +5        IF '$DATA(^TMP("LEXSCH",$JOB,"COM",0))

               Begin DoDot:1

 +6                SET LEXNAR=$$NAR

                   SET LEXSCH=$$SCH

                   SET LEXNUM=$$NUM

                   SET LEXAPP=$$APP

                   SET LEXSVC=$$SVC

 +7                SET LEXLOC=$$LOC

                   SET LEXFLN=$$FLN

                   SET LEXIDX=$$IDX

                   SET LEXSCT=$$SCT

                   SET LEXFIL=$$FIL

 +8                SET (DR,DIC("DR"))=".01////^S X=LEXNAR;1////^S X=LEXDTG;2////^S X=LEXSCH;3////^S X=LEXNUM;4////^S X=LEXAPP;5////^S X=LEXSVC;6////^S X=LEXLOC;7////^S X=LEXFLN;8////^S X=LEXIDX;9////^S X=LEXSCT;10////^S X=LEXFIL"

               End DoDot:1

 +9        IF $DATA(^TMP("LEXSCH",$JOB,"COM",0))

               Begin DoDot:1

 +10               SET (X,LEXNAR)=$$EXP

                   SET LEXIEN=$$IEN

                   SET LEXCOM=$$CMT

                   if '$LENGTH(LEXCOM)!(+LEXIEN=0)

                       SET LEXNAR=""

 +11               SET (DR,DIC("DR"))=".01///^S X=LEXNAR;1///^S X=LEXDTG;11////^S X=LEXIEN;12///^S X=LEXCOM"

               End DoDot:1

 +12       IF $LENGTH($GET(LEXNAR))

               Begin DoDot:1

 +13               NEW X,DIC

                   KILL DD,DO

                   SET DIC="^LEX(757.06,"

                   SET DIC(0)="L"

                   SET DLAYGO=757.06

                   SET X=LEXNAR

 +14               DO FILE^DICN

                   SET LEXADD=+($PIECE($GET(Y),"^",3))

                   if LEXADD

                       DO ED

                       DO SF

                   if 'LEXADD

                       DO KF

                   KILL DLAYGO

               End DoDot:1

 +15       if $DATA(ZTQUEUED)

               SET ZTREQ="@"

           if +($GET(LEX))'=0

               KILL ^TMP("LEXSCH",$JOB)

           if 'LEXADD

               GOTO SVQ

 +16       if +($$TOT)>49

               DO SEND^LEXAR7

SVQ       ; End of Narrative Save

 +1        QUIT 

ED        ; Edit fields  PCH 11

 +1        SET DR=$GET(DR)

           SET DIE="^LEX(757.06,"

           SET DA=+($GET(Y))

           if +DA'>0

               QUIT 

           if '$LENGTH(DR)

               QUIT 

           DO ^DIE

 +2        QUIT 

DTG(LEXX) ; FM Day-Time-Group

 +1        NEW %,%H,%I

           DO NOW^%DTC

           SET LEXX=%

           QUIT LEXX

NAR(LEXX) ; Narrative (provided by user)

 +1        SET LEXX=$TRANSLATE($$UP^XLFSTR($EXTRACT($GET(^TMP("LEXSCH",$JOB,"NAR",0)),1,99)),";"," ")

           if $LENGTH(LEXX)'>0

               SET LEXX="UNKNOWN"

           QUIT LEXX

EXP(LEXX) ; Narrative (provided by user)

 +1        SET LEXX=$TRANSLATE($$UP^XLFSTR($EXTRACT($GET(^TMP("LEXSCH",$JOB,"EXP",0)),1,99)),";"," ")

           if $LENGTH(LEXX)'>0

               SET LEXX="UNKNOWN"

           QUIT LEXX

SCH(LEXX) ; String searched for (provided by LEX)

 +1        SET LEXX=$$UP^XLFSTR($EXTRACT($GET(^TMP("LEXSCH",$JOB,"SCH",0)),1,100))

           if '$LENGTH(LEXX)

               SET LEXX="UNKNOWN"

           QUIT LEXX

NUM(LEXX) ; Number of terms found in search

 +1        QUIT +($GET(^TMP("LEXSCH",$JOB,"NUM",0)))

APP(LEXX) ; Application conducting the search

 +1        SET LEXX=$$UP^XLFSTR($EXTRACT($GET(^TMP("LEXSCH",$JOB,"APP",1)),1,63))

           if '$LENGTH(LEXX)

               SET LEXX="UNKNOWN"

           QUIT LEXX

IEN(LEXX) ; Internal Entry Number of term found (Comments only)

 +1        QUIT +($GET(^TMP("LEXSCH",$JOB,"IEN",0)))

SVC(LEXX) ; User's Service

 +1        SET LEXX=$$UP^XLFSTR($EXTRACT($GET(^TMP("LEXSCH",$JOB,"SVC",0)),1,63))

           if '$LENGTH(LEXX)

               SET LEXX="UNKNOWN"

           QUIT LEXX

LOC(LEXX) ; User's Hospital Location

 +1        SET LEXX=$$UP^XLFSTR($EXTRACT($GET(^TMP("LEXSCH",$JOB,"LOC",0)),1,63))

           if '$LENGTH(LEXX)

               SET LEXX="UNKNOWN"

           QUIT LEXX

FLN(LEXX) ; File number where search was conducted

 +1        SET LEXX=$EXTRACT($GET(^TMP("LEXSCH",$JOB,"FLN",0)),1,7)

           if '$LENGTH(LEXX)!($EXTRACT(LEXX,1,3)'="757")

               SET LEXX="UNKNOWN"

           QUIT LEXX

IDX(LEXX) ; Index used during the search

 +1        SET LEXX=$EXTRACT($$UP^XLFSTR($GET(^TMP("LEXSCH",$JOB,"IDX",0))),1,8)

           if '$LENGTH(LEXX)

               SET LEXX="UNKNONWN"

           QUIT LEXX

SCT(LEXX) ; Shortcuts used during the search

 +1        SET LEXX=$$UP^XLFSTR($EXTRACT($GET(^TMP("LEXSCH",$JOB,"SCT",1)),1,63))

           if '$LENGTH(LEXX)

               SET LEXX="NONE"

           QUIT LEXX

FIL(LEXX) ; Filter used during the search - DIC("S")

 +1        NEW X

           SET X=$GET(^TMP("LEXSCH",$JOB,"FIL",0))

           DO ^DIM

           if $LENGTH($GET(X))>244

               SET X=""

           SET LEXX=$GET(X)

           QUIT LEXX

CMT(LEXX) ; Comment

 +1        SET LEXX=$$UP^XLFSTR($EXTRACT($GET(^TMP("LEXSCH",$JOB,"COM",0)),1,199))

           QUIT LEXX

TOT(LEXX) ; Total # of narratives to send

 +1        NEW DA

           SET (DA,LEXX)=0

           DO SF

           DO KF

           FOR 

               SET DA=$ORDER(^LEX(757.06,DA))

               if +DA=0

                   QUIT 

               if '$DATA(^LEX(757.06,DA,0))

                   KILL ^LEX(757.06,DA,99)

               if +($GET(^LEX(757.06,DA,99)))>0

                   SET LEXX=LEXX+1

 +2        QUIT LEXX

SF        ; Set Send flag

 +1        NEW DA

           SET DA=0

           FOR 

               SET DA=$ORDER(^LEX(757.06,DA))

               if +DA=0

                   QUIT 

               if $DATA(^LEX(757.06,DA,0))

                   SET ^LEX(757.06,DA,99)=1

 +2        QUIT 

KF        ; Kill Send flag

 +1        NEW DA

           SET DA=0

           FOR 

               SET DA=$ORDER(^LEX(757.06,DA))

               if +DA=0

                   QUIT 

               if '$DATA(^LEX(757.06,DA,0))

                   KILL ^LEX(757.06,DA,99)

 +2        QUIT 

UNR(LEXX) ; Is the narrative in file 757.06

 +1        SET LEXX=$GET(LEXX)

           if LEXX=""

               QUIT 0

 +2        NEW LEXIN,DA

           SET LEXIN=0

           SET DA=0

           FOR 

               SET DA=$ORDER(^LEX(757.06,"B",$EXTRACT(LEXX,1,30),DA))

               if +DA=0

                   QUIT 

               if $PIECE($GET(^LEX(757.06,+DA,0)),"^",1)=LEXX

                   SET LEXIN=1

 +3        SET LEXX=LEXIN

           QUIT LEXX

DUP(LEXX) ; Is the comment narrative a duplicate 

 +1        SET LEXX=$GET(LEXX)

           if LEXX=""

               QUIT 0

 +2        NEW LEXIN,DA

           SET LEXIN=0

           SET DA=0

 +3        FOR 

               SET DA=$ORDER(^LEX(757.06,"B",$EXTRACT(LEXX,1,30),DA))

               if +DA=0

                   QUIT 

               Begin DoDot:1

 +4                if $EXTRACT($PIECE($GET(^LEX(757.06,+DA,0)),"^",1),1,$LENGTH(LEXX))=LEXX

                       SET LEXIN=LEXIN+1

               End DoDot:1

 +5        SET LEXX=LEXIN

           QUIT LEXX

OK(LEXX)  ; Ok to process

 +1        SET LEXX=$GET(LEXX)

           NEW LEXI,LEXN,LEXC,LEXOK

           SET LEXOK=1

           SET LEXC=$EXTRACT($$UP^XLFSTR($GET(^TMP("LEXSCH",$JOB,"EXP",0))),1,30)

 +2        SET LEXN=$EXTRACT(LEXC,1,($LENGTH(LEXC)-1))_$CHAR($ASCII($EXTRACT(LEXC,$LENGTH(LEXC)))-1)_"~"

 +3        FOR 

               SET LEXN=$ORDER(^LEX(757.06,"B",LEXN))

               if LEXN=""!($EXTRACT(LEXN,1,$LENGTH(LEXC))'=LEXC)

                   QUIT 

               Begin DoDot:1

 +4                SET LEXI=0

                   FOR 

                       SET LEXI=$ORDER(^LEX(757.06,"B",LEXN,LEXI))

                       if +LEXI=0

                           QUIT 

                       Begin DoDot:2

 +5                        if $GET(^LEX(757.06,LEXI,4))=LEXX

                               SET LEXOK=0

                       End DoDot:2

               End DoDot:1

 +6        SET LEXX=LEXOK

           QUIT LEXX