Routine: TIUEDITR

TIUEDITR ; SLC/JER - Enter/Edit a Document for Transcriber ;01-Aug-2011 11:29;MGH

 ;;1.0;TEXT INTEGRATION UTILITIES;**7,41,48,100,109,112,1009**;Jun 20, 1997;Build 22

 ; 2/2: Update DIE from TIUEDIT to TIUEDI4

 ;IHS/ITSC/LJF 02/26/2003 added code to edit visit and update V Note file

MAIN(TIUCLASS) ; Control Branching

 N TIUPREF,TIUOUT,TIUAUTH

 ; --- Get user's preferences ---

 S TIUPREF=$$PERSPRF^TIULE(DUZ)

 ; --- Get the author to be used for multiple patients

 S TIUAUTH=+$$AUTHOR^TIULA2

 I TIUAUTH'>0 Q

 F  D  Q:+$G(TIUOUT)

 . N DFN,TIUREL,TIUCHK,TIUDA,TIUEDIT,TIUY,TIUNEW,TIUTYP,TIUDPRM

 . N TIUASK,TIU,VAIN,VADM,TIULMETH,TIUVMETH,TIUENTRY,TIUEXIT,TIUCMMTX

 . N DA ;10/3/00

 . ;Removed with TIU*1*41 - Joel didn't think it was appropriate

 . ;I $P(TIUPREF,U,6)="M" D MAIN^TIUEDIM(TIUCLASS,.TIUOUT) Q

 . ; --- Get a patient ---

 . S DFN=+$$PATIENT^TIULA I +DFN'>0 S TIUOUT=1 Q

 . S TIUCLASS=$G(TIUCLASS,38)

 . ; --- Get a document type ---

 . D DOCSPICK^TIULA2(.TIUTYP,TIUCLASS,"1A","LAST","","$P(^TIU(8925.1,+Y,0),U,7)'=13,+$$CANENTR^TIULP(+Y)")

 . I +$G(TIUTYP)'>0 S TIUOUT=1 Q

 . S TIUTYP=+$P($G(TIUTYP(1)),U,2)

 . ; --- Re-direct surgical reports ---

 . I +$$ISA^TIULX(TIUTYP,+$$CLASS^TIUSROI("SURGICAL REPORTS")) D ENTEROP^TIUSROI(DFN,TIUTYP) Q

 . ; --- Initialize document parameters ---

 . D DOCPRM^TIULC1(TIUTYP,.TIUDPRM)

 . ; --- If an ENTRY ACTION exists, execute it ---

 . S TIUENTRY=$$GETENTRY^TIUEDI2(+TIUTYP)

 . I $L(TIUENTRY) X TIUENTRY

 . Q:+$G(TIUOUT)  ; If entry action sets TIUOUT=1 Abort Entry

 . ; --- Get associated visit ---

 . I +$$SUPPVSIT^TIULC1(TIUTYP)'>0 D  I 1

 . . S TIULMETH=$$GETLMETH^TIUEDI1(TIUTYP)

 . . I '$L(TIULMETH) D  S TIUOUT=1 Q

 . . . W !,$C(7),"No Visit Linkage Method defined for "

 . . . W $$PNAME^TIULC1(TIUTYP),".",!,"Please contact IRM..."

 . . X TIULMETH

 . E  D

 . . D EVENT^TIUSRVP1(.TIU,DFN)

 . I $S($D(DIROUT):1,$D(DTOUT):1,1:0) S TIUQUIT=1 Q

 . I '$D(TIU("VSTR")) D  Q

 . . W !,$C(7),"Patient & Visit required." H 2

 . ; --- Validate Selection ---

 . S TIUVMETH=$$GETVMETH^TIUEDI1(TIUTYP)

 . I '$L(TIUVMETH) D  S TIUOUT=1 Q

 . . W !,$C(7),"No Validation Method defined for "

 . . W $$PNAME^TIULC1(TIUTYP),".",!,"Please contact IRM..."

 . X TIUVMETH

. ;

 . D VEDIT^BTIUED("")  ;IHS/ITSC/LJF 02/26/2003 added call to edit visit

. ;

 . I $D(TIU),+$G(TIUASK) D

 . . ;S DA=$$GETREC^TIUEDI1(DFN,.TIU,1,.TIUNEW,.TIUDPRM,1)

 . . S DA=$$GETRECNW^TIUEDI3(DFN,.TIU,TIUTYP(1),.TIUNEW,.TIUDPRM,1)

 . . I +DA'>0 W !,"Unable to enter/edit." Q

 . . S TIUEDIT=$S('+$G(TIUNEW):$$CANDO^TIULP(DA,"EDIT RECORD"),1:1)

 . . I '+TIUEDIT D  Q

 . . . W !,$P(TIUEDIT,U,2) ; Echo denial message

 . . . D ADDENDUM^TIUADD(DA,"",.TIUCHNG)

 . . N TIUQUIT,TIUADD

 . . D DIE^TIUEDI4(DA,.TIUQUIT) Q:+$G(TIUQUIT)=2  ; **100**

 . . ;If (CP) and (Timeout or Not Select Consult) and (Consult Associated), Quit before EMPTYDOC check

 . . I +$$ISA^TIULX(TIUTYP,+$$CLASS^TIUCP),+$G(TIUQUIT)=1,+$P($G(^TIU(8925,+DA,14)),U,5)>0 Q

 . . I $$EMPTYDOC^TIULF(DA) D DELETE^TIUEDIT(DA,0) S:'+$G(TIUNEW) TIUCHNG("DELETE")=1 H:'+$G(TIUNEW) 2 Q

 . . Q:+$G(TIUQUIT)

 . . I +$G(TIUONCE) S TIUNDA(+$G(DA))=""

 . . I +$G(TIU("STOP")) D DEFER^TIUVSIT(DA,TIU("STOP")) I 1

 . . E  D QUE^TIUPXAP1

 . . ;

 . . ; --- Link PN to V Note file ---

 . . D VNOTE^BTIUPCC(DA,+TIU("VISIT"),DFN,"ADD") ;IHS/ITSC/LJF 02/26/2003

 . . ;

 . . ; --- Execute COMMIT procedure ---

 . . S TIUCMMTX=$$COMMIT^TIULC1(+$G(^TIU(8925,+DA,0)))

 . . I TIUCMMTX]"" X TIUCMMTX

 . . ; --- Execute RELEASE procedure ---

 . . D RELEASE^TIUT(DA)

 . . ; --- Execute VERIFY procedure ---

 . . D VERIFY^TIUT(DA)

 . . ; --- Execute SIGNATURE procedure ---

 . . D EDSIG^TIURS(DA)

 . . ; --- If an EXIT ACTION exists, execute it ---

 . . S TIUEXIT=$$GETEXIT^TIUEDI2(+$P(TIUTYP(1),U,2))

 . . I $L(TIUEXIT) X TIUEXIT

 . . ; --- If required, prompt for print

 . . I +$P($G(TIUDPRM(0)),U,8) D PRINT^TIUEPRNT(DA)

TIUEDITR  ; SLC/JER - Enter/Edit a Document for Transcriber ;01-Aug-2011 11:29;MGH

 +1       ;;1.0;TEXT INTEGRATION UTILITIES;**7,41,48,100,109,112,1009**;Jun 20, 1997;Build 22

 +2       ; 2/2: Update DIE from TIUEDIT to TIUEDI4

 +3       ;IHS/ITSC/LJF 02/26/2003 added code to edit visit and update V Note file

MAIN(TIUCLASS) ; Control Branching

 +1        NEW TIUPREF,TIUOUT,TIUAUTH

 +2       ; --- Get user's preferences ---

 +3        SET TIUPREF=$$PERSPRF^TIULE(DUZ)

 +4       ; --- Get the author to be used for multiple patients

 +5        SET TIUAUTH=+$$AUTHOR^TIULA2

 +6        IF TIUAUTH'>0

               QUIT

 +7        FOR

               Begin DoDot:1

 +8                NEW DFN,TIUREL,TIUCHK,TIUDA,TIUEDIT,TIUY,TIUNEW,TIUTYP,TIUDPRM

 +9                NEW TIUASK,TIU,VAIN,VADM,TIULMETH,TIUVMETH,TIUENTRY,TIUEXIT,TIUCMMTX

 +10      ;10/3/00

                   NEW DA

 +11      ;Removed with TIU*1*41 - Joel didn't think it was appropriate

 +12      ;I $P(TIUPREF,U,6)="M" D MAIN^TIUEDIM(TIUCLASS,.TIUOUT) Q

 +13      ; --- Get a patient ---

 +14               SET DFN=+$$PATIENT^TIULA

                   IF +DFN'>0

                       SET TIUOUT=1

                       QUIT

 +15               SET TIUCLASS=$GET(TIUCLASS,38)

 +16      ; --- Get a document type ---

 +17               DO DOCSPICK^TIULA2(.TIUTYP,TIUCLASS,"1A","LAST","","$P(^TIU(8925.1,+Y,0),U,7)'=13,+$$CANENTR^TIULP(+Y)")

 +18               IF +$GET(TIUTYP)'>0

                       SET TIUOUT=1

                       QUIT

 +19               SET TIUTYP=+$PIECE($GET(TIUTYP(1)),U,2)

 +20      ; --- Re-direct surgical reports ---

 +21               IF +$$ISA^TIULX(TIUTYP,+$$CLASS^TIUSROI("SURGICAL REPORTS"))

                       DO ENTEROP^TIUSROI(DFN,TIUTYP)

                       QUIT

 +22      ; --- Initialize document parameters ---

 +23               DO DOCPRM^TIULC1(TIUTYP,.TIUDPRM)

 +24      ; --- If an ENTRY ACTION exists, execute it ---

 +25               SET TIUENTRY=$$GETENTRY^TIUEDI2(+TIUTYP)

 +26               IF $LENGTH(TIUENTRY)

                       XECUTE TIUENTRY

 +27      ; If entry action sets TIUOUT=1 Abort Entry

                   IF +$GET(TIUOUT)

                       QUIT

 +28      ; --- Get associated visit ---

 +29               IF +$$SUPPVSIT^TIULC1(TIUTYP)'>0

                       Begin DoDot:2

 +30                       SET TIULMETH=$$GETLMETH^TIUEDI1(TIUTYP)

 +31                       IF '$LENGTH(TIULMETH)

                               Begin DoDot:3

 +32                               WRITE !,$CHAR(7),"No Visit Linkage Method defined for "

 +33                               WRITE $$PNAME^TIULC1(TIUTYP),".",!,"Please contact IRM..."

                               End DoDot:3

                               SET TIUOUT=1

                               QUIT

 +34                       XECUTE TIULMETH

                       End DoDot:2

                       IF 1

 +35              IF '$TEST

                       Begin DoDot:2

 +36                       DO EVENT^TIUSRVP1(.TIU,DFN)

                       End DoDot:2

 +37               IF $SELECT($DATA(DIROUT):1,$DATA(DTOUT):1,1:0)

                       SET TIUQUIT=1

                       QUIT

 +38               IF '$DATA(TIU("VSTR"))

                       Begin DoDot:2

 +39                       WRITE !,$CHAR(7),"Patient & Visit required."

                           HANG 2

                       End DoDot:2

                       QUIT

 +40      ; --- Validate Selection ---

 +41               SET TIUVMETH=$$GETVMETH^TIUEDI1(TIUTYP)

 +42               IF '$LENGTH(TIUVMETH)

                       Begin DoDot:2

 +43                       WRITE !,$CHAR(7),"No Validation Method defined for "

 +44                       WRITE $$PNAME^TIULC1(TIUTYP),".",!,"Please contact IRM..."

                       End DoDot:2

                       SET TIUOUT=1

                       QUIT

 +45               XECUTE TIUVMETH

 +46      ;

 +47      ;IHS/ITSC/LJF 02/26/2003 added call to edit visit

                   DO VEDIT^BTIUED("")

 +48      ;

 +49               IF $DATA(TIU)

                       IF +$GET(TIUASK)

                           Begin DoDot:2

 +50      ;S DA=$$GETREC^TIUEDI1(DFN,.TIU,1,.TIUNEW,.TIUDPRM,1)

 +51                           SET DA=$$GETRECNW^TIUEDI3(DFN,.TIU,TIUTYP(1),.TIUNEW,.TIUDPRM,1)

 +52                           IF +DA'>0

                                   WRITE !,"Unable to enter/edit."

                                   QUIT

 +53                           SET TIUEDIT=$SELECT('+$GET(TIUNEW):$$CANDO^TIULP(DA,"EDIT RECORD"),1:1)

 +54                           IF '+TIUEDIT

                                   Begin DoDot:3

 +55      ; Echo denial message

                                       WRITE !,$PIECE(TIUEDIT,U,2)

 +56                                   DO ADDENDUM^TIUADD(DA,"",.TIUCHNG)

                                   End DoDot:3

                                   QUIT

 +57                           NEW TIUQUIT,TIUADD

 +58      ; **100**

                               DO DIE^TIUEDI4(DA,.TIUQUIT)

                               IF +$GET(TIUQUIT)=2

                                   QUIT

 +59      ;If (CP) and (Timeout or Not Select Consult) and (Consult Associated), Quit before EMPTYDOC check

 +60                           IF +$$ISA^TIULX(TIUTYP,+$$CLASS^TIUCP)

                                   IF +$GET(TIUQUIT)=1

                                       IF +$PIECE($GET(^TIU(8925,+DA,14)),U,5)>0

                                           QUIT

 +61                           IF $$EMPTYDOC^TIULF(DA)

                                   DO DELETE^TIUEDIT(DA,0)

                                   IF '+$GET(TIUNEW)

                                       SET TIUCHNG("DELETE")=1

                                   IF '+$GET(TIUNEW)

                                       HANG 2

                                   QUIT

 +62                           IF +$GET(TIUQUIT)

                                   QUIT

 +63                           IF +$GET(TIUONCE)

                                   SET TIUNDA(+$GET(DA))=""

 +64                           IF +$GET(TIU("STOP"))

                                   DO DEFER^TIUVSIT(DA,TIU("STOP"))

                                   IF 1

 +65                          IF '$TEST

                                   DO QUE^TIUPXAP1

 +66      ;

 +67      ; --- Link PN to V Note file ---

 +68      ;IHS/ITSC/LJF 02/26/2003

                               DO VNOTE^BTIUPCC(DA,+TIU("VISIT"),DFN,"ADD")

 +69      ;

 +70      ; --- Execute COMMIT procedure ---

 +71                           SET TIUCMMTX=$$COMMIT^TIULC1(+$GET(^TIU(8925,+DA,0)))

 +72                           IF TIUCMMTX]""

                                   XECUTE TIUCMMTX

 +73      ; --- Execute RELEASE procedure ---

 +74                           DO RELEASE^TIUT(DA)

 +75      ; --- Execute VERIFY procedure ---

 +76                           DO VERIFY^TIUT(DA)

 +77      ; --- Execute SIGNATURE procedure ---

 +78                           DO EDSIG^TIURS(DA)

 +79      ; --- If an EXIT ACTION exists, execute it ---

 +80                           SET TIUEXIT=$$GETEXIT^TIUEDI2(+$PIECE(TIUTYP(1),U,2))

 +81                           IF $LENGTH(TIUEXIT)

                                   XECUTE TIUEXIT

 +82      ; --- If required, prompt for print

 +83                           IF +$PIECE($GET(TIUDPRM(0)),U,8)

                                   DO PRINT^TIUEPRNT(DA)

                           End DoDot:2

               End DoDot:1

               IF +$GET(TIUOUT)

                   QUIT

 +84       QUIT

TIUEDITR.m