- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIURB.m
r613 r623 1 TIURB ; SLC/JER - More Review Screen Actions ;12/11/07 2 ;;1.0;TEXT INTEGRATION UTILITIES;**4,32,52,78,58,100,109,155,184,234**;Jun 20, 1997;Build 6 3 ; DBIA 3473 TIU use of GMRCTIU 4 AMEND ; Amendment action 5 N TIUDA,DFN,DIE,DR,TIU,TIUDATA,TIUI,TIUSIG,TIUY,X,X1,Y 6 N DIROUT,TIUCHNG,TIUDAARY,TIULST 7 I '$D(VALMY) D EN^VALM2(XQORNOD(0)) 8 S TIUI=0 9 F S TIUI=$O(VALMY(TIUI)) Q:+TIUI'>0 D Q:$D(DIROUT) 10 . N RSTRCTD 11 . S TIUDATA=$G(^TMP("TIURIDX",$J,TIUI)) 12 . S TIUDA=+$P(TIUDATA,U,2) S RSTRCTD=$$DOCRES^TIULRR(TIUDA) 13 . I RSTRCTD D Q 14 . . W !!,$C(7),"Ok, no harm done...",! ; Echo denial message 15 . . I $$READ^TIUU("EA","RETURN to continue...") ; pause 16 . W !!,"Amending #",+TIUDATA 17 . S TIUCHNG=0 18 . D AMEND1 19 . I $G(TIUDAARY(TIUI)) D 20 . . S TIULST=$G(TIULST)_$S($G(TIULST)]"":",",1:"")_TIUI 21 ; -- Update or Rebuild list, restore video: 22 D UPRBLD^TIURL(.TIUCHNG,.VALMY) K VALMY 23 S VALMBCK="R" 24 D VMSG^TIURS1($G(TIULST),.TIUDAARY,"amended") 25 Q 26 AMEND1 ; Single record amend 27 N TIUCMT,TIUT0,TIUTYP,TIUAMND,TIUSNM,TIUSBLK,TIUCSNM,TIUCSBLK,DIE,DR 28 N DA,DFN,DIWESUB,TIU,TIUODA,TIUTITL,TIUCLSS,TIUCON,TIUCNSLT,TIUPRF,TIUFLAG 29 K ^TMP("TIURTRCT",$J) 30 ; TIU*155 Gets consult data if exists 31 S TIUTITL=$P($G(^TIU(8925,TIUDA,0)),U) 32 S TIUCLSS=$$CLASS^TIUCNSLT() 33 S TIUCON=+$$ISA^TIULX(TIUTITL,TIUCLSS) 34 S TIUCNSLT=+$P($G(^TIU(8925,TIUDA,14)),U,5) 35 S TIUPRF=0,TIUFLAG=0 36 D ISPRFTTL^TIUPRF2(.TIUPRF,TIUTITL) 37 I TIUPRF S TIUFLAG=$$FNDACTIF^TIUPRFL(TIUDA) 38 L +^TIU(8925,+TIUDA):1 39 E D Q 40 . W !?5,$C(7),"Another user is editing this entry." H 3 41 . S TIUCHNG("REFRESH")=1 42 I +$P($G(^TIU(8925,+TIUDA,0)),U,5)'>6 D Q 43 . W !?5,$C(7),"Only SIGNED Documents may be amended." 44 . I $$READ^TIUU("EA","Press RETURN to continue...") ; pause 45 . S TIUCHNG("REFRESH")=1 46 I '$$ISA^USRLM(+$G(DUZ),"PRIVACY ACT OFFICER"),'$$ISA^USRLM(+$G(DUZ),"CHIEF, MIS"),'$$ISA^USRLM(+$G(DUZ),"CHIEF, HIM") D Q 47 . W !?5,$C(7),"Only Privacy Act Officers or MIS/HIM Chiefs may amend documents." 48 . I $$READ^TIUU("EA","Press RETURN to continue...") ; pause 49 . S TIUCHNG("REFRESH")=1 50 I +$$HASIMG^TIURB2(TIUDA) D IMGNOTE^TIURB2 Q 51 ;S TIUAMND=$$CANDO^TIULP(TIUDA,"AMENDMENT") 52 ;I +TIUAMND'>0 D Q 53 ;. W !!,$C(7),$C(7),$C(7),$P(TIUAMND,U,2),! 54 ;. S TIUCHNG("REFRESH")=1 55 ;. I $$READ^TIUU("EA","Press RETURN to continue...") ; pause 56 W !!,"Before proceeding, please enter your Electronic Signature Code..." 57 S TIUAMND=$$GETSIG^TIURD2 58 I +TIUAMND'>0 D Q 59 . W !!," Ok, no harm done...",! 60 . S TIUCHNG("REFRESH")=1 61 . I $$READ^TIUU("EA","Press RETURN to continue...") ; pause 62 W !!,"The ORIGINAL document will be RETRACTED, and a copy will be amended...",! 63 S TIUODA=TIUDA 64 S TIUDA=+$$RETRACT^TIURD2(TIUDA,"",7) 65 I '+TIUDA D Q 66 . W !!,$C(7),$C(7),$C(7),"Retraction of Original Document Failed.",! 67 . I $$READ^TIUU("EA","Press RETURN to continue...") ; pause 68 . S TIUDA=TIUODA,TIUCHNG("REFRESH")=1 69 L +^TIU(8925,TIUDA):1 70 E D Q 71 . W !?5,$C(7),"Another user is editing this entry." 72 . D RECOVER^TIURD4(TIUODA,TIUDA) H 3 73 . S TIUPRF=$$LINK^TIUPRF1(TIUODA,+TIUFLAG,$P(TIUFLAG,U,2),$P($G(^TIU(8925,TIUODA,0)),U,2)) 74 . S TIUDA=TIUODA,TIUCHNG("REFRESH")=1 75 S TIUSNM=$$DECRYPT^TIULC1($P(^TIU(8925,TIUDA,15),U,3),1,$$CHKSUM^TIULC("^TIU(8925,"_TIUDA_",""TEXT"")")) 76 S TIUSBLK=$$DECRYPT^TIULC1($P($G(^TIU(8925,TIUDA,15)),U,4),1,$$CHKSUM^TIULC("^TIU(8925,"_TIUDA_",""TEXT"")")) 77 S TIUCSNM=$$DECRYPT^TIULC1($P(^TIU(8925,TIUDA,15),U,9),1,$$CHKSUM^TIULC("^TIU(8925,"_TIUDA_",""TEXT"")")) 78 S TIUCSBLK=$$DECRYPT^TIULC1($P($G(^TIU(8925,TIUDA,15)),U,10),1,$$CHKSUM^TIULC("^TIU(8925,"_TIUDA_",""TEXT"")")) 79 S TIUTYP=+$G(^TIU(8925,+TIUDA,0)),TIUT0=$G(^TIU(8925.1,+TIUTYP,0)) 80 S TIUTYP(1)="1^"_+TIUTYP_U_$P(TIUT0,U,3)_U 81 S DFN=$P($G(^TIU(8925,+TIUDA,0)),U,2) 82 D GETTIU^TIULD(.TIU,TIUDA) 83 S DIWESUB="Patient: "_$G(TIU("PNM")) 84 S TIUCHNG=0 D FULL^VALM1,TEXTEDIT^TIUEDI4(TIUDA,.TIUCMT,.TIUCHNG) 85 I '+$G(TIUCHNG) D Q 86 . L -^TIU(8925,TIUDA) 87 . D RECOVER^TIURD4(TIUODA,TIUDA) 88 . S TIUPRF=$$LINK^TIUPRF1(TIUODA,+TIUFLAG,$P(TIUFLAG,U,2),$P($G(^TIU(8925,TIUODA,0)),U,2)) 89 . L -^TIU(8925,TIUODA) H 3 90 . S TIUDA=TIUODA,TIUCHNG("REFRESH")=1 91 I +$G(TIUCHNG) D 92 . S DR=".05///AMENDED;1601////"_$$NOW^XLFDT_";1602////"_DUZ,DA=TIUDA,TIUSIG=0 93 . S DR=DR_";1603////"_$$NOW^XLFDT_";1604///^S X=$$SIGNAME^TIULS(DUZ);1605///^S X=$$SIGTITL^TIULS(DUZ)",TIUSIG=1 94 . S DIE=8925 D ^DIE 95 . ; Refile /es/-block fields 96 . S DR="1503///^S X=TIUSNM;1504///^S X=TIUSBLK;1509///^S X=TIUCSNM;1510///^S X=TIUCSBLK" 97 . D ^DIE 98 ; Drop Locks on both documents 99 L -^TIU(8925,+TIUDA) 100 L -^TIU(8925,+TIUODA) 101 S TIUDAARY(TIUI)=TIUDA 102 S TIUCHNG("RBLD")=1 103 ; if note is associated with a patient record flag - clean up 104 I +TIUFLAG S TIUPRF=$$LINK^TIUPRF1(TIUDA,+TIUFLAG,$P(TIUFLAG,U,2),$P($G(^TIU(8925,TIUDA,0)),U,2)) 105 ; TIU*155 If note is associated with a consult update ^GMR global 106 ; to include the amended note 107 ; Rollback retracted note from ^GMR(123 node 50 108 I $G(TIUCON)=1 D 109 . N STATUS,GMRCSTAT,TIUAUTH 110 . S STATUS=$P($G(^TIU(8925,TIUDA,0)),U,5) 111 . S GMRCSTAT=$S(STATUS>6:"COMPLETED",1:"INCOMPLETE") 112 . S TIUAUTH=$P($G(^TIU(8925,TIUDA,12)),U,2) 113 . D ROLLBACK^TIUCNSLT(TIUODA) 114 . D GET^GMRCTIU(TIUCNSLT,TIUDA,GMRCSTAT,TIUAUTH) 115 Q 116 SENDBACK ; Send back a Document to transcription 117 N TIUDA,DFN,TIU,TIUDATA,TIUCHNG,TIUI,TIUY,Y,DIROUT,TIULST 118 N TIUDAARY 119 I '$D(VALMY) D EN^VALM2(XQORNOD(0)) 120 S TIUI=0 121 I +$O(VALMY(0)) D CLEAR^VALM1 122 F S TIUI=$O(VALMY(TIUI)) Q:+TIUI'>0 D Q:$D(DIROUT) 123 . N TIU,RSTRCTD 124 . S TIUDATA=$G(^TMP("TIURIDX",$J,TIUI)) 125 . S TIUDA=+$P(TIUDATA,U,2) S RSTRCTD=$$DOCRES^TIULRR(TIUDA) 126 . I RSTRCTD D Q 127 . . W !!,$C(7),"Ok, no harm done...",! ; Echo denial message 128 . . I $$READ^TIUU("EA","RETURN to continue...") ; pause 129 . S TIUDAARY(TIUI)=TIUDA 130 . S TIUCHNG=0 131 . D EN^VALM("TIU SEND BACK") 132 . I +$G(TIUCHNG) D 133 . . S TIULST=$G(TIULST)_$S($G(TIULST)]"":",",1:"")_TIUI 134 SENDX ; Revise list and cycle back as appropriate 135 I $G(TIUCHNG("ADDM"))!$G(TIUCHNG("DELETE")) S TIUCHNG("RBLD")=1 136 E S TIUCHNG("UPDATE")=1 137 D UPRBLD^TIURL(.TIUCHNG,.VALMY) K VALMY 138 S VALMBCK="R" 139 D VMSG^TIURS1($G(TIULST),.TIUDAARY,"sent back") 140 Q 141 LINK ; Link to problem(s) 142 N TIUCHNG,TIUDA,DFN,TIU,TIUDATA,TIUEDIT,TIUI,TIUY,TIULST,Y,DIROUT 143 N TIUDAARY 144 I '$D(VALMY) D EN^VALM2(XQORNOD(0)) 145 S TIUI=0 146 I +$O(VALMY(0)) D CLEAR^VALM1 147 F S TIUI=$O(VALMY(TIUI)) Q:+TIUI'>0 D Q:$D(DIROUT) 148 . N TIU,VALMY,XQORM,VA,VADM,GMPDFN,GMPLUSER,RSTRCTD 149 . S TIUDATA=$G(^TMP("TIURIDX",$J,TIUI)) 150 . S TIUDA=+$P(TIUDATA,U,2),GMPLUSER=1 151 . I '$D(^TIU(8925,+TIUDA,0)) D Q 152 . . W !,$C(7),"Document no longer exists.",! 153 . . I $$READ^TIUU("EA","Press RETURN to continue...") W "" 154 . S RSTRCTD=$$DOCRES^TIULRR(TIUDA) 155 . I RSTRCTD D Q 156 . . W !!,$C(7),"Ok, no harm done...",! ; Echo denial message 157 . . I $$READ^TIUU("EA","RETURN to continue...") ; pause 158 . S TIUDAARY(TIUI)=TIUDA 159 . S DFN=+$P($G(^TIU(8925,+TIUDA,0)),U,2) 160 . I +DFN D DEM^VADPT S GMPDFN=DFN_U_VADM(1)_U_$E(VADM(1))_VA("BID") 161 . S TIUCHNG=0 162 . D EN^VALM("TIU LINK TO PROBLEM") 163 . I +$G(TIUCHNG) S TIULST=$G(TIULST)_$S($G(TIULST)]"":",",1:"")_TIUI 164 LINKX ; Revise list and cycle back as appropriate 165 S TIUCHNG("REFRESH")=1 166 D UPRBLD^TIURL(.TIUCHNG,.VALMY) K VALMY 167 S VALMBCK="R" 168 D VMSG^TIURS1($G(TIULST),.TIUDAARY,"linked to problems") 169 Q 170 DEL(DA) ; -- Call to DEL for backward compatibility 171 G GODEL^TIURB2 172 Q 1 TIURB ; SLC/JER - More Review Screen Actions ;4/11/05 2 ;;1.0;TEXT INTEGRATION UTILITIES;**4,32,52,78,58,100,109,155,184**;Jun 20, 1997 3 ; **100** Moved DELETE, DEL, DELTEXT, DIK to new rtn TIURB2 4 ; DBIA 3576 TIU use of GMRCTIU 5 AMEND ; Amendment action 6 N TIUDA,DFN,DIE,DR,TIU,TIUDATA,TIUI,TIUSIG,TIUY,X,X1,Y 7 N DIROUT,TIUCHNG,TIUDAARY,TIULST 8 I '$D(VALMY) D EN^VALM2(XQORNOD(0)) 9 S TIUI=0 10 F S TIUI=$O(VALMY(TIUI)) Q:+TIUI'>0 D Q:$D(DIROUT) 11 . N RSTRCTD 12 . S TIUDATA=$G(^TMP("TIURIDX",$J,TIUI)) 13 . S TIUDA=+$P(TIUDATA,U,2) S RSTRCTD=$$DOCRES^TIULRR(TIUDA) 14 . I RSTRCTD D Q 15 . . W !!,$C(7),"Ok, no harm done...",! ; Echo denial message 16 . . I $$READ^TIUU("EA","RETURN to continue...") ; pause 17 . W !!,"Amending #",+TIUDATA 18 . S TIUCHNG=0 19 . D AMEND1 20 . I $G(TIUDAARY(TIUI)) D 21 . . S TIULST=$G(TIULST)_$S($G(TIULST)]"":",",1:"")_TIUI 22 ; -- Update or Rebuild list, restore video: 23 D UPRBLD^TIURL(.TIUCHNG,.VALMY) K VALMY 24 S VALMBCK="R" 25 D VMSG^TIURS1($G(TIULST),.TIUDAARY,"amended") 26 Q 27 AMEND1 ; Single record amend 28 N TIUCMT,TIUT0,TIUTYP,TIUAMND,TIUSNM,TIUSBLK,TIUCSNM,TIUCSBLK,DIE,DR 29 N DA,DFN,DIWESUB,TIU,TIUODA,TIUTITL,TIUCLSS,TIUCON,TIUCNSLT,TIUPRF,TIUFLAG 30 K ^TMP("TIURTRCT",$J) 31 ; TIU*155 Gets consult data if exists 32 S TIUTITL=$P($G(^TIU(8925,TIUDA,0)),U) 33 S TIUCLSS=$$CLASS^TIUCNSLT() 34 S TIUCON=+$$ISA^TIULX(TIUTITL,TIUCLSS) 35 S TIUCNSLT=+$P($G(^TIU(8925,TIUDA,14)),U,5) 36 S TIUPRF=0,TIUFLAG=0 37 D ISPRFTTL^TIUPRF2(.TIUPRF,TIUTITL) 38 I TIUPRF S TIUFLAG=$$FNDACTIF^TIUPRFL(TIUDA) 39 L +^TIU(8925,+TIUDA):1 40 E D Q 41 . W !?5,$C(7),"Another user is editing this entry." H 3 42 . S TIUCHNG("REFRESH")=1 43 I +$P($G(^TIU(8925,+TIUDA,0)),U,5)'>6 D Q 44 . W !?5,$C(7),"Only SIGNED Documents may be amended." 45 . I $$READ^TIUU("EA","Press RETURN to continue...") ; pause 46 . S TIUCHNG("REFRESH")=1 47 I +$$HASIMG^TIURB2(TIUDA) D IMGNOTE^TIURB2 Q 48 S TIUAMND=$$CANDO^TIULP(TIUDA,"AMENDMENT") 49 I +TIUAMND'>0 D Q 50 . W !!,$C(7),$C(7),$C(7),$P(TIUAMND,U,2),! 51 . S TIUCHNG("REFRESH")=1 52 . I $$READ^TIUU("EA","Press RETURN to continue...") ; pause 53 W !!,"Before proceeding, please enter your Electronic Signature Code..." 54 S TIUAMND=$$GETSIG^TIURD2 55 I +TIUAMND'>0 D Q 56 . W !!," Ok, no harm done...",! 57 . S TIUCHNG("REFRESH")=1 58 . I $$READ^TIUU("EA","Press RETURN to continue...") ; pause 59 W !!,"The ORIGINAL document will be RETRACTED, and a copy will be amended...",! 60 S TIUODA=TIUDA 61 S TIUDA=+$$RETRACT^TIURD2(TIUDA,"",7) 62 I '+TIUDA D Q 63 . W !!,$C(7),$C(7),$C(7),"Retraction of Original Document Failed.",! 64 . I $$READ^TIUU("EA","Press RETURN to continue...") ; pause 65 . S TIUDA=TIUODA,TIUCHNG("REFRESH")=1 66 L +^TIU(8925,TIUDA):1 67 E D Q 68 . W !?5,$C(7),"Another user is editing this entry." 69 . D RECOVER^TIURD4(TIUODA,TIUDA) H 3 70 . S TIUPRF=$$LINK^TIUPRF1(TIUODA,+TIUFLAG,$P(TIUFLAG,U,2),$P($G(^TIU(8925,TIUODA,0)),U,2)) 71 . S TIUDA=TIUODA,TIUCHNG("REFRESH")=1 72 S TIUSNM=$$DECRYPT^TIULC1($P(^TIU(8925,TIUDA,15),U,3),1,$$CHKSUM^TIULC("^TIU(8925,"_TIUDA_",""TEXT"")")) 73 S TIUSBLK=$$DECRYPT^TIULC1($P($G(^TIU(8925,TIUDA,15)),U,4),1,$$CHKSUM^TIULC("^TIU(8925,"_TIUDA_",""TEXT"")")) 74 S TIUCSNM=$$DECRYPT^TIULC1($P(^TIU(8925,TIUDA,15),U,9),1,$$CHKSUM^TIULC("^TIU(8925,"_TIUDA_",""TEXT"")")) 75 S TIUCSBLK=$$DECRYPT^TIULC1($P($G(^TIU(8925,TIUDA,15)),U,10),1,$$CHKSUM^TIULC("^TIU(8925,"_TIUDA_",""TEXT"")")) 76 S TIUTYP=+$G(^TIU(8925,+TIUDA,0)),TIUT0=$G(^TIU(8925.1,+TIUTYP,0)) 77 S TIUTYP(1)="1^"_+TIUTYP_U_$P(TIUT0,U,3)_U 78 S DFN=$P($G(^TIU(8925,+TIUDA,0)),U,2) 79 D GETTIU^TIULD(.TIU,TIUDA) 80 S DIWESUB="Patient: "_$G(TIU("PNM")) 81 S TIUCHNG=0 D FULL^VALM1,TEXTEDIT^TIUEDI4(TIUDA,.TIUCMT,.TIUCHNG) 82 I '+$G(TIUCHNG) D Q 83 . L -^TIU(8925,TIUDA) 84 . D RECOVER^TIURD4(TIUODA,TIUDA) 85 . S TIUPRF=$$LINK^TIUPRF1(TIUODA,+TIUFLAG,$P(TIUFLAG,U,2),$P($G(^TIU(8925,TIUODA,0)),U,2)) 86 . L -^TIU(8925,TIUODA) H 3 87 . S TIUDA=TIUODA,TIUCHNG("REFRESH")=1 88 I +$G(TIUCHNG) D 89 . S DR=".05///AMENDED;1601////"_$$NOW^XLFDT_";1602////"_DUZ,DA=TIUDA,TIUSIG=0 90 . S DR=DR_";1603////"_$$NOW^XLFDT_";1604///^S X=$$SIGNAME^TIULS(DUZ);1605///^S X=$$SIGTITL^TIULS(DUZ)",TIUSIG=1 91 . S DIE=8925 D ^DIE 92 . ; Refile /es/-block fields 93 . S DR="1503///^S X=TIUSNM;1504///^S X=TIUSBLK;1509///^S X=TIUCSNM;1510///^S X=TIUCSBLK" 94 . D ^DIE 95 ; Drop Locks on both documents 96 L -^TIU(8925,+TIUDA) 97 L -^TIU(8925,+TIUODA) 98 S TIUDAARY(TIUI)=TIUDA 99 S TIUCHNG("RBLD")=1 100 ; if note is associated with a patient record flag - clean up 101 I +TIUFLAG S TIUPRF=$$LINK^TIUPRF1(TIUDA,+TIUFLAG,$P(TIUFLAG,U,2),$P($G(^TIU(8925,TIUDA,0)),U,2)) 102 ; TIU*155 If note is associated with a consult update ^GMR global 103 ; to include the amended note 104 ; Rollback retracted note from ^GMR(123 node 50 105 I $G(TIUCON)=1 D 106 . N STATUS,GMRCSTAT,TIUAUTH 107 . S STATUS=$P($G(^TIU(8925,TIUDA,0)),U,5) 108 . S GMRCSTAT=$S(STATUS>6:"COMPLETED",1:"INCOMPLETE") 109 . S TIUAUTH=$P($G(^TIU(8925,TIUDA,12)),U,2) 110 . D ROLLBACK^TIUCNSLT(TIUODA) 111 . D GET^GMRCTIU(TIUCNSLT,TIUDA,GMRCSTAT,TIUAUTH) 112 Q 113 SENDBACK ; Send back a Document to transcription 114 N TIUDA,DFN,TIU,TIUDATA,TIUCHNG,TIUI,TIUY,Y,DIROUT,TIULST 115 N TIUDAARY 116 I '$D(VALMY) D EN^VALM2(XQORNOD(0)) 117 S TIUI=0 118 I +$O(VALMY(0)) D CLEAR^VALM1 119 F S TIUI=$O(VALMY(TIUI)) Q:+TIUI'>0 D Q:$D(DIROUT) 120 . N TIU,RSTRCTD 121 . S TIUDATA=$G(^TMP("TIURIDX",$J,TIUI)) 122 . S TIUDA=+$P(TIUDATA,U,2) S RSTRCTD=$$DOCRES^TIULRR(TIUDA) 123 . I RSTRCTD D Q 124 . . W !!,$C(7),"Ok, no harm done...",! ; Echo denial message 125 . . I $$READ^TIUU("EA","RETURN to continue...") ; pause 126 . S TIUDAARY(TIUI)=TIUDA 127 . S TIUCHNG=0 128 . D EN^VALM("TIU SEND BACK") 129 . I +$G(TIUCHNG) D 130 . . S TIULST=$G(TIULST)_$S($G(TIULST)]"":",",1:"")_TIUI 131 SENDX ; Revise list and cycle back as appropriate 132 I $G(TIUCHNG("ADDM"))!$G(TIUCHNG("DELETE")) S TIUCHNG("RBLD")=1 133 E S TIUCHNG("UPDATE")=1 134 D UPRBLD^TIURL(.TIUCHNG,.VALMY) K VALMY 135 S VALMBCK="R" 136 D VMSG^TIURS1($G(TIULST),.TIUDAARY,"sent back") 137 Q 138 LINK ; Link to problem(s) 139 N TIUCHNG,TIUDA,DFN,TIU,TIUDATA,TIUEDIT,TIUI,TIUY,TIULST,Y,DIROUT 140 N TIUDAARY 141 I '$D(VALMY) D EN^VALM2(XQORNOD(0)) 142 S TIUI=0 143 I +$O(VALMY(0)) D CLEAR^VALM1 144 F S TIUI=$O(VALMY(TIUI)) Q:+TIUI'>0 D Q:$D(DIROUT) 145 . N TIU,VALMY,XQORM,VA,VADM,GMPDFN,GMPLUSER,RSTRCTD 146 . S TIUDATA=$G(^TMP("TIURIDX",$J,TIUI)) 147 . S TIUDA=+$P(TIUDATA,U,2),GMPLUSER=1 148 . I '$D(^TIU(8925,+TIUDA,0)) D Q 149 . . W !,$C(7),"Document no longer exists.",! 150 . . I $$READ^TIUU("EA","Press RETURN to continue...") W "" 151 . S RSTRCTD=$$DOCRES^TIULRR(TIUDA) 152 . I RSTRCTD D Q 153 . . W !!,$C(7),"Ok, no harm done...",! ; Echo denial message 154 . . I $$READ^TIUU("EA","RETURN to continue...") ; pause 155 . S TIUDAARY(TIUI)=TIUDA 156 . S DFN=+$P($G(^TIU(8925,+TIUDA,0)),U,2) 157 . I +DFN D DEM^VADPT S GMPDFN=DFN_U_VADM(1)_U_$E(VADM(1))_VA("BID") 158 . S TIUCHNG=0 159 . D EN^VALM("TIU LINK TO PROBLEM") 160 . I +$G(TIUCHNG) S TIULST=$G(TIULST)_$S($G(TIULST)]"":",",1:"")_TIUI 161 LINKX ; Revise list and cycle back as appropriate 162 S TIUCHNG("REFRESH")=1 163 D UPRBLD^TIURL(.TIUCHNG,.VALMY) K VALMY 164 S VALMBCK="R" 165 D VMSG^TIURS1($G(TIULST),.TIUDAARY,"linked to problems") 166 Q 167 DEL(DA) ; -- Call to DEL for backward compatibility 168 G GODEL^TIURB2 169 Q
Note:
See TracChangeset
for help on using the changeset viewer.
