source: WorldVistAEHR/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIURB.m@ 1489

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

revised back to 6/30/08 version
File size: 6.8 KB
RevLine 
[623]1TIURB ; SLC/JER - More Review Screen Actions ;4/11/05
2 ;;1.0;TEXT INTEGRATION UTILITIES;**4,32,52,78,58,100,109,155,184**;Jun 20, 1997
3 ; **100** Moved DELETE, DEL, DELTEXT, DIK to new rtn TIURB2
4 ; DBIA 3576 TIU use of GMRCTIU
5AMEND ; Amendment action
6 N TIUDA,DFN,DIE,DR,TIU,TIUDATA,TIUI,TIUSIG,TIUY,X,X1,Y
7 N DIROUT,TIUCHNG,TIUDAARY,TIULST
8 I '$D(VALMY) D EN^VALM2(XQORNOD(0))
9 S TIUI=0
10 F S TIUI=$O(VALMY(TIUI)) Q:+TIUI'>0 D Q:$D(DIROUT)
11 . N RSTRCTD
12 . S TIUDATA=$G(^TMP("TIURIDX",$J,TIUI))
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...",! ; Echo denial message
16 . . I $$READ^TIUU("EA","RETURN to continue...") ; pause
17 . W !!,"Amending #",+TIUDATA
18 . S TIUCHNG=0
19 . D AMEND1
20 . I $G(TIUDAARY(TIUI)) D
21 . . S TIULST=$G(TIULST)_$S($G(TIULST)]"":",",1:"")_TIUI
22 ; -- Update or Rebuild list, restore video:
23 D UPRBLD^TIURL(.TIUCHNG,.VALMY) K VALMY
24 S VALMBCK="R"
25 D VMSG^TIURS1($G(TIULST),.TIUDAARY,"amended")
26 Q
27AMEND1 ; Single record amend
28 N TIUCMT,TIUT0,TIUTYP,TIUAMND,TIUSNM,TIUSBLK,TIUCSNM,TIUCSBLK,DIE,DR
29 N DA,DFN,DIWESUB,TIU,TIUODA,TIUTITL,TIUCLSS,TIUCON,TIUCNSLT,TIUPRF,TIUFLAG
30 K ^TMP("TIURTRCT",$J)
31 ; TIU*155 Gets consult data if exists
32 S TIUTITL=$P($G(^TIU(8925,TIUDA,0)),U)
33 S TIUCLSS=$$CLASS^TIUCNSLT()
34 S TIUCON=+$$ISA^TIULX(TIUTITL,TIUCLSS)
35 S TIUCNSLT=+$P($G(^TIU(8925,TIUDA,14)),U,5)
36 S TIUPRF=0,TIUFLAG=0
37 D ISPRFTTL^TIUPRF2(.TIUPRF,TIUTITL)
38 I TIUPRF S TIUFLAG=$$FNDACTIF^TIUPRFL(TIUDA)
39 L +^TIU(8925,+TIUDA):1
40 E D Q
41 . W !?5,$C(7),"Another user is editing this entry." H 3
42 . S TIUCHNG("REFRESH")=1
43 I +$P($G(^TIU(8925,+TIUDA,0)),U,5)'>6 D Q
44 . W !?5,$C(7),"Only SIGNED Documents may be amended."
45 . I $$READ^TIUU("EA","Press RETURN to continue...") ; pause
46 . S TIUCHNG("REFRESH")=1
47 I +$$HASIMG^TIURB2(TIUDA) D IMGNOTE^TIURB2 Q
48 S TIUAMND=$$CANDO^TIULP(TIUDA,"AMENDMENT")
49 I +TIUAMND'>0 D Q
50 . W !!,$C(7),$C(7),$C(7),$P(TIUAMND,U,2),!
51 . S TIUCHNG("REFRESH")=1
52 . I $$READ^TIUU("EA","Press RETURN to continue...") ; pause
53 W !!,"Before proceeding, please enter your Electronic Signature Code..."
54 S TIUAMND=$$GETSIG^TIURD2
55 I +TIUAMND'>0 D Q
56 . W !!," Ok, no harm done...",!
57 . S TIUCHNG("REFRESH")=1
58 . I $$READ^TIUU("EA","Press RETURN to continue...") ; pause
59 W !!,"The ORIGINAL document will be RETRACTED, and a copy will be amended...",!
60 S TIUODA=TIUDA
61 S TIUDA=+$$RETRACT^TIURD2(TIUDA,"",7)
62 I '+TIUDA D Q
63 . W !!,$C(7),$C(7),$C(7),"Retraction of Original Document Failed.",!
64 . I $$READ^TIUU("EA","Press RETURN to continue...") ; pause
65 . S TIUDA=TIUODA,TIUCHNG("REFRESH")=1
66 L +^TIU(8925,TIUDA):1
67 E D Q
68 . W !?5,$C(7),"Another user is editing this entry."
69 . D RECOVER^TIURD4(TIUODA,TIUDA) H 3
70 . S TIUPRF=$$LINK^TIUPRF1(TIUODA,+TIUFLAG,$P(TIUFLAG,U,2),$P($G(^TIU(8925,TIUODA,0)),U,2))
71 . S TIUDA=TIUODA,TIUCHNG("REFRESH")=1
72 S TIUSNM=$$DECRYPT^TIULC1($P(^TIU(8925,TIUDA,15),U,3),1,$$CHKSUM^TIULC("^TIU(8925,"_TIUDA_",""TEXT"")"))
73 S TIUSBLK=$$DECRYPT^TIULC1($P($G(^TIU(8925,TIUDA,15)),U,4),1,$$CHKSUM^TIULC("^TIU(8925,"_TIUDA_",""TEXT"")"))
74 S TIUCSNM=$$DECRYPT^TIULC1($P(^TIU(8925,TIUDA,15),U,9),1,$$CHKSUM^TIULC("^TIU(8925,"_TIUDA_",""TEXT"")"))
75 S TIUCSBLK=$$DECRYPT^TIULC1($P($G(^TIU(8925,TIUDA,15)),U,10),1,$$CHKSUM^TIULC("^TIU(8925,"_TIUDA_",""TEXT"")"))
76 S TIUTYP=+$G(^TIU(8925,+TIUDA,0)),TIUT0=$G(^TIU(8925.1,+TIUTYP,0))
77 S TIUTYP(1)="1^"_+TIUTYP_U_$P(TIUT0,U,3)_U
78 S DFN=$P($G(^TIU(8925,+TIUDA,0)),U,2)
79 D GETTIU^TIULD(.TIU,TIUDA)
80 S DIWESUB="Patient: "_$G(TIU("PNM"))
81 S TIUCHNG=0 D FULL^VALM1,TEXTEDIT^TIUEDI4(TIUDA,.TIUCMT,.TIUCHNG)
82 I '+$G(TIUCHNG) D Q
83 . L -^TIU(8925,TIUDA)
84 . D RECOVER^TIURD4(TIUODA,TIUDA)
85 . S TIUPRF=$$LINK^TIUPRF1(TIUODA,+TIUFLAG,$P(TIUFLAG,U,2),$P($G(^TIU(8925,TIUODA,0)),U,2))
86 . L -^TIU(8925,TIUODA) H 3
87 . S TIUDA=TIUODA,TIUCHNG("REFRESH")=1
88 I +$G(TIUCHNG) D
89 . S DR=".05///AMENDED;1601////"_$$NOW^XLFDT_";1602////"_DUZ,DA=TIUDA,TIUSIG=0
90 . S DR=DR_";1603////"_$$NOW^XLFDT_";1604///^S X=$$SIGNAME^TIULS(DUZ);1605///^S X=$$SIGTITL^TIULS(DUZ)",TIUSIG=1
91 . S DIE=8925 D ^DIE
92 . ; Refile /es/-block fields
93 . S DR="1503///^S X=TIUSNM;1504///^S X=TIUSBLK;1509///^S X=TIUCSNM;1510///^S X=TIUCSBLK"
94 . D ^DIE
95 ; Drop Locks on both documents
96 L -^TIU(8925,+TIUDA)
97 L -^TIU(8925,+TIUODA)
98 S TIUDAARY(TIUI)=TIUDA
99 S TIUCHNG("RBLD")=1
100 ; if note is associated with a patient record flag - clean up
101 I +TIUFLAG S TIUPRF=$$LINK^TIUPRF1(TIUDA,+TIUFLAG,$P(TIUFLAG,U,2),$P($G(^TIU(8925,TIUDA,0)),U,2))
102 ; TIU*155 If note is associated with a consult update ^GMR global
103 ; to include the amended note
104 ; Rollback retracted note from ^GMR(123 node 50
105 I $G(TIUCON)=1 D
106 . N STATUS,GMRCSTAT,TIUAUTH
107 . S STATUS=$P($G(^TIU(8925,TIUDA,0)),U,5)
108 . S GMRCSTAT=$S(STATUS>6:"COMPLETED",1:"INCOMPLETE")
109 . S TIUAUTH=$P($G(^TIU(8925,TIUDA,12)),U,2)
110 . D ROLLBACK^TIUCNSLT(TIUODA)
111 . D GET^GMRCTIU(TIUCNSLT,TIUDA,GMRCSTAT,TIUAUTH)
112 Q
113SENDBACK ; Send back a Document to transcription
114 N TIUDA,DFN,TIU,TIUDATA,TIUCHNG,TIUI,TIUY,Y,DIROUT,TIULST
115 N TIUDAARY
116 I '$D(VALMY) D EN^VALM2(XQORNOD(0))
117 S TIUI=0
118 I +$O(VALMY(0)) D CLEAR^VALM1
119 F S TIUI=$O(VALMY(TIUI)) Q:+TIUI'>0 D Q:$D(DIROUT)
120 . N TIU,RSTRCTD
121 . S TIUDATA=$G(^TMP("TIURIDX",$J,TIUI))
122 . S TIUDA=+$P(TIUDATA,U,2) S RSTRCTD=$$DOCRES^TIULRR(TIUDA)
123 . I RSTRCTD D Q
124 . . W !!,$C(7),"Ok, no harm done...",! ; Echo denial message
125 . . I $$READ^TIUU("EA","RETURN to continue...") ; pause
126 . S TIUDAARY(TIUI)=TIUDA
127 . S TIUCHNG=0
128 . D EN^VALM("TIU SEND BACK")
129 . I +$G(TIUCHNG) D
130 . . S TIULST=$G(TIULST)_$S($G(TIULST)]"":",",1:"")_TIUI
131SENDX ; Revise list and cycle back as appropriate
132 I $G(TIUCHNG("ADDM"))!$G(TIUCHNG("DELETE")) S TIUCHNG("RBLD")=1
133 E S TIUCHNG("UPDATE")=1
134 D UPRBLD^TIURL(.TIUCHNG,.VALMY) K VALMY
135 S VALMBCK="R"
136 D VMSG^TIURS1($G(TIULST),.TIUDAARY,"sent back")
137 Q
138LINK ; Link to problem(s)
139 N TIUCHNG,TIUDA,DFN,TIU,TIUDATA,TIUEDIT,TIUI,TIUY,TIULST,Y,DIROUT
140 N TIUDAARY
141 I '$D(VALMY) D EN^VALM2(XQORNOD(0))
142 S TIUI=0
143 I +$O(VALMY(0)) D CLEAR^VALM1
144 F S TIUI=$O(VALMY(TIUI)) Q:+TIUI'>0 D Q:$D(DIROUT)
145 . N TIU,VALMY,XQORM,VA,VADM,GMPDFN,GMPLUSER,RSTRCTD
146 . S TIUDATA=$G(^TMP("TIURIDX",$J,TIUI))
147 . S TIUDA=+$P(TIUDATA,U,2),GMPLUSER=1
148 . I '$D(^TIU(8925,+TIUDA,0)) D Q
149 . . W !,$C(7),"Document no longer exists.",!
150 . . I $$READ^TIUU("EA","Press RETURN to continue...") W ""
151 . S RSTRCTD=$$DOCRES^TIULRR(TIUDA)
152 . I RSTRCTD D Q
153 . . W !!,$C(7),"Ok, no harm done...",! ; Echo denial message
154 . . I $$READ^TIUU("EA","RETURN to continue...") ; pause
155 . S TIUDAARY(TIUI)=TIUDA
156 . S DFN=+$P($G(^TIU(8925,+TIUDA,0)),U,2)
157 . I +DFN D DEM^VADPT S GMPDFN=DFN_U_VADM(1)_U_$E(VADM(1))_VA("BID")
158 . S TIUCHNG=0
159 . D EN^VALM("TIU LINK TO PROBLEM")
160 . I +$G(TIUCHNG) S TIULST=$G(TIULST)_$S($G(TIULST)]"":",",1:"")_TIUI
161LINKX ; Revise list and cycle back as appropriate
162 S TIUCHNG("REFRESH")=1
163 D UPRBLD^TIURL(.TIUCHNG,.VALMY) K VALMY
164 S VALMBCK="R"
165 D VMSG^TIURS1($G(TIULST),.TIUDAARY,"linked to problems")
166 Q
167DEL(DA) ; -- Call to DEL for backward compatibility
168 G GODEL^TIURB2
169 Q
Note: See TracBrowser for help on using the repository browser.