1 | TIUT ; SLC/JER - Release from or Send back to transcription ;12/18/00
|
---|
2 | ;;1.0;TEXT INTEGRATION UTILITIES;**3,4,32,100**;Jun 20, 1997
|
---|
3 | SENDBACK(DA) ; Send Document back to transcription
|
---|
4 | N DIE,DR,TIUTYP,TIUSBOK
|
---|
5 | I $$DADORKID^TIUGBR(DA) S TIUSBOK="0^You cannot send back interdisciplinary entries. They must be detached first."
|
---|
6 | I '$D(TIUSBOK) S TIUSBOK=$$CANDO^TIULP(DA,"SEND BACK")
|
---|
7 | I +TIUSBOK'>0 D Q
|
---|
8 | . W !,$C(7),$P(TIUSBOK,U,2) ; Echo denial message
|
---|
9 | . I $$READ^TIUU("EA","Press RETURN to continue...") W "" ; pause
|
---|
10 | L +^TIU(8925,+DA):1
|
---|
11 | E W !?5,$C(7),"Another user is editing this entry." H 3 Q
|
---|
12 | S TIUTYP=$P($P(^TIU(8925.1,+^TIU(8925,+DA,0),0),U),U)
|
---|
13 | I +$$CANSEND^TIULP1(DA) D
|
---|
14 | . S DR=".05///UNRELEASED;1501///@;1306///@;1305///@;1304///@",DIE=8925 D ^DIE
|
---|
15 | . W !,TIUTYP," Sent Back." H 2
|
---|
16 | . D SENDTRAN^TIUALRT(DA) S TIUCHNG=1
|
---|
17 | . ; D UPDTIRT^TIUIRT(.TIU,+DA)
|
---|
18 | E D
|
---|
19 | . W !,$C(7),$C(7),$C(7),TIUTYP," Not Sent Back." H 2
|
---|
20 | L -^TIU(8925,+DA)
|
---|
21 | Q
|
---|
22 | RELEASE(DA,TIUREL) ; Release Document from transcription
|
---|
23 | ; TIUREL=1 ==> Document released
|
---|
24 | N DADTYP,DIE,DR,TIUD0,TIUTYP,TIUTNM,TIULINE,TIUDPRM
|
---|
25 | S TIUD0=$G(^TIU(8925,+DA,0)),TIUTYP=+TIUD0,TIUTNM=$$PNAME^TIULC1(TIUTYP)
|
---|
26 | ; If status is beyond unsigned quit
|
---|
27 | I +$P(TIUD0,U,5)>5 Q
|
---|
28 | ; If a document is already released quit
|
---|
29 | I +$P($G(^TIU(8925,DA,13)),U,4) Q
|
---|
30 | ;S TIUREL=$S($G(TIUREL)]"":+$G(TIUREL),+$P($G(^TIU(8925,DA,13)),U,4):1,1:0)
|
---|
31 | D DOCPRM^TIULC1(TIUTYP,.TIUDPRM,DA)
|
---|
32 | ; If Release is required, and not automatic, prompt user to determine
|
---|
33 | ; whether document is ready...
|
---|
34 | I '+$G(TIUREL),+$P($G(TIUDPRM(0)),U,2) D Q:'+TIUREL
|
---|
35 | . S TIUREL=$$READ^TIUU("YO","Is this "_TIUTNM_" ready to release from DRAFT","YES","^D REL^TIUDIRH")
|
---|
36 | . I '+TIUREL W !," NOT RELEASED." H 2
|
---|
37 | ; If release is not required, release automatically this assures alerts
|
---|
38 | ; printing, etc. happen appropriately, even for documents where release
|
---|
39 | ; from draft is not a "normal" processing step
|
---|
40 | I '+$G(TIUREL),'+$P($G(TIUDPRM(0)),U,2) S TIUREL=1
|
---|
41 | I +$G(TIUREL) D
|
---|
42 | . L +^TIU(8925,+DA):1
|
---|
43 | . E W:'$D(ZTQUEUED) !?5,$C(7),"Another user is editing this entry." H 3 Q
|
---|
44 | . S TIULINE=$$LINECNT^TIULC(DA)
|
---|
45 | . S DR=".05///"_$S(+$$REQVER^TIULC(+DA,+$P($G(TIUDPRM(0)),U,3)):"UNVERIFIED",1:"UNSIGNED")
|
---|
46 | . S DR=DR_";.1////"_TIULINE
|
---|
47 | . ; If verification is required and user holds autoverify key, stuff
|
---|
48 | . ; verifying clerk and verification date
|
---|
49 | . I +$$REQVER^TIULC(+DA,+$P($G(TIUDPRM(0)),U,3)),+$D(^XUSEC("TIU AUTOVERIFY",DUZ)) S DR=DR_";1306////"_DUZ_";1305////"_$$NOW^TIULC
|
---|
50 | . S DR=DR_";1304////"_$$NOW^TIULC,DIE=8925 D ^DIE
|
---|
51 | . L -^TIU(8925,+DA)
|
---|
52 | . I '$D(ZTQUEUED),+$$ISA^USRLM(DUZ,"TRANSCRIPTIONIST") W !,"LINES TYPED: ",TIULINE
|
---|
53 | I '$D(ZTQUEUED),(+$P($G(TIUDPRM(0)),U,2)=1) W !,$$PNAME^TIULC1(TIUTYP),$S(+$G(TIUREL):" Released.",1:" Unreleased.") H 2
|
---|
54 | I +$G(TIUREL) D
|
---|
55 | . N TIURELX
|
---|
56 | . S TIURELX=$$RELEASE^TIULC1(+TIUD0)
|
---|
57 | . I TIURELX]"" X TIURELX
|
---|
58 | . I +$P($G(TIUDPRM(0)),U,8)'>0 D MAIN^TIUPD(+DA,"R")
|
---|
59 | . D ALERTDEL^TIUALRT(DA)
|
---|
60 | . ;If the document does not require verification, or if the document
|
---|
61 | . ;does require verification, but the user holds the AUTOVERIFY key,
|
---|
62 | . ;send alerts
|
---|
63 | . I $S('+$$REQVER^TIULC(+DA,+$P($G(TIUDPRM(0)),U,3)):1,(+$$REQVER^TIULC(+DA,+$P($G(TIUDPRM(0)),U,3))&$D(^XUSEC("TIU AUTOVERIFY",+DUZ))):1,1:0) D SEND^TIUALRT(DA)
|
---|
64 | Q
|
---|
65 | VERIFY(DA) ; Evaluate requirements for verification, prompt as appropriate
|
---|
66 | N DADTYP,TIUTYP,TIUDPRM,TIUTNM,TIUD13,TIUY
|
---|
67 | S TIUD13=$G(^TIU(8925,+DA,13))
|
---|
68 | S TIUTYP=+$G(^TIU(8925,+DA,0))
|
---|
69 | ; I +$$ISADDNDM^TIULC1(DA) D I 1
|
---|
70 | ; . S DADTYP=+$G(^TIU(8925,+$P(^TIU(8925,+DA,0),U,6),0))
|
---|
71 | ; . D DOCPRM^TIULC1(DADTYP,.TIUDPRM)
|
---|
72 | D DOCPRM^TIULC1(TIUTYP,.TIUDPRM,+DA)
|
---|
73 | ; If verification isn't required, or if the user is not authorized to
|
---|
74 | ; verify the document, then quit
|
---|
75 | I '$D(TIUDPRM(0)) Q
|
---|
76 | I '+$$REQVER^TIULC(+DA,+$P(TIUDPRM(0),U,3)) Q
|
---|
77 | I '+$$CANDO^TIULP(+DA,"VERIFICATION") Q
|
---|
78 | S TIUTNM=$$PNAME^TIULC1(TIUTYP)
|
---|
79 | I +$P(TIUD13,U,5) D I 1
|
---|
80 | . W !!,"This "_TIUTNM_" is already verified."
|
---|
81 | . S TIUY=$$READ^TIUU("YO","Do you want to UNVERIFY this "_TIUTNM,"NO","^D UNVER^TIUDIRH")
|
---|
82 | . I +TIUY W !," UNVERIFIED." D
|
---|
83 | . . S DIE=8925,DR="1305///@;1306///@" D ^DIE W "."
|
---|
84 | . . D ALERTDEL^TIUALRT(DA)
|
---|
85 | E D
|
---|
86 | . N TIUVERX
|
---|
87 | . S TIUY=$$READ^TIUU("YO","VERIFY this "_TIUTNM,"NO","^D VER^TIUDIRH")
|
---|
88 | . I '+TIUY W !," NOT VERIFIED." Q
|
---|
89 | . S DIE=8925,DR=".05///UNSIGNED;1305////"_+$G(DT)_";1306////"_DUZ D ^DIE
|
---|
90 | . I +DA W !," VERIFIED." D MAIN^TIUPD(+DA,"V"),SEND^TIUALRT(DA)
|
---|
91 | . S TIUVERX=$$VERIFY^TIULC1(+TIUTYP) I TIUVERX]"" X TIUVERX
|
---|
92 | Q
|
---|