- TIURD3 ;SLC/JER - Reassign actions ;04/18/17 07:42
- ;;1.0;TEXT INTEGRATION UTILITIES;**61,124,113,112,295,290**;Jun 20, 1997;Build 548
- ;Per VHA Directive 2004-038, this routine should not be modified
- REASSIGO ; Reassign an original Document
- N TIU,TIUASK,TIUDPRM,TIUREASS,TIUVMETH,TIULMETH,TIUODA
- 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,,,,,1)
- I TIUDA'>0 D Q
- . S TIUOUT=1
- . D NOTIFY^TIUUTL("SEND")
- . 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
- . D NOTIFY^TIUUTL("SEND")
- . 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
- . D NOTIFY^TIUUTL("SEND")
- . 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
- . D NOTIFY^TIUUTL("SEND")
- . 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
- . D NOTIFY^TIUUTL("SEND")
- . 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
- . D NOTIFY^TIUUTL("CLEAR")
- . 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
- . . . D NOTIFY^TIUUTL("CLEAR")
- . . . 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
- . . . D NOTIFY^TIUUTL("CLEAR")
- . . . 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
- . . D NOTIFY^TIUUTL("REASSIGN",+$P(TIUOLD0,U,2),DFN,.TIU,TIUDA)
- . ; --- 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)
- . 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:+$$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 ---
- . ;*295 SET FLAG TO AVOID DEFER CODE
- . S TIUREASS=1
- . ; 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
- . ; 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)
- . ;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
- . . 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
- . D NOTIFY^TIUUTL("REASSIGN",+$P(TIUD0(0),U,2),DFN,.TIU,TIUDA,0,$P(TIUD0(0),U,3))
- . 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIURD3 9576 printed Jan 18, 2025@03:46:19 Page 2
- TIURD3 ;SLC/JER - Reassign actions ;04/18/17 07:42
- +1 ;;1.0;TEXT INTEGRATION UTILITIES;**61,124,113,112,295,290**;Jun 20, 1997;Build 548
- +2 ;Per VHA Directive 2004-038, this routine should not be modified
- REASSIGO ; Reassign an original Document
- +1 NEW TIU,TIUASK,TIUDPRM,TIUREASS,TIUVMETH,TIULMETH,TIUODA
- +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,,,,,1)
- End DoDot:1
- +16 IF TIUDA'>0
- Begin DoDot:1
- +17 SET TIUOUT=1
- +18 DO NOTIFY^TIUUTL("SEND")
- +19 WRITE !!,"Creation of a new Copy of the RETRACTED record failed...Contact IRM.",!
- +20 ; pause
- IF $$READ^TIUU("EA","Press RETURN to continue...")
- End DoDot:1
- QUIT
- +21 ; --- Get Document Parameters for TIUTYPE
- +22 DO DOCPRM^TIULC1(TIUTYPE,.TIUDPRM)
- +23 ; --- Get associated visit ---
- +24 SET TIULMETH=$$GETLMETH^TIUEDI1(TIUTYPE)
- +25 IF '$LENGTH(TIULMETH)
- Begin DoDot:1
- +26 SET TIUOUT=1
- +27 DO NOTIFY^TIUUTL("SEND")
- +28 WRITE !!,$CHAR(7),"No Visit Linkage Method defined for "
- +29 WRITE $$PNAME^TIULC1(TIUTYPE),".",!,"Please contact IRM...",!
- +30 ; pause
- IF $$READ^TIUU("EA","Press RETURN to continue...")
- End DoDot:1
- QUIT
- +31 XECUTE TIULMETH
- +32 IF '$DATA(TIU)
- Begin DoDot:1
- +33 SET TIUOUT=1
- +34 DO NOTIFY^TIUUTL("SEND")
- +35 WRITE !!,$CHAR(7),"Patient & Visit required: Aborting Transaction...No Harm Done.",!
- +36 ; pause
- IF $$READ^TIUU("EA","Press RETURN to continue...")
- End DoDot:1
- QUIT
- +37 ; --- Validate Selection ---
- +38 SET TIUVMETH=$$GETVMETH^TIUEDI1(TIUTYPE)
- +39 IF '$LENGTH(TIUVMETH)
- Begin DoDot:1
- +40 SET TIUOUT=1
- +41 DO NOTIFY^TIUUTL("SEND")
- +42 WRITE !!,$CHAR(7),"No Validation Method defined for "
- +43 WRITE $$PNAME^TIULC1(TIUTYPE),".",!,"Please contact IRM...",!
- +44 ; pause
- IF $$READ^TIUU("EA","Press RETURN to continue...")
- End DoDot:1
- QUIT
- +45 XECUTE TIUVMETH
- +46 IF +$GET(TIUASK)'>0
- Begin DoDot:1
- +47 SET TIUOUT=1
- +48 DO NOTIFY^TIUUTL("SEND")
- +49 WRITE !!,$CHAR(7),"Okay, No Harm Done.",!
- +50 IF $$READ^TIUU("EA","Press RETURN to continue...")
- WRITE ""
- End DoDot:1
- QUIT
- +51 ; --- If same Pt & Visit, abort transaction ---
- +52 IF +$GET(TIU("VISIT"))=$PIECE(TIUD0(0),U,3)
- Begin DoDot:1
- +53 IF +$GET(TIUADD0)
- IF +$PIECE($GET(TIUDPRM(0)),U,10)
- QUIT
- +54 SET TIUOUT=1
- +55 DO NOTIFY^TIUUTL("CLEAR")
- +56 WRITE !!,$CHAR(7),$CHAR(7),$CHAR(7),"This ",$$PNAME^TIULC1(TIUTYPE)," is already associated with the selected visit...",!
- +57 WRITE !,"No action taken.",!
- +58 ; pause
- IF $$READ^TIUU("EA","Press RETURN to continue...")
- End DoDot:1
- if +$GET(TIUOUT)
- QUIT
- +59 ; --- If valid Pt and Visit, Reassign the document ---
- +60 IF $LENGTH($GET(TIU("VSTR")))
- Begin DoDot:1
- +61 NEW DA,DR,DIE,TIUORIG,TIUOLD0
- +62 SET TIUORIG=+$ORDER(^TIU(8925,"APTLD",DFN,TIUTYPE,$GET(TIU("VSTR")),0))
- +63 SET TIUOLD0=$GET(^TIU(8925,+TIUORIG,0))
- +64 ; If record exists and >1 documents/visit NOT allowed, offer
- +65 ; chance to attach record as addendum
- +66 IF +TIUORIG
- IF (+$PIECE(TIUDPRM(0),U,10)'>0)
- IF (+$PIECE(TIUOLD0,U,5)'>13)
- Begin DoDot:2
- +67 NEW TIUATT
- +68 IF TIUORIG=TIUDA
- Begin DoDot:3
- +69 DO NOTIFY^TIUUTL("CLEAR")
- +70 WRITE !,$CHAR(7),$CHAR(7),$CHAR(7),"This ",$$PNAME^TIULC1(TIUTYPE)," is already associated with the selected visit...",!
- +71 WRITE !,"No action taken.",!
- +72 ; pause
- IF $$READ^TIUU("EA","Press RETURN to continue...")
- End DoDot:3
- QUIT
- +73 WRITE !!,$CHAR(7),$CHAR(7),$CHAR(7),"This patient already has a "
- +74 WRITE $$UP^XLFSTR($$PNAME^TIULC1(TIUTYPE))," for the selected care"
- +75 WRITE !,"episode. Do you wish to make the current record an ADDENDUM of that ",!,$$UP^XLFSTR($$PNAME^TIULC1(TIUTYPE)),"?",!
- +76 SET TIUATT=$$READ^TIUU("YOA"," ...OK? ","YES")
- +77 IF +TIUATT'>0
- Begin DoDot:3
- +78 WRITE !!,"All right. No harm done.",!
- +79 SET TIUOUT=1
- +80 DO NOTIFY^TIUUTL("CLEAR")
- +81 ; pause
- IF $$READ^TIUU("EA","Press RETURN to continue...")
- End DoDot:3
- QUIT
- +82 DO DELIRT^TIUDIRT($SELECT(+$GET(TIUODA):+TIUODA,1:+TIUDA))
- +83 DO ATTACH^TIURD2(+TIUORIG,TIUDA)
- DO SEND^TIUALRT(TIUDA)
- SET TIUCHNG=1
- +84 DO NOTIFY^TIUUTL("REASSIGN",+$PIECE(TIUOLD0,U,2),DFN,.TIU,TIUDA)
- End DoDot:2
- QUIT
- +85 ; --- Roll back old IRT data ---
- +86 DO DELIRT^TIUDIRT($SELECT(+$GET(TIUODA):+TIUODA,1:+TIUDA))
- +87 ; --- Set up the ^DIE Call ---
- +88 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)
- +89 SET DR=DR_";1205////"_$PIECE($GET(TIU("LOC")),U)_";1401////"_$SELECT($LENGTH($GET(TIU("AD#"))):+$GET(TIU("AD#")),1:"@")_";1402////"_$PIECE($GET(TIU("TS")),U)_";1211////"_$PIECE($GET(TIU("VLOC")),U)_";1212////"_$PIECE($GET(TIU("INST")),U
- )
- +90 if +$$ISDS^TIULX(TIUTYPE)
- SET DR=DR_";1301////^S X="_$$REFDTO^TIURD2(TIUDA,.TIU)
- +91 ; --- Don't ask author or cosigner for documents that have been signed ---
- +92 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"
- +93 ; --- Call ^DIE to affect the Reassignment ---
- +94 SET DA=TIUDA
- SET DIE=8925
- DO ^DIE
- +95 ; --- Post-reassignment Steps ---
- +96 ;*295 SET FLAG TO AVOID DEFER CODE
- +97 SET TIUREASS=1
- +98 ; 1. Package Reassign Action:
- +99 DO PKGACT(TIUDA,.TIUD0,.TIUD12,.TIUD13,.TIUD14,.TIUOUT)
- +100 if +$GET(TIUOUT)
- QUIT
- +101 WRITE !!,$GET(TIUNAME)," Reassigned.",!
- +102 ; 2. Attach document to new Visit
- +103 DO QUE^TIUPXAP1
- +104 ; 3. Update Addenda to Document
- +105 DO UPDTADD^TIURD2(TIUDA)
- +106 ; 4. Update IRT Record
- +107 DO UPDTIRT^TIUDIRT(.TIU,+TIUDA)
- +108 ; 5. Send Signature Alerts
- +109 DO SEND^TIUALRT(TIUDA)
- +110 ; 6. Audit Reassignment
- +111 SET TIUD0(1)=$GET(^TIU(8925,+TIUDA,0))
- SET TIUD12(1)=$GET(^(12))
- +112 DO AUDREASS^TIURB1(TIUDA,.TIUD0,.TIUD12)
- +113 ; 7. If document was retracted, register audit trail for it
- +114 IF +$GET(TIUODA)
- DO AUDREASS^TIURB1(TIUODA,.TIUD0,.TIUD12)
- +115 IF +$PIECE($GET(TIUD0(0)),U,3)
- DO WKLD(.TIUD0,.TIUD12)
- +116 ;Finally, collect workload for target visit as appropriate
- +117 IF (+$PIECE(^TIU(8925,+TIUDA,0),U,5)>6)
- IF +$PIECE(^TIU(8925,+TIUDA,0),U,11)
- Begin DoDot:2
- +118 IF $PIECE(+$GET(TIU("EDT")),".")'>DT
- Begin DoDot:3
- +119 WRITE !!,"You may now edit the encounter data for the DESTINATION Visit...",!
- +120 WRITE !,"Patient: ",$GET(TIU("PNM")),!," Visit: ",$PIECE($GET(TIU("EDT")),U,2)," to ",$PIECE($GET(TIU("VLOC")),U,2)
- +121 WRITE !
- SET TIUASK=+$$READ^TIUU("Y","Do you wish to do this now","NO")
- End DoDot:3
- if '+TIUASK
- QUIT
- +122 ;If no workload process using TIU's interview
- +123 ;else, process using PCE's interview
- +124 IF '$$CHKVST^TIUPXAP2(+TIUDA)
- Begin DoDot:3
- +125 NEW TIUCONT,TIUPRMT
- +126 if $DATA(XWBOS)
- QUIT
- +127 IF $PIECE(+$PIECE(^TIU(8925,+TIUDA,0),U,7),".")>DT
- Begin DoDot:4
- +128 WRITE !!
- +129 DO QUE^TIUPXAP1
- +130 ; pause
- IF $$READ^TIUU("EA","Press RETURN to continue...")
- End DoDot:4
- QUIT
- +131 ;W !!
- +132 ;need workload? if yes enter
- +133 IF $$CHKWKL^TIUPXAP2(+TIUDA,.TIUDPRM)
- DO CREDIT^TIUVSIT(TIUDA)
- End DoDot:3
- IF 1
- +134 IF '$TEST
- Begin DoDot:3
- +135 ;need workload? if yes enter
- +136 IF $$CHKWKL^TIUPXAP2(+TIUDA,.TIUDPRM)
- DO EDTENC^TIUPXAP2(TIUDA)
- End DoDot:3
- End DoDot:2
- +137 SET TIUCHNG=1
- if +$GET(TIUODA)
- SET TIUCHNG=TIUCHNG_U_TIUDA
- +138 DO NOTIFY^TIUUTL("REASSIGN",+$PIECE(TIUD0(0),U,2),DFN,.TIU,TIUDA,0,$PIECE(TIUD0(0),U,3))
- +139 ; pause
- WRITE !
- IF $$READ^TIUU("EA","Press RETURN to continue...")
- End DoDot:1
- +140 QUIT
- +141 ;
- 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