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 ---[H[J[2J[HLEXAR6 7206 printed Oct 16, 2024@18:07:47 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
