source: WorldVistAEHR/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIULA1.m@ 1000

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

initial load of WorldVistAEHR

File size: 5.3 KB
Line 
1TIULA1 ; SLC/JER - More interactive functions ;4/18/03
2 ;;1.0;TEXT INTEGRATION UTILITIES;**75,113,207**;Jun 20, 1997
3TRAVERSE(DA,RETURN,PARM,TYPE) ; Select Document Type(s)
4 N C,I,XQORM,Y N:'$D(LEVEL) LEVEL S LEVEL=+$G(LEVEL)+1
5 S:$G(TYPE)']"" TYPE="D"
6 S XQORM=DA_";TIU(8925.1,",XQORM(0)=$S($L($G(PARM)):PARM,1:"AD")
7 I XQORM(0)["D" S XQORM("H")="W !!,$$CENTER^TIULS(""--- ""_$P(^TIU(8925.1,+DA,0),U,3)_"" ---""),!"
8 S XQORM("B")=$G(^DISV(DUZ,"XQORM",DA_";TIU(8925.1,",1))
9 S XQORM("A")="Select "_$S(XQORM(0)["D":"Document",1:$P(^TIU(8925.1,+DA,0),U,3))_$S("CD"[$P(^TIU(8925.1,+DA,0),U,4):" Component",1:" Type")_$S(+XQORM(0)'=1:"(s)",1:"")_": "
10 D EN^XQORM
11 M RETURN(LEVEL)=Y
12 S I=0 F S I=$O(Y(I)) Q:+I'>0 D
13 . S J=+$P(Y(I),U,2)
14 . I $P(^TIU(8925.1,+J,0),U,4)'=TYPE,$D(^TIU(8925.1,+J,10))'<10 D TRAVERSE(+J,.RETURN,$G(PARM))
15 Q
16ASKSIG() ; Prompt for ES, return encrypted data
17 N ESNAME,ESTITLE,Y S Y=0
18 D SIG^XUSESIG I X1']"" S:'$D(X) X=0 D BADSIG^TIULG(X) G ASKX
19 S ESNAME=$P($G(^VA(200,DUZ,20)),U,2),ESTITLE=$P($G(^(20)),U,3)
20 S Y=1_U_ESNAME_U_ESTITLE
21ASKX Q Y
22ASKSUBJ() ; Handle query by subject
23 N Y
24 S Y=$$READ^TIUU("FO","Where SUBJECT CONTAINS")
25 Q $$UPPER^TIULS(Y)
26ASKLOC() ; Handle query by location
27 N Y
28 S Y=$$READ^TIUU("P^44:AEMQ","Select HOSPITAL LOCATION")
29 Q Y
30TYPMATCH(TYPE,CURTYP) ; Check for type match
31 N TIUI,TIUY S TIUY=0
32 I $L(TYPE,"!")=1,TYPE=CURTYP S TIUY=1
33 E F TIUI=1:1:$L(TYPE,"!") I $P(TYPE,"!",TIUI)=CURTYP S TIUY=1 Q
34 Q TIUY
35DOCLIST(CLASS,Y,PARM,DFLT) ; Get preferred documents for user
36 N TIUDA,XQORM,X
37 S TIUDA=+$O(^TIU(8925.98,"AC",DUZ,CLASS,0)),XQORM=TIUDA_";TIU(8925.98,"
38 I +TIUDA'>0!(+$O(^XUTL("XQORM",XQORM,0))'>0) S Y=-1 Q
39 I $G(DFLT)="LAST" D
40 . S DFLT=$O(^DISV(DUZ,"XQORM",XQORM,0))
41 . S DFLT=$S(+DFLT:$G(^DISV(DUZ,"XQORM",XQORM,DFLT)),1:"")
42 S XQORM(0)=$S(+$P($G(^TIU(8925.98,+TIUDA,10,0)),U,3)=1:"F",1:PARM)
43 S XQORM("B")=$S(+$P($G(^TIU(8925.98,+TIUDA,10,0)),U,3)=1:$P($G(^(0)),U,3),1:DFLT)
44 I XQORM(0)'["A" S X=XQORM("B")
45 S XQORM("A")=$S(CLASS=3:"",1:"Select ")_$S(CLASS=3:"TITLE",1:"Document")_$S(+XQORM(0)'=1:"(s)",1:"")_": "
46 I XQORM(0)["D" D
47 . N LISTNAME,PERSNAME S LISTNAME=$$PNAME^TIULC1(CLASS)
48 . I $E(LISTNAME,$L(LISTNAME))="Y" D
49 . . S LISTNAME=$E(LISTNAME,1,($L(LISTNAME)-1))_"IES"
50 . I $E(LISTNAME,$L(LISTNAME))="y" D
51 . . S LISTNAME=$E(LISTNAME,1,($L(LISTNAME)-1))_"ies"
52 . S PERSNAME=$$PERSNAME^TIULC1(DUZ)
53 . S LISTNAME=""""_"--- "_LISTNAME_" for "_PERSNAME_" ---"_""""
54 . S XQORM("H")="W !!,$$CENTER^TIULS("_LISTNAME_"),!"
55 S XQORM("S")="I $$CANPICK^TIULP(+$G(^TIU(8925.98,+DA(1),10,+DA,0)))"
56 D EN^XQORM
57 Q
58SELCAT(Y,PARM,DFLT,TIUOVER) ; Get preferred documents for user
59 N TIUI,TIUDA,CATREC,CATLOOK,CATSCRN,CATVAL,XQORM,X ;P75 newed CATVAL
60 N TIUT1,TIUT2,TIUTSTR,TIUHOLD
61 S TIUI=0
62 S XQORM="1;TIU(8925.8,"
63 I $G(DFLT)="LAST" D
64 . S DFLT=$O(^DISV(DUZ,"XQORM",XQORM,0))
65 . S DFLT=$S(+DFLT:$G(^DISV(DUZ,"XQORM",XQORM,DFLT)),1:"")
66 S XQORM(0)=$G(PARM,"1A")
67 S XQORM("B")=$G(DFLT,"AUTHOR")
68 I +$G(ORVP) S XQORM("S")="I $G(^XUTL(""XQORM"",XQORM,+$O(^XUTL(""XQORM"",XQORM,""B"",DA,0)),0))'[""Patient"""
69 I XQORM(0)'["A" S X=XQORM("B")
70 S XQORM("A")="Select SEARCH CATEGOR"_$S(+XQORM(0)'=1:"IES",1:"Y")_": "
71 I XQORM(0)["D" S XQORM("H")="W !!,$$CENTER^TIULS(""--- Search Categories ---""),!"
72 D EN^XQORM
73 ; BEGIN TIU207
74 ; FLAG IF TITLE OR ALL CATEGORIES WERE SELECTED. NEEDED IN HDR^TIURH AS ^TMP("TIUR","TIU OVERRIDE")
75 S TIUT1="",TIUTSTR=""
76 F S TIUT1=$O(Y(TIUT1)) Q:TIUT1="" D
77 .I $P(Y(TIUT1),"^",3)="Title" S TIUTSTR=TIUTSTR_"TITLE"
78 .I $P(Y(TIUT1),"^",3)="All Categories" S TIUTSTR=TIUTSTR_"ALL"
79 I TIUTSTR["TITLE" S TIUOVER=TIUTSTR
80 ; IF SPECIFIC CATEGORY AND ALL CATEGORIES WHERE SELECTED THEN REMOVE ALL CATEGORIES.
81 I $O(Y(""),-1)>1,TIUTSTR["ALL" D
82 .M TIUHOLD=Y K Y
83 .S TIUT1="",TIUT2=1
84 .F S TIUT1=$O(TIUHOLD(TIUT1)) Q:TIUT1="" D
85 ..I $P(TIUHOLD(TIUT1),"^",3)="All Categories" Q
86 ..S Y(TIUT2)=TIUHOLD(TIUT1)
87 ..S Y=TIUT2
88 ..S TIUT2=TIUT2+1
89 ; END TIU207
90 F S TIUI=$O(Y(TIUI)) Q:+TIUI'>0 D
91 . S TIUDA=+$P(Y(TIUI),U,2)
92 . S CATREC=$G(^TIU(8925.8,TIUDA,0))
93 . S CATSCRN=$G(^TIU(8925.8,TIUDA,1))
94 . S CATLOOK=$G(^TIU(8925.8,TIUDA,2))
95 . S CATVAL=-1 ;P75
96 . I CATLOOK']"",+$P(CATREC,U,4) S CATVAL=$$DICLOOK(CATREC,CATSCRN)
97 . I CATLOOK]"" S CATVAL=$$LOOK(CATLOOK)
98 . I +CATVAL'=-1,$L(CATVAL) S Y(TIUI)=$P(CATREC,U,2)_U_CATVAL
99 . E K Y(TIUI) S Y=+$G(Y)-1
100 Q
101DICLOOK(CATEGORY,SCREEN) ; Call ^DIC to get category value
102 N DIC,X,Y
103 S DIC=+$P(CATEGORY,U,4),DIC(0)="AEMQZ"
104 S DIC("A")="Select "_$P(CATEGORY,U)_": "
105 I SCREEN]"" X SCREEN
106 D ^DIC I +$G(DUOUT),(X="^^") S DIROUT=1
107 Q Y
108LOOK(LOOKUP) ; Execute LOOKUP CODE
109 N X,Y
110 X LOOKUP
111 Q Y
112GETVSIT(DFN) ; Visit selection code
113 N X,Y
114 I +$G(ORVP),'+$G(DFN) S DFN=+$G(ORVP)
115 D MAIN^TIUVISIT(.Y,$G(DFN))
116 S Y=$G(Y("VISIT"))
117 I +Y,+$P(Y,U,2) S $P(Y,U,2)=$$DATE^TIULS($P(Y,U,2),"MM/DD/YY HR:MIN")
118 Q Y
119GETTERM(X) ; Get Lexicon term
120 N DIC,USEX,Y
121 S DIC=757.01,DIC(0)="AEMQZ",DIC("A")="Select PROBLEM: "
122 D ^DIC
123 I +Y'>0,(X]""),(X'=" "),(X'["^") D
124 . S USEX=$$READ^TIUU("Y",">>> Use "_X,"Yes")
125 . I +USEX S Y=1_U_X
126 Q Y
127GETDIV() ; Get Institution Number and Name
128 N TIUDIV,TIUSTN,Y
129 S TIUDIV=$S($P($G(^DG(43,1,"GL")),U,2):$$MULTDIV,1:$$PRIM^VASITE)
130 S TIUSTN=$$SITE^VASITE(,TIUDIV)
131 I $P(TIUSTN,U)>0,($P(TIUSTN,U,2)]"") D
132 . S Y=$P(TIUSTN,U)_U_$P(TIUSTN,U,2)
133 E D
134 . S Y=-1
135 Q Y
136MULTDIV() ; User selects from active divisions
137 N DIR,X,Y
138 S DIR(0)="PA^40.8:EM"
139 S DIR("A")="Select DIVISION: "
140 S DIR("S")="I $$SITE^VASITE(,+Y)>0"
141 D ^DIR
142 Q +Y
Note: See TracBrowser for help on using the repository browser.