source: FOIAVistA/trunk/r/LEXICON_UTILITY-LEX-GMPT/LEXAR6.m@ 1123

Last change on this file since 1123 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 6.4 KB
Line 
1LEXAR6 ; ISL Look-up Response (Unresolved Narr) ; 05/25/1998
2 ;;2.0;LEXICON UTILITY;**3,9,11**;Sep 23, 1996
3 ;
4 Q
5 ; This routines saves Unresolved Narratives (terms not found
6 ; in the Lexicon) in file 757.06. It also saves comments about
7 ; a term. Both the Unresolved Narratives and comments are used
8 ; as a tool to update the Lexicon Utility.
9 ;
10SAVE ; Save Unresolved Narrative
11 G:'$L($G(^TMP("LEXSCH",$J,"NAR",0))) SAVEQ
12 N Y,DIC,DO,D0,DA,ZTQUEUED,ZTREQ,ZTSAVE,ZTSK,ZTDESC,ZTDTH,ZTIO,ZTRTN,%
13 N LEXUNR S LEXUNR=$$UNR($G(^TMP("LEXSCH",$J,"NAR",0))) G:LEXUNR>0 SAVEQ
14 S ZTSAVE("^TMP(""LEXSCH"",$J,")="",ZTRTN="SV^LEXAR6",ZTDESC="Saving Unresolved Narrative",ZTIO="",ZTDTH=$H
15 D ^%ZTLOAD,HOME^%ZIS K ZTSAVE,ZTSK,ZTDESC,ZTDTH,ZTIO,ZTRTN
16 D:+($G(^TMP("LEXSCH",$J,"NUM",0)))>0 SET^LEXAR4(1)
17 G SAVEQ
18COM(LEXX) ; Save a comment as a Unresolved Narative
19 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)
20 ; Internal Entry Number
21 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
22 ; Expression
23 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
24 ; Duplicate Comment
25 S LEXDUP=$$DUP($$UP^XLFSTR($G(^TMP("LEXSCH",$J,"EXP",0)))),LEXOK=$$OK(LEXCMT) G:'LEXOK COMQ
26 ; Comment
27 S ^TMP("LEXSCH",$J,"COM",0)=$P(LEXX,"^",2) G:'$L(^TMP("LEXSCH",$J,"COM",0)) COMQ
28 K LEXCMT,LEXDUP,LEXOK S ZTSAVE("^TMP(""LEXSCH"",$J,")="",ZTRTN="SV^LEXAR6",ZTDESC="Saving Unresolved Narrative Comment",ZTIO="",ZTDTH=$H D ^%ZTLOAD,HOME^%ZIS
29COMQ ; End of Comment
30 K Y,ZTSAVE,ZTSK,ZTDESC,ZTDTH,ZTIO,ZTRTN
31 ;
32SAVEQ ; End of Save
33 ;
34 ; End Dialog with the Application (Unresolved Narrative)
35 ; Kill LEX, ^TMP("LEXFND",$J), ^TMP("LEXHIT",$J), ^TMP("LEXSCH",$J)
36 I +($G(LEX))'=0 D EDA^LEXAR
37 ;
38 ; End Dialog with the User
39 ; Set LEX("NAR"), LEX("EXM") and LEX=0
40 ; Kill ^TMP("LEXFND",$J), ^TMP("LEXHIT",$J)
41 ; Kill LEX("LIST"),LEX("MAT"),LEX("MIN"),LEX("MAX")
42 I +($G(LEX))=0 D EDU^LEXAR
43 ;
44 ; End Dialog with the Application (Comment)
45 I $D(^TMP("LEXSCH",$J,"COM")) K ^TMP("LEXSCH",$J,"COM"),^TMP("LEXSCH",$J,"EXP"),^TMP("LEXSCH",$J,"IEN") K:+($G(LEX))=0 LEX
46 Q
47SV ; Save an unresolved narrative (tasked) in file 757.06
48 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
49 S LEXDTG=$$DTG,LEXADD=0
50 I '$D(^TMP("LEXSCH",$J,"COM",0)) D
51 . S LEXNAR=$$NAR,LEXSCH=$$SCH,LEXNUM=$$NUM,LEXAPP=$$APP,LEXSVC=$$SVC
52 . S LEXLOC=$$LOC,LEXFLN=$$FLN,LEXIDX=$$IDX,LEXSCT=$$SCT,LEXFIL=$$FIL
53 . 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"
54 I $D(^TMP("LEXSCH",$J,"COM",0)) D
55 . S (X,LEXNAR)=$$EXP,LEXIEN=$$IEN,LEXCOM=$$CMT S:'$L(LEXCOM)!(+LEXIEN=0) LEXNAR=""
56 . S (DR,DIC("DR"))=".01///^S X=LEXNAR;1///^S X=LEXDTG;11////^S X=LEXIEN;12///^S X=LEXCOM"
57 I $L($G(LEXNAR)) D
58 . N X,DIC K DD,DO S DIC="^LEX(757.06,",DIC(0)="L",DLAYGO=757.06,X=LEXNAR
59 . D FILE^DICN S LEXADD=+($P($G(Y),"^",3)) D:LEXADD ED,SF D:'LEXADD KF K DLAYGO
60 S:$D(ZTQUEUED) ZTREQ="@" K:+($G(LEX))'=0 ^TMP("LEXSCH",$J) G:'LEXADD SVQ
61 D:+($$TOT)>49 SEND^LEXAR7
62SVQ ; End of Narrative Save
63 Q
64ED ; Edit fields PCH 11
65 S DR=$G(DR),DIE="^LEX(757.06,",DA=+($G(Y)) Q:+DA'>0 Q:'$L(DR) D ^DIE
66 Q
67DTG(LEXX) ; FM Day-Time-Group
68 N %,%H,%I D NOW^%DTC S LEXX=% Q LEXX
69NAR(LEXX) ; Narrative (provided by user)
70 S LEXX=$TR($$UP^XLFSTR($E($G(^TMP("LEXSCH",$J,"NAR",0)),1,99)),";"," ") S:$L(LEXX)'>0 LEXX="UNKNOWN" Q LEXX
71EXP(LEXX) ; Narrative (provided by user)
72 S LEXX=$TR($$UP^XLFSTR($E($G(^TMP("LEXSCH",$J,"EXP",0)),1,99)),";"," ") S:$L(LEXX)'>0 LEXX="UNKNOWN" Q LEXX
73SCH(LEXX) ; String searched for (provided by LEX)
74 S LEXX=$$UP^XLFSTR($E($G(^TMP("LEXSCH",$J,"SCH",0)),1,100)) S:'$L(LEXX) LEXX="UNKNOWN" Q LEXX
75NUM(LEXX) ; Number of terms found in search
76 Q +($G(^TMP("LEXSCH",$J,"NUM",0)))
77APP(LEXX) ; Application conducting the search
78 S LEXX=$$UP^XLFSTR($E($G(^TMP("LEXSCH",$J,"APP",1)),1,63)) S:'$L(LEXX) LEXX="UNKNOWN" Q LEXX
79IEN(LEXX) ; Internal Entry Number of term found (Comments only)
80 Q +($G(^TMP("LEXSCH",$J,"IEN",0)))
81SVC(LEXX) ; User's Service
82 S LEXX=$$UP^XLFSTR($E($G(^TMP("LEXSCH",$J,"SVC",0)),1,63)) S:'$L(LEXX) LEXX="UNKNOWN" Q LEXX
83LOC(LEXX) ; User's Hospital Location
84 S LEXX=$$UP^XLFSTR($E($G(^TMP("LEXSCH",$J,"LOC",0)),1,63)) S:'$L(LEXX) LEXX="UNKNOWN" Q LEXX
85FLN(LEXX) ; File number where search was conducted
86 S LEXX=$E($G(^TMP("LEXSCH",$J,"FLN",0)),1,7) S:'$L(LEXX)!($E(LEXX,1,3)'="757") LEXX="UNKNOWN" Q LEXX
87IDX(LEXX) ; Index used during the search
88 S LEXX=$E($$UP^XLFSTR($G(^TMP("LEXSCH",$J,"IDX",0))),1,8) S:'$L(LEXX) LEXX="UNKNONWN" Q LEXX
89SCT(LEXX) ; Shortcuts used during the search
90 S LEXX=$$UP^XLFSTR($E($G(^TMP("LEXSCH",$J,"SCT",1)),1,63)) S:'$L(LEXX) LEXX="NONE" Q LEXX
91FIL(LEXX) ; Filter used during the search - DIC("S")
92 N X S X=$G(^TMP("LEXSCH",$J,"FIL",0)) D ^DIM S:$L($G(X))>244 X="" S LEXX=$G(X) Q LEXX
93CMT(LEXX) ; Comment
94 S LEXX=$$UP^XLFSTR($E($G(^TMP("LEXSCH",$J,"COM",0)),1,199)) Q LEXX
95TOT(LEXX) ; Total # of narratives to send
96 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
97 Q LEXX
98SF ; Set Send flag
99 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
100 Q
101KF ; Kill Send flag
102 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)
103 Q
104UNR(LEXX) ; Is the narrative in file 757.06
105 S LEXX=$G(LEXX) Q:LEXX="" 0
106 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
107 S LEXX=LEXIN Q LEXX
108DUP(LEXX) ; Is the comment narrative a duplicate
109 S LEXX=$G(LEXX) Q:LEXX="" 0
110 N LEXIN,DA S LEXIN=0,DA=0
111 F S DA=$O(^LEX(757.06,"B",$E(LEXX,1,30),DA)) Q:+DA=0 D
112 . S:$E($P($G(^LEX(757.06,+DA,0)),"^",1),1,$L(LEXX))=LEXX LEXIN=LEXIN+1
113 S LEXX=LEXIN Q LEXX
114OK(LEXX) ; Ok to process
115 S LEXX=$G(LEXX) N LEXI,LEXN,LEXC,LEXOK S LEXOK=1,LEXC=$E($$UP^XLFSTR($G(^TMP("LEXSCH",$J,"EXP",0))),1,30)
116 S LEXN=$E(LEXC,1,($L(LEXC)-1))_$C($A($E(LEXC,$L(LEXC)))-1)_"~"
117 F S LEXN=$O(^LEX(757.06,"B",LEXN)) Q:LEXN=""!($E(LEXN,1,$L(LEXC))'=LEXC) D
118 . S LEXI=0 F S LEXI=$O(^LEX(757.06,"B",LEXN,LEXI)) Q:+LEXI=0 D
119 . . S:$G(^LEX(757.06,LEXI,4))=LEXX LEXOK=0
120 S LEXX=LEXOK Q LEXX
Note: See TracBrowser for help on using the repository browser.