TIURD3 ; SLC/JER - Reassign actions ;01-Aug-2011 12:06;MGH
;;1.0;TEXT INTEGRATION UTILITIES;**61,124,113,112,1001,1005,1006,1009**;Jun 20, 1997;Build 22
;IHS/ITSC/LJF 02/27/2003 added code to update visit pointer in V note when changed here
; deleted inpatient data if changed to outpatient visit
;07/22/2004 bypass PCE coding on reassign
;IHS/ITSC/LJF 01/07/2005 found another place to bypass PCE coding PATCH 1001
;
;IHS/MSC/MGH 08/03/2006 Changed code for reference date on reassign
;IHS/MSC/MGH 10/22/2008 Changed the code back to entered date
REASSIGO ; Reassign an original Document
N TIU,TIUASK,TIUDPRM
W !!,"Please choose the correct PATIENT and CARE EPISODE:",!
; --- Get a patient ---
S DFN=+$$PATIENT^TIULA
; --- If no pt. selected, QUIT ---
I +$G(DFN)'>0 D Q
. S TIUOUT=1
. W !!,"No PATIENT Selected: Aborting Transaction, No Harm Done...",!
. I $$READ^TIUU("EA","Press RETURN to continue...") ; pause
; --- If document is a Surgical Report, redirect processing ---
I +$$ISA^TIULX(TIUTYPE,+$$CLASS^TIUSROI("SURGICAL REPORTS")) D REASSOP^TIUSROI(DFN,TIUDA) Q
; --- If moving to another pt keep retracted original ---
I +$G(DFN)'=$P(TIUD0(0),U,2),(+$P(TIUD0(0),U,5)>5) D
. W !!,"Moving signed document to another Patient...A RETRACTED copy will be retained.",!
. S TIUODA=TIUDA,TIUDA=+$$RETRACT^TIURD2(TIUDA)
I TIUDA'>0 D Q
. S TIUOUT=1
. W !!,"Creation of a new Copy of the RETRACTED record failed...Contact IRM.",!
. I $$READ^TIUU("EA","Press RETURN to continue...") ; pause
; --- Get Document Parameters for TIUTYPE
D DOCPRM^TIULC1(TIUTYPE,.TIUDPRM)
; --- Get associated visit ---
S TIULMETH=$$GETLMETH^TIUEDI1(TIUTYPE)
I '$L(TIULMETH) D Q
. S TIUOUT=1
. W !!,$C(7),"No Visit Linkage Method defined for "
. W $$PNAME^TIULC1(TIUTYPE),".",!,"Please contact IRM...",!
. I $$READ^TIUU("EA","Press RETURN to continue...") ; pause
X TIULMETH
I '$D(TIU) D Q
. S TIUOUT=1
. W !!,$C(7),"Patient & Visit required: Aborting Transaction...No Harm Done.",!
. I $$READ^TIUU("EA","Press RETURN to continue...") ; pause
; --- Validate Selection ---
S TIUVMETH=$$GETVMETH^TIUEDI1(TIUTYPE)
I '$L(TIUVMETH) D Q
. S TIUOUT=1
. W !!,$C(7),"No Validation Method defined for "
. W $$PNAME^TIULC1(TIUTYPE),".",!,"Please contact IRM...",!
. I $$READ^TIUU("EA","Press RETURN to continue...") ; pause
X TIUVMETH
I +$G(TIUASK)'>0 D Q
. S TIUOUT=1
. W !!,$C(7),"Okay, No Harm Done.",!
. I $$READ^TIUU("EA","Press RETURN to continue...") W ""
; --- If same Pt & Visit, abort transaction ---
I +$G(TIU("VISIT"))=$P(TIUD0(0),U,3) D Q:+$G(TIUOUT)
. I +$G(TIUADD0),+$P($G(TIUDPRM(0)),U,10) Q
. S TIUOUT=1
. W !!,$C(7),$C(7),$C(7),"This ",$$PNAME^TIULC1(TIUTYPE)," is already associated with the selected visit...",!
. W !,"No action taken.",!
. I $$READ^TIUU("EA","Press RETURN to continue...") ; pause
; --- If valid Pt and Visit, Reassign the document ---
I $L($G(TIU("VSTR"))) D
. N DA,DR,DIE,TIUORIG,TIUOLD0
. S TIUORIG=+$O(^TIU(8925,"APTLD",DFN,TIUTYPE,$G(TIU("VSTR")),0))
. S TIUOLD0=$G(^TIU(8925,+TIUORIG,0))
. ; If record exists and >1 documents/visit NOT allowed, offer
. ; chance to attach record as addendum
. I +TIUORIG,(+$P(TIUDPRM(0),U,10)'>0),(+$P(TIUOLD0,U,5)'>13) D Q
. . N TIUATT
. . I TIUORIG=TIUDA D Q
. . . W !,$C(7),$C(7),$C(7),"This ",$$PNAME^TIULC1(TIUTYPE)," is already associated with the selected visit...",!
. . . W !,"No action taken.",!
. . . I $$READ^TIUU("EA","Press RETURN to continue...") ; pause
. . W !!,$C(7),$C(7),$C(7),"This patient already has a "
. . W $$UP^XLFSTR($$PNAME^TIULC1(TIUTYPE))," for the selected care"
. . W !,"episode. Do you wish to make the current record an ADDENDUM of that ",!,$$UP^XLFSTR($$PNAME^TIULC1(TIUTYPE)),"?",!
. . S TIUATT=$$READ^TIUU("YOA"," ...OK? ","YES")
. . I +TIUATT'>0 D Q
. . . W !!,"All right. No harm done.",!
. . . S TIUOUT=1
. . . I $$READ^TIUU("EA","Press RETURN to continue...") ; pause
. . D DELIRT^TIUDIRT($S(+$G(TIUODA):+TIUODA,1:+TIUDA))
. . D ATTACH^TIURD2(+TIUORIG,TIUDA),SEND^TIUALRT(TIUDA) S TIUCHNG=1
. ; --- Roll back old IRT data ---
. D DELIRT^TIUDIRT($S(+$G(TIUODA):+TIUODA,1:+TIUDA))
. ; --- Set up the ^DIE Call ---
. S DR=$G(DR)_".02////"_DFN_";.03////"_$S(+$P($G(TIU("VISIT")),U):$P($G(TIU("VISIT")),U),1:"@")_";.07////"_$P($G(TIU("EDT")),U)_";.08////"_$S(+$G(TIU("LDT")):$P($G(TIU("LDT")),U),1:"@")_";.13////"_$P($G(TIU("VSTR")),";",3)
. ;IHS/ITSC/LJF 02/27/2003 add reference date to update, delete inpt data if needed
. ;S DR=DR_";1205////"_$P($G(TIU("LOC")),U)_";1401////"_$S($L($G(TIU("AD#"))):+$G(TIU("AD#")),1:"@")_";1402////"_$P($G(TIU("TS")),U)_";1211////"_$P($G(TIU("VLOC")),U)_";1212////"_$P($G(TIU("INST")),U)
. S DR=DR_";1205////"_$S(+$G(TIU("LOC")):$P($G(TIU("LOC")),U),1:"@")
. S DR=DR_";1401////"_$S(+$G(TIU("AD#")):$G(TIU("AD#")),1:"@")
. S DR=DR_";1402////"_$S(+$G(TIU("TS")):$P($G(TIU("TS")),U),1:"@")
. S DR=DR_";1211////"_$S(+$G(TIU("VLOC")):$P($G(TIU("VLOC")),U),1:"@")
. ;IHS/ITSC/LJF 02/27/2003 end of mods
. S:+$$ISDS^TIULX(TIUTYPE) DR=DR_";1301////^S X="_$$REFDTO^TIURD2(TIUDA,.TIU)
. ; --- Don't ask author or cosigner for documents that have been signed ---
. S:+$P($G(^TIU(8925,+TIUDA,0)),U,5)'>5 DR=DR_";1202;1204////^S X=$P(^TIU(8925,DA,12),U,2);I '+$P($G(^TIU(8925,+TIUDA,12)),U,8) S Y=0;1208"
. ; --- Call ^DIE to affect the Reassignment ---
. S DA=TIUDA,DIE=8925 D ^DIE
. ; --- Post-reassignment Steps ---
. ; 1. Package Reassign Action:
. D PKGACT(TIUDA,.TIUD0,.TIUD12,.TIUD13,.TIUD14,.TIUOUT)
. Q:+$G(TIUOUT)
. W !!,$G(TIUNAME)," Reassigned.",!
. ; 2. Attach document to new Visit
. D QUE^TIUPXAP1
. D VNOTFIX^BTIUU1(TIUDA) ;IHS/ITSC/LJF 02/27/2003 update V Note
. ; 3. Update Addenda to Document
. D UPDTADD^TIURD2(TIUDA)
. ; 4. Update IRT Record
. D UPDTIRT^TIUDIRT(.TIU,+TIUDA)
. ; 5. Send Signature Alerts
. D SEND^TIUALRT(TIUDA)
. ; 6. Audit Reassignment
. S TIUD0(1)=$G(^TIU(8925,+TIUDA,0)),TIUD12(1)=$G(^(12))
. D AUDREASS^TIURB1(TIUDA,.TIUD0,.TIUD12)
. ; 7. If document was retracted, register audit trail for it
. I +$G(TIUODA) D AUDREASS^TIURB1(TIUODA,.TIUD0,.TIUD12)
. ;I +$P($G(TIUD0(0)),U,3) D WKLD(.TIUD0,.TIUD12) ;IHS/ITSC/LJF 7/22/2004
. ;Finally, collect workload for target visit as appropriate
. I (+$P(^TIU(8925,+TIUDA,0),U,5)>6),+$P(^TIU(8925,+TIUDA,0),U,11) D
. . Q ;IHS/ITSC/LJF 7/22/2004 bypass PCE coding
. . I $P(+$G(TIU("EDT")),".")'>DT D Q:'+TIUASK
. . . W !!,"You may now edit the encounter data for the DESTINATION Visit...",!
. . . W !,"Patient: ",$G(TIU("PNM")),!," Visit: ",$P($G(TIU("EDT")),U,2)," to ",$P($G(TIU("VLOC")),U,2)
. . . W ! S TIUASK=+$$READ^TIUU("Y","Do you wish to do this now","NO")
. . ;If no workload process using TIU's interview
. . ;else, process using PCE's interview
. . I '$$CHKVST^TIUPXAP2(+TIUDA) D I 1
. . . N TIUCONT,TIUPRMT
. . . Q:$D(XWBOS)
. . . I $P(+$P(^TIU(8925,+TIUDA,0),U,7),".")>DT D Q
. . . . W !!
. . . . D QUE^TIUPXAP1
. . . . I $$READ^TIUU("EA","Press RETURN to continue...") ; pause
. . . ;W !!
. . . ;need workload? if yes enter
. . . I $$CHKWKL^TIUPXAP2(+TIUDA,.TIUDPRM) D CREDIT^TIUVSIT(TIUDA)
. . E D
. . . ;need workload? if yes enter
. . . I $$CHKWKL^TIUPXAP2(+TIUDA,.TIUDPRM) D EDTENC^TIUPXAP2(TIUDA)
. S TIUCHNG=1 S:+$G(TIUODA) TIUCHNG=TIUCHNG_U_TIUDA
. W ! I $$READ^TIUU("EA","Press RETURN to continue...") ; pause
Q
;
WKLD(TIUD0,TIUD12) ; Allow user to clean up workload for visit from which document was removed
N TIUVSIT,TIUWHAT,TIUERR,TIUDFN,TIUEDT,TIUHL
I $S($P(TIUD0(0),U,13)="H":1,$P(TIUD0(0),U,13)="E":1,1:0) Q
S TIUHL=$P(TIUD12(0),U,11)
I $P($G(^SC(+TIUHL,0)),U,3)'="C" Q
S TIUDFN=$P(TIUD0(0),U,2),TIUEDT=$P(TIUD0(0),U,7),TIUVSIT=$P(TIUD0(0),U,3)
W !,"You may now clean up the encounter data for the ORIGINAL Visit...",!
W !,"Patient: ",$$PTNAME^TIULC1(TIUDFN),!," Visit: ",$$DATE^TIULS(TIUEDT,"AMTH DD, CCYY@HR:MIN")," to ",$$VLOC^TIURD2(TIUHL)
W ! I '+$$READ^TIUU("Y","Do you wish to do this now","NO") Q
I $G(VALMAR)'="^TMP(""TIUR"",$J)" W !!,"Editing Encounter Data...",!
S TIUWHAT=$S($$CHKAPPT^TIUPXAP2(TIUVSIT,TIUDFN,TIUEDT,TIUHL):"INTV",1:"ADDEDIT")
S TIUERR=$$INTV^PXAPI(TIUWHAT,"TIU","TEXT INTEGRATION UTILITIES",.TIUVSIT,$S(+$G(TIUVSIT):"",1:TIUHL),TIUDFN,$S(+$G(TIUVSIT):"",1:TIUEDT))
;
;If an error is returned prompt to continue otherwise if a Visit
;IEN is returned and one is not already defined update the document
;I +TIUERR<0 D I 1
;. W ! I $$READ^TIUU("EA","Press RETURN to continue...") ; pause
;E I +$G(TIUVSIT),(+$G(TIUVSIT)'=$P($G(^TIU(8925,+TIUDA,0)),U,3)) D
;.
Q
PKGACT(TIUDA,TIUD0,TIUD12,TIUD13,TIUD14,TIUOUT) ; Get/Execute Package Reassign Action
N TIUREASX,TIUPOP
S TIUREASX=$$REASSIGN^TIULC1(+$G(^TIU(8925,+TIUDA,0)))
I TIUREASX]"" D Q:+$G(TIUPOP)
. X TIUREASX
. I +$G(TIUPOP) D Q
. . S TIUOUT=1
. . D WHOABACK(TIUDA,TIUD0(0),TIUD12(0),TIUD13(0),TIUD14(0))
. . W !!,$C(7),"Can't Reassign this document...",!
. . I $$READ^TIUU("EA","Press RETURN to continue...") ; pause
. ; --- If original was retracted, call package Delete Action to roll-back ---
. I +$G(TIUODA) D
. . N TIUDA,TIUDELX
. . S TIUDA=TIUODA
. . S TIUDELX=$$DELETE^TIULC1(+$G(^TIU(8925,+TIUDA,0)))
. . I TIUDELX]"" X TIUDELX
Q
;
WHOABACK(DA,TIUD0,TIUD12,TIUD13,TIUD14) ; Undo Reassign when fails
N DIE,DR S DIE=8925
S DR=".02////"_$P(TIUD0,U,2)_";.03////"_$P(TIUD0,U,3)_";.07////"_$P(TIUD0,U,7)_";.08////"_$P(TIUD0,U,8)_";.13////"_$P(TIUD0,U,13)
S DR=DR_";1205////"_$P(TIUD12,U,5)_";1401////"_$P(TIUD14,U)_";1402////"_$P(TIUD14,U,2)_";1211////"_$P(TIUD12,U,11)_";1212////"_$P(TIUD12,U,12)
D ^DIE
I +$P($G(^TIU(8925,+DA,0)),U,5)'>5 D
. S DR="1202////"_$P(TIUD12,U,2)_";1305////"_$P(TIUD13,U,5)_";1306////"_$P(TIUD13,U,6)_";1208////"_$P(TIUD12,U,8)_";1209////"_$P(TIUD12,U,9)
. S DIE=8925 D ^DIE
Q
TIURD3 ; SLC/JER - Reassign actions ;01-Aug-2011 12:06;MGH
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**61,124,113,112,1001,1005,1006,1009**;Jun 20, 1997;Build 22
+2 ;IHS/ITSC/LJF 02/27/2003 added code to update visit pointer in V note when changed here
+3 ; deleted inpatient data if changed to outpatient visit
+4 ;07/22/2004 bypass PCE coding on reassign
+5 ;IHS/ITSC/LJF 01/07/2005 found another place to bypass PCE coding PATCH 1001
+6 ;
+7 ;IHS/MSC/MGH 08/03/2006 Changed code for reference date on reassign
+8 ;IHS/MSC/MGH 10/22/2008 Changed the code back to entered date
REASSIGO ; Reassign an original Document
+1 NEW TIU,TIUASK,TIUDPRM
+2 WRITE !!,"Please choose the correct PATIENT and CARE EPISODE:",!
+3 ; --- Get a patient ---
+4 SET DFN=+$$PATIENT^TIULA
+5 ; --- If no pt. selected, QUIT ---
+6 IF +$GET(DFN)'>0
Begin DoDot:1
+7 SET TIUOUT=1
+8 WRITE !!,"No PATIENT Selected: Aborting Transaction, No Harm Done...",!
+9 ; pause
IF $$READ^TIUU("EA","Press RETURN to continue...")
End DoDot:1
QUIT
+10 ; --- If document is a Surgical Report, redirect processing ---
+11 IF +$$ISA^TIULX(TIUTYPE,+$$CLASS^TIUSROI("SURGICAL REPORTS"))
DO REASSOP^TIUSROI(DFN,TIUDA)
QUIT
+12 ; --- If moving to another pt keep retracted original ---
+13 IF +$GET(DFN)'=$PIECE(TIUD0(0),U,2)
IF (+$PIECE(TIUD0(0),U,5)>5)
Begin DoDot:1
+14 WRITE !!,"Moving signed document to another Patient...A RETRACTED copy will be retained.",!
+15 SET TIUODA=TIUDA
SET TIUDA=+$$RETRACT^TIURD2(TIUDA)
End DoDot:1
+16 IF TIUDA'>0
Begin DoDot:1
+17 SET TIUOUT=1
+18 WRITE !!,"Creation of a new Copy of the RETRACTED record failed...Contact IRM.",!
+19 ; pause
IF $$READ^TIUU("EA","Press RETURN to continue...")
End DoDot:1
QUIT
+20 ; --- Get Document Parameters for TIUTYPE
+21 DO DOCPRM^TIULC1(TIUTYPE,.TIUDPRM)
+22 ; --- Get associated visit ---
+23 SET TIULMETH=$$GETLMETH^TIUEDI1(TIUTYPE)
+24 IF '$LENGTH(TIULMETH)
Begin DoDot:1
+25 SET TIUOUT=1
+26 WRITE !!,$CHAR(7),"No Visit Linkage Method defined for "
+27 WRITE $$PNAME^TIULC1(TIUTYPE),".",!,"Please contact IRM...",!
+28 ; pause
IF $$READ^TIUU("EA","Press RETURN to continue...")
End DoDot:1
QUIT
+29 XECUTE TIULMETH
+30 IF '$DATA(TIU)
Begin DoDot:1
+31 SET TIUOUT=1
+32 WRITE !!,$CHAR(7),"Patient & Visit required: Aborting Transaction...No Harm Done.",!
+33 ; pause
IF $$READ^TIUU("EA","Press RETURN to continue...")
End DoDot:1
QUIT
+34 ; --- Validate Selection ---
+35 SET TIUVMETH=$$GETVMETH^TIUEDI1(TIUTYPE)
+36 IF '$LENGTH(TIUVMETH)
Begin DoDot:1
+37 SET TIUOUT=1
+38 WRITE !!,$CHAR(7),"No Validation Method defined for "
+39 WRITE $$PNAME^TIULC1(TIUTYPE),".",!,"Please contact IRM...",!
+40 ; pause
IF $$READ^TIUU("EA","Press RETURN to continue...")
End DoDot:1
QUIT
+41 XECUTE TIUVMETH
+42 IF +$GET(TIUASK)'>0
Begin DoDot:1
+43 SET TIUOUT=1
+44 WRITE !!,$CHAR(7),"Okay, No Harm Done.",!
+45 IF $$READ^TIUU("EA","Press RETURN to continue...")
WRITE ""
End DoDot:1
QUIT
+46 ; --- If same Pt & Visit, abort transaction ---
+47 IF +$GET(TIU("VISIT"))=$PIECE(TIUD0(0),U,3)
Begin DoDot:1
+48 IF +$GET(TIUADD0)
IF +$PIECE($GET(TIUDPRM(0)),U,10)
QUIT
+49 SET TIUOUT=1
+50 WRITE !!,$CHAR(7),$CHAR(7),$CHAR(7),"This ",$$PNAME^TIULC1(TIUTYPE)," is already associated with the selected visit...",!
+51 WRITE !,"No action taken.",!
+52 ; pause
IF $$READ^TIUU("EA","Press RETURN to continue...")
End DoDot:1
IF +$GET(TIUOUT)
QUIT
+53 ; --- If valid Pt and Visit, Reassign the document ---
+54 IF $LENGTH($GET(TIU("VSTR")))
Begin DoDot:1
+55 NEW DA,DR,DIE,TIUORIG,TIUOLD0
+56 SET TIUORIG=+$ORDER(^TIU(8925,"APTLD",DFN,TIUTYPE,$GET(TIU("VSTR")),0))
+57 SET TIUOLD0=$GET(^TIU(8925,+TIUORIG,0))
+58 ; If record exists and >1 documents/visit NOT allowed, offer
+59 ; chance to attach record as addendum
+60 IF +TIUORIG
IF (+$PIECE(TIUDPRM(0),U,10)'>0)
IF (+$PIECE(TIUOLD0,U,5)'>13)
Begin DoDot:2
+61 NEW TIUATT
+62 IF TIUORIG=TIUDA
Begin DoDot:3
+63 WRITE !,$CHAR(7),$CHAR(7),$CHAR(7),"This ",$$PNAME^TIULC1(TIUTYPE)," is already associated with the selected visit...",!
+64 WRITE !,"No action taken.",!
+65 ; pause
IF $$READ^TIUU("EA","Press RETURN to continue...")
End DoDot:3
QUIT
+66 WRITE !!,$CHAR(7),$CHAR(7),$CHAR(7),"This patient already has a "
+67 WRITE $$UP^XLFSTR($$PNAME^TIULC1(TIUTYPE))," for the selected care"
+68 WRITE !,"episode. Do you wish to make the current record an ADDENDUM of that ",!,$$UP^XLFSTR($$PNAME^TIULC1(TIUTYPE)),"?",!
+69 SET TIUATT=$$READ^TIUU("YOA"," ...OK? ","YES")
+70 IF +TIUATT'>0
Begin DoDot:3
+71 WRITE !!,"All right. No harm done.",!
+72 SET TIUOUT=1
+73 ; pause
IF $$READ^TIUU("EA","Press RETURN to continue...")
End DoDot:3
QUIT
+74 DO DELIRT^TIUDIRT($SELECT(+$GET(TIUODA):+TIUODA,1:+TIUDA))
+75 DO ATTACH^TIURD2(+TIUORIG,TIUDA)
DO SEND^TIUALRT(TIUDA)
SET TIUCHNG=1
End DoDot:2
QUIT
+76 ; --- Roll back old IRT data ---
+77 DO DELIRT^TIUDIRT($SELECT(+$GET(TIUODA):+TIUODA,1:+TIUDA))
+78 ; --- Set up the ^DIE Call ---
+79 SET DR=$GET(DR)_".02////"_DFN_";.03////"_$SELECT(+$PIECE($GET(TIU("VISIT")),U):$PIECE($GET(TIU("VISIT")),U),1:"@")_";.07////"_$PIECE($GET(TIU("EDT")),U)_";.08////"_$SELECT(+...
... $GET(TIU("LDT")):$PIECE($GET(TIU("LDT")),U),1:"@")_";.13////"_$PIECE($GET(TIU("VSTR")),";",3)
+80 ;IHS/ITSC/LJF 02/27/2003 add reference date to update, delete inpt data if needed
+81 ;S DR=DR_";1205////"_$P($G(TIU("LOC")),U)_";1401////"_$S($L($G(TIU("AD#"))):+$G(TIU("AD#")),1:"@")_";1402////"_$P($G(TIU("TS")),U)_";1211////"_$P($G(TIU("VLOC")),U)_";1212////"_$P($G(TIU("INST")),U)
+82 SET DR=DR_";1205////"_$SELECT(+$GET(TIU("LOC")):$PIECE($GET(TIU("LOC")),U),1:"@")
+83 SET DR=DR_";1401////"_$SELECT(+$GET(TIU("AD#")):$GET(TIU("AD#")),1:"@")
+84 SET DR=DR_";1402////"_$SELECT(+$GET(TIU("TS")):$PIECE($GET(TIU("TS")),U),1:"@")
+85 SET DR=DR_";1211////"_$SELECT(+$GET(TIU("VLOC")):$PIECE($GET(TIU("VLOC")),U),1:"@")
+86 ;IHS/ITSC/LJF 02/27/2003 end of mods
+87 IF +$$ISDS^TIULX(TIUTYPE)
SET DR=DR_";1301////^S X="_$$REFDTO^TIURD2(TIUDA,.TIU)
+88 ; --- Don't ask author or cosigner for documents that have been signed ---
+89 IF +$PIECE($GET(^TIU(8925,+TIUDA,0)),U,5)'>5
SET DR=DR_";1202;1204////^S X=$P(^TIU(8925,DA,12),U,2);I '+$P($G(^TIU(8925,+TIUDA,12)),U,8) S Y=0;1208"
+90 ; --- Call ^DIE to affect the Reassignment ---
+91 SET DA=TIUDA
SET DIE=8925
DO ^DIE
+92 ; --- Post-reassignment Steps ---
+93 ; 1. Package Reassign Action:
+94 DO PKGACT(TIUDA,.TIUD0,.TIUD12,.TIUD13,.TIUD14,.TIUOUT)
+95 IF +$GET(TIUOUT)
QUIT
+96 WRITE !!,$GET(TIUNAME)," Reassigned.",!
+97 ; 2. Attach document to new Visit
+98 DO QUE^TIUPXAP1
+99 ;IHS/ITSC/LJF 02/27/2003 update V Note
DO VNOTFIX^BTIUU1(TIUDA)
+100 ; 3. Update Addenda to Document
+101 DO UPDTADD^TIURD2(TIUDA)
+102 ; 4. Update IRT Record
+103 DO UPDTIRT^TIUDIRT(.TIU,+TIUDA)
+104 ; 5. Send Signature Alerts
+105 DO SEND^TIUALRT(TIUDA)
+106 ; 6. Audit Reassignment
+107 SET TIUD0(1)=$GET(^TIU(8925,+TIUDA,0))
SET TIUD12(1)=$GET(^(12))
+108 DO AUDREASS^TIURB1(TIUDA,.TIUD0,.TIUD12)
+109 ; 7. If document was retracted, register audit trail for it
+110 IF +$GET(TIUODA)
DO AUDREASS^TIURB1(TIUODA,.TIUD0,.TIUD12)
+111 ;I +$P($G(TIUD0(0)),U,3) D WKLD(.TIUD0,.TIUD12) ;IHS/ITSC/LJF 7/22/2004
+112 ;Finally, collect workload for target visit as appropriate
+113 IF (+$PIECE(^TIU(8925,+TIUDA,0),U,5)>6)
IF +$PIECE(^TIU(8925,+TIUDA,0),U,11)
Begin DoDot:2
+114 ;IHS/ITSC/LJF 7/22/2004 bypass PCE coding
QUIT
+115 IF $PIECE(+$GET(TIU("EDT")),".")'>DT
Begin DoDot:3
+116 WRITE !!,"You may now edit the encounter data for the DESTINATION Visit...",!
+117 WRITE !,"Patient: ",$GET(TIU("PNM")),!," Visit: ",$PIECE($GET(TIU("EDT")),U,2)," to ",$PIECE($GET(TIU("VLOC")),U,2)
+118 WRITE !
SET TIUASK=+$$READ^TIUU("Y","Do you wish to do this now","NO")
End DoDot:3
IF '+TIUASK
QUIT
+119 ;If no workload process using TIU's interview
+120 ;else, process using PCE's interview
+121 IF '$$CHKVST^TIUPXAP2(+TIUDA)
Begin DoDot:3
+122 NEW TIUCONT,TIUPRMT
+123 IF $DATA(XWBOS)
QUIT
+124 IF $PIECE(+$PIECE(^TIU(8925,+TIUDA,0),U,7),".")>DT
Begin DoDot:4
+125 WRITE !!
+126 DO QUE^TIUPXAP1
+127 ; pause
IF $$READ^TIUU("EA","Press RETURN to continue...")
End DoDot:4
QUIT
+128 ;W !!
+129 ;need workload? if yes enter
+130 IF $$CHKWKL^TIUPXAP2(+TIUDA,.TIUDPRM)
DO CREDIT^TIUVSIT(TIUDA)
End DoDot:3
IF 1
+131 IF '$TEST
Begin DoDot:3
+132 ;need workload? if yes enter
+133 IF $$CHKWKL^TIUPXAP2(+TIUDA,.TIUDPRM)
DO EDTENC^TIUPXAP2(TIUDA)
End DoDot:3
End DoDot:2
+134 SET TIUCHNG=1
IF +$GET(TIUODA)
SET TIUCHNG=TIUCHNG_U_TIUDA
+135 ; pause
WRITE !
IF $$READ^TIUU("EA","Press RETURN to continue...")
End DoDot:1
+136 QUIT
+137 ;
WKLD(TIUD0,TIUD12) ; Allow user to clean up workload for visit from which document was removed
+1 NEW TIUVSIT,TIUWHAT,TIUERR,TIUDFN,TIUEDT,TIUHL
+2 IF $SELECT($PIECE(TIUD0(0),U,13)="H":1,$PIECE(TIUD0(0),U,13)="E":1,1:0)
QUIT
+3 SET TIUHL=$PIECE(TIUD12(0),U,11)
+4 IF $PIECE($GET(^SC(+TIUHL,0)),U,3)'="C"
QUIT
+5 SET TIUDFN=$PIECE(TIUD0(0),U,2)
SET TIUEDT=$PIECE(TIUD0(0),U,7)
SET TIUVSIT=$PIECE(TIUD0(0),U,3)
+6 WRITE !,"You may now clean up the encounter data for the ORIGINAL Visit...",!
+7 WRITE !,"Patient: ",$$PTNAME^TIULC1(TIUDFN),!," Visit: ",$$DATE^TIULS(TIUEDT,"AMTH DD, CCYY@HR:MIN")," to ",$$VLOC^TIURD2(TIUHL)
+8 WRITE !
IF '+$$READ^TIUU("Y","Do you wish to do this now","NO")
QUIT
+9 IF $GET(VALMAR)'="^TMP(""TIUR"",$J)"
WRITE !!,"Editing Encounter Data...",!
+10 SET TIUWHAT=$SELECT($$CHKAPPT^TIUPXAP2(TIUVSIT,TIUDFN,TIUEDT,TIUHL):"INTV",1:"ADDEDIT")
+11 SET TIUERR=$$INTV^PXAPI(TIUWHAT,"TIU","TEXT INTEGRATION UTILITIES",.TIUVSIT,$SELECT(+$GET(TIUVSIT):"",1:TIUHL),TIUDFN,$SELECT(+$GET(TIUVSIT):"",1:TIUEDT))
+12 ;
+13 ;If an error is returned prompt to continue otherwise if a Visit
+14 ;IEN is returned and one is not already defined update the document
+15 ;I +TIUERR<0 D I 1
+16 ;. W ! I $$READ^TIUU("EA","Press RETURN to continue...") ; pause
+17 ;E I +$G(TIUVSIT),(+$G(TIUVSIT)'=$P($G(^TIU(8925,+TIUDA,0)),U,3)) D
+18 ;.
+19 QUIT
PKGACT(TIUDA,TIUD0,TIUD12,TIUD13,TIUD14,TIUOUT) ; Get/Execute Package Reassign Action
+1 NEW TIUREASX,TIUPOP
+2 SET TIUREASX=$$REASSIGN^TIULC1(+$GET(^TIU(8925,+TIUDA,0)))
+3 IF TIUREASX]""
Begin DoDot:1
+4 XECUTE TIUREASX
+5 IF +$GET(TIUPOP)
Begin DoDot:2
+6 SET TIUOUT=1
+7 DO WHOABACK(TIUDA,TIUD0(0),TIUD12(0),TIUD13(0),TIUD14(0))
+8 WRITE !!,$CHAR(7),"Can't Reassign this document...",!
+9 ; pause
IF $$READ^TIUU("EA","Press RETURN to continue...")
End DoDot:2
QUIT
+10 ; --- If original was retracted, call package Delete Action to roll-back ---
+11 IF +$GET(TIUODA)
Begin DoDot:2
+12 NEW TIUDA,TIUDELX
+13 SET TIUDA=TIUODA
+14 SET TIUDELX=$$DELETE^TIULC1(+$GET(^TIU(8925,+TIUDA,0)))
+15 IF TIUDELX]""
XECUTE TIUDELX
End DoDot:2
End DoDot:1
IF +$GET(TIUPOP)
QUIT
+16 QUIT
+17 ;
WHOABACK(DA,TIUD0,TIUD12,TIUD13,TIUD14) ; Undo Reassign when fails
+1 NEW DIE,DR
SET DIE=8925
+2 SET DR=".02////"_$PIECE(TIUD0,U,2)_";.03////"_$PIECE(TIUD0,U,3)_";.07////"_$PIECE(TIUD0,U,7)_";.08////"_$PIECE(TIUD0,U,8)_";.13////"_$PIECE(TIUD0,U,13)
+3 SET DR=DR_";1205////"_$PIECE(TIUD12,U,5)_";1401////"_$PIECE(TIUD14,U)_";1402////"_$PIECE(TIUD14,U,2)_";1211////"_$PIECE(TIUD12,U,11)_";1212////"_$PIECE(TIUD12,U,12)
+4 DO ^DIE
+5 IF +$PIECE($GET(^TIU(8925,+DA,0)),U,5)'>5
Begin DoDot:1
+6 SET DR="1202////"_$PIECE(TIUD12,U,2)_";1305////"_$PIECE(TIUD13,U,5)_";1306////"_$PIECE(TIUD13,U,6)_";1208////"_$PIECE(TIUD12,U,8)_";1209////"_$PIECE(TIUD12,U,9)
+7 SET DIE=8925
DO ^DIE
End DoDot:1
+8 QUIT
