source: WorldVistAEHR/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIURA3.m@ 1800

Last change on this file since 1800 was 623, checked in by George Lilly, 15 years ago

revised back to 6/30/08 version
File size: 4.5 KB
RevLine 
[623]1TIURA3 ; 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
4EDITCOS ; 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
32EDITCOS1 ; 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
100COS1X ;
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 TracBrowser for help on using the repository browser.