source: FOIAVistA/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIULA2.m@ 1354

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

initial load of FOIAVistA 6/30/08 version
File size: 8.0 KB
Line 
1TIULA2 ; SLC/JER - More interactive functions ;10/19/06 14:32
2 ;;1.0;TEXT INTEGRATION UTILITIES;**1,50,86,93,61,100,116,143,211**;Jun 20, 1997;Build 26
3ASKTYP(TIUCLASS,DFLT,SCREEN,PROMPT,NOLOINC) ; Call ^DIC to select single type
4 N D,DIC,X,Y,TIUFPRIV,ITMCNT S TIUFPRIV=1
5 S DIC=8925.1,TIUCLASS=$G(TIUCLASS,38),ITMCNT=$$ITMCNT(TIUCLASS)
6 I +ITMCNT=1 D G ASKTYPX
7 . I $P($G(^TIU(8925.1,+TIUCLASS,0)),U,4)="CL" D Q
8 . . S TIUCLASS=+$G(^TIU(8925.1,+TIUCLASS,10,+$P(ITMCNT,U,2),0))
9 . . S Y=$$ASKTYP(+TIUCLASS,DFLT,SCREEN,$G(PROMPT))
10 . S DIC(0)="NX",X=+$G(^TIU(8925.1,+TIUCLASS,10,+$P(ITMCNT,U,2),0))
11 . D ^DIC S Y=Y_U_"SINGLE ITEM"
12 S DIC(0)="AEMQZOV"
13 S DIC("A")=$S($G(PROMPT)]"":$G(PROMPT),1:"Select TITLE: ")
14 I $G(DFLT)="LAST" S DFLT=$P($$PERSDOC^TIULE(DUZ,+$G(TIUCLASS,38)),U,2)
15 I +$G(DFLT),+$D(TIUCLASS),(+$$ISA^TIULX(+$G(DFLT),+$G(TIUCLASS))'>0) S DFLT=""
16 I $G(DFLT)]"" S DIC("B")=$G(DFLT)
17 I $G(SCREEN)]"" S DIC("S")=SCREEN
18 S D="B^C^D^E"_$S(+$G(NOLOINC):"",1:"^LOINC")
19 D MIX^DIC1 K DIC("S")
20ASKTYPX Q Y
21ITMCNT(CLASS) ; Count the number of members of a class or document class
22 N TIUI,TIUCNT,TIUY S (TIUI,TIUCNT,TIUY)=0
23 F S TIUI=$O(^TIU(8925.1,+CLASS,10,TIUI)) Q:+TIUI'>0 D
24 . I +$$CANPICK^TIULP(+$G(^TIU(8925.1,+CLASS,10,TIUI,0))) D
25 . . S TIUCNT=TIUCNT+1
26 . . S TIUY=TIUCNT_U_TIUI
27 Q TIUY
28DOCPICK(TIUCLASS,DFLT,ADDSCRN) ; Ask for document, given a class or document class
29 N SCREEN,PROMPT S PROMPT=$S(TIUCLASS=3:"TITLE: ",1:"")
30 S SCREEN="I $P(^TIU(8925.1,+Y,0),U,4)=""DOC"",+$$ISA^TIULX(+Y,TIUCLASS),+$$CANPICK^TIULP(+Y)"_$S($G(ADDSCRN)]"":",",1:"")_$G(ADDSCRN)
31 Q $$ASKTYP(+TIUCLASS,$G(DFLT),SCREEN,PROMPT)
32DOCSPICK(TIUY,TIUCLASS,PARM,DFLT,PROMPT,ADDSCRN) ; Ask for TITLE(S)
33 ; with pick-list
34 N SCREEN,Y,ATTCHID
35 S DFLT=$S($G(DFLT)=0:"",$G(DFLT)]"":$G(DFLT),1:"LAST")
36 S PARM=$S($G(PARM)]"":PARM,1:"A")
37 ; D DOCLIST^TIULA1(TIUCLASS,.TIUY,PARM,DFLT) I +TIUY>0 Q
38 ; ADD CALL TO PERSONAL DOCUMENT LISTER HERE
39 S ATTCHID=0 I $G(ADDSCRN)["CANLINK^TIULP" S ATTCHID=1
40 I PARM="1A" D TITLPICK^TIULA4(.TIUY,TIUCLASS,ATTCHID) I +$G(TIUY)>0 Q
41 S PROMPT=$S($G(PROMPT)]"":$G(PROMPT),TIUCLASS=3:"TITLE: ",1:"")
42 S SCREEN="I $P(^TIU(8925.1,+Y,0),U,4)=""DOC"",($P(^(0),U)'[""ADDENDUM""),+$$ISA^TIULX(+Y,TIUCLASS)"_$S($G(ADDSCRN)]"":",",1:"")_$G(ADDSCRN)
43 I $G(TIUY("NODFLT")) S DFLT="" ; User selected "Other title"
44 S TIUY=$$ASKTYP(+TIUCLASS,$G(DFLT),SCREEN,PROMPT)
45 I +TIUY>0 S TIUY(1)=1_U_TIUY,TIUY=1
46 Q
47SELPAT(TIURTN,TIUTYP,DFN,TIUASK) ; Select a patient's document
48 N TIUI,TIUQRY,TIUREC,TIUEDT,TIULDT,TIUPRMT,TIUA,TIUZ,TIUTOT,TIUSTOP
49 N TIULAST,TIULIST,TIUJ,TIUY,TIUPNOUN,TIUSMPL,TIUTMP,TIUEDFLT,TIUCONT
50 K ^TMP("TIULIST",$J),^TMP("TIULIDX",$J)
51 K ^TMP("TIUYLIST",$J) ; TIU*1.0*143
52 S TIUTYP=$G(TIUTYP,38)
53 S TIUPNOUN=$S(TIUTYP=3:"notes",TIUTYP=244:"summaries",1:"documents")
54 I '+$G(DFN) S DFN=+$$PATIENT^TIULA Q:+DFN'>0
55 I +$O(^TIU(8925,"APTCL",+DFN,+TIUTYP,0))'>0 D Q
56 . W !!,"No ",TIUPNOUN," on file for ",$P(^DPT(+DFN,0),U)
57 . I $$READ^TIUU("EA","Press RETURN to continue...") W ""
58 S TIUSMPL=$$SAMPLE(DFN,TIUTYP)
59 I +TIUSMPL'>0 D Q
60 . W !!,"No ",TIUPNOUN," available for ",$P(^DPT(+DFN,0),U),!
61 . I $$READ^TIUU("EA","Press RETURN to continue...") W ""
62 S TIUTOT=+$P(TIUSMPL,U)
63 S TIUEDT=+$P(TIUSMPL,U,2)_U_$$DATE^TIULS(+$P(TIUSMPL,U,2),"MM/DD/CCYY")
64 S TIULDT=+$P(TIUSMPL,U,3)_U_$$DATE^TIULS(+$P(TIUSMPL,U,3),"MM/DD/CCYY")
65 W !!,"Available ",TIUPNOUN,": ",$P(TIUEDT,U,2)
66 W " thru ",$P(TIULDT,U,2)," (",TIUTOT,")"
67 I +$G(TIUASK)>0 D Q:+$G(TIUCONT)'>0
68 . N TIUPRMT S TIUPRMT="Do you wish to see any of these notes"
69 . S TIUCONT=+$$READ^TIUU("YO",TIUPRMT,"NO")
70 I +TIUTOT=1,+$P(TIUSMPL,U,4) S TIURTN=1,TIURTN(1)=+$P(TIUSMPL,U,4) Q
71 W !!,"Please specify a date range from which to select ",TIUPNOUN_":"
72 S TIUPRMT="List "_TIUPNOUN_" Beginning: "
73 S TIUEDFLT=$P(TIUEDT,U)
74 I +TIUEDFLT<+$P(TIUEDT,U) S TIUEDFLT=$P(TIUEDT,U,2)
75 I TIUEDFLT'["/" S TIUEDFLT=$$DATE^TIULS(TIUEDFLT,"MM/DD/CCYY")
76 S TIUA=+$$READ^TIUU("DA^"_+$P(TIUEDT,".")_":"_+TIULDT_":E",TIUPRMT,TIUEDFLT)
77 I +$D(DIRUT)!(TIUA'>0) Q
78 S TIUPRMT=$J("Thru: ",$L(TIUPRMT))
79 S TIUZ=+$$READ^TIUU("DA^"_+$P(TIUEDT,".")_":"_+TIULDT_":E",TIUPRMT,$P(TIULDT,U,2))_".2401" W !
80 I +$D(DIRUT)!(TIUA'>0) Q
81 I +TIUA>TIUZ S TIUTMP=TIUA,TIUA=TIUZ,TIUZ=TIUTMP
82 ; ZDEBUG ON B 1
83 D LIST^TIUSRVLL(.TIUY,TIUTYP,DFN,TIUA,TIUZ)
84 I $D(^TMP("TIUYLIST",$J))>9 D ; I $D(TIUY)>9 - modified TIU*1.0*143
85 . ; S TIUI=0 F S TIUI=$O(TIUY(TIUI)) Q:+TIUI'>0!(+$G(TIUSTOP)>0) D ; - modified TIU*1.0*143
86 . S TIUI=0 F S TIUI=$O(^TMP("TIUYLIST",$J,TIUI)) Q:+TIUI'>0!(+$G(TIUSTOP)>0) D
87 . . N TIUD0,TIUD13,TIUD12,TIUD17,TIUDOC,PREFIX
88 . . ; S TIUD0=$G(^TIU(8925,+TIUY(TIUI),0)),TIUD12=$G(^(12)) ; - modified TIU*1.0*143
89 . . S TIUD0=$G(^TIU(8925,+^TMP("TIUYLIST",$J,TIUI),0)),TIUD12=$G(^(12))
90 . . ; S TIUD13=$G(^TIU(8925,+TIUY(TIUI),13)),TIUD17=$G(^(17)),TIULAST=TIUI ; - modified TIU*1.0*143
91 . . S TIUD13=$G(^TIU(8925,+^TMP("TIUYLIST",$J,TIUI),13)),TIUD17=$G(^(17)),TIULAST=TIUI
92 . . S TIUDOC=$E($$PNAME^TIULC1(+TIUD0),1,36)
93 . . I TIUDOC="Addendum" S TIUDOC=TIUDOC_" to "_$$PNAME^TIULC1(+$G(^TIU(8925,+$P(TIUD0,U,6),0)))
94 . . ; S PREFIX=$$PREFIX(+TIUY(TIUI),1),TIUDOC=PREFIX_TIUDOC ; - modified TIU*1.0*143
95 . . S PREFIX=$$PREFIX(+^TMP("TIUYLIST",$J,TIUI),1),TIUDOC=PREFIX_TIUDOC
96 . . I +$P(TIUD0,U,5)=15 S TIUDOC=TIUDOC_" (RETRACTED)"
97 . . W !,TIUI,?4,$$DATE^TIULS(+TIUD13,"MM/DD/CCYY HR:MIN")
98 . . W ?22,TIUDOC
99 . . W ?60,$E($$NAME^TIULS($$PERSNAME^TIULC1(+$P(TIUD12,U,2)),"LAST,FI"),1,19)
100 . . W !?$S($P(TIUD0,U,13)="H":24,1:22),$S($P(TIUD0,U,13)="H":"Adm: ",1:"Visit: "),$$DATE^TIULS($P(TIUD0,U,7),"MM/DD/CCYY")
101 . . I $P(TIUD0,U,13)="H" W ?41,"Dis: ",$$DATE^TIULS($P(TIUD0,U,8),"MM/DD/CCYY")
102 . . I $L(TIUD17) W !,"SUBJECT: ",$E(TIUD17,1,70)
103 . . I '(TIUI#5),(TIUI<+$P(TIUY,U)) D CHOOSE(.TIUSTOP," '^' TO STOP: ",1,TIUI,1)
104 . ; I +TIUY=1 S TIURTN(1)=+TIUY(1) D Q ; - modified TIU*1.0*143
105 . I +TIUY=1 S TIURTN(1)=+^TMP("TIUYLIST",$J,1) D Q
106 . . W !!,"One ",$S(TIUTYP=3:"note",TIUTYP=244:"summary",1:"document")
107 . . W " found within date range..." H 1
108 . I +$G(TIUSTOP)>0,(+$G(TIUSTOP)'=9999999) M TIULIST=TIUSTOP
109 . E D CHOOSE(.TIULIST,"Choose one or more "_TIUPNOUN_": (1-"_+$G(TIULAST)_"): ",1,+$G(TIULAST))
110 . N TIUK
111 . S TIUK="",TIURTN=0
112 . F S TIUK=$O(TIULIST(TIUK)) Q:TIUK="" D
113 . . F TIUI=1:1:$L(TIULIST(TIUK),",") D
114 . . . S TIUJ=$P(TIULIST,",",TIUI)
115 . . . ; I +TIUJ>0,+$G(^TIU(8925,+$G(TIUY(+TIUJ)),0)) S TIURTN(TIUI)=+$G(TIUY(+TIUJ)),TIURTN=TIURTN+1 ; - modified TIU*1.0*143
116 . . . I +TIUJ>0,+$G(^TIU(8925,+$G(^TMP("TIUYLIST",$J,+TIUJ)),0)) S TIURTN(TIUI)=+$G(^TMP("TIUYLIST",$J,+TIUJ)),TIURTN=TIURTN+1
117 K ^TMP("TIUYLIST",$J) ; TIU*1.0*143
118 Q
119 ;
120PREFIX(DA,IDKID) ; Return addendum, urgency, ID indicators.
121 ; I $G(IDKID)=1, include '>' if note is ID kid.
122 N PREFIX,IDKIDFLG
123 S PREFIX=""
124 S IDKIDFLG=1 ; check ID kids too for addenda
125 I $$HASIDKID^TIUGBR(DA) S PREFIX="<"_PREFIX
126 I $G(IDKID),$$HASIDDAD^TIUGBR(DA) S PREFIX=">"_PREFIX
127 I $$HASADDEN^TIULC1(DA,IDKIDFLG) S PREFIX="+"_PREFIX
128 I +$$URGENCY^TIURM(DA)=1 S PREFIX="*"_PREFIX
129 I $L(PREFIX) S PREFIX=PREFIX_" "
130 Q PREFIX
131 ;
132SAMPLE(DFN,CLASS) ; Quick sample for range and count
133 N EARLY,LATE,TOTAL,TIUI,TIUJ,TIUL,TIUY,TIULDA
134 I '$D(TIUPRM0) D SETPARM^TIULE
135 S (TIUI,TIUL,TIULDA,LATE,EARLY,TOTAL)=0
136 F S TIUI=$O(^TIU(8925,"APTCL",DFN,CLASS,TIUI)) Q:+TIUI'>0 D
137 . S TIUJ=0
138 . F S TIUJ=$O(^TIU(8925,"APTCL",DFN,CLASS,TIUI,TIUJ)) Q:+TIUJ'>0 D
139 . . I ($P(TIUPRM0,U,6)="S"),(+$$CANDO^TIULP(TIUJ,"VIEW")'>0) Q
140 . . I +$G(^TIU(8925,+TIUJ,0))=81!'$D(^TIU(8925,+TIUJ,0)) Q
141 . . S:'LATE LATE=9999999-TIUI
142 . . S TIUL=TIUI,TOTAL=TOTAL+1,TIULDA=TIUJ
143 S:+TIUL EARLY=9999999-TIUL
144 S TIUY=TOTAL_U_EARLY_U_LATE
145 S:TOTAL=1 TIUY=TIUY_U_TIULDA
146 Q TIUY
147CHOOSE(Y,PROMPT,LO,HI,PAUSE) ; Call reader for pause or list selection
148 N DIR,DIRUT,DUOUT,DTOUT,X
149 S DIR(0)="LOA^"_LO_":"_HI
150 S DIR("A")=PROMPT
151 D ^DIR
152 I +$G(PAUSE),(Y="^")!$D(DUOUT)!$D(DIROUT)!$D(DTOUT) S Y=9999999
153 ; B 1
154 Q
155AUTHOR(TERMOK) ; Get author
156 N TIUY,TIURTYP,TIUPRMT,TIUSCRN,DFLT S TERMOK=+$G(TERMOK)
157 S:+$$ISA^USRLM(DUZ,"PROVIDER")!+$$ISA^USRLM(DUZ,"STUDENT") DFLT=$$PERSNAME^TIULC1(DUZ)
158 S TIURTYP="P^200:AEMQZ",TIUPRMT="Select AUTHOR"
159 S TIUSCRN="I $S(+TERMOK:1,1:'+$$ISTERM^USRLM(+Y))"
160 S TIUY=$$READ^TIUU(TIURTYP,TIUPRMT,$G(DFLT),"",TIUSCRN)
161 Q TIUY
Note: See TracBrowser for help on using the repository browser.