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

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

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