121 lines
6.4 KiB
Mathematica
121 lines
6.4 KiB
Mathematica
LEXAR6 ; ISL Look-up Response (Unresolved Narr) ; 05/25/1998
|
|
;;2.0;LEXICON UTILITY;**3,9,11**;Sep 23, 1996;Build 1
|
|
;
|
|
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
|
|
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
|
|
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
|