source: WorldVistAEHR/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIUAL1.m@ 949

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

initial load of WorldVistAEHR
File size: 9.5 KB
RevLine 
[613]1TIUAL1 ;SLC/AJB - TIU Alerts List Manager ; 7/6/05 4:06pm
2 ;;1.0;TEXT INTEGRATION UTILITIES;**158,199**;Jun 20, 1997
3 ;
4 Q
5CHNGSRCH ; allows user to change search parameters
6 D FULL^VALM1
7 W @IOF
8 D SETUP^TIUALSET
9 I $D(TIU("QUIT")) K TIU("QUIT") S VALMBCK="R" Q
10 K ^TMP("TIUDA",$J),^TMP("TIUDOC",$J) D CLEAN^VALM10,INIT,HDR S VALMBG=1
11 Q
12EDIT ;
13 N D,DIV,TIUDA,TIUCHNG,TIUDCSNR,TIUDIV1,TIUESNR,TIUNODE
14 N TIUFPRIV,TIUPREF,TIUPRM0,TIUPRM1,TIURQCS,TIUS,TIUSEL,X,Y
15 D FULL^VALM1
16 I TIU("CNT")=0 W !,"No documents to select." H 3 Q
17 S TIUSEL=$P(XQORNOD(0),"=",2)
18 I TIUSEL="" D Q:TIUSEL=U!($D(DIRUT))
19 . N DIR,X,Y
20 . S DIR("A")="Select Document: (1-"_VALMLST_") "
21 . S DIR(0)="NA^1:"_VALMLST
22 . D ^DIR S TIUSEL=Y
23 I $A($E(TIUSEL,$L(TIUSEL)))<48!($A($E(TIUSEL,$L(TIUSEL)))>57) S TIUSEL=$E(TIUSEL,1,$L(TIUSEL)-1)
24 F X=1:1 Q:$P(TIUSEL,",",X)="" S TIUC($P(TIUSEL,",",X))=$O(@VALMAR@("IDX",$P(TIUSEL,",",X),""))
25 S TIUDA=TIUC(TIUSEL)
26 D EDIT1^TIURA
27 D UPDATE^TIUALSET
28 Q
29EN ; main entry point for TIU ALERTS
30 N %DT,D0,POP,TIU,TIUC,TIUTMP,X,Y
31 K ^TMP("TIUDA",$J),^TMP("TIUDOC",$J)
32 D SETUP^TIUALSET Q:$D(TIU("QUIT"))
33 D EN^VALM("TIU ALERTS")
34 K ^TMP("TIUDA",$J),^TMP("TIUDOC",$J)
35 Q
36EVAL(TIUDA) ;
37 N TIUCHK,TIUCNT,TIUY
38 S TIUCHK="" F S TIUCHK=$O(TIU("S",TIUCHK)) Q:TIUCHK="" I $P(TIUD0,U,5)=+TIU("S",TIUCHK),$P(TIUD13,U)'<TIU("D",1),$P(TIUD13,U)'>TIU("D",2) S TIUY=1
39 I $G(TIUY),$P(TIUCAT,U)="CA",$P(TIUD12,U,2)=+TIU("P") Q 1
40 I $G(TIUY),$P(TIUCAT,U)="AE",$D(^TIU(8925.7,"AE",TIUDA,TIU("P"))) Q 1
41 I $G(TIUY),$P(TIUCAT,U)="CS",$P(TIUCAT,U,2)="Expected Cosigner",$P(TIUD12,U,8)=+TIU("P") Q 1
42 I $G(TIUY),$P(TIUCAT,U)="CS",$P(TIUCAT,U,2)="Attending Physician",$P(TIUD12,U,9)=+TIU("P") Q 1
43 I $G(TIUY),$P(TIUCAT,U)="CS",$P(TIUCAT,U,3)="Attending Physician",$P(TIUD12,U,9)=+TIU("P") Q 1
44 Q +$G(TIUY)
45EXIT ; exit code
46 Q
47EXPND ; expand code
48 Q
49FMTDT(DATE) ; formats date
50 N TMPDATE
51 S TMPDATE=$$FDATE^VALM1(DATE)
52 I $P(TMPDATE,"/")="00",$P(TMPDATE,"/",2)="00" Q $$FMTE^XLFDT(DATE,"D")
53 I $P(TMPDATE,"/",2)="00" S TMPDATE=$E(TMPDATE,1,3)_$E(TMPDATE,7,8)
54 Q TMPDATE
55HDR ; header code
56 N HDRTITLE,X,Y
57 S HDRTITLE(1)=$S(TIU("S")=1:$$UPPER^VALM1($P(TIU("S",1),U,3))_" Documents",1:"Clinical Documents")
58 S HDRTITLE(2)=TIU("CNT")_" "_$S(TIU("CNT")=1:"Document",1:"Documents")
59 S HDRTITLE(3)="for ("_$E($$GET1^DIQ(200,TIU("P")_",",.01),1,35)_")"_" from "_$$FMTDT(TIU("D",1))_" to "_$$FMTDT(TIU("D",2))
60 S (X,Y)=""
61 F S X=$O(TIU("C",X)) Q:X="" S Y=Y_TIU("C",X)
62 S Y="by "_"("_$$UP^XLFSTR($TR($E(Y,2,67),U,","))_")"
63 S $P(HDRTITLE(1)," ",IOM-($L(HDRTITLE(1))+$L(HDRTITLE(2))))="",HDRTITLE(1)=HDRTITLE(1)_HDRTITLE(2)
64 S VALMHDR(1)=HDRTITLE(1)
65 S VALMHDR(2)=$$SETSTR^VALM1(Y,"",(IOM-$L(Y))/2,$L(Y))
66 S VALMHDR(3)=$$SETSTR^VALM1(HDRTITLE(3),"",(IOM-$L(HDRTITLE(3)))/2,$L(HDRTITLE(3)))
67 D XQORM
68 Q
69HELP ; help code
70 N DIR
71 I X="?" S DIR("A")="Enter RETURN to continue or '^' to exit",DIR(0)="E"
72 D FULL^VALM1
73 W !!,"The following actions are available:"
74 W !,"Browse a Document - View a selected document (if authorized)"
75 W !,"Change View - Modify search criteria"
76 W !,"Combination Alerts - Send alerts to expected signers and 3rd parties"
77 W !,"Delete Alerts - Delete a document's alerts"
78 W !,"Detailed Display - View detailed display of a document (if authorized)"
79 W !,"Edit a Document - Edit a selected document (if authorized)"
80 W !,"Identify Signers - Identify/Change Signers of a document (if authorized)"
81 W !,"Resend Alerts - Resend alerts to expected signers"
82 W !,"Third Party Alerts - Send alerts to one or more 3rd parties",!
83 I $D(DIR("A")) D ^DIR
84 S VALMBCK="R"
85 Q
86INIT ; finds documents and prepares LM display
87 N CNT,TIUCNT,TIUDA,TIUDOC,TIUDT,TIUTMP
88 S CNT="",(TIUCNT,TIU("CNT"))=0
89 S TIU("IOCUOFF")=$C(27)_"[?25l",TIU("IOCUON")=$C(27)_"[?25h"
90 W TIU("IOCUOFF")
91 W !,"Searching for the documents."
92 F S CNT=$O(TIU("C",CNT)) Q:CNT="" D INIT2(CNT_TIU("C",CNT))
93 S TIUTMP=0,(CNT,TIUDA,TIUDT)=""
94 F S TIUDT=$O(^TMP("TIUDOC",$J,TIUDT)) Q:TIUDT="" F S CNT=$O(^TMP("TIUDOC",$J,TIUDT,CNT)) Q:CNT="" F S TIUDA=$O(^TMP("TIUDOC",$J,TIUDT,CNT,TIUDA)) Q:TIUDA="" D
95 . N TIUDISP,TIUNODE
96 . S TIUTMP=TIUTMP+1
97 . W:TIUTMP#3=0 "."
98 . S TIUDISP("PATIENT")=$P($P(^TMP("TIUDOC",$J,TIUDT,CNT,TIUDA),U,2),",")_","_$E($P($P(^TMP("TIUDOC",$J,TIUDT,CNT,TIUDA),U,2),",",2),1)
99 . S TIUDISP("L4")="("_$E(TIUDISP("PATIENT"))_$E($P($G(^DPT(+$P(^TIU(8925,TIUDA,0),U,2),0)),U,9),6,9)_")"
100 . S TIUNODE=^TMP("TIUDOC",$J,TIUDT,CNT,TIUDA)
101 . S TIUDISP("TITLE")=$E($S(+TIUNODE>0:"_ "_$P(TIUNODE,U,3),$P(TIUNODE,U)="A":" |_"_$P(TIUNODE,U,3),1:$P(TIUNODE,U,3)),1,36)
102 . S TIUDISP("REFDT")=$$FMTDT($P(^TMP("TIUDOC",$J,TIUDT,CNT,TIUDA),U,4))
103 . S TIUDISP("S")=$P(^TMP("TIUDOC",$J,TIUDT,CNT,TIUDA),U,5)
104 . S TIUDISP("A/D")=$$GET1^DIQ(8925,TIUDA,1202)
105 . S TIUDISP("EC")=$$GET1^DIQ(8925,TIUDA,1208)
106 . S TIUDISP("ATT")=$$GET1^DIQ(8925,TIUDA,1209)
107 . S TIUDISP("ADS")=$$GET1^DIQ(8925.7,$P(TIUNODE,U,6),.03)
108 . S TIUDISP=$$SETSTR^VALM1(TIUTMP,"",1,5)
109 . S TIUDISP=$$SETSTR^VALM1(TIUDISP("PATIENT"),TIUDISP,6,26)
110 . S TIUDISP=$$SETSTR^VALM1(TIUDISP("L4"),TIUDISP,20,26)
111 . S TIUDISP=$$SETSTR^VALM1($E(TIUDISP("TITLE"),1,30),TIUDISP,28,58)
112 . S TIUDISP=$$SETSTR^VALM1(TIUDISP("REFDT"),TIUDISP,60,68)
113 . S TIUDISP=$$SETSTR^VALM1($$LOW^XLFSTR(TIUDISP("S")),TIUDISP,70,80)
114 . S TIUDISP=$$SETSTR^VALM1(TIUTMP,TIUDISP,81,86)
115 . S TIUDISP=$$SETSTR^VALM1($E(TIUDISP("A/D"),1,17),TIUDISP,88,105)
116 . S TIUDISP=$$SETSTR^VALM1($E($G(TIUDISP("EC")),1,17),TIUDISP,107,124)
117 . S TIUDISP=$$SETSTR^VALM1($E($G(TIUDISP("ATT")),1,17),TIUDISP,126,143)
118 . S TIUDISP=$$SETSTR^VALM1($E($G(TIUDISP("ADS")),1,15),TIUDISP,145,160)
119 . D SET^VALM10(TIUTMP,$E(TIUDISP,1,160),TIUDA)
120 S VALMCNT=TIUTMP
121 I VALMCNT=0 S VALMCNT=1 D
122 . D SET^VALM10(1," ",0)
123 . S TIUDOC="No records found to satisfy search criteria."
124 . S TIUDOC=$$SETSTR^VALM1(TIUDOC,"",(IOM-$L(TIUDOC))/2,$L(TIUDOC))
125 . D SET^VALM10(2,TIUDOC,0)
126 W TIU("IOCUON")
127 Q
128INIT2(TIUCAT) ;
129 S TIUDA=""
130 I $P(TIUCAT,U)'="AE" F S TIUDA=$O(^TIU(8925,$P(TIUCAT,U),TIU("P"),TIUDA)) Q:TIUDA="" D
131 . N TIUD0,TIUD12,TIUD13
132 . S TIUD0=$G(^TIU(8925,TIUDA,0))
133 . S TIUD12=$G(^TIU(8925,TIUDA,12))
134 . S TIUD13=$G(^TIU(8925,TIUDA,13))
135 . I TIUD0=""!(TIUD12="")!(TIUD13="") Q
136 . I $$EVAL(TIUDA) S ^TMP("TIUDA",$J,TIUDA)="",TIU("CNT")=TIU("CNT")+1
137 I $P(TIUCAT,U)="AE" F S TIUDA=$O(^TIU(8925.7,"AE",TIUDA)) Q:TIUDA="" I $D(^TIU(8925.7,"AE",TIUDA,TIU("P"))) D
138 . S TIU("AS")="",TIU("AS")=$O(^TIU(8925.7,"AE",TIUDA,TIU("P"),TIU("AS")))
139 . I $P($G(^TIU(8925.7,TIU("AS"),0)),U,4),$P($G(^TIU(8925.7,TIU("AS"),0)),U,5)=TIU("P") Q
140 . I TIU("AS")'="",$P($G(^TIU(8925.7,TIU("AS"),0)),"^",9)=1 Q
141 . N TIUD0,TIUD12,TIUD13
142 . S TIUD0=$G(^TIU(8925,TIUDA,0))
143 . S TIUD12=$G(^TIU(8925,TIUDA,12))
144 . S TIUD13=$G(^TIU(8925,TIUDA,13))
145 . I TIUD0=""!(TIUD12="")!(TIUD13="") Q
146 . I $$EVAL(TIUDA) S ^TMP("TIUDA",$J,TIUDA)=""_U_"AE"_U_$G(TIU("AS")),TIU("CNT")=TIU("CNT")+1
147 . K TIU("AS")
148 F S TIUDA=$O(^TMP("TIUDA",$J,TIUDA)) Q:TIUDA="" D
149 . I +^TMP("TIUDA",$J,TIUDA)=1 Q
150 . N TIUD0,TIUD12,TIUD13
151 . S TIUD0=$G(^TIU(8925,TIUDA,0))
152 . S TIUD12=$G(^TIU(8925,TIUDA,12))
153 . S TIUD13=$G(^TIU(8925,TIUDA,13))
154 . I TIUD0=""!(TIUD12="")!(TIUD13="") Q
155 . W:TIUCNT#3=0 "."
156 . I +$$HASKIDS^TIUSRVLI(TIUDA),$P(^TMP("TIUDA",$J,TIUDA),U,2)'="AE" D Q
157 . . N TMPCNT
158 . . S TIUCNT=TIUCNT+1,TMPCNT=TIUCNT
159 . . S ^TMP("TIUDA",$J,TIUDA)=1
160 . . N CHILD,I,SEQUENCE,TIUI
161 . . S CHILD="CHILD",(SEQUENCE,TIUI)=""
162 . . D SETKIDS^TIUSRVLI(.CHILD,TIUDA,.TIUI) I $G(TIUI)="" Q
163 . . F I=1:1:TIUI I $D(^TMP("TIUDA",$J,+CHILD(I))),'+$G(^TMP("TIUDA",$J,+CHILD(I))) D
164 . . . N TIUREFDT
165 . . . S TIUCNT=TIUCNT+1
166 . . . S ^TMP("TIUDA",$J,+CHILD(I))=1
167 . . . S TIUREFDT=+^TIU(8925,+CHILD(I),13)
168 . . . I $$GET1^DIQ(8925,+CHILD(I),.01)'["Addendum" S ^TMP("TIUDOC",$J,+TIUD13,TIUCNT,+CHILD(I))="A"_U_$$GET1^DIQ(8925,TIUDA,.02)_U_$$GET1^DIQ(8925,+CHILD(I),.01)_U_TIUREFDT_U_$$GET1^DIQ(8925,+CHILD(I),.05)
169 . . . E S ^TMP("TIUDOC",$J,+TIUD13,TIUCNT,+CHILD(I))="A"_U_$$GET1^DIQ(8925,TIUDA,.02)_U_"Addendum to "_$$GET1^DIQ(8925,TIUDA,.01)_U_TIUREFDT_U_$$GET1^DIQ(8925,+CHILD(I),.05)
170 . . S ^TMP("TIUDOC",$J,+TIUD13,TMPCNT,TIUDA)=(TIUCNT-TMPCNT)_U_$$GET1^DIQ(8925,TIUDA,.02)_U_$$GET1^DIQ(8925,TIUDA,.01)_U_+TIUD13_U_$$GET1^DIQ(8925,TIUDA,.05)
171 . I $P(^TMP("TIUDA",$J,TIUDA),U,2)="AE"!(+$$HASDAD^TIUSRVLI(TIUDA)) D Q
172 . . N TIUAS
173 . . S TIUCNT=TIUCNT+1
174 . . S $P(^TMP("TIUDA",$J,TIUDA),U)=1
175 . . S TIUAS=$P(^TMP("TIUDA",$J,TIUDA),U,3)
176 . . I $$GET1^DIQ(8925,TIUDA,.01)'["Addendum" S ^TMP("TIUDOC",$J,+TIUD13,TIUCNT,TIUDA)=U_$$GET1^DIQ(8925,TIUDA,.02)_U_$$GET1^DIQ(8925,TIUDA,.01)_U_+TIUD13_U_$$GET1^DIQ(8925,TIUDA,.05)_U_TIUAS
177 . . E D
178 . . . N PARENT,SEQUENCE,TIUI
179 . . . S PARENT="PARENT",(SEQUENCE,TIUI)=""
180 . . . D SETDAD^TIUSRVLI(.PARENT,TIUDA,.TIUI) I $G(TIUI)="" Q
181 . . . S ^TMP("TIUDOC",$J,+TIUD13,TIUCNT,TIUDA)=U_$$GET1^DIQ(8925,TIUDA,.02)_U_"Addendum to "_$$GET1^DIQ(8925,+PARENT(TIUI),.01)_U_$P(TIUD13,U)_U_$$GET1^DIQ(8925,TIUDA,.05)_U_TIUAS
182 . I '+$$HASKIDS^TIUSRVLI(TIUDA),'+$$HASDAD^TIUSRVLI(TIUDA) D Q
183 . . S TIUCNT=TIUCNT+1
184 . . S ^TMP("TIUDA",$J,TIUDA)=1
185 . . S ^TMP("TIUDOC",$J,+TIUD13,TIUCNT,TIUDA)=U_$$GET1^DIQ(8925,TIUDA,.02)_U_$$GET1^DIQ(8925,TIUDA,.01)_U_$P(TIUD13,U)_U_$$GET1^DIQ(8925,TIUDA,.05)
186 Q
187LSEXIT ; exit code
188 D XQORM
189 Q
190SELSTAT(Y,PARM,DEF,MENU) ; Select Signature status
191 N I,XQORM,X,TIUY
192 S XQORM=+$O(^ORD(101,"B",MENU,0))_";ORD(101,"
193 I +XQORM'>0 W !,"Status selection unavailable." S TIUY=-1 G STATX
194 S XQORM(0)=$G(PARM),XQORM("A")=$S(MENU="TIU STATUS MENU":"Select DOCUMENT STATUS: ",1:"Select SEARCH CATEGORY: ")
195 I $S(PARM="F":1,PARM="R":1,1:0) S X=DEF
196 S XQORM("B")=DEF D EN^XQORM
197 S TIUY=$G(Y)
198 I MENU="TIU STATUS MENU",+$G(Y)=1,(+$G(Y(1))=7) S Y=2,Y(2)="8^4843^amended^8"
199STATX Q TIUY
200XQORM ;
201 S XQORM("#")=$O(^ORD(101,"B","TIU ALERTS SELECT",0))_U_"1:"_VALMCNT
202 Q
Note: See TracBrowser for help on using the repository browser.