Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: TIURB

TIURB.m

Go to the documentation of this file.
  1. 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
  1. ; ICR 3473 TIU use of GMRCTIU
  1. ; ICR 1544 TIU use of $$ISA^USRLM
  1. AMEND ; Amendment action
  1. N TIUDA,DFN,DIE,DR,TIU,TIUDATA,TIUI,TIUSIG,TIUY,X,X1,Y
  1. N DIROUT,TIUCHNG,TIUDAARY,TIULST
  1. I '$D(VALMY) D EN^VALM2(XQORNOD(0))
  1. S TIUI=0
  1. F S TIUI=$O(VALMY(TIUI)) Q:+TIUI'>0 D Q:$D(DIROUT)
  1. . N RSTRCTD
  1. . S TIUDATA=$G(^TMP("TIURIDX",$J,TIUI))
  1. . S TIUDA=+$P(TIUDATA,U,2) S RSTRCTD=$$DOCRES^TIULRR(TIUDA)
  1. . I RSTRCTD D Q
  1. . . W !!,$C(7),"Ok, no harm done...",! ; Echo denial message
  1. . . I $$READ^TIUU("EA","RETURN to continue...") ; pause
  1. . W !!,"Amending #",+TIUDATA
  1. . S TIUCHNG=0
  1. . D AMEND1
  1. . I $G(TIUDAARY(TIUI)) D
  1. . . S TIULST=$G(TIULST)_$S($G(TIULST)]"":",",1:"")_TIUI
  1. ; -- Update or Rebuild list, restore video:
  1. D UPRBLD^TIURL(.TIUCHNG,.VALMY) K VALMY
  1. S VALMBCK="R"
  1. D VMSG^TIURS1($G(TIULST),.TIUDAARY,"amended")
  1. Q
  1. AMEND1 ; Single record amend
  1. N TIUCMT,TIUT0,TIUTYP,TIUAMND,TIUSNM,TIUSBLK,TIUCSNM,TIUCSBLK,DIE,DR
  1. N DA,DFN,DIWESUB,TIU,TIUODA,TIUTITL,TIUCLSS,TIUCON,TIUCNSLT,TIUPRF,TIUFLAG
  1. K ^TMP("TIURTRCT",$J)
  1. ; TIU*155 Gets consult data if exists
  1. S TIUTITL=$P($G(^TIU(8925,TIUDA,0)),U)
  1. S TIUCLSS=$$CLASS^TIUCNSLT()
  1. S TIUCON=+$$ISA^TIULX(TIUTITL,TIUCLSS)
  1. S TIUCNSLT=+$P($G(^TIU(8925,TIUDA,14)),U,5)
  1. S TIUPRF=0,TIUFLAG=0
  1. D ISPRFTTL^TIUPRF2(.TIUPRF,TIUTITL)
  1. I TIUPRF S TIUFLAG=$$FNDACTIF^TIUPRFL(TIUDA)
  1. L +^TIU(8925,+TIUDA):1
  1. E D Q
  1. . W !?5,$C(7),"Another user is editing this entry." H 3
  1. . S TIUCHNG("REFRESH")=1
  1. I +$P($G(^TIU(8925,+TIUDA,0)),U,5)'>6 D Q
  1. . W !?5,$C(7),"Only COMPLETED Documents may be amended."
  1. . I $$READ^TIUU("EA","Press RETURN to continue...") ; pause
  1. . S TIUCHNG("REFRESH")=1
  1. I '$$ISA^USRLM(+$G(DUZ),"PRIVACY ACT OFFICER"),'$$ISA^USRLM(+$G(DUZ),"CHIEF, MIS"),'$$ISA^USRLM(+$G(DUZ),"CHIEF, HIM") D Q
  1. . W !?5,$C(7),"Only Privacy Act Officers or MIS/HIM Chiefs may amend documents."
  1. . I $$READ^TIUU("EA","Press RETURN to continue...") ; pause
  1. . S TIUCHNG("REFRESH")=1
  1. I +$$HASIMG^TIURB2(TIUDA) D IMGNOTE^TIURB2 Q
  1. ;S TIUAMND=$$CANDO^TIULP(TIUDA,"AMENDMENT")
  1. ;I +TIUAMND'>0 D Q
  1. ;. W !!,$C(7),$C(7),$C(7),$P(TIUAMND,U,2),!
  1. ;. S TIUCHNG("REFRESH")=1
  1. ;. I $$READ^TIUU("EA","Press RETURN to continue...") ; pause
  1. ;VMP/ELR P232. ADDED NEXT PARAGRAPH TO PREVENT AMEND OF NIR OR ANESTHESIA REPORT MUST USE SURGERY
  1. I $$ISSURG^TIULP3(+TIUDA) D Q
  1. . S TIUAMND=$$SURMSG^TIULP3("AMENDMENT")
  1. . W !!,$C(7),$C(7),$C(7),$G(TIUAMND),!
  1. . S TIUCHNG("REFRESH")=1
  1. . I $$READ^TIUU("EA","Press RETURN to continue...") ; pause
  1. W !!,"Before proceeding, please enter your Electronic Signature Code..."
  1. S TIUAMND=$$GETSIG^TIURD2
  1. I +TIUAMND'>0 D Q
  1. . W !!," Ok, no harm done...",!
  1. . S TIUCHNG("REFRESH")=1
  1. . I $$READ^TIUU("EA","Press RETURN to continue...") ; pause
  1. W !!,"The ORIGINAL document will be RETRACTED, and a copy will be amended...",!
  1. S TIUODA=TIUDA
  1. S TIUDA=+$$RETRACT^TIURD2(TIUDA,"",7)
  1. I '+TIUDA D Q
  1. . W !!,$C(7),$C(7),$C(7),"Retraction of Original Document Failed.",!
  1. . I $$READ^TIUU("EA","Press RETURN to continue...") ; pause
  1. . S TIUDA=TIUODA,TIUCHNG("REFRESH")=1
  1. L +^TIU(8925,TIUDA):1
  1. E D Q
  1. . W !?5,$C(7),"Another user is editing this entry."
  1. . D RECOVER^TIURD4(TIUODA,TIUDA) H 3
  1. . S TIUPRF=$$LINK^TIUPRF1(TIUODA,+TIUFLAG,$P(TIUFLAG,U,2),$P($G(^TIU(8925,TIUODA,0)),U,2))
  1. . S TIUDA=TIUODA,TIUCHNG("REFRESH")=1
  1. S TIUSNM=$$DECRYPT^TIULC1($P(^TIU(8925,TIUDA,15),U,3),1,$$CHKSUM^TIULC("^TIU(8925,"_TIUDA_",""TEXT"")"))
  1. S TIUSBLK=$$DECRYPT^TIULC1($P($G(^TIU(8925,TIUDA,15)),U,4),1,$$CHKSUM^TIULC("^TIU(8925,"_TIUDA_",""TEXT"")"))
  1. S TIUCSNM=$$DECRYPT^TIULC1($P(^TIU(8925,TIUDA,15),U,9),1,$$CHKSUM^TIULC("^TIU(8925,"_TIUDA_",""TEXT"")"))
  1. S TIUCSBLK=$$DECRYPT^TIULC1($P($G(^TIU(8925,TIUDA,15)),U,10),1,$$CHKSUM^TIULC("^TIU(8925,"_TIUDA_",""TEXT"")"))
  1. S TIUTYP=+$G(^TIU(8925,+TIUDA,0)),TIUT0=$G(^TIU(8925.1,+TIUTYP,0))
  1. S TIUTYP(1)="1^"_+TIUTYP_U_$P(TIUT0,U,3)_U
  1. S DFN=$P($G(^TIU(8925,+TIUDA,0)),U,2)
  1. D GETTIU^TIULD(.TIU,TIUDA)
  1. S DIWESUB="Patient: "_$G(TIU("PNM"))
  1. S TIUCHNG=0 D FULL^VALM1,TEXTEDIT^TIUEDI4(TIUDA,.TIUCMT,.TIUCHNG)
  1. I '+$G(TIUCHNG) D Q
  1. . L -^TIU(8925,TIUDA)
  1. . D RECOVER^TIURD4(TIUODA,TIUDA)
  1. . S TIUPRF=$$LINK^TIUPRF1(TIUODA,+TIUFLAG,$P(TIUFLAG,U,2),$P($G(^TIU(8925,TIUODA,0)),U,2))
  1. . L -^TIU(8925,TIUODA) H 3
  1. . S TIUDA=TIUODA,TIUCHNG("REFRESH")=1
  1. I +$G(TIUCHNG) D
  1. . S DR=".05///AMENDED;1601////"_$$NOW^XLFDT_";1602////"_DUZ,DA=TIUDA,TIUSIG=0
  1. . S DR=DR_";1603////"_$$NOW^XLFDT_";1604///^S X=$$SIGNAME^TIULS(DUZ);1605///^S X=$$SIGTITL^TIULS(DUZ)",TIUSIG=1
  1. . S DIE=8925 D ^DIE
  1. . ; Refile /es/-block fields
  1. . S DR="1503///^S X=TIUSNM;1504///^S X=TIUSBLK;1509///^S X=TIUCSNM;1510///^S X=TIUCSBLK"
  1. . D ^DIE
  1. ; Drop Locks on both documents
  1. L -^TIU(8925,+TIUDA)
  1. L -^TIU(8925,+TIUODA)
  1. S TIUDAARY(TIUI)=TIUDA
  1. S TIUCHNG("RBLD")=1
  1. ; if note is associated with a patient record flag - clean up
  1. I +TIUFLAG S TIUPRF=$$LINK^TIUPRF1(TIUDA,+TIUFLAG,$P(TIUFLAG,U,2),$P($G(^TIU(8925,TIUDA,0)),U,2))
  1. ; TIU*155 If note is associated with a consult update ^GMR global
  1. ; to include the amended note
  1. ; Rollback retracted note from ^GMR(123 node 50
  1. I $G(TIUCON)=1 D
  1. . N STATUS,GMRCSTAT,TIUAUTH
  1. . S STATUS=$P($G(^TIU(8925,TIUDA,0)),U,5)
  1. . S GMRCSTAT=$S(STATUS>6:"COMPLETED",1:"INCOMPLETE")
  1. . S TIUAUTH=$P($G(^TIU(8925,TIUDA,12)),U,2)
  1. . D ROLLBACK^TIUCNSLT(TIUODA)
  1. . D GET^GMRCTIU(TIUCNSLT,TIUDA,GMRCSTAT,TIUAUTH)
  1. Q
  1. SENDBACK ; Send back a Document to transcription
  1. N TIUDA,DFN,TIU,TIUDATA,TIUCHNG,TIUI,TIUY,Y,DIROUT,TIULST
  1. N TIUDAARY
  1. I '$D(VALMY) D EN^VALM2(XQORNOD(0))
  1. S TIUI=0
  1. I +$O(VALMY(0)) D CLEAR^VALM1
  1. F S TIUI=$O(VALMY(TIUI)) Q:+TIUI'>0 D Q:$D(DIROUT)
  1. . N TIU,RSTRCTD
  1. . S TIUDATA=$G(^TMP("TIURIDX",$J,TIUI))
  1. . S TIUDA=+$P(TIUDATA,U,2) S RSTRCTD=$$DOCRES^TIULRR(TIUDA)
  1. . I RSTRCTD D Q
  1. . . W !!,$C(7),"Ok, no harm done...",! ; Echo denial message
  1. . . I $$READ^TIUU("EA","RETURN to continue...") ; pause
  1. . S TIUDAARY(TIUI)=TIUDA
  1. . S TIUCHNG=0
  1. . D EN^VALM("TIU SEND BACK")
  1. . I +$G(TIUCHNG) D
  1. . . S TIULST=$G(TIULST)_$S($G(TIULST)]"":",",1:"")_TIUI
  1. SENDX ; Revise list and cycle back as appropriate
  1. I $G(TIUCHNG("ADDM"))!$G(TIUCHNG("DELETE")) S TIUCHNG("RBLD")=1
  1. E S TIUCHNG("UPDATE")=1
  1. N TIUVALMY M TIUVALMY=VALMY
  1. D UPRBLD^TIURL(.TIUCHNG,.TIUVALMY) K VALMY
  1. S VALMBCK="R"
  1. D VMSG^TIURS1($G(TIULST),.TIUDAARY,"sent back")
  1. Q
  1. N TIUCHNG,TIUDA,DFN,TIU,TIUDATA,TIUEDIT,TIUI,TIUY,TIULST,Y,DIROUT
  1. N TIUDAARY
  1. I '$D(VALMY) D EN^VALM2(XQORNOD(0))
  1. S TIUI=0
  1. I +$O(VALMY(0)) D CLEAR^VALM1
  1. F S TIUI=$O(VALMY(TIUI)) Q:+TIUI'>0 D Q:$D(DIROUT)
  1. . N TIU,VALMY,XQORM,VA,VADM,GMPDFN,GMPLUSER,RSTRCTD
  1. . S TIUDATA=$G(^TMP("TIURIDX",$J,TIUI))
  1. . S TIUDA=+$P(TIUDATA,U,2),GMPLUSER=1
  1. . I '$D(^TIU(8925,+TIUDA,0)) D Q
  1. . . W !,$C(7),"Document no longer exists.",!
  1. . . I $$READ^TIUU("EA","Press RETURN to continue...") W ""
  1. . S RSTRCTD=$$DOCRES^TIULRR(TIUDA)
  1. . I RSTRCTD D Q
  1. . . W !!,$C(7),"Ok, no harm done...",! ; Echo denial message
  1. . . I $$READ^TIUU("EA","RETURN to continue...") ; pause
  1. . S TIUDAARY(TIUI)=TIUDA
  1. . S DFN=+$P($G(^TIU(8925,+TIUDA,0)),U,2)
  1. . I +DFN D DEM^VADPT S GMPDFN=DFN_U_VADM(1)_U_$E(VADM(1))_VA("BID")
  1. . S TIUCHNG=0
  1. . D EN^VALM("TIU LINK TO PROBLEM")
  1. . I +$G(TIUCHNG) S TIULST=$G(TIULST)_$S($G(TIULST)]"":",",1:"")_TIUI
  1. LINKX ; Revise list and cycle back as appropriate
  1. S TIUCHNG("REFRESH")=1
  1. N TIUVALMY M TIUVALMY=VALMY
  1. D UPRBLD^TIURL(.TIUCHNG,.TIUVALMY) K VALMY
  1. S VALMBCK="R"
  1. D VMSG^TIURS1($G(TIULST),.TIUDAARY,"linked to problems")
  1. Q
  1. DEL(DA) ; -- Call to DEL for backward compatibility
  1. G GODEL^TIURB2
  1. Q