- TIURB ; SLC/JER - More Review Screen Actions ;07/12/16 13:05
- ;;1.0;TEXT INTEGRATION UTILITIES;**4,32,52,78,58,100,109,155,184,234,232,290**;Jun 20, 1997;Build 548
- ; ICR 3473 TIU use of GMRCTIU
- ; ICR 1544 TIU use of $$ISA^USRLM
- 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 COMPLETED Documents may be amended."
- . I $$READ^TIUU("EA","Press RETURN to continue...") ; pause
- . S TIUCHNG("REFRESH")=1
- I '$$ISA^USRLM(+$G(DUZ),"PRIVACY ACT OFFICER"),'$$ISA^USRLM(+$G(DUZ),"CHIEF, MIS"),'$$ISA^USRLM(+$G(DUZ),"CHIEF, HIM") D Q
- . W !?5,$C(7),"Only Privacy Act Officers or MIS/HIM Chiefs may amend documents."
- . 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
- ;VMP/ELR P232. ADDED NEXT PARAGRAPH TO PREVENT AMEND OF NIR OR ANESTHESIA REPORT MUST USE SURGERY
- I $$ISSURG^TIULP3(+TIUDA) D Q
- . S TIUAMND=$$SURMSG^TIULP3("AMENDMENT")
- . W !!,$C(7),$C(7),$C(7),$G(TIUAMND),!
- . 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
- N TIUVALMY M TIUVALMY=VALMY
- D UPRBLD^TIURL(.TIUCHNG,.TIUVALMY) 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
- N TIUVALMY M TIUVALMY=VALMY
- D UPRBLD^TIURL(.TIUCHNG,.TIUVALMY) 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIURB 7832 printed Jan 18, 2025@03:46:10 Page 2
- 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
- +2 ; ICR 3473 TIU use of GMRCTIU
- +3 ; ICR 1544 TIU use of $$ISA^USRLM
- AMEND ; Amendment action
- +1 NEW TIUDA,DFN,DIE,DR,TIU,TIUDATA,TIUI,TIUSIG,TIUY,X,X1,Y
- +2 NEW DIROUT,TIUCHNG,TIUDAARY,TIULST
- +3 IF '$DATA(VALMY)
- DO EN^VALM2(XQORNOD(0))
- +4 SET TIUI=0
- +5 FOR
- SET TIUI=$ORDER(VALMY(TIUI))
- if +TIUI'>0
- QUIT
- Begin DoDot:1
- +6 NEW RSTRCTD
- +7 SET TIUDATA=$GET(^TMP("TIURIDX",$JOB,TIUI))
- +8 SET TIUDA=+$PIECE(TIUDATA,U,2)
- SET RSTRCTD=$$DOCRES^TIULRR(TIUDA)
- +9 IF RSTRCTD
- Begin DoDot:2
- +10 ; Echo denial message
- WRITE !!,$CHAR(7),"Ok, no harm done...",!
- +11 ; pause
- IF $$READ^TIUU("EA","RETURN to continue...")
- End DoDot:2
- QUIT
- +12 WRITE !!,"Amending #",+TIUDATA
- +13 SET TIUCHNG=0
- +14 DO AMEND1
- +15 IF $GET(TIUDAARY(TIUI))
- Begin DoDot:2
- +16 SET TIULST=$GET(TIULST)_$SELECT($GET(TIULST)]"":",",1:"")_TIUI
- End DoDot:2
- End DoDot:1
- if $DATA(DIROUT)
- QUIT
- +17 ; -- Update or Rebuild list, restore video:
- +18 DO UPRBLD^TIURL(.TIUCHNG,.VALMY)
- KILL VALMY
- +19 SET VALMBCK="R"
- +20 DO VMSG^TIURS1($GET(TIULST),.TIUDAARY,"amended")
- +21 QUIT
- AMEND1 ; Single record amend
- +1 NEW TIUCMT,TIUT0,TIUTYP,TIUAMND,TIUSNM,TIUSBLK,TIUCSNM,TIUCSBLK,DIE,DR
- +2 NEW DA,DFN,DIWESUB,TIU,TIUODA,TIUTITL,TIUCLSS,TIUCON,TIUCNSLT,TIUPRF,TIUFLAG
- +3 KILL ^TMP("TIURTRCT",$JOB)
- +4 ; TIU*155 Gets consult data if exists
- +5 SET TIUTITL=$PIECE($GET(^TIU(8925,TIUDA,0)),U)
- +6 SET TIUCLSS=$$CLASS^TIUCNSLT()
- +7 SET TIUCON=+$$ISA^TIULX(TIUTITL,TIUCLSS)
- +8 SET TIUCNSLT=+$PIECE($GET(^TIU(8925,TIUDA,14)),U,5)
- +9 SET TIUPRF=0
- SET TIUFLAG=0
- +10 DO ISPRFTTL^TIUPRF2(.TIUPRF,TIUTITL)
- +11 IF TIUPRF
- SET TIUFLAG=$$FNDACTIF^TIUPRFL(TIUDA)
- +12 LOCK +^TIU(8925,+TIUDA):1
- +13 IF '$TEST
- Begin DoDot:1
- +14 WRITE !?5,$CHAR(7),"Another user is editing this entry."
- HANG 3
- +15 SET TIUCHNG("REFRESH")=1
- End DoDot:1
- QUIT
- +16 IF +$PIECE($GET(^TIU(8925,+TIUDA,0)),U,5)'>6
- Begin DoDot:1
- +17 WRITE !?5,$CHAR(7),"Only COMPLETED Documents may be amended."
- +18 ; pause
- IF $$READ^TIUU("EA","Press RETURN to continue...")
- +19 SET TIUCHNG("REFRESH")=1
- End DoDot:1
- QUIT
- +20 IF '$$ISA^USRLM(+$GET(DUZ),"PRIVACY ACT OFFICER")
- IF '$$ISA^USRLM(+$GET(DUZ),"CHIEF, MIS")
- IF '$$ISA^USRLM(+$GET(DUZ),"CHIEF, HIM")
- Begin DoDot:1
- +21 WRITE !?5,$CHAR(7),"Only Privacy Act Officers or MIS/HIM Chiefs may amend documents."
- +22 ; pause
- IF $$READ^TIUU("EA","Press RETURN to continue...")
- +23 SET TIUCHNG("REFRESH")=1
- End DoDot:1
- QUIT
- +24 IF +$$HASIMG^TIURB2(TIUDA)
- DO IMGNOTE^TIURB2
- QUIT
- +25 ;S TIUAMND=$$CANDO^TIULP(TIUDA,"AMENDMENT")
- +26 ;I +TIUAMND'>0 D Q
- +27 ;. W !!,$C(7),$C(7),$C(7),$P(TIUAMND,U,2),!
- +28 ;. S TIUCHNG("REFRESH")=1
- +29 ;. I $$READ^TIUU("EA","Press RETURN to continue...") ; pause
- +30 ;VMP/ELR P232. ADDED NEXT PARAGRAPH TO PREVENT AMEND OF NIR OR ANESTHESIA REPORT MUST USE SURGERY
- +31 IF $$ISSURG^TIULP3(+TIUDA)
- Begin DoDot:1
- +32 SET TIUAMND=$$SURMSG^TIULP3("AMENDMENT")
- +33 WRITE !!,$CHAR(7),$CHAR(7),$CHAR(7),$GET(TIUAMND),!
- +34 SET TIUCHNG("REFRESH")=1
- +35 ; pause
- IF $$READ^TIUU("EA","Press RETURN to continue...")
- End DoDot:1
- QUIT
- +36 WRITE !!,"Before proceeding, please enter your Electronic Signature Code..."
- +37 SET TIUAMND=$$GETSIG^TIURD2
- +38 IF +TIUAMND'>0
- Begin DoDot:1
- +39 WRITE !!," Ok, no harm done...",!
- +40 SET TIUCHNG("REFRESH")=1
- +41 ; pause
- IF $$READ^TIUU("EA","Press RETURN to continue...")
- End DoDot:1
- QUIT
- +42 WRITE !!,"The ORIGINAL document will be RETRACTED, and a copy will be amended...",!
- +43 SET TIUODA=TIUDA
- +44 SET TIUDA=+$$RETRACT^TIURD2(TIUDA,"",7)
- +45 IF '+TIUDA
- Begin DoDot:1
- +46 WRITE !!,$CHAR(7),$CHAR(7),$CHAR(7),"Retraction of Original Document Failed.",!
- +47 ; pause
- IF $$READ^TIUU("EA","Press RETURN to continue...")
- +48 SET TIUDA=TIUODA
- SET TIUCHNG("REFRESH")=1
- End DoDot:1
- QUIT
- +49 LOCK +^TIU(8925,TIUDA):1
- +50 IF '$TEST
- Begin DoDot:1
- +51 WRITE !?5,$CHAR(7),"Another user is editing this entry."
- +52 DO RECOVER^TIURD4(TIUODA,TIUDA)
- HANG 3
- +53 SET TIUPRF=$$LINK^TIUPRF1(TIUODA,+TIUFLAG,$PIECE(TIUFLAG,U,2),$PIECE($GET(^TIU(8925,TIUODA,0)),U,2))
- +54 SET TIUDA=TIUODA
- SET TIUCHNG("REFRESH")=1
- End DoDot:1
- QUIT
- +55 SET TIUSNM=$$DECRYPT^TIULC1($PIECE(^TIU(8925,TIUDA,15),U,3),1,$$CHKSUM^TIULC("^TIU(8925,"_TIUDA_",""TEXT"")"))
- +56 SET TIUSBLK=$$DECRYPT^TIULC1($PIECE($GET(^TIU(8925,TIUDA,15)),U,4),1,$$CHKSUM^TIULC("^TIU(8925,"_TIUDA_",""TEXT"")"))
- +57 SET TIUCSNM=$$DECRYPT^TIULC1($PIECE(^TIU(8925,TIUDA,15),U,9),1,$$CHKSUM^TIULC("^TIU(8925,"_TIUDA_",""TEXT"")"))
- +58 SET TIUCSBLK=$$DECRYPT^TIULC1($PIECE($GET(^TIU(8925,TIUDA,15)),U,10),1,$$CHKSUM^TIULC("^TIU(8925,"_TIUDA_",""TEXT"")"))
- +59 SET TIUTYP=+$GET(^TIU(8925,+TIUDA,0))
- SET TIUT0=$GET(^TIU(8925.1,+TIUTYP,0))
- +60 SET TIUTYP(1)="1^"_+TIUTYP_U_$PIECE(TIUT0,U,3)_U
- +61 SET DFN=$PIECE($GET(^TIU(8925,+TIUDA,0)),U,2)
- +62 DO GETTIU^TIULD(.TIU,TIUDA)
- +63 SET DIWESUB="Patient: "_$GET(TIU("PNM"))
- +64 SET TIUCHNG=0
- DO FULL^VALM1
- DO TEXTEDIT^TIUEDI4(TIUDA,.TIUCMT,.TIUCHNG)
- +65 IF '+$GET(TIUCHNG)
- Begin DoDot:1
- +66 LOCK -^TIU(8925,TIUDA)
- +67 DO RECOVER^TIURD4(TIUODA,TIUDA)
- +68 SET TIUPRF=$$LINK^TIUPRF1(TIUODA,+TIUFLAG,$PIECE(TIUFLAG,U,2),$PIECE($GET(^TIU(8925,TIUODA,0)),U,2))
- +69 LOCK -^TIU(8925,TIUODA)
- HANG 3
- +70 SET TIUDA=TIUODA
- SET TIUCHNG("REFRESH")=1
- End DoDot:1
- QUIT
- +71 IF +$GET(TIUCHNG)
- Begin DoDot:1
- +72 SET DR=".05///AMENDED;1601////"_$$NOW^XLFDT_";1602////"_DUZ
- SET DA=TIUDA
- SET TIUSIG=0
- +73 SET DR=DR_";1603////"_$$NOW^XLFDT_";1604///^S X=$$SIGNAME^TIULS(DUZ);1605///^S X=$$SIGTITL^TIULS(DUZ)"
- SET TIUSIG=1
- +74 SET DIE=8925
- DO ^DIE
- +75 ; Refile /es/-block fields
- +76 SET DR="1503///^S X=TIUSNM;1504///^S X=TIUSBLK;1509///^S X=TIUCSNM;1510///^S X=TIUCSBLK"
- +77 DO ^DIE
- End DoDot:1
- +78 ; Drop Locks on both documents
- +79 LOCK -^TIU(8925,+TIUDA)
- +80 LOCK -^TIU(8925,+TIUODA)
- +81 SET TIUDAARY(TIUI)=TIUDA
- +82 SET TIUCHNG("RBLD")=1
- +83 ; if note is associated with a patient record flag - clean up
- +84 IF +TIUFLAG
- SET TIUPRF=$$LINK^TIUPRF1(TIUDA,+TIUFLAG,$PIECE(TIUFLAG,U,2),$PIECE($GET(^TIU(8925,TIUDA,0)),U,2))
- +85 ; TIU*155 If note is associated with a consult update ^GMR global
- +86 ; to include the amended note
- +87 ; Rollback retracted note from ^GMR(123 node 50
- +88 IF $GET(TIUCON)=1
- Begin DoDot:1
- +89 NEW STATUS,GMRCSTAT,TIUAUTH
- +90 SET STATUS=$PIECE($GET(^TIU(8925,TIUDA,0)),U,5)
- +91 SET GMRCSTAT=$SELECT(STATUS>6:"COMPLETED",1:"INCOMPLETE")
- +92 SET TIUAUTH=$PIECE($GET(^TIU(8925,TIUDA,12)),U,2)
- +93 DO ROLLBACK^TIUCNSLT(TIUODA)
- +94 DO GET^GMRCTIU(TIUCNSLT,TIUDA,GMRCSTAT,TIUAUTH)
- End DoDot:1
- +95 QUIT
- SENDBACK ; Send back a Document to transcription
- +1 NEW TIUDA,DFN,TIU,TIUDATA,TIUCHNG,TIUI,TIUY,Y,DIROUT,TIULST
- +2 NEW TIUDAARY
- +3 IF '$DATA(VALMY)
- DO EN^VALM2(XQORNOD(0))
- +4 SET TIUI=0
- +5 IF +$ORDER(VALMY(0))
- DO CLEAR^VALM1
- +6 FOR
- SET TIUI=$ORDER(VALMY(TIUI))
- if +TIUI'>0
- QUIT
- Begin DoDot:1
- +7 NEW TIU,RSTRCTD
- +8 SET TIUDATA=$GET(^TMP("TIURIDX",$JOB,TIUI))
- +9 SET TIUDA=+$PIECE(TIUDATA,U,2)
- SET RSTRCTD=$$DOCRES^TIULRR(TIUDA)
- +10 IF RSTRCTD
- Begin DoDot:2
- +11 ; Echo denial message
- WRITE !!,$CHAR(7),"Ok, no harm done...",!
- +12 ; pause
- IF $$READ^TIUU("EA","RETURN to continue...")
- End DoDot:2
- QUIT
- +13 SET TIUDAARY(TIUI)=TIUDA
- +14 SET TIUCHNG=0
- +15 DO EN^VALM("TIU SEND BACK")
- +16 IF +$GET(TIUCHNG)
- Begin DoDot:2
- +17 SET TIULST=$GET(TIULST)_$SELECT($GET(TIULST)]"":",",1:"")_TIUI
- End DoDot:2
- End DoDot:1
- if $DATA(DIROUT)
- QUIT
- SENDX ; Revise list and cycle back as appropriate
- +1 IF $GET(TIUCHNG("ADDM"))!$GET(TIUCHNG("DELETE"))
- SET TIUCHNG("RBLD")=1
- +2 IF '$TEST
- SET TIUCHNG("UPDATE")=1
- +3 NEW TIUVALMY
- MERGE TIUVALMY=VALMY
- +4 DO UPRBLD^TIURL(.TIUCHNG,.TIUVALMY)
- KILL VALMY
- +5 SET VALMBCK="R"
- +6 DO VMSG^TIURS1($GET(TIULST),.TIUDAARY,"sent back")
- +7 QUIT
- LINK ; Link to problem(s)
- +1 NEW TIUCHNG,TIUDA,DFN,TIU,TIUDATA,TIUEDIT,TIUI,TIUY,TIULST,Y,DIROUT
- +2 NEW TIUDAARY
- +3 IF '$DATA(VALMY)
- DO EN^VALM2(XQORNOD(0))
- +4 SET TIUI=0
- +5 IF +$ORDER(VALMY(0))
- DO CLEAR^VALM1
- +6 FOR
- SET TIUI=$ORDER(VALMY(TIUI))
- if +TIUI'>0
- QUIT
- Begin DoDot:1
- +7 NEW TIU,VALMY,XQORM,VA,VADM,GMPDFN,GMPLUSER,RSTRCTD
- +8 SET TIUDATA=$GET(^TMP("TIURIDX",$JOB,TIUI))
- +9 SET TIUDA=+$PIECE(TIUDATA,U,2)
- SET GMPLUSER=1
- +10 IF '$DATA(^TIU(8925,+TIUDA,0))
- Begin DoDot:2
- +11 WRITE !,$CHAR(7),"Document no longer exists.",!
- +12 IF $$READ^TIUU("EA","Press RETURN to continue...")
- WRITE ""
- End DoDot:2
- QUIT
- +13 SET RSTRCTD=$$DOCRES^TIULRR(TIUDA)
- +14 IF RSTRCTD
- Begin DoDot:2
- +15 ; Echo denial message
- WRITE !!,$CHAR(7),"Ok, no harm done...",!
- +16 ; pause
- IF $$READ^TIUU("EA","RETURN to continue...")
- End DoDot:2
- QUIT
- +17 SET TIUDAARY(TIUI)=TIUDA
- +18 SET DFN=+$PIECE($GET(^TIU(8925,+TIUDA,0)),U,2)
- +19 IF +DFN
- DO DEM^VADPT
- SET GMPDFN=DFN_U_VADM(1)_U_$EXTRACT(VADM(1))_VA("BID")
- +20 SET TIUCHNG=0
- +21 DO EN^VALM("TIU LINK TO PROBLEM")
- +22 IF +$GET(TIUCHNG)
- SET TIULST=$GET(TIULST)_$SELECT($GET(TIULST)]"":",",1:"")_TIUI
- End DoDot:1
- if $DATA(DIROUT)
- QUIT
- LINKX ; Revise list and cycle back as appropriate
- +1 SET TIUCHNG("REFRESH")=1
- +2 NEW TIUVALMY
- MERGE TIUVALMY=VALMY
- +3 DO UPRBLD^TIURL(.TIUCHNG,.TIUVALMY)
- KILL VALMY
- +4 SET VALMBCK="R"
- +5 DO VMSG^TIURS1($GET(TIULST),.TIUDAARY,"linked to problems")
- +6 QUIT
- DEL(DA) ; -- Call to DEL for backward compatibility
- +1 GOTO GODEL^TIURB2
- +2 QUIT