TIURB ; SLC/JER - More Review Screen Actions ;07/12/16 13:05
;;1.0;TEXT INTEGRATION UTILITIES;**4,32,52,78,58,100,109,155,184,234,232,290**;Jun 20, 1997;Build 548
; ICR 3473 TIU use of GMRCTIU
; ICR 1544 TIU use of $$ISA^USRLM
AMEND ; Amendment action
N TIUDA,DFN,DIE,DR,TIU,TIUDATA,TIUI,TIUSIG,TIUY,X,X1,Y
N DIROUT,TIUCHNG,TIUDAARY,TIULST
I '$D(VALMY) D EN^VALM2(XQORNOD(0))
S TIUI=0
F S TIUI=$O(VALMY(TIUI)) Q:+TIUI'>0 D Q:$D(DIROUT)
. N RSTRCTD
. S TIUDATA=$G(^TMP("TIURIDX",$J,TIUI))
. S TIUDA=+$P(TIUDATA,U,2) S RSTRCTD=$$DOCRES^TIULRR(TIUDA)
. I RSTRCTD D Q
. . W !!,$C(7),"Ok, no harm done...",! ; Echo denial message
. . I $$READ^TIUU("EA","RETURN to continue...") ; pause
. W !!,"Amending #",+TIUDATA
. S TIUCHNG=0
. D AMEND1
. I $G(TIUDAARY(TIUI)) D
. . S TIULST=$G(TIULST)_$S($G(TIULST)]"":",",1:"")_TIUI
; -- Update or Rebuild list, restore video:
D UPRBLD^TIURL(.TIUCHNG,.VALMY) K VALMY
S VALMBCK="R"
D VMSG^TIURS1($G(TIULST),.TIUDAARY,"amended")
Q
AMEND1 ; Single record amend
N TIUCMT,TIUT0,TIUTYP,TIUAMND,TIUSNM,TIUSBLK,TIUCSNM,TIUCSBLK,DIE,DR
N DA,DFN,DIWESUB,TIU,TIUODA,TIUTITL,TIUCLSS,TIUCON,TIUCNSLT,TIUPRF,TIUFLAG
K ^TMP("TIURTRCT",$J)
; TIU*155 Gets consult data if exists
S TIUTITL=$P($G(^TIU(8925,TIUDA,0)),U)
S TIUCLSS=$$CLASS^TIUCNSLT()
S TIUCON=+$$ISA^TIULX(TIUTITL,TIUCLSS)
S TIUCNSLT=+$P($G(^TIU(8925,TIUDA,14)),U,5)
S TIUPRF=0,TIUFLAG=0
D ISPRFTTL^TIUPRF2(.TIUPRF,TIUTITL)
I TIUPRF S TIUFLAG=$$FNDACTIF^TIUPRFL(TIUDA)
L +^TIU(8925,+TIUDA):1
E D Q
. W !?5,$C(7),"Another user is editing this entry." H 3
. S TIUCHNG("REFRESH")=1
I +$P($G(^TIU(8925,+TIUDA,0)),U,5)'>6 D Q
. W !?5,$C(7),"Only COMPLETED Documents may be amended."
. I $$READ^TIUU("EA","Press RETURN to continue...") ; pause
. S TIUCHNG("REFRESH")=1
I '$$ISA^USRLM(+$G(DUZ),"PRIVACY ACT OFFICER"),'$$ISA^USRLM(+$G(DUZ),"CHIEF, MIS"),'$$ISA^USRLM(+$G(DUZ),"CHIEF, HIM") D Q
. W !?5,$C(7),"Only Privacy Act Officers or MIS/HIM Chiefs may amend documents."
. I $$READ^TIUU("EA","Press RETURN to continue...") ; pause
. S TIUCHNG("REFRESH")=1
I +$$HASIMG^TIURB2(TIUDA) D IMGNOTE^TIURB2 Q
;S TIUAMND=$$CANDO^TIULP(TIUDA,"AMENDMENT")
;I +TIUAMND'>0 D Q
;. W !!,$C(7),$C(7),$C(7),$P(TIUAMND,U,2),!
;. S TIUCHNG("REFRESH")=1
;. I $$READ^TIUU("EA","Press RETURN to continue...") ; pause
;VMP/ELR P232. ADDED NEXT PARAGRAPH TO PREVENT AMEND OF NIR OR ANESTHESIA REPORT MUST USE SURGERY
I $$ISSURG^TIULP3(+TIUDA) D Q
. S TIUAMND=$$SURMSG^TIULP3("AMENDMENT")
. W !!,$C(7),$C(7),$C(7),$G(TIUAMND),!
. S TIUCHNG("REFRESH")=1
. I $$READ^TIUU("EA","Press RETURN to continue...") ; pause
W !!,"Before proceeding, please enter your Electronic Signature Code..."
S TIUAMND=$$GETSIG^TIURD2
I +TIUAMND'>0 D Q
. W !!," Ok, no harm done...",!
. S TIUCHNG("REFRESH")=1
. I $$READ^TIUU("EA","Press RETURN to continue...") ; pause
W !!,"The ORIGINAL document will be RETRACTED, and a copy will be amended...",!
S TIUODA=TIUDA
S TIUDA=+$$RETRACT^TIURD2(TIUDA,"",7)
I '+TIUDA D Q
. W !!,$C(7),$C(7),$C(7),"Retraction of Original Document Failed.",!
. I $$READ^TIUU("EA","Press RETURN to continue...") ; pause
. S TIUDA=TIUODA,TIUCHNG("REFRESH")=1
L +^TIU(8925,TIUDA):1
E D Q
. W !?5,$C(7),"Another user is editing this entry."
. D RECOVER^TIURD4(TIUODA,TIUDA) H 3
. S TIUPRF=$$LINK^TIUPRF1(TIUODA,+TIUFLAG,$P(TIUFLAG,U,2),$P($G(^TIU(8925,TIUODA,0)),U,2))
. S TIUDA=TIUODA,TIUCHNG("REFRESH")=1
S TIUSNM=$$DECRYPT^TIULC1($P(^TIU(8925,TIUDA,15),U,3),1,$$CHKSUM^TIULC("^TIU(8925,"_TIUDA_",""TEXT"")"))
S TIUSBLK=$$DECRYPT^TIULC1($P($G(^TIU(8925,TIUDA,15)),U,4),1,$$CHKSUM^TIULC("^TIU(8925,"_TIUDA_",""TEXT"")"))
S TIUCSNM=$$DECRYPT^TIULC1($P(^TIU(8925,TIUDA,15),U,9),1,$$CHKSUM^TIULC("^TIU(8925,"_TIUDA_",""TEXT"")"))
S TIUCSBLK=$$DECRYPT^TIULC1($P($G(^TIU(8925,TIUDA,15)),U,10),1,$$CHKSUM^TIULC("^TIU(8925,"_TIUDA_",""TEXT"")"))
S TIUTYP=+$G(^TIU(8925,+TIUDA,0)),TIUT0=$G(^TIU(8925.1,+TIUTYP,0))
S TIUTYP(1)="1^"_+TIUTYP_U_$P(TIUT0,U,3)_U
S DFN=$P($G(^TIU(8925,+TIUDA,0)),U,2)
D GETTIU^TIULD(.TIU,TIUDA)
S DIWESUB="Patient: "_$G(TIU("PNM"))
S TIUCHNG=0 D FULL^VALM1,TEXTEDIT^TIUEDI4(TIUDA,.TIUCMT,.TIUCHNG)
I '+$G(TIUCHNG) D Q
. L -^TIU(8925,TIUDA)
. D RECOVER^TIURD4(TIUODA,TIUDA)
. S TIUPRF=$$LINK^TIUPRF1(TIUODA,+TIUFLAG,$P(TIUFLAG,U,2),$P($G(^TIU(8925,TIUODA,0)),U,2))
. L -^TIU(8925,TIUODA) H 3
. S TIUDA=TIUODA,TIUCHNG("REFRESH")=1
I +$G(TIUCHNG) D
. S DR=".05///AMENDED;1601////"_$$NOW^XLFDT_";1602////"_DUZ,DA=TIUDA,TIUSIG=0
. S DR=DR_";1603////"_$$NOW^XLFDT_";1604///^S X=$$SIGNAME^TIULS(DUZ);1605///^S X=$$SIGTITL^TIULS(DUZ)",TIUSIG=1
. S DIE=8925 D ^DIE
. ; Refile /es/-block fields
. S DR="1503///^S X=TIUSNM;1504///^S X=TIUSBLK;1509///^S X=TIUCSNM;1510///^S X=TIUCSBLK"
. D ^DIE
; Drop Locks on both documents
L -^TIU(8925,+TIUDA)
L -^TIU(8925,+TIUODA)
S TIUDAARY(TIUI)=TIUDA
S TIUCHNG("RBLD")=1
; if note is associated with a patient record flag - clean up
I +TIUFLAG S TIUPRF=$$LINK^TIUPRF1(TIUDA,+TIUFLAG,$P(TIUFLAG,U,2),$P($G(^TIU(8925,TIUDA,0)),U,2))
; TIU*155 If note is associated with a consult update ^GMR global
; to include the amended note
; Rollback retracted note from ^GMR(123 node 50
I $G(TIUCON)=1 D
. N STATUS,GMRCSTAT,TIUAUTH
. S STATUS=$P($G(^TIU(8925,TIUDA,0)),U,5)
. S GMRCSTAT=$S(STATUS>6:"COMPLETED",1:"INCOMPLETE")
. S TIUAUTH=$P($G(^TIU(8925,TIUDA,12)),U,2)
. D ROLLBACK^TIUCNSLT(TIUODA)
. D GET^GMRCTIU(TIUCNSLT,TIUDA,GMRCSTAT,TIUAUTH)
Q
SENDBACK ; Send back a Document to transcription
N TIUDA,DFN,TIU,TIUDATA,TIUCHNG,TIUI,TIUY,Y,DIROUT,TIULST
N TIUDAARY
I '$D(VALMY) D EN^VALM2(XQORNOD(0))
S TIUI=0
I +$O(VALMY(0)) D CLEAR^VALM1
F S TIUI=$O(VALMY(TIUI)) Q:+TIUI'>0 D Q:$D(DIROUT)
. N TIU,RSTRCTD
. S TIUDATA=$G(^TMP("TIURIDX",$J,TIUI))
. S TIUDA=+$P(TIUDATA,U,2) S RSTRCTD=$$DOCRES^TIULRR(TIUDA)
. I RSTRCTD D Q
. . W !!,$C(7),"Ok, no harm done...",! ; Echo denial message
. . I $$READ^TIUU("EA","RETURN to continue...") ; pause
. S TIUDAARY(TIUI)=TIUDA
. S TIUCHNG=0
. D EN^VALM("TIU SEND BACK")
. I +$G(TIUCHNG) D
. . S TIULST=$G(TIULST)_$S($G(TIULST)]"":",",1:"")_TIUI
SENDX ; Revise list and cycle back as appropriate
I $G(TIUCHNG("ADDM"))!$G(TIUCHNG("DELETE")) S TIUCHNG("RBLD")=1
E S TIUCHNG("UPDATE")=1
N TIUVALMY M TIUVALMY=VALMY
D UPRBLD^TIURL(.TIUCHNG,.TIUVALMY) K VALMY
S VALMBCK="R"
D VMSG^TIURS1($G(TIULST),.TIUDAARY,"sent back")
Q
LINK ; Link to problem(s)
N TIUCHNG,TIUDA,DFN,TIU,TIUDATA,TIUEDIT,TIUI,TIUY,TIULST,Y,DIROUT
N TIUDAARY
I '$D(VALMY) D EN^VALM2(XQORNOD(0))
S TIUI=0
I +$O(VALMY(0)) D CLEAR^VALM1
F S TIUI=$O(VALMY(TIUI)) Q:+TIUI'>0 D Q:$D(DIROUT)
. N TIU,VALMY,XQORM,VA,VADM,GMPDFN,GMPLUSER,RSTRCTD
. S TIUDATA=$G(^TMP("TIURIDX",$J,TIUI))
. S TIUDA=+$P(TIUDATA,U,2),GMPLUSER=1
. I '$D(^TIU(8925,+TIUDA,0)) D Q
. . W !,$C(7),"Document no longer exists.",!
. . I $$READ^TIUU("EA","Press RETURN to continue...") W ""
. S RSTRCTD=$$DOCRES^TIULRR(TIUDA)
. I RSTRCTD D Q
. . W !!,$C(7),"Ok, no harm done...",! ; Echo denial message
. . I $$READ^TIUU("EA","RETURN to continue...") ; pause
. S TIUDAARY(TIUI)=TIUDA
. S DFN=+$P($G(^TIU(8925,+TIUDA,0)),U,2)
. I +DFN D DEM^VADPT S GMPDFN=DFN_U_VADM(1)_U_$E(VADM(1))_VA("BID")
. S TIUCHNG=0
. D EN^VALM("TIU LINK TO PROBLEM")
. I +$G(TIUCHNG) S TIULST=$G(TIULST)_$S($G(TIULST)]"":",",1:"")_TIUI
LINKX ; Revise list and cycle back as appropriate
S TIUCHNG("REFRESH")=1
N TIUVALMY M TIUVALMY=VALMY
D UPRBLD^TIURL(.TIUCHNG,.TIUVALMY) K VALMY
S VALMBCK="R"
D VMSG^TIURS1($G(TIULST),.TIUDAARY,"linked to problems")
Q
DEL(DA) ; -- Call to DEL for backward compatibility
G GODEL^TIURB2
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIURB 7832 printed Apr 09, 2024@21:45:32 Page 2
TIURB ; SLC/JER - More Review Screen Actions ;07/12/16 13:05
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**4,32,52,78,58,100,109,155,184,234,232,290**;Jun 20, 1997;Build 548
+2 ; ICR 3473 TIU use of GMRCTIU
+3 ; ICR 1544 TIU use of $$ISA^USRLM
AMEND ; Amendment action
+1 NEW TIUDA,DFN,DIE,DR,TIU,TIUDATA,TIUI,TIUSIG,TIUY,X,X1,Y
+2 NEW DIROUT,TIUCHNG,TIUDAARY,TIULST
+3 IF '$DATA(VALMY)
DO EN^VALM2(XQORNOD(0))
+4 SET TIUI=0
+5 FOR
SET TIUI=$ORDER(VALMY(TIUI))
if +TIUI'>0
QUIT
Begin DoDot:1
+6 NEW RSTRCTD
+7 SET TIUDATA=$GET(^TMP("TIURIDX",$JOB,TIUI))
+8 SET TIUDA=+$PIECE(TIUDATA,U,2)
SET RSTRCTD=$$DOCRES^TIULRR(TIUDA)
+9 IF RSTRCTD
Begin DoDot:2
+10 ; Echo denial message
WRITE !!,$CHAR(7),"Ok, no harm done...",!
+11 ; pause
IF $$READ^TIUU("EA","RETURN to continue...")
End DoDot:2
QUIT
+12 WRITE !!,"Amending #",+TIUDATA
+13 SET TIUCHNG=0
+14 DO AMEND1
+15 IF $GET(TIUDAARY(TIUI))
Begin DoDot:2
+16 SET TIULST=$GET(TIULST)_$SELECT($GET(TIULST)]"":",",1:"")_TIUI
End DoDot:2
End DoDot:1
if $DATA(DIROUT)
QUIT
+17 ; -- Update or Rebuild list, restore video:
+18 DO UPRBLD^TIURL(.TIUCHNG,.VALMY)
KILL VALMY
+19 SET VALMBCK="R"
+20 DO VMSG^TIURS1($GET(TIULST),.TIUDAARY,"amended")
+21 QUIT
AMEND1 ; Single record amend
+1 NEW TIUCMT,TIUT0,TIUTYP,TIUAMND,TIUSNM,TIUSBLK,TIUCSNM,TIUCSBLK,DIE,DR
+2 NEW DA,DFN,DIWESUB,TIU,TIUODA,TIUTITL,TIUCLSS,TIUCON,TIUCNSLT,TIUPRF,TIUFLAG
+3 KILL ^TMP("TIURTRCT",$JOB)
+4 ; TIU*155 Gets consult data if exists
+5 SET TIUTITL=$PIECE($GET(^TIU(8925,TIUDA,0)),U)
+6 SET TIUCLSS=$$CLASS^TIUCNSLT()
+7 SET TIUCON=+$$ISA^TIULX(TIUTITL,TIUCLSS)
+8 SET TIUCNSLT=+$PIECE($GET(^TIU(8925,TIUDA,14)),U,5)
+9 SET TIUPRF=0
SET TIUFLAG=0
+10 DO ISPRFTTL^TIUPRF2(.TIUPRF,TIUTITL)
+11 IF TIUPRF
SET TIUFLAG=$$FNDACTIF^TIUPRFL(TIUDA)
+12 LOCK +^TIU(8925,+TIUDA):1
+13 IF '$TEST
Begin DoDot:1
+14 WRITE !?5,$CHAR(7),"Another user is editing this entry."
HANG 3
+15 SET TIUCHNG("REFRESH")=1
End DoDot:1
QUIT
+16 IF +$PIECE($GET(^TIU(8925,+TIUDA,0)),U,5)'>6
Begin DoDot:1
+17 WRITE !?5,$CHAR(7),"Only COMPLETED Documents may be amended."
+18 ; pause
IF $$READ^TIUU("EA","Press RETURN to continue...")
+19 SET TIUCHNG("REFRESH")=1
End DoDot:1
QUIT
+20 IF '$$ISA^USRLM(+$GET(DUZ),"PRIVACY ACT OFFICER")
IF '$$ISA^USRLM(+$GET(DUZ),"CHIEF, MIS")
IF '$$ISA^USRLM(+$GET(DUZ),"CHIEF, HIM")
Begin DoDot:1
+21 WRITE !?5,$CHAR(7),"Only Privacy Act Officers or MIS/HIM Chiefs may amend documents."
+22 ; pause
IF $$READ^TIUU("EA","Press RETURN to continue...")
+23 SET TIUCHNG("REFRESH")=1
End DoDot:1
QUIT
+24 IF +$$HASIMG^TIURB2(TIUDA)
DO IMGNOTE^TIURB2
QUIT
+25 ;S TIUAMND=$$CANDO^TIULP(TIUDA,"AMENDMENT")
+26 ;I +TIUAMND'>0 D Q
+27 ;. W !!,$C(7),$C(7),$C(7),$P(TIUAMND,U,2),!
+28 ;. S TIUCHNG("REFRESH")=1
+29 ;. I $$READ^TIUU("EA","Press RETURN to continue...") ; pause
+30 ;VMP/ELR P232. ADDED NEXT PARAGRAPH TO PREVENT AMEND OF NIR OR ANESTHESIA REPORT MUST USE SURGERY
+31 IF $$ISSURG^TIULP3(+TIUDA)
Begin DoDot:1
+32 SET TIUAMND=$$SURMSG^TIULP3("AMENDMENT")
+33 WRITE !!,$CHAR(7),$CHAR(7),$CHAR(7),$GET(TIUAMND),!
+34 SET TIUCHNG("REFRESH")=1
+35 ; pause
IF $$READ^TIUU("EA","Press RETURN to continue...")
End DoDot:1
QUIT
+36 WRITE !!,"Before proceeding, please enter your Electronic Signature Code..."
+37 SET TIUAMND=$$GETSIG^TIURD2
+38 IF +TIUAMND'>0
Begin DoDot:1
+39 WRITE !!," Ok, no harm done...",!
+40 SET TIUCHNG("REFRESH")=1
+41 ; pause
IF $$READ^TIUU("EA","Press RETURN to continue...")
End DoDot:1
QUIT
+42 WRITE !!,"The ORIGINAL document will be RETRACTED, and a copy will be amended...",!
+43 SET TIUODA=TIUDA
+44 SET TIUDA=+$$RETRACT^TIURD2(TIUDA,"",7)
+45 IF '+TIUDA
Begin DoDot:1
+46 WRITE !!,$CHAR(7),$CHAR(7),$CHAR(7),"Retraction of Original Document Failed.",!
+47 ; pause
IF $$READ^TIUU("EA","Press RETURN to continue...")
+48 SET TIUDA=TIUODA
SET TIUCHNG("REFRESH")=1
End DoDot:1
QUIT
+49 LOCK +^TIU(8925,TIUDA):1
+50 IF '$TEST
Begin DoDot:1
+51 WRITE !?5,$CHAR(7),"Another user is editing this entry."
+52 DO RECOVER^TIURD4(TIUODA,TIUDA)
HANG 3
+53 SET TIUPRF=$$LINK^TIUPRF1(TIUODA,+TIUFLAG,$PIECE(TIUFLAG,U,2),$PIECE($GET(^TIU(8925,TIUODA,0)),U,2))
+54 SET TIUDA=TIUODA
SET TIUCHNG("REFRESH")=1
End DoDot:1
QUIT
+55 SET TIUSNM=$$DECRYPT^TIULC1($PIECE(^TIU(8925,TIUDA,15),U,3),1,$$CHKSUM^TIULC("^TIU(8925,"_TIUDA_",""TEXT"")"))
+56 SET TIUSBLK=$$DECRYPT^TIULC1($PIECE($GET(^TIU(8925,TIUDA,15)),U,4),1,$$CHKSUM^TIULC("^TIU(8925,"_TIUDA_",""TEXT"")"))
+57 SET TIUCSNM=$$DECRYPT^TIULC1($PIECE(^TIU(8925,TIUDA,15),U,9),1,$$CHKSUM^TIULC("^TIU(8925,"_TIUDA_",""TEXT"")"))
+58 SET TIUCSBLK=$$DECRYPT^TIULC1($PIECE($GET(^TIU(8925,TIUDA,15)),U,10),1,$$CHKSUM^TIULC("^TIU(8925,"_TIUDA_",""TEXT"")"))
+59 SET TIUTYP=+$GET(^TIU(8925,+TIUDA,0))
SET TIUT0=$GET(^TIU(8925.1,+TIUTYP,0))
+60 SET TIUTYP(1)="1^"_+TIUTYP_U_$PIECE(TIUT0,U,3)_U
+61 SET DFN=$PIECE($GET(^TIU(8925,+TIUDA,0)),U,2)
+62 DO GETTIU^TIULD(.TIU,TIUDA)
+63 SET DIWESUB="Patient: "_$GET(TIU("PNM"))
+64 SET TIUCHNG=0
DO FULL^VALM1
DO TEXTEDIT^TIUEDI4(TIUDA,.TIUCMT,.TIUCHNG)
+65 IF '+$GET(TIUCHNG)
Begin DoDot:1
+66 LOCK -^TIU(8925,TIUDA)
+67 DO RECOVER^TIURD4(TIUODA,TIUDA)
+68 SET TIUPRF=$$LINK^TIUPRF1(TIUODA,+TIUFLAG,$PIECE(TIUFLAG,U,2),$PIECE($GET(^TIU(8925,TIUODA,0)),U,2))
+69 LOCK -^TIU(8925,TIUODA)
HANG 3
+70 SET TIUDA=TIUODA
SET TIUCHNG("REFRESH")=1
End DoDot:1
QUIT
+71 IF +$GET(TIUCHNG)
Begin DoDot:1
+72 SET DR=".05///AMENDED;1601////"_$$NOW^XLFDT_";1602////"_DUZ
SET DA=TIUDA
SET TIUSIG=0
+73 SET DR=DR_";1603////"_$$NOW^XLFDT_";1604///^S X=$$SIGNAME^TIULS(DUZ);1605///^S X=$$SIGTITL^TIULS(DUZ)"
SET TIUSIG=1
+74 SET DIE=8925
DO ^DIE
+75 ; Refile /es/-block fields
+76 SET DR="1503///^S X=TIUSNM;1504///^S X=TIUSBLK;1509///^S X=TIUCSNM;1510///^S X=TIUCSBLK"
+77 DO ^DIE
End DoDot:1
+78 ; Drop Locks on both documents
+79 LOCK -^TIU(8925,+TIUDA)
+80 LOCK -^TIU(8925,+TIUODA)
+81 SET TIUDAARY(TIUI)=TIUDA
+82 SET TIUCHNG("RBLD")=1
+83 ; if note is associated with a patient record flag - clean up
+84 IF +TIUFLAG
SET TIUPRF=$$LINK^TIUPRF1(TIUDA,+TIUFLAG,$PIECE(TIUFLAG,U,2),$PIECE($GET(^TIU(8925,TIUDA,0)),U,2))
+85 ; TIU*155 If note is associated with a consult update ^GMR global
+86 ; to include the amended note
+87 ; Rollback retracted note from ^GMR(123 node 50
+88 IF $GET(TIUCON)=1
Begin DoDot:1
+89 NEW STATUS,GMRCSTAT,TIUAUTH
+90 SET STATUS=$PIECE($GET(^TIU(8925,TIUDA,0)),U,5)
+91 SET GMRCSTAT=$SELECT(STATUS>6:"COMPLETED",1:"INCOMPLETE")
+92 SET TIUAUTH=$PIECE($GET(^TIU(8925,TIUDA,12)),U,2)
+93 DO ROLLBACK^TIUCNSLT(TIUODA)
+94 DO GET^GMRCTIU(TIUCNSLT,TIUDA,GMRCSTAT,TIUAUTH)
End DoDot:1
+95 QUIT
SENDBACK ; Send back a Document to transcription
+1 NEW TIUDA,DFN,TIU,TIUDATA,TIUCHNG,TIUI,TIUY,Y,DIROUT,TIULST
+2 NEW TIUDAARY
+3 IF '$DATA(VALMY)
DO EN^VALM2(XQORNOD(0))
+4 SET TIUI=0
+5 IF +$ORDER(VALMY(0))
DO CLEAR^VALM1
+6 FOR
SET TIUI=$ORDER(VALMY(TIUI))
if +TIUI'>0
QUIT
Begin DoDot:1
+7 NEW TIU,RSTRCTD
+8 SET TIUDATA=$GET(^TMP("TIURIDX",$JOB,TIUI))
+9 SET TIUDA=+$PIECE(TIUDATA,U,2)
SET RSTRCTD=$$DOCRES^TIULRR(TIUDA)
+10 IF RSTRCTD
Begin DoDot:2
+11 ; Echo denial message
WRITE !!,$CHAR(7),"Ok, no harm done...",!
+12 ; pause
IF $$READ^TIUU("EA","RETURN to continue...")
End DoDot:2
QUIT
+13 SET TIUDAARY(TIUI)=TIUDA
+14 SET TIUCHNG=0
+15 DO EN^VALM("TIU SEND BACK")
+16 IF +$GET(TIUCHNG)
Begin DoDot:2
+17 SET TIULST=$GET(TIULST)_$SELECT($GET(TIULST)]"":",",1:"")_TIUI
End DoDot:2
End DoDot:1
if $DATA(DIROUT)
QUIT
SENDX ; Revise list and cycle back as appropriate
+1 IF $GET(TIUCHNG("ADDM"))!$GET(TIUCHNG("DELETE"))
SET TIUCHNG("RBLD")=1
+2 IF '$TEST
SET TIUCHNG("UPDATE")=1
+3 NEW TIUVALMY
MERGE TIUVALMY=VALMY
+4 DO UPRBLD^TIURL(.TIUCHNG,.TIUVALMY)
KILL VALMY
+5 SET VALMBCK="R"
+6 DO VMSG^TIURS1($GET(TIULST),.TIUDAARY,"sent back")
+7 QUIT
LINK ; Link to problem(s)
+1 NEW TIUCHNG,TIUDA,DFN,TIU,TIUDATA,TIUEDIT,TIUI,TIUY,TIULST,Y,DIROUT
+2 NEW TIUDAARY
+3 IF '$DATA(VALMY)
DO EN^VALM2(XQORNOD(0))
+4 SET TIUI=0
+5 IF +$ORDER(VALMY(0))
DO CLEAR^VALM1
+6 FOR
SET TIUI=$ORDER(VALMY(TIUI))
if +TIUI'>0
QUIT
Begin DoDot:1
+7 NEW TIU,VALMY,XQORM,VA,VADM,GMPDFN,GMPLUSER,RSTRCTD
+8 SET TIUDATA=$GET(^TMP("TIURIDX",$JOB,TIUI))
+9 SET TIUDA=+$PIECE(TIUDATA,U,2)
SET GMPLUSER=1
+10 IF '$DATA(^TIU(8925,+TIUDA,0))
Begin DoDot:2
+11 WRITE !,$CHAR(7),"Document no longer exists.",!
+12 IF $$READ^TIUU("EA","Press RETURN to continue...")
WRITE ""
End DoDot:2
QUIT
+13 SET RSTRCTD=$$DOCRES^TIULRR(TIUDA)
+14 IF RSTRCTD
Begin DoDot:2
+15 ; Echo denial message
WRITE !!,$CHAR(7),"Ok, no harm done...",!
+16 ; pause
IF $$READ^TIUU("EA","RETURN to continue...")
End DoDot:2
QUIT
+17 SET TIUDAARY(TIUI)=TIUDA
+18 SET DFN=+$PIECE($GET(^TIU(8925,+TIUDA,0)),U,2)
+19 IF +DFN
DO DEM^VADPT
SET GMPDFN=DFN_U_VADM(1)_U_$EXTRACT(VADM(1))_VA("BID")
+20 SET TIUCHNG=0
+21 DO EN^VALM("TIU LINK TO PROBLEM")
+22 IF +$GET(TIUCHNG)
SET TIULST=$GET(TIULST)_$SELECT($GET(TIULST)]"":",",1:"")_TIUI
End DoDot:1
if $DATA(DIROUT)
QUIT
LINKX ; Revise list and cycle back as appropriate
+1 SET TIUCHNG("REFRESH")=1
+2 NEW TIUVALMY
MERGE TIUVALMY=VALMY
+3 DO UPRBLD^TIURL(.TIUCHNG,.TIUVALMY)
KILL VALMY
+4 SET VALMBCK="R"
+5 DO VMSG^TIURS1($GET(TIULST),.TIUDAARY,"linked to problems")
+6 QUIT
DEL(DA) ; -- Call to DEL for backward compatibility
+1 GOTO GODEL^TIURB2
+2 QUIT
