- 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/TIURA3.m
r613 r623 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 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 ;
Note:
See TracChangeset
for help on using the changeset viewer.
