143 lines
5.3 KiB
Mathematica
143 lines
5.3 KiB
Mathematica
TIULA1 ; SLC/JER - More interactive functions ;4/18/03
|
|
;;1.0;TEXT INTEGRATION UTILITIES;**75,113,207**;Jun 20, 1997
|
|
TRAVERSE(DA,RETURN,PARM,TYPE) ; Select Document Type(s)
|
|
N C,I,XQORM,Y N:'$D(LEVEL) LEVEL S LEVEL=+$G(LEVEL)+1
|
|
S:$G(TYPE)']"" TYPE="D"
|
|
S XQORM=DA_";TIU(8925.1,",XQORM(0)=$S($L($G(PARM)):PARM,1:"AD")
|
|
I XQORM(0)["D" S XQORM("H")="W !!,$$CENTER^TIULS(""--- ""_$P(^TIU(8925.1,+DA,0),U,3)_"" ---""),!"
|
|
S XQORM("B")=$G(^DISV(DUZ,"XQORM",DA_";TIU(8925.1,",1))
|
|
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:"")_": "
|
|
D EN^XQORM
|
|
M RETURN(LEVEL)=Y
|
|
S I=0 F S I=$O(Y(I)) Q:+I'>0 D
|
|
. S J=+$P(Y(I),U,2)
|
|
. I $P(^TIU(8925.1,+J,0),U,4)'=TYPE,$D(^TIU(8925.1,+J,10))'<10 D TRAVERSE(+J,.RETURN,$G(PARM))
|
|
Q
|
|
ASKSIG() ; Prompt for ES, return encrypted data
|
|
N ESNAME,ESTITLE,Y S Y=0
|
|
D SIG^XUSESIG I X1']"" S:'$D(X) X=0 D BADSIG^TIULG(X) G ASKX
|
|
S ESNAME=$P($G(^VA(200,DUZ,20)),U,2),ESTITLE=$P($G(^(20)),U,3)
|
|
S Y=1_U_ESNAME_U_ESTITLE
|
|
ASKX Q Y
|
|
ASKSUBJ() ; Handle query by subject
|
|
N Y
|
|
S Y=$$READ^TIUU("FO","Where SUBJECT CONTAINS")
|
|
Q $$UPPER^TIULS(Y)
|
|
ASKLOC() ; Handle query by location
|
|
N Y
|
|
S Y=$$READ^TIUU("P^44:AEMQ","Select HOSPITAL LOCATION")
|
|
Q Y
|
|
TYPMATCH(TYPE,CURTYP) ; Check for type match
|
|
N TIUI,TIUY S TIUY=0
|
|
I $L(TYPE,"!")=1,TYPE=CURTYP S TIUY=1
|
|
E F TIUI=1:1:$L(TYPE,"!") I $P(TYPE,"!",TIUI)=CURTYP S TIUY=1 Q
|
|
Q TIUY
|
|
DOCLIST(CLASS,Y,PARM,DFLT) ; Get preferred documents for user
|
|
N TIUDA,XQORM,X
|
|
S TIUDA=+$O(^TIU(8925.98,"AC",DUZ,CLASS,0)),XQORM=TIUDA_";TIU(8925.98,"
|
|
I +TIUDA'>0!(+$O(^XUTL("XQORM",XQORM,0))'>0) S Y=-1 Q
|
|
I $G(DFLT)="LAST" D
|
|
. S DFLT=$O(^DISV(DUZ,"XQORM",XQORM,0))
|
|
. S DFLT=$S(+DFLT:$G(^DISV(DUZ,"XQORM",XQORM,DFLT)),1:"")
|
|
S XQORM(0)=$S(+$P($G(^TIU(8925.98,+TIUDA,10,0)),U,3)=1:"F",1:PARM)
|
|
S XQORM("B")=$S(+$P($G(^TIU(8925.98,+TIUDA,10,0)),U,3)=1:$P($G(^(0)),U,3),1:DFLT)
|
|
I XQORM(0)'["A" S X=XQORM("B")
|
|
S XQORM("A")=$S(CLASS=3:"",1:"Select ")_$S(CLASS=3:"TITLE",1:"Document")_$S(+XQORM(0)'=1:"(s)",1:"")_": "
|
|
I XQORM(0)["D" D
|
|
. N LISTNAME,PERSNAME S LISTNAME=$$PNAME^TIULC1(CLASS)
|
|
. I $E(LISTNAME,$L(LISTNAME))="Y" D
|
|
. . S LISTNAME=$E(LISTNAME,1,($L(LISTNAME)-1))_"IES"
|
|
. I $E(LISTNAME,$L(LISTNAME))="y" D
|
|
. . S LISTNAME=$E(LISTNAME,1,($L(LISTNAME)-1))_"ies"
|
|
. S PERSNAME=$$PERSNAME^TIULC1(DUZ)
|
|
. S LISTNAME=""""_"--- "_LISTNAME_" for "_PERSNAME_" ---"_""""
|
|
. S XQORM("H")="W !!,$$CENTER^TIULS("_LISTNAME_"),!"
|
|
S XQORM("S")="I $$CANPICK^TIULP(+$G(^TIU(8925.98,+DA(1),10,+DA,0)))"
|
|
D EN^XQORM
|
|
Q
|
|
SELCAT(Y,PARM,DFLT,TIUOVER) ; Get preferred documents for user
|
|
N TIUI,TIUDA,CATREC,CATLOOK,CATSCRN,CATVAL,XQORM,X ;P75 newed CATVAL
|
|
N TIUT1,TIUT2,TIUTSTR,TIUHOLD
|
|
S TIUI=0
|
|
S XQORM="1;TIU(8925.8,"
|
|
I $G(DFLT)="LAST" D
|
|
. S DFLT=$O(^DISV(DUZ,"XQORM",XQORM,0))
|
|
. S DFLT=$S(+DFLT:$G(^DISV(DUZ,"XQORM",XQORM,DFLT)),1:"")
|
|
S XQORM(0)=$G(PARM,"1A")
|
|
S XQORM("B")=$G(DFLT,"AUTHOR")
|
|
I +$G(ORVP) S XQORM("S")="I $G(^XUTL(""XQORM"",XQORM,+$O(^XUTL(""XQORM"",XQORM,""B"",DA,0)),0))'[""Patient"""
|
|
I XQORM(0)'["A" S X=XQORM("B")
|
|
S XQORM("A")="Select SEARCH CATEGOR"_$S(+XQORM(0)'=1:"IES",1:"Y")_": "
|
|
I XQORM(0)["D" S XQORM("H")="W !!,$$CENTER^TIULS(""--- Search Categories ---""),!"
|
|
D EN^XQORM
|
|
; BEGIN TIU207
|
|
; FLAG IF TITLE OR ALL CATEGORIES WERE SELECTED. NEEDED IN HDR^TIURH AS ^TMP("TIUR","TIU OVERRIDE")
|
|
S TIUT1="",TIUTSTR=""
|
|
F S TIUT1=$O(Y(TIUT1)) Q:TIUT1="" D
|
|
.I $P(Y(TIUT1),"^",3)="Title" S TIUTSTR=TIUTSTR_"TITLE"
|
|
.I $P(Y(TIUT1),"^",3)="All Categories" S TIUTSTR=TIUTSTR_"ALL"
|
|
I TIUTSTR["TITLE" S TIUOVER=TIUTSTR
|
|
; IF SPECIFIC CATEGORY AND ALL CATEGORIES WHERE SELECTED THEN REMOVE ALL CATEGORIES.
|
|
I $O(Y(""),-1)>1,TIUTSTR["ALL" D
|
|
.M TIUHOLD=Y K Y
|
|
.S TIUT1="",TIUT2=1
|
|
.F S TIUT1=$O(TIUHOLD(TIUT1)) Q:TIUT1="" D
|
|
..I $P(TIUHOLD(TIUT1),"^",3)="All Categories" Q
|
|
..S Y(TIUT2)=TIUHOLD(TIUT1)
|
|
..S Y=TIUT2
|
|
..S TIUT2=TIUT2+1
|
|
; END TIU207
|
|
F S TIUI=$O(Y(TIUI)) Q:+TIUI'>0 D
|
|
. S TIUDA=+$P(Y(TIUI),U,2)
|
|
. S CATREC=$G(^TIU(8925.8,TIUDA,0))
|
|
. S CATSCRN=$G(^TIU(8925.8,TIUDA,1))
|
|
. S CATLOOK=$G(^TIU(8925.8,TIUDA,2))
|
|
. S CATVAL=-1 ;P75
|
|
. I CATLOOK']"",+$P(CATREC,U,4) S CATVAL=$$DICLOOK(CATREC,CATSCRN)
|
|
. I CATLOOK]"" S CATVAL=$$LOOK(CATLOOK)
|
|
. I +CATVAL'=-1,$L(CATVAL) S Y(TIUI)=$P(CATREC,U,2)_U_CATVAL
|
|
. E K Y(TIUI) S Y=+$G(Y)-1
|
|
Q
|
|
DICLOOK(CATEGORY,SCREEN) ; Call ^DIC to get category value
|
|
N DIC,X,Y
|
|
S DIC=+$P(CATEGORY,U,4),DIC(0)="AEMQZ"
|
|
S DIC("A")="Select "_$P(CATEGORY,U)_": "
|
|
I SCREEN]"" X SCREEN
|
|
D ^DIC I +$G(DUOUT),(X="^^") S DIROUT=1
|
|
Q Y
|
|
LOOK(LOOKUP) ; Execute LOOKUP CODE
|
|
N X,Y
|
|
X LOOKUP
|
|
Q Y
|
|
GETVSIT(DFN) ; Visit selection code
|
|
N X,Y
|
|
I +$G(ORVP),'+$G(DFN) S DFN=+$G(ORVP)
|
|
D MAIN^TIUVISIT(.Y,$G(DFN))
|
|
S Y=$G(Y("VISIT"))
|
|
I +Y,+$P(Y,U,2) S $P(Y,U,2)=$$DATE^TIULS($P(Y,U,2),"MM/DD/YY HR:MIN")
|
|
Q Y
|
|
GETTERM(X) ; Get Lexicon term
|
|
N DIC,USEX,Y
|
|
S DIC=757.01,DIC(0)="AEMQZ",DIC("A")="Select PROBLEM: "
|
|
D ^DIC
|
|
I +Y'>0,(X]""),(X'=" "),(X'["^") D
|
|
. S USEX=$$READ^TIUU("Y",">>> Use "_X,"Yes")
|
|
. I +USEX S Y=1_U_X
|
|
Q Y
|
|
GETDIV() ; Get Institution Number and Name
|
|
N TIUDIV,TIUSTN,Y
|
|
S TIUDIV=$S($P($G(^DG(43,1,"GL")),U,2):$$MULTDIV,1:$$PRIM^VASITE)
|
|
S TIUSTN=$$SITE^VASITE(,TIUDIV)
|
|
I $P(TIUSTN,U)>0,($P(TIUSTN,U,2)]"") D
|
|
. S Y=$P(TIUSTN,U)_U_$P(TIUSTN,U,2)
|
|
E D
|
|
. S Y=-1
|
|
Q Y
|
|
MULTDIV() ; User selects from active divisions
|
|
N DIR,X,Y
|
|
S DIR(0)="PA^40.8:EM"
|
|
S DIR("A")="Select DIVISION: "
|
|
S DIR("S")="I $$SITE^VASITE(,+Y)>0"
|
|
D ^DIR
|
|
Q +Y
|