[613] | 1 | TIURA3 ; SLC/JER - Review screen actions ; 11/21/07
|
---|
| 2 | ;;1.0;TEXT INTEGRATION UTILITIES;**220,234**;Jun 20, 1997;Build 6
|
---|
| 3 | ; Call to ISA^USRLM supported by DBIA 2324
|
---|
| 4 | ; Call to ISTERM^USRLM supported by DBIA 2712
|
---|
| 5 | EDITCOS ; Edit Expected Cosigner
|
---|
| 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 | I '+$G(TIUDA) W !,"No Documents selected." H 2 Q
|
---|
| 35 | ; Evaluate edit privilege
|
---|
| 36 | N NODE0,STATUS,OK2CHNG,NODE12,REQCOSIG
|
---|
| 37 | N ECSIGNER,ESIGNER,OKCLASS,TIUISDS,DA,DR,DIE,X
|
---|
| 38 | N ALTNODE0,ALTTIUDA,NESIGNR,NECSIGNR,ATTEND,NATTEND,CHKSUM,LNO,MSGNO
|
---|
| 39 | N CANDO,TIUISCP,TIUISCST,TIUISPN,MSG
|
---|
| 40 | ; NECSIGNER,NATTEND etc,(N for new) means post-edit. It may not differ
|
---|
| 41 | ;from the original. It may be null if the original was null.
|
---|
| 42 | S NODE0=^TIU(8925,TIUDA,0),STATUS=$P(NODE0,U,5),(OK2CHNG,OKCLASS)=1
|
---|
| 43 | S ALTNODE0=NODE0,ALTTIUDA=TIUDA,NODE12=$G(^TIU(8925,TIUDA,12))
|
---|
| 44 | I $$ISADDNDM^TIULC1(TIUDA) D
|
---|
| 45 | . S ALTTIUDA=$P(NODE0,U,6)
|
---|
| 46 | . S ALTNODE0=^TIU(8925,ALTTIUDA,0)
|
---|
| 47 | S TIUISDS=$$ISDS^TIULX(+ALTNODE0),TIUISPN=$$ISPN^TIULX(+ALTNODE0)
|
---|
| 48 | S TIUISCST=$$ISA^TIULX(+ALTNODE0,$$CLASS^TIUCNSLT())
|
---|
| 49 | S TIUISCP=$$ISA^TIULX(+ALTNODE0,$$CLASS^TIUCP())
|
---|
| 50 | I 'TIUISDS,'TIUISPN,'TIUISCST,'TIUISCP D G COS1X
|
---|
| 51 | . S MSG(1,1)=" This action is permitted only for Progress Notes, Discharge"
|
---|
| 52 | . S MSG(1,2)="Summaries, Clinical Procedures and Consults."
|
---|
| 53 | I STATUS>6 S MSG(2,1)=" This document has already been Completed!" G COS1X
|
---|
| 54 | I STATUS<5 S MSG(3,1)=" This document still needs Release or Verification!" G COS1X
|
---|
| 55 | ; Status = 5 unsigned or 6 uncosigned:
|
---|
| 56 | ; Try rules for EDIT COSIGNER:
|
---|
| 57 | S CANDO=$$CANDO^TIULP(TIUDA,"EDIT COSIGNER")
|
---|
| 58 | I 'CANDO S MSG(4,1)=" "_$P(CANDO,U,2) G:STATUS=6 COS1X
|
---|
| 59 | ; If docmt is unsigned and EDIT COSIGNER rules failed,
|
---|
| 60 | ; try EDIT RECORD rules:
|
---|
| 61 | I STATUS=5,'CANDO D G:'CANDO COS1X
|
---|
| 62 | . S CANDO=$$CANDO^TIULP(TIUDA,"EDIT RECORD")
|
---|
| 63 | . I CANDO K MSG(4) Q
|
---|
| 64 | . S MSG(5,1)=" You are not authorized to edit any aspect of this document."
|
---|
| 65 | ; User authorized to change Expected Cosigner/attending:
|
---|
| 66 | S DA=TIUDA,DIE=8925
|
---|
| 67 | ;
|
---|
| 68 | ; **Docmt is PN, CP or Consult**
|
---|
| 69 | I 'TIUISDS D G COS1X
|
---|
| 70 | . S ESIGNER=$P(NODE12,U,4)
|
---|
| 71 | . S ECSIGNER=$P(NODE12,U,8)
|
---|
| 72 | . I ESIGNER'>0 S MSG(6,1)=" This document has no Expected Signer!" Q
|
---|
| 73 | . S REQCOSIG=$$REQCOSIG^TIULP(+NODE0,+TIUDA,ESIGNER)
|
---|
| 74 | . ;
|
---|
| 75 | . ; **Cosig NOT REQUIRED:**
|
---|
| 76 | . I 'REQCOSIG D Q
|
---|
| 77 | . . ; Status Uncosigned - Do not permit completion of notes:
|
---|
| 78 | . . I STATUS=6 D Q
|
---|
| 79 | . . . S MSG(7,1)=" Cosignature is not currently required. This option cannot be"
|
---|
| 80 | . . . S MSG(7,2)="used to change document status to COMPLETED. It looks like the author's"
|
---|
| 81 | . . . S MSG(7,3)="requirement has changed since this document was written."
|
---|
| 82 | . . . S MSG(7,4)="Please contact your CAC and/or HIMS for assistance."
|
---|
| 83 | . . ; Unsigned, Has no EC:
|
---|
| 84 | . . I ECSIGNER']"" S MSG(8,1)=" ?? Cosignature not required." Q
|
---|
| 85 | . . ; Unsigned, Has EC:
|
---|
| 86 | . . S MSG(8,1)=" Cosignature not required. Expected Cosigner deleted."
|
---|
| 87 | . . S DR="1208///@;1506///@" D ^DIE S TIUCHNG=1
|
---|
| 88 | . . ;
|
---|
| 89 | . ; **Cosig REQUIRED:**
|
---|
| 90 | . W !!," You may edit the Expected Cosigner:"
|
---|
| 91 | . S DR="1208R//;1506////1" D ^DIE
|
---|
| 92 | . S NECSIGNR=$P(^TIU(8925,TIUDA,12),U,8)
|
---|
| 93 | . I NECSIGNR']"" D Q
|
---|
| 94 | . . S MSG(9,1)=" Cosignature is required! Expected Cosigners cannot be alerted "
|
---|
| 95 | . . S MSG(9,2)="until they are designated. "
|
---|
| 96 | . . I STATUS=6 S MSG(9,3)="Please designate an Expected Cosigner as soon as possible!!"
|
---|
| 97 | . I NECSIGNR=ECSIGNER D Q
|
---|
| 98 | . . W !!," Expected Cosigner not changed." H 1
|
---|
| 99 | . W !!," Expected Cosigner edited." H 1 S TIUCHNG=1 Q
|
---|
| 100 | ;
|
---|
| 101 | ; **Docmt is a Discharge Summary. Attending required: **
|
---|
| 102 | S ATTEND=$P($G(^TIU(8925,TIUDA,12)),U,9)
|
---|
| 103 | W !!,"You may edit the Attending Physician:"
|
---|
| 104 | S DR="1209R//" D ^DIE
|
---|
| 105 | S NATTEND=$P(^TIU(8925,TIUDA,12),U,9)
|
---|
| 106 | S MSG("ALERT")=" Attendings cannot be alerted until designated!"
|
---|
| 107 | I NATTEND']0 S MSG(1,1)=" Attending is Required!",MSG(1,2)=MSG("ALERT") G COS1X
|
---|
| 108 | ; NATTEND is not null. Does it pass screen from TIU*1*219?
|
---|
| 109 | ; (Needed even after 219 for ^ or Return with no Attending)
|
---|
| 110 | ; Overwrite most likely msgs with least likely:
|
---|
| 111 | I +$$REQCOSIG^TIULP(+NODE0,+TIUDA,NATTEND) S MSG(2,1)=" This person requires a cosignature. Please select a different Attending.",MSG(2,2)=MSG("ALERT")
|
---|
| 112 | I '$$ISA^USRLM(NATTEND,"PROVIDER") D
|
---|
| 113 | . K MSG(2)
|
---|
| 114 | . S MSG(2,1)=" This person is not in User Class PROVIDER. Please check User "
|
---|
| 115 | . S MSG(2,2)="Class or select a different Attending."
|
---|
| 116 | . S MSG(2,3)=MSG("ALERT")
|
---|
| 117 | I $$ISTERM^USRLM(NATTEND) K MSG(2) S MSG(2,1)=" This person is terminated! Please select a different Attending.",MSG(2,2)=MSG("ALERT")
|
---|
| 118 | ; Att fails. Restore old att:
|
---|
| 119 | I $D(MSG(2)) D G COS1X
|
---|
| 120 | . S X=$S((STATUS=5)&(ATTEND']""):"@",1:ATTEND),DR="1209////" D ^DIE
|
---|
| 121 | ; Attending exists and is good:
|
---|
| 122 | S NESIGNR=$$WHOSIGNS^TIULC1(DA),NECSIGNR=$$WHOCOSIG^TIULC1(DA)
|
---|
| 123 | S DR="1204////^S X=NESIGNR"
|
---|
| 124 | S DR=DR_";1208////^S X=NECSIGNR"
|
---|
| 125 | S DR=DR_";1506////^S X=$S(+NESIGNR=+NATTEND:0,1:1)"
|
---|
| 126 | D ^DIE
|
---|
| 127 | I NATTEND=ATTEND D G COS1X
|
---|
| 128 | . W !!," Attending Physician not changed." H 1
|
---|
| 129 | ; New Attend Changed - Go on to audit
|
---|
| 130 | W !!," Attending Physician edited." S TIUCHNG=1 H 1
|
---|
| 131 | COS1X ;
|
---|
| 132 | I $G(TIUCHNG) D
|
---|
| 133 | . D SEND^TIUALRT(TIUDA)
|
---|
| 134 | . Q:$G(STATUS)'=6 D ; Audit uncosigned docmts only
|
---|
| 135 | . S CHKSUM=+$$CHKSUM^TIULC("^TIU(8925,"_+TIUDA_",""TEXT"")")
|
---|
| 136 | . D AUDIT^TIUEDI1(TIUDA,CHKSUM,CHKSUM)
|
---|
| 137 | I $D(MSG) W ! F MSGNO=1:1:9 D
|
---|
| 138 | . F LNO=1:1:10 Q:'$D(MSG(MSGNO,LNO)) W !,MSG(MSGNO,LNO)
|
---|
| 139 | I $D(MSG),$$READ^TIUU("EA","RETURN to continue...")
|
---|
| 140 | Q
|
---|