source: WorldVistAEHR/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIURB.m@ 623

TIURB ; SLC/JER - More Review Screen Actions ;4/11/05
 ;;1.0;TEXT INTEGRATION UTILITIES;**4,32,52,78,58,100,109,155,184**;Jun 20, 1997
 ; **100** Moved DELETE, DEL, DELTEXT, DIK to new rtn TIURB2
 ; DBIA 3576 TIU use of GMRCTIU
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 SIGNED Documents may be amended."
 . 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
 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
 D UPRBLD^TIURL(.TIUCHNG,.VALMY) 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
 D UPRBLD^TIURL(.TIUCHNG,.VALMY) 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