source: WorldVistAEHR/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIURA.m@ 1608

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

initial load of WorldVistAEHR

File size: 8.3 KB
Line 
1TIURA ; SLC/JER - Review screen actions ; 7/7/04
2 ;;1.0;TEXT INTEGRATION UTILITIES;**1,10,20,79,88,58,100,109,182**;Jun 20, 1997
3 ; Call to ISA^USRLM supported by DBIA 2324
4EDIT ; Edit Documents
5 N TIUDA,DFN,TIUDDT,TIUDATA,TIUCHNG,TIUEDIT,TIUI,DIROUT,TIUDAARY
6 N TIULST,MSGVERB
7 S TIUI=0
8 I '$D(VALMY) D EN^VALM2(XQORNOD(0))
9 F S TIUI=$O(VALMY(TIUI)) Q:+TIUI'>0 D Q:$D(DIROUT)
10 . N RSTRCTD
11 . S TIUDATA=$G(^TMP("TIURIDX",$J,TIUI))
12 . D CLEAR^VALM1 W !!,"Editing #",+TIUDATA
13 . S TIUDA=+$P(TIUDATA,U,2) S RSTRCTD=$$DOCRES^TIULRR(TIUDA)
14 . I RSTRCTD D Q
15 . . W !!,$C(7),"Ok, no harm done...",!
16 . . I $$READ^TIUU("EA","RETURN to continue...") ; pause
17 . S TIUDAARY(TIUI)=TIUDA
18 . S TIUCHNG=0
19 . I +$D(^TIU(8925,+TIUDA,0)) D EDIT1
20 . I +$G(TIUCHNG) D
21 . . S TIULST=$G(TIULST)_$S($G(TIULST)]"":",",1:"")_TIUI
22 ; -- Update or Rebuild list, restore video: --
23 I $G(TIUCHNG("ADDM"))!$G(TIUCHNG("DELETE")) S TIUCHNG("RBLD")=1
24 E S TIUCHNG("UPDATE")=1
25 D UPRBLD^TIURL(.TIUCHNG,.VALMY) K VALMY
26 S VALMBCK="R"
27 S MSGVERB=$S($G(TIUCHNG("ADDM")):"edited/addended",1:"edited")
28 D VMSG^TIURS1($G(TIULST),.TIUDAARY,MSGVERB)
29 Q
30EDIT1 ; Single record edit
31 ; Receives TIUDA
32 N %X,%Y,C,D,D0,DDWTMP,DFN,DI,DIC,TIUEDIT,TIUMSG,TIUQUIT,TIUADD,TIUREL
33 N TIUTYP,TIUT0,TIUDPRM,TIULDT,DIWESUB,TIU,TIUCMMTX
34 I '$D(TIUPRM0)!'$D(TIUPRM1) D SETPARM^TIULE
35 I '+$G(TIUDA) W !,"No Documents selected." H 2 Q
36 ; Evaluate edit privilege
37 S TIUEDIT=$$CANDO^TIULP(TIUDA,"EDIT RECORD")
38 ; if 'canedit, offer explanation, and let add addendum
39 I '+TIUEDIT D Q
40 . K ^TIU(8925,"ASAVE",DUZ,TIUDA)
41 . W !!,$C(7),$P(TIUEDIT,U,2),!
42 . I $$READ^TIUU("EA","Press RETURN to continue...")
43 . D ADDENDUM^TIUADD(TIUDA,"",.TIUCHNG)
44 S TIUTYP=+$G(^TIU(8925,+TIUDA,0)),TIUT0=$G(^TIU(8925.1,+TIUTYP,0))
45 S TIUTYP(1)="1^"_+TIUTYP_U_$P(TIUT0,U,3)_U
46 S DFN=$P($G(^TIU(8925,+TIUDA,0)),U,2),TIULDT=$P(^(0),U,8)
47 D GETTIU^TIULD(.TIU,TIUDA)
48 S DIWESUB="Patient: "_$G(TIU("PNM"))
49 D DIE^TIUEDI4(TIUDA,.TIUQUIT,.TIUCHNG) ; **100**
50 K ^TIU(8925,"ASAVE",DUZ,TIUDA)
51 I +$G(TIUCPYNG),+$G(TIUQUIT) D DELETE^TIUEDIT(TIUDA,0,"",1) Q
52 Q:+$G(TIUQUIT)=2
53 ;If (CP) and (Timeout or Not Select Consult) and (Consult Associated), Quit before EMPTYDOC check
54 I +$$ISA^TIULX(TIUTYP,+$$CLASS^TIUCP),+$G(TIUQUIT)=1,+$P($G(^TIU(8925,+TIUDA,14)),U,5)>0 Q
55 I $$EMPTYDOC^TIULF(TIUDA) D DELETE^TIUEDIT(TIUDA,0) S TIUCHNG("DELETE")=1 H 2 Q
56 Q:+$G(TIUQUIT)
57 I +$G(TIU("STOP")) D DEFER^TIUVSIT(TIUDA,TIU("STOP")) I 1
58 E I +$P($G(^TIU(8925,+TIUDA,0)),U,3)'>0 D QUE^TIUPXAP1
59 ; - Commit proc -
60 S TIUCMMTX=$$COMMIT^TIULC1(+$P(TIUTYP(1),U,2))
61 I TIUCMMTX]"" D
62 . N DA S DA=TIUDA X TIUCMMTX
63 ; i. Execute RELEASE logic
64 D RELEASE^TIUT(+TIUDA)
65 ; ii. Execute VERIFICATION logic
66 D VERIFY^TIUT(+TIUDA)
67 ; iii. Execute ES logic
68 D EDSIG^TIURS(+TIUDA,"",1)
69 ; iv. If document is an ADDENDUM process alert
70 I +$$ISADDNDM^TIULC1(+TIUDA) D SENDADD^TIUALRT(+TIUDA)
71 I $D(^TMP("TIUR",$J,"CTXT")),(+$P($G(^TIU(8925,+TIUDA,0)),U,5)'<6) S VALMBCK="Q"
72 Q
73PRINT ; Print selected documents
74 N DFN,TIUDA,TIUDARR,TIUDATA,TIUI,DIROUT,TIUDE,POP,TIUPFLG,TIUDEV
75 I '$D(VALMY) D EN^VALM2(XQORNOD(0)) G:$D(VALMY)'>9 PRINTX
76 D CLEAR^VALM1
77 D PRNTSCRN^TIURA2(.VALMY)
78 I '$D(VALMY) D G PRINTX
79 . W !!,"No Printable Documents Remain in your List.",!
80 . I $$READ^TIUU("EA","Press RETURN to continue...")
81 I +$$CHARTANY^TIURA1(.VALMY) S TIUPFLG=$$FLAG^TIUPRPN3
82 S TIUDEV=$$DEVICE^TIUDEV(.IO) ; Get Device/allow queueing
83 I $S(IO']"":1,TIUDEV']"":1,1:0) G PRINTX
84 I $D(IO("Q")) D QUE^TIUDEV("PRINTN^TIURA",TIUDEV) G PRINTX
85 D PRINTN
86PRINTX N IOSTBM D ^%ZISC,FIXLSTNW^TIULM
87 K VALMY S VALMBCK="R"
88 Q
89PRINTN ; Loop through selected doc's & invoke print code
90 N TIUI,TIUTYP,TIUDARR,DFN K ^TMP("TIUPR",$J)
91 N ARRAYDA
92 U IO
93 S TIUI=0
94 F S TIUI=$O(VALMY(TIUI)) Q:+TIUI'>0 D Q:$D(DIROUT)
95 . N TIUPMTHD,TIUDTYP,TIUPFHDR,TIUPFNBR,TIUPGRP,TIUPRINT,TIUFLAG
96 . S TIUDATA=$G(^TMP("TIURIDX",$J,TIUI))
97 . S TIUDA=+$P(TIUDATA,U,2)
98 . S TIUTYP=+$G(^TIU(8925,TIUDA,0)) ;P182
99 . I TIUTYP'>0 D Q
100 . . W !!,"Item #",TIUI," no longer exists.",!
101 . . I IO=IO(0),'$D(ZTQUEUED),$$READ^TIUU("EA","RETURN to continue...")
102 . S ARRAYDA(TIUDA)=""
103 . ; -- If TIUDA is an addendum, print its parent instead,
104 . ; or quit if the parent has already been printed: --
105 . I +$$ISADDNDM^TIULC1(TIUDA) D Q:'TIUDA
106 . . S TIUDA=+$P($G(^TIU(8925,TIUDA,0)),U,6)
107 . . I $D(ARRAYDA(TIUDA)) S TIUDA=0 Q
108 . . S TIUDTYP=+$G(^TIU(8925,TIUDA,0))
109 . ; -- If TIUDA is an ID kid, print its parent instead,
110 . ; or quit if the parent has already been printed: --
111 . I $G(^TIU(8925,TIUDA,21)) D Q:'TIUDA
112 . . S TIUDA=^TIU(8925,TIUDA,21)
113 . . I $D(ARRAYDA(TIUDA)) S TIUDA=0 Q
114 . . S TIUDTYP=+$G(^TIU(8925,TIUDA,0))
115 . S TIUPRINT=$$CANDO^TIULP(TIUDA,"PRINT RECORD")
116 . I +TIUPRINT'>0 D Q ; Exclude records user can't print
117 . . W !!,"Item #",TIUI,": ",!,$P(TIUPRINT,U,2),!
118 . . I IO=IO(0),'$D(ZTQUEUED),$$READ^TIUU("EA","RETURN to continue...")
119 . I +$G(TIUPFLG) S TIUFLAG=+$$CHARTONE^TIURA1(TIUDA)
120 . S DFN=$P($G(^TIU(8925,+TIUDA,0)),U,2)
121 . I +TIUTYP,'$G(TIUDTYP) D
122 . . S TIUPMTHD=$$PRNTMTHD^TIULG(+TIUTYP)
123 . . S TIUPGRP=$$PRNTGRP^TIULG(+TIUTYP)
124 . . S TIUPFHDR=$$PRNTHDR^TIULG(+TIUTYP)
125 . . S TIUPFNBR=$$PRNTNBR^TIULG(+TIUTYP)
126 . I +$G(TIUDTYP) S TIUPMTHD=$$PRNTMTHD^TIULG(+TIUDTYP),TIUPGRP=$$PRNTGRP^TIULG(+TIUDTYP),TIUPFHDR=$$PRNTHDR^TIULG(+TIUDTYP),TIUPFNBR=$$PRNTNBR^TIULG(+TIUDTYP)
127 . I $G(TIUPMTHD)']"" D Q ; Exclude records lacking print method P182
128 . . W !!,"Item #",TIUI," has no Print Method.",!
129 . . I IO=IO(0),'$D(ZTQUEUED),$$READ^TIUU("EA","RETURN to continue...")
130 . ;I +$G(TIUPGRP),($G(TIUPFHDR)]""),($G(TIUPFNBR)]"") S TIUDARR(TIUPMTHD,$G(TIUPGRP)_"$"_TIUPFHDR_";"_DFN,TIUI,TIUDA)=TIUPFNBR
131 . ;E S TIUDARR(TIUPMTHD,DFN,TIUI,TIUDA)=""
132 . ; -- P182: Set array same whether or not flds are defined, with
133 . ; TIUPGRP piece possibly 0, TIUPFHDR piece possibly null, and
134 . ; array value TIUPFNBR possibly null.
135 . S TIUDARR(TIUPMTHD,+$G(TIUPGRP)_"$"_$G(TIUPFHDR)_";"_DFN,TIUI,TIUDA)=$G(TIUPFNBR)
136 . D:'$D(ZTQUEUED) RESTORE^VALM10(+TIUI)
137 S TIUPMTHD="" F S TIUPMTHD=$O(TIUDARR(TIUPMTHD)) Q:TIUPMTHD="" D
138 . D PRNTDOC(TIUPMTHD,.TIUDARR)
139 Q
140PRINT1 ; Print a single document
141 N TIUDARR,TIUDEV,TIUTYP,DFN,TIUPMTHD,TIUD0,TIUDPRM,TIUFLAG,TIUDTYP
142 N TIUPGRP,TIUPFHDR,TIUPFNBR,TIUPRINT,POP,TIUTMPDA
143 D CLEAR^VALM1
144 S TIUTMPDA=TIUDA
145 I +$$ISADDNDM^TIULC1(TIUTMPDA) D
146 . S TIUTMPDA=+$P($G(^TIU(8925,TIUTMPDA,0)),U,6)
147 . S TIUDTYP=+$G(^TIU(8925,TIUTMPDA,0))
148 I $G(^TIU(8925,TIUTMPDA,21)) D
149 . S TIUTMPDA=^TIU(8925,TIUTMPDA,21)
150 . S TIUDTYP=+$G(^TIU(8925,TIUTMPDA,0))
151 S TIUPRINT=$$CANDO^TIULP(TIUTMPDA,"PRINT RECORD")
152 I +TIUPRINT'>0 D Q
153 . W !!,$C(7),$P(TIUPRINT,U,2),!
154 . I $$READ^TIUU("EA","RETURN to continue...") ; pause
155 I +$G(TIUDTYP) D
156 . S TIUPMTHD=$$PRNTMTHD^TIULG(+TIUDTYP)
157 . S TIUPGRP=$$PRNTGRP^TIULG(+TIUDTYP)
158 . S TIUPFHDR=$$PRNTHDR^TIULG(+TIUDTYP)
159 . S TIUPFNBR=$$PRNTNBR^TIULG(+TIUDTYP)
160 . D DOCPRM^TIULC1(+TIUDTYP,.TIUDPRM,TIUTMPDA)
161 S TIUD0=$G(^TIU(8925,TIUTMPDA,0))
162 S TIUTYP=$P(TIUD0,U),DFN=$P(TIUD0,U,2)
163 I +TIUTYP'>0 Q
164 I '$G(TIUDTYP) D
165 . S TIUPMTHD=$$PRNTMTHD^TIULG(+TIUTYP)
166 . S TIUPGRP=$$PRNTGRP^TIULG(+TIUTYP)
167 . S TIUPFHDR=$$PRNTHDR^TIULG(+TIUTYP)
168 . S TIUPFNBR=$$PRNTNBR^TIULG(+TIUTYP)
169 . D DOCPRM^TIULC1(+TIUTYP,.TIUDPRM,TIUTMPDA)
170 I +$P($G(TIUDPRM(0)),U,9) S TIUFLAG=$$FLAG^TIUPRPN3
171 I (+$P($G(TIUDPRM(0)),U,9)'>0),+$$ISA^USRLM(DUZ,"MEDICAL INFORMATION SECTION") S TIUFLAG=$$FLAG^TIUPRPN3
172 ;I $G(TIUPMTHD)]"",+$G(TIUPGRP),($G(TIUPFHDR)]""),($G(TIUPFNBR)]"") S TIUDARR(TIUPMTHD,$G(TIUPGRP)_"$"_TIUPFHDR_";"_DFN,1,TIUTMPDA)=TIUPFNBR
173 ;E S TIUDARR(TIUPMTHD,DFN,1,TIUTMPDA)=""
174 I $G(TIUPMTHD)']"" W !,$C(7),"No Print Method Defined for ",$P($G(^TIU(8925.1,+TIUTYP,0)),U) H 2 G PRINT1X
175 ; -- P182: See PRINTN
176 S TIUDARR(TIUPMTHD,+$G(TIUPGRP)_"$"_$G(TIUPFHDR)_";"_DFN,1,TIUTMPDA)=$G(TIUPFNBR)
177 S TIUDEV=$$DEVICE^TIUDEV(.IO) ; Get Device
178 I $S(IO']"":1,TIUDEV']"":1,1:0) G PRINT1X
179 I $D(IO("Q")) D QUE^TIUDEV("PRINTQ^TIURA",TIUDEV) G PRINT1X
180 D PRINTQ
181PRINT1X D ^%ZISC
182 Q
183PRINTQ ; Queued document print
184 D PRNTDOC(TIUPMTHD,.TIUDARR)
185 Q
186PRNTDOC(TIUPMTHD,TIUDARR) ; Print docmts w/ Print Method TIUPMTHD in
187 ;array TIUDARR
188 ; Requires TIUPMTHD & TIUDARR
189 N TIUDA
190 I '+$D(TIUDARR) W !,"No Documents selected." Q
191 M ^TMP("TIUPR",$J)=TIUDARR(TIUPMTHD)
192 I TIUPMTHD']"" D G PRNTDOCX
193 . W !!,"No Print Method Defined for ",$P(TIUTYP,U,2) H 2
194 X TIUPMTHD
195PRNTDOCX K ^TMP("TIUPR",$J)
196 Q
197BROWS1(TIULTMP) ; -- Call to BROWS1 for backward compatibility
198 D BROWS1^TIURA2(TIULTMP,TIUDA)
199 Q
Note: See TracBrowser for help on using the repository browser.