source: WorldVistAEHR/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIUEDITR.m@ 1704

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

initial load of WorldVistAEHR
File size: 3.5 KB
Line 
1TIUEDITR ; SLC/JER - Enter/Edit a Document for Transcriber ;6/11/2002
2 ;;1.0;TEXT INTEGRATION UTILITIES;**7,41,48,100,109,112**;Jun 20, 1997
3 ; 2/2: Update DIE from TIUEDIT to TIUEDI4
4MAIN(TIUCLASS) ; Control Branching
5 N TIUPREF,TIUOUT,TIUAUTH
6 ; --- Get user's preferences ---
7 S TIUPREF=$$PERSPRF^TIULE(DUZ)
8 ; --- Get the author to be used for multiple patients
9 S TIUAUTH=+$$AUTHOR^TIULA2
10 I TIUAUTH'>0 Q
11 F D Q:+$G(TIUOUT)
12 . N DFN,TIUREL,TIUCHK,TIUDA,TIUEDIT,TIUY,TIUNEW,TIUTYP,TIUDPRM
13 . N TIUASK,TIU,VAIN,VADM,TIULMETH,TIUVMETH,TIUENTRY,TIUEXIT,TIUCMMTX
14 . N DA ;10/3/00
15 . ;Removed with TIU*1*41 - Joel didn't think it was appropriate
16 . ;I $P(TIUPREF,U,6)="M" D MAIN^TIUEDIM(TIUCLASS,.TIUOUT) Q
17 . ; --- Get a patient ---
18 . S DFN=+$$PATIENT^TIULA I +DFN'>0 S TIUOUT=1 Q
19 . S TIUCLASS=$G(TIUCLASS,38)
20 . ; --- Get a document type ---
21 . D DOCSPICK^TIULA2(.TIUTYP,TIUCLASS,"1A","LAST","","$P(^TIU(8925.1,+Y,0),U,7)'=13,+$$CANENTR^TIULP(+Y)")
22 . I +$G(TIUTYP)'>0 S TIUOUT=1 Q
23 . S TIUTYP=+$P($G(TIUTYP(1)),U,2)
24 . ; --- Re-direct surgical reports ---
25 . I +$$ISA^TIULX(TIUTYP,+$$CLASS^TIUSROI("SURGICAL REPORTS")) D ENTEROP^TIUSROI(DFN,TIUTYP) Q
26 . ; --- Initialize document parameters ---
27 . D DOCPRM^TIULC1(TIUTYP,.TIUDPRM)
28 . ; --- If an ENTRY ACTION exists, execute it ---
29 . S TIUENTRY=$$GETENTRY^TIUEDI2(+TIUTYP)
30 . I $L(TIUENTRY) X TIUENTRY
31 . Q:+$G(TIUOUT) ; If entry action sets TIUOUT=1 Abort Entry
32 . ; --- Get associated visit ---
33 . I +$$SUPPVSIT^TIULC1(TIUTYP)'>0 D I 1
34 . . S TIULMETH=$$GETLMETH^TIUEDI1(TIUTYP)
35 . . I '$L(TIULMETH) D S TIUOUT=1 Q
36 . . . W !,$C(7),"No Visit Linkage Method defined for "
37 . . . W $$PNAME^TIULC1(TIUTYP),".",!,"Please contact IRM..."
38 . . X TIULMETH
39 . E D
40 . . D EVENT^TIUSRVP1(.TIU,DFN)
41 . I $S($D(DIROUT):1,$D(DTOUT):1,1:0) S TIUQUIT=1 Q
42 . I '$D(TIU("VSTR")) D Q
43 . . W !,$C(7),"Patient & Visit required." H 2
44 . ; --- Validate Selection ---
45 . S TIUVMETH=$$GETVMETH^TIUEDI1(TIUTYP)
46 . I '$L(TIUVMETH) D S TIUOUT=1 Q
47 . . W !,$C(7),"No Validation Method defined for "
48 . . W $$PNAME^TIULC1(TIUTYP),".",!,"Please contact IRM..."
49 . X TIUVMETH
50 . I $D(TIU),+$G(TIUASK) D
51 . . ;S DA=$$GETREC^TIUEDI1(DFN,.TIU,1,.TIUNEW,.TIUDPRM,1)
52 . . S DA=$$GETRECNW^TIUEDI3(DFN,.TIU,TIUTYP(1),.TIUNEW,.TIUDPRM,1)
53 . . I +DA'>0 W !,"Unable to enter/edit." Q
54 . . S TIUEDIT=$S('+$G(TIUNEW):$$CANDO^TIULP(DA,"EDIT RECORD"),1:1)
55 . . I '+TIUEDIT D Q
56 . . . W !,$P(TIUEDIT,U,2) ; Echo denial message
57 . . . D ADDENDUM^TIUADD(DA,"",.TIUCHNG)
58 . . N TIUQUIT,TIUADD
59 . . D DIE^TIUEDI4(DA,.TIUQUIT) Q:+$G(TIUQUIT)=2 ; **100**
60 . . ;If (CP) and (Timeout or Not Select Consult) and (Consult Associated), Quit before EMPTYDOC check
61 . . I +$$ISA^TIULX(TIUTYP,+$$CLASS^TIUCP),+$G(TIUQUIT)=1,+$P($G(^TIU(8925,+DA,14)),U,5)>0 Q
62 . . I $$EMPTYDOC^TIULF(DA) D DELETE^TIUEDIT(DA,0) S:'+$G(TIUNEW) TIUCHNG("DELETE")=1 H:'+$G(TIUNEW) 2 Q
63 . . Q:+$G(TIUQUIT)
64 . . I +$G(TIUONCE) S TIUNDA(+$G(DA))=""
65 . . I +$G(TIU("STOP")) D DEFER^TIUVSIT(DA,TIU("STOP")) I 1
66 . . E D QUE^TIUPXAP1
67 . . ; --- Execute COMMIT procedure ---
68 . . S TIUCMMTX=$$COMMIT^TIULC1(+$G(^TIU(8925,+DA,0)))
69 . . I TIUCMMTX]"" X TIUCMMTX
70 . . ; --- Execute RELEASE procedure ---
71 . . D RELEASE^TIUT(DA)
72 . . ; --- Execute VERIFY procedure ---
73 . . D VERIFY^TIUT(DA)
74 . . ; --- Execute SIGNATURE procedure ---
75 . . D EDSIG^TIURS(DA)
76 . . ; --- If an EXIT ACTION exists, execute it ---
77 . . S TIUEXIT=$$GETEXIT^TIUEDI2(+$P(TIUTYP(1),U,2))
78 . . I $L(TIUEXIT) X TIUEXIT
79 . . ; --- If required, prompt for print
80 . . I +$P($G(TIUDPRM(0)),U,8) D PRINT^TIUEPRNT(DA)
81 Q
Note: See TracBrowser for help on using the repository browser.