source: FOIAVistA/tag/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIUT.m@ 628

Last change on this file since 628 was 628, checked in by George Lilly, 14 years ago

initial load of FOIAVistA 6/30/08 version
File size: 4.3 KB
Line 
1TIUT ; 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
3SENDBACK(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
22RELEASE(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
65VERIFY(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
Note: See TracBrowser for help on using the repository browser.