| [613] | 1 | TIURD3 ; SLC/JER - Reassign actions ;11/01/03
|
|---|
| 2 | ;;1.0;TEXT INTEGRATION UTILITIES;**61,124,113,112**;Jun 20, 1997
|
|---|
| 3 | REASSIGO ; Reassign an original Document
|
|---|
| 4 | N TIU,TIUASK,TIUDPRM
|
|---|
| 5 | W !!,"Please choose the correct PATIENT and CARE EPISODE:",!
|
|---|
| 6 | ; --- Get a patient ---
|
|---|
| 7 | S DFN=+$$PATIENT^TIULA
|
|---|
| 8 | ; --- If no pt. selected, QUIT ---
|
|---|
| 9 | I +$G(DFN)'>0 D Q
|
|---|
| 10 | . S TIUOUT=1
|
|---|
| 11 | . W !!,"No PATIENT Selected: Aborting Transaction, No Harm Done...",!
|
|---|
| 12 | . I $$READ^TIUU("EA","Press RETURN to continue...") ; pause
|
|---|
| 13 | ; --- If document is a Surgical Report, redirect processing ---
|
|---|
| 14 | I +$$ISA^TIULX(TIUTYPE,+$$CLASS^TIUSROI("SURGICAL REPORTS")) D REASSOP^TIUSROI(DFN,TIUDA) Q
|
|---|
| 15 | ; --- If moving to another pt keep retracted original ---
|
|---|
| 16 | I +$G(DFN)'=$P(TIUD0(0),U,2),(+$P(TIUD0(0),U,5)>5) D
|
|---|
| 17 | . W !!,"Moving signed document to another Patient...A RETRACTED copy will be retained.",!
|
|---|
| 18 | . S TIUODA=TIUDA,TIUDA=+$$RETRACT^TIURD2(TIUDA)
|
|---|
| 19 | I TIUDA'>0 D Q
|
|---|
| 20 | . S TIUOUT=1
|
|---|
| 21 | . W !!,"Creation of a new Copy of the RETRACTED record failed...Contact IRM.",!
|
|---|
| 22 | . I $$READ^TIUU("EA","Press RETURN to continue...") ; pause
|
|---|
| 23 | ; --- Get Document Parameters for TIUTYPE
|
|---|
| 24 | D DOCPRM^TIULC1(TIUTYPE,.TIUDPRM)
|
|---|
| 25 | ; --- Get associated visit ---
|
|---|
| 26 | S TIULMETH=$$GETLMETH^TIUEDI1(TIUTYPE)
|
|---|
| 27 | I '$L(TIULMETH) D Q
|
|---|
| 28 | . S TIUOUT=1
|
|---|
| 29 | . W !!,$C(7),"No Visit Linkage Method defined for "
|
|---|
| 30 | . W $$PNAME^TIULC1(TIUTYPE),".",!,"Please contact IRM...",!
|
|---|
| 31 | . I $$READ^TIUU("EA","Press RETURN to continue...") ; pause
|
|---|
| 32 | X TIULMETH
|
|---|
| 33 | I '$D(TIU) D Q
|
|---|
| 34 | . S TIUOUT=1
|
|---|
| 35 | . W !!,$C(7),"Patient & Visit required: Aborting Transaction...No Harm Done.",!
|
|---|
| 36 | . I $$READ^TIUU("EA","Press RETURN to continue...") ; pause
|
|---|
| 37 | ; --- Validate Selection ---
|
|---|
| 38 | S TIUVMETH=$$GETVMETH^TIUEDI1(TIUTYPE)
|
|---|
| 39 | I '$L(TIUVMETH) D Q
|
|---|
| 40 | . S TIUOUT=1
|
|---|
| 41 | . W !!,$C(7),"No Validation Method defined for "
|
|---|
| 42 | . W $$PNAME^TIULC1(TIUTYPE),".",!,"Please contact IRM...",!
|
|---|
| 43 | . I $$READ^TIUU("EA","Press RETURN to continue...") ; pause
|
|---|
| 44 | X TIUVMETH
|
|---|
| 45 | I +$G(TIUASK)'>0 D Q
|
|---|
| 46 | . S TIUOUT=1
|
|---|
| 47 | . W !!,$C(7),"Okay, No Harm Done.",!
|
|---|
| 48 | . I $$READ^TIUU("EA","Press RETURN to continue...") W ""
|
|---|
| 49 | ; --- If same Pt & Visit, abort transaction ---
|
|---|
| 50 | I +$G(TIU("VISIT"))=$P(TIUD0(0),U,3) D Q:+$G(TIUOUT)
|
|---|
| 51 | . I +$G(TIUADD0),+$P($G(TIUDPRM(0)),U,10) Q
|
|---|
| 52 | . S TIUOUT=1
|
|---|
| 53 | . W !!,$C(7),$C(7),$C(7),"This ",$$PNAME^TIULC1(TIUTYPE)," is already associated with the selected visit...",!
|
|---|
| 54 | . W !,"No action taken.",!
|
|---|
| 55 | . I $$READ^TIUU("EA","Press RETURN to continue...") ; pause
|
|---|
| 56 | ; --- If valid Pt and Visit, Reassign the document ---
|
|---|
| 57 | I $L($G(TIU("VSTR"))) D
|
|---|
| 58 | . N DA,DR,DIE,TIUORIG,TIUOLD0
|
|---|
| 59 | . S TIUORIG=+$O(^TIU(8925,"APTLD",DFN,TIUTYPE,$G(TIU("VSTR")),0))
|
|---|
| 60 | . S TIUOLD0=$G(^TIU(8925,+TIUORIG,0))
|
|---|
| 61 | . ; If record exists and >1 documents/visit NOT allowed, offer
|
|---|
| 62 | . ; chance to attach record as addendum
|
|---|
| 63 | . I +TIUORIG,(+$P(TIUDPRM(0),U,10)'>0),(+$P(TIUOLD0,U,5)'>13) D Q
|
|---|
| 64 | . . N TIUATT
|
|---|
| 65 | . . I TIUORIG=TIUDA D Q
|
|---|
| 66 | . . . W !,$C(7),$C(7),$C(7),"This ",$$PNAME^TIULC1(TIUTYPE)," is already associated with the selected visit...",!
|
|---|
| 67 | . . . W !,"No action taken.",!
|
|---|
| 68 | . . . I $$READ^TIUU("EA","Press RETURN to continue...") ; pause
|
|---|
| 69 | . . W !!,$C(7),$C(7),$C(7),"This patient already has a "
|
|---|
| 70 | . . W $$UP^XLFSTR($$PNAME^TIULC1(TIUTYPE))," for the selected care"
|
|---|
| 71 | . . W !,"episode. Do you wish to make the current record an ADDENDUM of that ",!,$$UP^XLFSTR($$PNAME^TIULC1(TIUTYPE)),"?",!
|
|---|
| 72 | . . S TIUATT=$$READ^TIUU("YOA"," ...OK? ","YES")
|
|---|
| 73 | . . I +TIUATT'>0 D Q
|
|---|
| 74 | . . . W !!,"All right. No harm done.",!
|
|---|
| 75 | . . . S TIUOUT=1
|
|---|
| 76 | . . . I $$READ^TIUU("EA","Press RETURN to continue...") ; pause
|
|---|
| 77 | . . D DELIRT^TIUDIRT($S(+$G(TIUODA):+TIUODA,1:+TIUDA))
|
|---|
| 78 | . . D ATTACH^TIURD2(+TIUORIG,TIUDA),SEND^TIUALRT(TIUDA) S TIUCHNG=1
|
|---|
| 79 | . ; --- Roll back old IRT data ---
|
|---|
| 80 | . D DELIRT^TIUDIRT($S(+$G(TIUODA):+TIUODA,1:+TIUDA))
|
|---|
| 81 | . ; --- Set up the ^DIE Call ---
|
|---|
| 82 | . 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)
|
|---|
| 83 | . 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)
|
|---|
| 84 | . S:+$$ISDS^TIULX(TIUTYPE) DR=DR_";1301////^S X="_$$REFDTO^TIURD2(TIUDA,.TIU)
|
|---|
| 85 | . ; --- Don't ask author or cosigner for documents that have been signed ---
|
|---|
| 86 | . 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"
|
|---|
| 87 | . ; --- Call ^DIE to affect the Reassignment ---
|
|---|
| 88 | . S DA=TIUDA,DIE=8925 D ^DIE
|
|---|
| 89 | . ; --- Post-reassignment Steps ---
|
|---|
| 90 | . ; 1. Package Reassign Action:
|
|---|
| 91 | . D PKGACT(TIUDA,.TIUD0,.TIUD12,.TIUD13,.TIUD14,.TIUOUT)
|
|---|
| 92 | . Q:+$G(TIUOUT)
|
|---|
| 93 | . W !!,$G(TIUNAME)," Reassigned.",!
|
|---|
| 94 | . ; 2. Attach document to new Visit
|
|---|
| 95 | . D QUE^TIUPXAP1
|
|---|
| 96 | . ; 3. Update Addenda to Document
|
|---|
| 97 | . D UPDTADD^TIURD2(TIUDA)
|
|---|
| 98 | . ; 4. Update IRT Record
|
|---|
| 99 | . D UPDTIRT^TIUDIRT(.TIU,+TIUDA)
|
|---|
| 100 | . ; 5. Send Signature Alerts
|
|---|
| 101 | . D SEND^TIUALRT(TIUDA)
|
|---|
| 102 | . ; 6. Audit Reassignment
|
|---|
| 103 | . S TIUD0(1)=$G(^TIU(8925,+TIUDA,0)),TIUD12(1)=$G(^(12))
|
|---|
| 104 | . D AUDREASS^TIURB1(TIUDA,.TIUD0,.TIUD12)
|
|---|
| 105 | . ; 7. If document was retracted, register audit trail for it
|
|---|
| 106 | . I +$G(TIUODA) D AUDREASS^TIURB1(TIUODA,.TIUD0,.TIUD12)
|
|---|
| 107 | . I +$P($G(TIUD0(0)),U,3) D WKLD(.TIUD0,.TIUD12)
|
|---|
| 108 | . ;Finally, collect workload for target visit as appropriate
|
|---|
| 109 | . I (+$P(^TIU(8925,+TIUDA,0),U,5)>6),+$P(^TIU(8925,+TIUDA,0),U,11) D
|
|---|
| 110 | . . I $P(+$G(TIU("EDT")),".")'>DT D Q:'+TIUASK
|
|---|
| 111 | . . . W !!,"You may now edit the encounter data for the DESTINATION Visit...",!
|
|---|
| 112 | . . . W !,"Patient: ",$G(TIU("PNM")),!," Visit: ",$P($G(TIU("EDT")),U,2)," to ",$P($G(TIU("VLOC")),U,2)
|
|---|
| 113 | . . . W ! S TIUASK=+$$READ^TIUU("Y","Do you wish to do this now","NO")
|
|---|
| 114 | . . ;If no workload process using TIU's interview
|
|---|
| 115 | . . ;else, process using PCE's interview
|
|---|
| 116 | . . I '$$CHKVST^TIUPXAP2(+TIUDA) D I 1
|
|---|
| 117 | . . . N TIUCONT,TIUPRMT
|
|---|
| 118 | . . . Q:$D(XWBOS)
|
|---|
| 119 | . . . I $P(+$P(^TIU(8925,+TIUDA,0),U,7),".")>DT D Q
|
|---|
| 120 | . . . . W !!
|
|---|
| 121 | . . . . D QUE^TIUPXAP1
|
|---|
| 122 | . . . . I $$READ^TIUU("EA","Press RETURN to continue...") ; pause
|
|---|
| 123 | . . . ;W !!
|
|---|
| 124 | . . . ;need workload? if yes enter
|
|---|
| 125 | . . . I $$CHKWKL^TIUPXAP2(+TIUDA,.TIUDPRM) D CREDIT^TIUVSIT(TIUDA)
|
|---|
| 126 | . . E D
|
|---|
| 127 | . . . ;need workload? if yes enter
|
|---|
| 128 | . . . I $$CHKWKL^TIUPXAP2(+TIUDA,.TIUDPRM) D EDTENC^TIUPXAP2(TIUDA)
|
|---|
| 129 | . S TIUCHNG=1 S:+$G(TIUODA) TIUCHNG=TIUCHNG_U_TIUDA
|
|---|
| 130 | . W ! I $$READ^TIUU("EA","Press RETURN to continue...") ; pause
|
|---|
| 131 | Q
|
|---|
| 132 | ;
|
|---|
| 133 | WKLD(TIUD0,TIUD12) ; Allow user to clean up workload for visit from which document was removed
|
|---|
| 134 | N TIUVSIT,TIUWHAT,TIUERR,TIUDFN,TIUEDT,TIUHL
|
|---|
| 135 | I $S($P(TIUD0(0),U,13)="H":1,$P(TIUD0(0),U,13)="E":1,1:0) Q
|
|---|
| 136 | S TIUHL=$P(TIUD12(0),U,11)
|
|---|
| 137 | I $P($G(^SC(+TIUHL,0)),U,3)'="C" Q
|
|---|
| 138 | S TIUDFN=$P(TIUD0(0),U,2),TIUEDT=$P(TIUD0(0),U,7),TIUVSIT=$P(TIUD0(0),U,3)
|
|---|
| 139 | W !,"You may now clean up the encounter data for the ORIGINAL Visit...",!
|
|---|
| 140 | W !,"Patient: ",$$PTNAME^TIULC1(TIUDFN),!," Visit: ",$$DATE^TIULS(TIUEDT,"AMTH DD, CCYY@HR:MIN")," to ",$$VLOC^TIURD2(TIUHL)
|
|---|
| 141 | W ! I '+$$READ^TIUU("Y","Do you wish to do this now","NO") Q
|
|---|
| 142 | I $G(VALMAR)'="^TMP(""TIUR"",$J)" W !!,"Editing Encounter Data...",!
|
|---|
| 143 | S TIUWHAT=$S($$CHKAPPT^TIUPXAP2(TIUVSIT,TIUDFN,TIUEDT,TIUHL):"INTV",1:"ADDEDIT")
|
|---|
| 144 | S TIUERR=$$INTV^PXAPI(TIUWHAT,"TIU","TEXT INTEGRATION UTILITIES",.TIUVSIT,$S(+$G(TIUVSIT):"",1:TIUHL),TIUDFN,$S(+$G(TIUVSIT):"",1:TIUEDT))
|
|---|
| 145 | ;
|
|---|
| 146 | ;If an error is returned prompt to continue otherwise if a Visit
|
|---|
| 147 | ;IEN is returned and one is not already defined update the document
|
|---|
| 148 | ;I +TIUERR<0 D I 1
|
|---|
| 149 | ;. W ! I $$READ^TIUU("EA","Press RETURN to continue...") ; pause
|
|---|
| 150 | ;E I +$G(TIUVSIT),(+$G(TIUVSIT)'=$P($G(^TIU(8925,+TIUDA,0)),U,3)) D
|
|---|
| 151 | ;.
|
|---|
| 152 | Q
|
|---|
| 153 | PKGACT(TIUDA,TIUD0,TIUD12,TIUD13,TIUD14,TIUOUT) ; Get/Execute Package Reassign Action
|
|---|
| 154 | N TIUREASX,TIUPOP
|
|---|
| 155 | S TIUREASX=$$REASSIGN^TIULC1(+$G(^TIU(8925,+TIUDA,0)))
|
|---|
| 156 | I TIUREASX]"" D Q:+$G(TIUPOP)
|
|---|
| 157 | . X TIUREASX
|
|---|
| 158 | . I +$G(TIUPOP) D Q
|
|---|
| 159 | . . S TIUOUT=1
|
|---|
| 160 | . . D WHOABACK(TIUDA,TIUD0(0),TIUD12(0),TIUD13(0),TIUD14(0))
|
|---|
| 161 | . . W !!,$C(7),"Can't Reassign this document...",!
|
|---|
| 162 | . . I $$READ^TIUU("EA","Press RETURN to continue...") ; pause
|
|---|
| 163 | . ; --- If original was retracted, call package Delete Action to roll-back ---
|
|---|
| 164 | . I +$G(TIUODA) D
|
|---|
| 165 | . . N TIUDA,TIUDELX
|
|---|
| 166 | . . S TIUDA=TIUODA
|
|---|
| 167 | . . S TIUDELX=$$DELETE^TIULC1(+$G(^TIU(8925,+TIUDA,0)))
|
|---|
| 168 | . . I TIUDELX]"" X TIUDELX
|
|---|
| 169 | Q
|
|---|
| 170 | ;
|
|---|
| 171 | WHOABACK(DA,TIUD0,TIUD12,TIUD13,TIUD14) ; Undo Reassign when fails
|
|---|
| 172 | N DIE,DR S DIE=8925
|
|---|
| 173 | 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)
|
|---|
| 174 | 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)
|
|---|
| 175 | D ^DIE
|
|---|
| 176 | I +$P($G(^TIU(8925,+DA,0)),U,5)'>5 D
|
|---|
| 177 | . 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)
|
|---|
| 178 | . S DIE=8925 D ^DIE
|
|---|
| 179 | Q
|
|---|
