| 1 | TIURA3 ; SLC/JER - Review screen actions ; 11/7/06
|
|---|
| 2 | ;;1.0;TEXT INTEGRATION UTILITIES;**220**;Jun 20, 1997;Build 4
|
|---|
| 3 | ; Call to ISA^USRLM supported by DBIA 2324
|
|---|
| 4 | EDITCOS ; Edit Expected Cosigner
|
|---|
| 5 | ; Modeled after EDIT^TIURA
|
|---|
| 6 | N TIUDA,TIUDATA,TIUCHNG,TIUI,DIROUT,TIUDAARY
|
|---|
| 7 | N TIULST,MSGVERB,TIUXNOD
|
|---|
| 8 | S TIUXNOD=$G(XQORNOD(0))
|
|---|
| 9 | I $P(TIUXNOD,U,3)="EC" W "Edit Cosigner",! S $P(TIUXNOD,U,4)="EC="_$P($P(TIUXNOD,U,4),"==",2)
|
|---|
| 10 | S TIUI=0
|
|---|
| 11 | I '$D(VALMY) D EN^VALM2(TIUXNOD)
|
|---|
| 12 | F S TIUI=$O(VALMY(TIUI)) Q:+TIUI'>0 D Q:$D(DIROUT)
|
|---|
| 13 | . N RSTRCTD
|
|---|
| 14 | . S TIUDATA=$G(^TMP("TIURIDX",$J,TIUI))
|
|---|
| 15 | . D CLEAR^VALM1 W !!,"Editing #",+TIUDATA
|
|---|
| 16 | . S TIUDA=+$P(TIUDATA,U,2) S RSTRCTD=$$DOCRES^TIULRR(TIUDA)
|
|---|
| 17 | . I RSTRCTD D Q
|
|---|
| 18 | . . W !!,$C(7),"Ok, no harm done...",!
|
|---|
| 19 | . . I $$READ^TIUU("EA","RETURN to continue...") ; pause
|
|---|
| 20 | . S TIUDAARY(TIUI)=TIUDA
|
|---|
| 21 | . S TIUCHNG=0
|
|---|
| 22 | . I +$D(^TIU(8925,+TIUDA,0)) D EDITCOS1
|
|---|
| 23 | . I +$G(TIUCHNG) D
|
|---|
| 24 | . . S TIULST=$G(TIULST)_$S($G(TIULST)]"":",",1:"")_TIUI
|
|---|
| 25 | ; -- Update or Rebuild list, restore video: --
|
|---|
| 26 | S TIUCHNG("UPDATE")=1
|
|---|
| 27 | D UPRBLD^TIURL(.TIUCHNG,.VALMY) K VALMY
|
|---|
| 28 | S VALMBCK="R"
|
|---|
| 29 | S MSGVERB="edited"
|
|---|
| 30 | D VMSG^TIURS1($G(TIULST),.TIUDAARY,MSGVERB)
|
|---|
| 31 | Q
|
|---|
| 32 | EDITCOS1 ; Edit expected cosigner/attending for single record
|
|---|
| 33 | ; Receives TIUDA
|
|---|
| 34 | ; Modeled after Input template for document type
|
|---|
| 35 | I '+$G(TIUDA) W !,"No Documents selected." H 2 Q
|
|---|
| 36 | ; Evaluate edit privilege
|
|---|
| 37 | N NODE0,STATUS,OK2CHNG,CANTMSG,NODE12,REQCOSIG,PROBMSG
|
|---|
| 38 | N ECSIGNER,ESIGNER,OKCLASS,TIUISDS,DA,DR,DIE,X
|
|---|
| 39 | N ALTNODE0,ALTTIUDA,NESIGNR,NECSIGNR,ATTEND,NATTEND,CHKSUM
|
|---|
| 40 | S NODE0=^TIU(8925,TIUDA,0),STATUS=$P(NODE0,U,5),(OK2CHNG,OKCLASS)=1
|
|---|
| 41 | S ALTNODE0=NODE0,ALTTIUDA=TIUDA,NODE12=$G(^TIU(8925,TIUDA,12))
|
|---|
| 42 | I $$ISADDNDM^TIULC1(TIUDA) D
|
|---|
| 43 | . S ALTTIUDA=$P(NODE0,U,6)
|
|---|
| 44 | . S ALTNODE0=^TIU(8925,ALTTIUDA,0)
|
|---|
| 45 | S TIUISDS=$$ISDS^TIULX(+ALTNODE0)
|
|---|
| 46 | I '$$ISPN^TIULX(+ALTNODE0),'TIUISDS,'$$ISA^TIULX(+ALTNODE0,$$CLASS^TIUCNSLT()) S OKCLASS=0
|
|---|
| 47 | I 'OKCLASS S PROBMSG="This action is valid only for Progress Notes, Discharge Summaries, and Consults." G COS1X
|
|---|
| 48 | I STATUS>6 S PROBMSG="This document is already Complete!" G COS1X
|
|---|
| 49 | I STATUS<5 S PROBMSG="This document still needs Release or Verification!" G COS1X
|
|---|
| 50 | ; -- Status = 5 unsigned or 6 uncosigned.
|
|---|
| 51 | ; Try rules for EDIT COSIGNER:
|
|---|
| 52 | S OK2CHNG=$$CANDO^TIULP(TIUDA,"EDIT COSIGNER")
|
|---|
| 53 | I 'OK2CHNG S CANTMSG=OK2CHNG G:STATUS=6 COS1X
|
|---|
| 54 | ; -- If docmt is unsigned and EDIT COSIGNER rules failed,
|
|---|
| 55 | ; try EDIT RECORD rules:
|
|---|
| 56 | I STATUS=5,'OK2CHNG D G:'OK2CHNG COS1X
|
|---|
| 57 | . S OK2CHNG=$$CANDO^TIULP(TIUDA,"EDIT RECORD")
|
|---|
| 58 | . I 'OK2CHNG S CANTMSG="0^You are not authorized to edit this document."
|
|---|
| 59 | ; -- DUZ may change Expected Cosigner/attending.
|
|---|
| 60 | S DA=TIUDA,DIE=8925
|
|---|
| 61 | ; -- If docmt is a Progress Note or Consult:
|
|---|
| 62 | I 'TIUISDS D G COS1X
|
|---|
| 63 | . ; -- Does Expected Signer Require Cosignature?
|
|---|
| 64 | . S ESIGNER=$P(NODE12,U,4)
|
|---|
| 65 | . S ECSIGNER=$P(NODE12,U,8)
|
|---|
| 66 | . I ESIGNER']"" S PROBMSG="This document has no Expected Signer!" Q
|
|---|
| 67 | . S REQCOSIG=$$REQCOSIG^TIULP(+NODE0,+TIUDA,ESIGNER)
|
|---|
| 68 | . ; -- If cosig not required:
|
|---|
| 69 | . I 'REQCOSIG D Q
|
|---|
| 70 | . . ; -- If status is uncosigned, "see IRM" and quit:
|
|---|
| 71 | . . I STATUS=6 S PROBMSG="Cosignature not required! See IRM." Q
|
|---|
| 72 | . . ; -- If (status is unsigned) & has no exp cosgnr, say so and quit:
|
|---|
| 73 | . . I ECSIGNER="" S PROBMSG="Cosignature not required." Q
|
|---|
| 74 | . . ; -- If (status is unsigned), has exp cosgnr, fix it:
|
|---|
| 75 | . . I ECSIGNER]"" D Q
|
|---|
| 76 | . . . S PROBMSG="Cosignature not required. Expected Cosigner deleted."
|
|---|
| 77 | . . . S DR="1208///@;1506///@" D ^DIE
|
|---|
| 78 | . ; --Cosig is required so get it or change it:
|
|---|
| 79 | . W !!,"You may edit the Expected Cosigner:"
|
|---|
| 80 | . S DR="1208R//;1506////1" D ^DIE
|
|---|
| 81 | . S NECSIGNR=$P(^TIU(8925,TIUDA,12),U,8)
|
|---|
| 82 | . I NECSIGNR'=ECSIGNER D Q
|
|---|
| 83 | . . W !!,"Expected Cosigner edited." H 1 S TIUCHNG=1
|
|---|
| 84 | ; -- Docmt is a Discharge Summary:
|
|---|
| 85 | S ATTEND=$P($G(^TIU(8925,TIUDA,12)),U,9)
|
|---|
| 86 | W !!,"You may edit the Attending Physician:"
|
|---|
| 87 | S DR="1209R//" D ^DIE
|
|---|
| 88 | S NATTEND=$P(^TIU(8925,TIUDA,12),U,9)
|
|---|
| 89 | I STATUS=6,NATTEND=$P(NODE12,U,2) D G COS1X
|
|---|
| 90 | . S PROBMSG="You may not change the Attending of a signed"
|
|---|
| 91 | . S PROBMSG=PROBMSG_" summary to the author."
|
|---|
| 92 | . S DR="1209////^S X=ATTEND" D ^DIE
|
|---|
| 93 | S NESIGNR=$$WHOSIGNS^TIULC1(DA),NECSIGNR=$$WHOCOSIG^TIULC1(DA)
|
|---|
| 94 | S DR="1204////^S X=NESIGNR"
|
|---|
| 95 | S DR=DR_";1208////^S X=NECSIGNR"
|
|---|
| 96 | S DR=DR_";1506////^S X=$S(+NESIGNR=+NATTEND:0,1:1)"
|
|---|
| 97 | D ^DIE
|
|---|
| 98 | I NATTEND'=ATTEND D
|
|---|
| 99 | . W !!,"Attending Physician edited" H 1 S TIUCHNG=1
|
|---|
| 100 | COS1X ;
|
|---|
| 101 | I $G(TIUCHNG),$G(STATUS)=6 D ; Audit uncosigned docmts only
|
|---|
| 102 | . S CHKSUM=+$$CHKSUM^TIULC("^TIU(8925,"_+TIUDA_",""TEXT"")")
|
|---|
| 103 | . D AUDIT^TIUEDI1(TIUDA,CHKSUM,CHKSUM)
|
|---|
| 104 | I $D(PROBMSG) W !!,PROBMSG
|
|---|
| 105 | I 'OK2CHNG W !!,$P(CANTMSG,U,2)
|
|---|
| 106 | I $D(PROBMSG)!'OK2CHNG I $$READ^TIUU("EA","RETURN to continue...")
|
|---|
| 107 | D SEND^TIUALRT(TIUDA)
|
|---|
| 108 | Q
|
|---|
| 109 | ;
|
|---|
