- TIUEDIT ; SLC/JER - Enter/Edit a Document ;01-Aug-2011 11:29;MGH
- ;;1.0;TEXT INTEGRATION UTILITIES;**1,7,22,52,100,109,112,1009**;Jun 20, 1997;Build 22
- ; Moved LOADDFLT, BOIL, CANXEC, REPLACE, INSMULT to TIUEDI4
- ; Moved DIE, TEXTEDIT from TIUEDIT to TIUEDI4
- ; Separated out modules SETTL, GETVST, ASKOK
- ; Moved SETTL, GETVST, ASKOK from TIUEDIT to TIUEDI4
- ; Changed call to GETREC^TIUEDI1 to call GETRECNW^TIUEDI3
- ;IHS/ITSC/LJF 02/26/2003 create v note entry & clean up TIUTITLE variable
- ;IHS/ITSC/LJF 08/22/2003 quit patient loop if called by IPD option (BTIURPT)
- ;IHS/ITSC/LJF 12/11/2003 review previous notes works for all notes
- MAIN(TIUCLASS,SUCCESS,DFN,TIUTITLE,EVNTFLAG,NOSAVE,TIUNDA,TIUSNGL,TIUCHNG) ; Create new document(s)
- ; May branch off to edit existing docmt instead of creating new one.
- ; Call with: [TIUCLASS] --> pointer to file (8925) corresponding to
- ; the class (e.g., Progress Notes=3)
- ; from which to select a title
- ; [by ref] [SUCCESS] --> Boolean flag returned as IFN when a
- ; record is created, or 0 when record
- ; creation fails
- ; [DFN] --> IEN in patient file (#2)
- ; [TIUTITLE] --> Pointer or NAME or PTR^NAME of the
- ; TITLE from file 8925.1 to be used as
- ; the default.
- ; [EVNTFLAG] --> Boolean flag for visit prompt (0 to
- ; prompt, 1 to force event type visit)
- ; [NOSAVE] --> Boolean flag to suppress saving the data
- ; (e.g., when testing new Boilerplates
- ; using DDEF action TRY, etc.).
- ; [by ref] [TIUNDA] --> array of form: TIUNDA(IFN)="".
- ; Used in SHOW NOTES ACROSS PATIENTS.
- ; See TIURC, which sets TIUONCE.
- ; Also used in TIUEDIM, for mult pts.
- ; [TIUSNGL] --> Boolean flag to create only ONE note
- ; regardless of multiple pt preference.
- ; [by ref] [TIUCHNG] --> If received, passes back TIUCHNG array,
- ; which collects info across records about
- ; actions taken. Used in feedback
- ; msgs to user.
- ; Other variables:
- ; sets [TIUTYP] --> array with form similar to that of XQORNOD:
- ; TIUTYP = title IFN
- ; TIUTYP(1) = 1^title IFN^title name,
- ; where 1 for us is just a positive #
- ; sets [TIUBY] --> used in some input templates to BYpass fields.
- ; Called by:
- ; Outpt Pharmacy, Consults, ...
- N TIUASK,TIUOUT,TIUREL,TIUCHK,TIUDA,TIUEDIT,TIUY,TIUTYP,TIUDPRM
- N TIUDFLT,TIUPREF,TIULMETH,TIUVMETH,DIRUT,DUOUT,DTOUT,TIUPRM0
- N TIUPRM1,TIUPRM3,TIUENTRY,TIUEXIT,TIUBY,TIUPNAME,TIUST
- S EVNTFLAG=+$G(EVNTFLAG,0)
- ; --Get user's division parameters, preferences: --
- I '$D(TIUPRM0) D SETPARM^TIULE
- S TIUPREF=$$PERSPRF^TIULE(DUZ)
- ; -- multiple pts; not in OERR, not TRYing DDEF, not single docmt: --
- I $P(TIUPREF,U,6)="M",(+$G(ORVP)'>0),(+$G(NOSAVE)'>0),'+$G(TIUSNGL) D MAIN^TIUEDIM(TIUCLASS,.TIUOUT,.TIUNDA,.TIUCHNG) Q
- ; -- Loop: Create docmt --
- ;F D Q:+$G(ORVP)!+$G(TIUOUT)!+$G(NOSAVE)!+$G(TIUSNGL)
- F D Q:+$G(ORVP)!+$G(TIUOUT)!+$G(NOSAVE)!+$G(TIUSNGL)!$G(BTIURPT) ;IHS/ITSC/LJF 08/22/2003
- . N TIU,TIUCMMTX,TIUBY,TIUEDIT,TIUNEW,TIUTYP,VADM,VAIN,CANEDIT
- . ; -- User specifies basic info for new docmt --
- . ; -- Get patient --
- . I +$G(ORVP) S DFN=+$G(ORVP)
- . I +$G(DFN)'>0 D I +DFN'>0 S TIUOUT=1 Q
- . . S DFN=+$$PATIENT^TIULA
- . ; -- [For progress notes, show available notes]: --
- . S TIUCLASS=$G(TIUCLASS,38)
- . ;
- . ;IHS/ITSC/LJF 12/11/2003
- . ;I TIUCLASS=3,$S(+$$ISA^USRLM(DUZ,"TRANSCRIPTIONIST"):0,1:1),(+$G(NOSAVE)'>0) D EXSTNOTE^TIUEDI2(DFN) D:$G(VALMAR)="^TMP(""OR"",$J,""CURRENT"")" FULL^VALM1
- . I $S(+$$ISA^USRLM(DUZ,"TRANSCRIPTIONIST"):0,1:1),(+$G(NOSAVE)'>0) D EXSTNOTE^TIUEDI2(DFN) D:$G(VALMAR)="^TMP(""OR"",$J,""CURRENT"")" FULL^VALM1
- . ;
- . I +$G(DIROUT)!+$G(DUOUT)!+$G(DTOUT) S TIUOUT=1 Q
- . ; -- Set title array TIUTYP (use TIUTITLE or ask user) --
- . D SETTL^TIUEDI4(.TIUTYP,TIUCLASS,$G(TIUTITLE)) I +$G(TIUTYP)'>0 S TIUOUT=1 Q
- . ; --- Re-direct SURGICAL REPORTS ---
- . I +$$ISA^TIULX(TIUTYP,+$$CLASS^TIUSROI("SURGICAL REPORTS")) D ENTEROP^TIUSROI(DFN,TIUTYP) Q
- . ; -- Get doc parameters for title, X entry action --
- . D DOCPRM^TIULC1(TIUTYP,.TIUDPRM)
- . S TIUENTRY=$$GETENTRY^TIUEDI2(+TIUTYP)
- . I $L(TIUENTRY) X TIUENTRY
- . Q:+$G(TIUOUT) ; If ENTRY ACTION sets TIUOUT=1 Abort entry
- . ; -- Set visit array TIU --
- . D GETVST^TIUEDI4(DFN,TIUTYP,.TIU,EVNTFLAG)
- . I '$D(TIU("VSTR")) K DFN,TIUTYP Q
- . ; -- Ask OK --
- . D ASKOK^TIUEDI4(TIUTYP,.TIU,.TIUBY,.TIUASK) I '$D(TIU("VSTR")) K DFN,TIUTYP Q
- . ; -- If user OK'd basic info, go on to get text, etc.: --
- . I $D(TIU),+$G(TIUASK) D
- . . ; -- Get record DA --
- . . ; DA is either: new stub record, ready for edit, or
- . . ; existing record, for edit, or
- . . ; existing record, for addendum
- . . N DA
- . . S DA=$$GETRECNW^TIUEDI3(DFN,.TIU,TIUTYP(1),.TIUNEW,.TIUDPRM,1,DUZ,.CANEDIT)
- . . I +DA'>0 W !,"Unable to enter/edit." Q
- . . ; -- [Addend DA and Quit] --
- . . ; If record not new & user can't edit it, let user
- . . ; write addendum and quit:
- . . I 'TIUNEW,'CANEDIT D Q
- . . . D ADDENDUM^TIUADD(DA,"",.TIUCHNG,1)
- . . N TIUQUIT,TIUADD,TIUTDA
- . . ; -- Edit new or existing DA --
- . . D DIE^TIUEDI4(DA,.TIUQUIT)
- . . Q:+$G(TIUQUIT)=2 ; DA doesn't exist (e.g. uparrowed w/ bad record)
- . . ;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(DA,0) S:$G(VALMAR)="^TMP(""TIUVIEW"",$J)" VALMBCK="Q" S:'+$G(TIUNEW) TIUCHNG("DELETE")=1 H:'+$G(TIUNEW) 2 Q
- . . Q:+$G(TIUQUIT)
- . . S:+DA SUCCESS=+DA
- . . I +$G(TIUONCE) S TIUNDA(+$G(DA))="" ; See TIURC, Across Patients
- . . ; -- Misc after-edit-stuff for DA --
- . . ; -- Mark to ask workload at signature;
- . . ; (STOP for Stop codes for stand-alone visits): --
- . . I +$G(TIU("STOP")),(+$P($G(TIUDPRM(0)),U,14)'=1) D DEFER^TIUVSIT(DA,TIU("STOP")) I 1 ;piece 14 = suppress DX/CPT on entry
- . . E D QUE^TIUPXAP1 ; Post workload now in background
- . . ;
- . . D VNOTE^BTIUPCC(DA,+TIU("VISIT"),DFN,"ADD") ;IHS/ITSC/LJF 02/26/2003
- . . ;
- . . S TIUCMMTX=$$COMMIT^TIULC1(+$P(TIUTYP(1),U,2))
- . . I TIUCMMTX]"" X TIUCMMTX
- . . D RELEASE^TIUT(DA)
- . . D VERIFY^TIUT(DA)
- . . ; -- Get signature for DA
- . . D EDSIG^TIURS(DA)
- . . ; - execute EXIT ACTION -
- . . S TIUEXIT=$$GETEXIT^TIUEDI2(+$P(TIUTYP(1),U,2))
- . . I $L(TIUEXIT) S TIUTDA=DA X TIUEXIT S DA=TIUTDA
- . . ; -- [Prompt to add ID stub] --
- . . ; I +$P($G(TIUDPRM(0)),U,20) D ADDSTUB^TIUGEDIT(DA)
- . . ; -- [Prompt to print DA] --
- . . I +$P($G(TIUDPRM(0)),U,8) D PRINT^TIUEPRNT(DA)
- . K DFN ; Free patient
- . K TIUTITLE ;IHS/ITSC/LJF 02/26/2003 clean up variable for next note
- . S TIUPNAME=$$PNAME^TIULC1(TIUCLASS)
- . I $$UP^XLFSTR($E(TIUPNAME,$L(TIUPNAME)))="S" S TIUPNAME=$E(TIUPNAME,1,$L(TIUPNAME)-1)
- . ; -- [loop again] --
- . I '+$G(NOSAVE),'+$G(ORVP),'+$G(TIUSNGL) W !!,"You may enter another ",TIUPNAME,". Press RETURN to exit.",!
- Q
- ;
- DELETE(TIUDA,PROMPT,MSG,HUSH) ; Delete record
- N DIDEL,DIE,DR,TIUD0,TIUVSIT,TIUVKILL,TIUDELX,TIUTYPE
- S TIUD0=$G(^TIU(8925,+TIUDA,0)),TIUVSIT=$P(TIUD0,U,3),TIUTYPE=+TIUD0
- I +$G(PROMPT),'+$$READ^TIUU("YO",MSG,"NO") W !,"Nothing Deleted." Q
- K ^TIU(8925,"ASAVE",DUZ,TIUDA)
- D DELIRT^TIUDIRT(TIUDA)
- ; If a DELETE Action exists for the document definition, execute it
- S TIUDELX=$$DELETE^TIULC1(TIUTYPE)
- I TIUDELX]"" X TIUDELX
- S DA=TIUDA,(DIDEL,DIE)=8925,DR=".01///@"
- D ^DIE W:'+$G(HUSH) !,"<NOTHING ENTERED. "
- I '+$G(HUSH) W:+TIUD0 $$PNAME^TIULC1(+TIUD0)," DELETED>"
- D DELCOMP^TIUEDI1(TIUDA),DELAUDIT^TIUEDI1(TIUDA)
- K ^TIU(8925,"ASAVE",DUZ,TIUDA) ; Remove Save Flag
- D ALERTDEL^TIUALRT(TIUDA),ADDENDEL^TIUALRT(TIUDA)
- ; I +TIUVSIT S TIUVKILL=$$DELVFILE^PXAPI("ALL",TIUVSIT,"","TEXT INTEGRATION UTILITIES")
- Q
- ;
- TIUEDIT ; SLC/JER - Enter/Edit a Document ;01-Aug-2011 11:29;MGH
- +1 ;;1.0;TEXT INTEGRATION UTILITIES;**1,7,22,52,100,109,112,1009**;Jun 20, 1997;Build 22
- +2 ; Moved LOADDFLT, BOIL, CANXEC, REPLACE, INSMULT to TIUEDI4
- +3 ; Moved DIE, TEXTEDIT from TIUEDIT to TIUEDI4
- +4 ; Separated out modules SETTL, GETVST, ASKOK
- +5 ; Moved SETTL, GETVST, ASKOK from TIUEDIT to TIUEDI4
- +6 ; Changed call to GETREC^TIUEDI1 to call GETRECNW^TIUEDI3
- +7 ;IHS/ITSC/LJF 02/26/2003 create v note entry & clean up TIUTITLE variable
- +8 ;IHS/ITSC/LJF 08/22/2003 quit patient loop if called by IPD option (BTIURPT)
- +9 ;IHS/ITSC/LJF 12/11/2003 review previous notes works for all notes
- MAIN(TIUCLASS,SUCCESS,DFN,TIUTITLE,EVNTFLAG,NOSAVE,TIUNDA,TIUSNGL,TIUCHNG) ; Create new document(s)
- +1 ; May branch off to edit existing docmt instead of creating new one.
- +2 ; Call with: [TIUCLASS] --> pointer to file (8925) corresponding to
- +3 ; the class (e.g., Progress Notes=3)
- +4 ; from which to select a title
- +5 ; [by ref] [SUCCESS] --> Boolean flag returned as IFN when a
- +6 ; record is created, or 0 when record
- +7 ; creation fails
- +8 ; [DFN] --> IEN in patient file (#2)
- +9 ; [TIUTITLE] --> Pointer or NAME or PTR^NAME of the
- +10 ; TITLE from file 8925.1 to be used as
- +11 ; the default.
- +12 ; [EVNTFLAG] --> Boolean flag for visit prompt (0 to
- +13 ; prompt, 1 to force event type visit)
- +14 ; [NOSAVE] --> Boolean flag to suppress saving the data
- +15 ; (e.g., when testing new Boilerplates
- +16 ; using DDEF action TRY, etc.).
- +17 ; [by ref] [TIUNDA] --> array of form: TIUNDA(IFN)="".
- +18 ; Used in SHOW NOTES ACROSS PATIENTS.
- +19 ; See TIURC, which sets TIUONCE.
- +20 ; Also used in TIUEDIM, for mult pts.
- +21 ; [TIUSNGL] --> Boolean flag to create only ONE note
- +22 ; regardless of multiple pt preference.
- +23 ; [by ref] [TIUCHNG] --> If received, passes back TIUCHNG array,
- +24 ; which collects info across records about
- +25 ; actions taken. Used in feedback
- +26 ; msgs to user.
- +27 ; Other variables:
- +28 ; sets [TIUTYP] --> array with form similar to that of XQORNOD:
- +29 ; TIUTYP = title IFN
- +30 ; TIUTYP(1) = 1^title IFN^title name,
- +31 ; where 1 for us is just a positive #
- +32 ; sets [TIUBY] --> used in some input templates to BYpass fields.
- +33 ; Called by:
- +34 ; Outpt Pharmacy, Consults, ...
- +35 NEW TIUASK,TIUOUT,TIUREL,TIUCHK,TIUDA,TIUEDIT,TIUY,TIUTYP,TIUDPRM
- +36 NEW TIUDFLT,TIUPREF,TIULMETH,TIUVMETH,DIRUT,DUOUT,DTOUT,TIUPRM0
- +37 NEW TIUPRM1,TIUPRM3,TIUENTRY,TIUEXIT,TIUBY,TIUPNAME,TIUST
- +38 SET EVNTFLAG=+$GET(EVNTFLAG,0)
- +39 ; --Get user's division parameters, preferences: --
- +40 IF '$DATA(TIUPRM0)
- DO SETPARM^TIULE
- +41 SET TIUPREF=$$PERSPRF^TIULE(DUZ)
- +42 ; -- multiple pts; not in OERR, not TRYing DDEF, not single docmt: --
- +43 IF $PIECE(TIUPREF,U,6)="M"
- IF (+$GET(ORVP)'>0)
- IF (+$GET(NOSAVE)'>0)
- IF '+$GET(TIUSNGL)
- DO MAIN^TIUEDIM(TIUCLASS,.TIUOUT,.TIUNDA,.TIUCHNG)
- QUIT
- +44 ; -- Loop: Create docmt --
- +45 ;F D Q:+$G(ORVP)!+$G(TIUOUT)!+$G(NOSAVE)!+$G(TIUSNGL)
- +46 ;IHS/ITSC/LJF 08/22/2003
- FOR
- Begin DoDot:1
- +47 NEW TIU,TIUCMMTX,TIUBY,TIUEDIT,TIUNEW,TIUTYP,VADM,VAIN,CANEDIT
- +48 ; -- User specifies basic info for new docmt --
- +49 ; -- Get patient --
- +50 IF +$GET(ORVP)
- SET DFN=+$GET(ORVP)
- +51 IF +$GET(DFN)'>0
- Begin DoDot:2
- +52 SET DFN=+$$PATIENT^TIULA
- End DoDot:2
- IF +DFN'>0
- SET TIUOUT=1
- QUIT
- +53 ; -- [For progress notes, show available notes]: --
- +54 SET TIUCLASS=$GET(TIUCLASS,38)
- +55 ;
- +56 ;IHS/ITSC/LJF 12/11/2003
- +57 ;I TIUCLASS=3,$S(+$$ISA^USRLM(DUZ,"TRANSCRIPTIONIST"):0,1:1),(+$G(NOSAVE)'>0) D EXSTNOTE^TIUEDI2(DFN) D:$G(VALMAR)="^TMP(""OR"",$J,""CURRENT"")" FULL^VALM1
- +58 IF $SELECT(+$$ISA^USRLM(DUZ,"TRANSCRIPTIONIST"):0,1:1)
- IF (+$GET(NOSAVE)'>0)
- DO EXSTNOTE^TIUEDI2(DFN)
- IF $GET(VALMAR)="^TMP(""OR"",$J,""CURRENT"")"
- DO FULL^VALM1
- +59 ;
- +60 IF +$GET(DIROUT)!+$GET(DUOUT)!+$GET(DTOUT)
- SET TIUOUT=1
- QUIT
- +61 ; -- Set title array TIUTYP (use TIUTITLE or ask user) --
- +62 DO SETTL^TIUEDI4(.TIUTYP,TIUCLASS,$GET(TIUTITLE))
- IF +$GET(TIUTYP)'>0
- SET TIUOUT=1
- QUIT
- +63 ; --- Re-direct SURGICAL REPORTS ---
- +64 IF +$$ISA^TIULX(TIUTYP,+$$CLASS^TIUSROI("SURGICAL REPORTS"))
- DO ENTEROP^TIUSROI(DFN,TIUTYP)
- QUIT
- +65 ; -- Get doc parameters for title, X entry action --
- +66 DO DOCPRM^TIULC1(TIUTYP,.TIUDPRM)
- +67 SET TIUENTRY=$$GETENTRY^TIUEDI2(+TIUTYP)
- +68 IF $LENGTH(TIUENTRY)
- XECUTE TIUENTRY
- +69 ; If ENTRY ACTION sets TIUOUT=1 Abort entry
- IF +$GET(TIUOUT)
- QUIT
- +70 ; -- Set visit array TIU --
- +71 DO GETVST^TIUEDI4(DFN,TIUTYP,.TIU,EVNTFLAG)
- +72 IF '$DATA(TIU("VSTR"))
- KILL DFN,TIUTYP
- QUIT
- +73 ; -- Ask OK --
- +74 DO ASKOK^TIUEDI4(TIUTYP,.TIU,.TIUBY,.TIUASK)
- IF '$DATA(TIU("VSTR"))
- KILL DFN,TIUTYP
- QUIT
- +75 ; -- If user OK'd basic info, go on to get text, etc.: --
- +76 IF $DATA(TIU)
- IF +$GET(TIUASK)
- Begin DoDot:2
- +77 ; -- Get record DA --
- +78 ; DA is either: new stub record, ready for edit, or
- +79 ; existing record, for edit, or
- +80 ; existing record, for addendum
- +81 NEW DA
- +82 SET DA=$$GETRECNW^TIUEDI3(DFN,.TIU,TIUTYP(1),.TIUNEW,.TIUDPRM,1,DUZ,.CANEDIT)
- +83 IF +DA'>0
- WRITE !,"Unable to enter/edit."
- QUIT
- +84 ; -- [Addend DA and Quit] --
- +85 ; If record not new & user can't edit it, let user
- +86 ; write addendum and quit:
- +87 IF 'TIUNEW
- IF 'CANEDIT
- Begin DoDot:3
- +88 DO ADDENDUM^TIUADD(DA,"",.TIUCHNG,1)
- End DoDot:3
- QUIT
- +89 NEW TIUQUIT,TIUADD,TIUTDA
- +90 ; -- Edit new or existing DA --
- +91 DO DIE^TIUEDI4(DA,.TIUQUIT)
- +92 ; DA doesn't exist (e.g. uparrowed w/ bad record)
- IF +$GET(TIUQUIT)=2
- QUIT
- +93 ;If (CP) and (Timeout or Not Select Consult) and (Consult Associated), Quit before EMPTYDOC check
- +94 IF +$$ISA^TIULX(TIUTYP,+$$CLASS^TIUCP)
- IF +$GET(TIUQUIT)=1
- IF +$PIECE($GET(^TIU(8925,+DA,14)),U,5)>0
- QUIT
- +95 IF $$EMPTYDOC^TIULF(DA)
- DO DELETE(DA,0)
- IF $GET(VALMAR)="^TMP(""TIUVIEW"",$J)"
- SET VALMBCK="Q"
- IF '+$GET(TIUNEW)
- SET TIUCHNG("DELETE")=1
- IF '+$GET(TIUNEW)
- HANG 2
- QUIT
- +96 IF +$GET(TIUQUIT)
- QUIT
- +97 IF +DA
- SET SUCCESS=+DA
- +98 ; See TIURC, Across Patients
- IF +$GET(TIUONCE)
- SET TIUNDA(+$GET(DA))=""
- +99 ; -- Misc after-edit-stuff for DA --
- +100 ; -- Mark to ask workload at signature;
- +101 ; (STOP for Stop codes for stand-alone visits): --
- +102 ;piece 14 = suppress DX/CPT on entry
- IF +$GET(TIU("STOP"))
- IF (+$PIECE($GET(TIUDPRM(0)),U,14)'=1)
- DO DEFER^TIUVSIT(DA,TIU("STOP"))
- IF 1
- +103 ; Post workload now in background
- IF '$TEST
- DO QUE^TIUPXAP1
- +104 ;
- +105 ;IHS/ITSC/LJF 02/26/2003
- DO VNOTE^BTIUPCC(DA,+TIU("VISIT"),DFN,"ADD")
- +106 ;
- +107 SET TIUCMMTX=$$COMMIT^TIULC1(+$PIECE(TIUTYP(1),U,2))
- +108 IF TIUCMMTX]""
- XECUTE TIUCMMTX
- +109 DO RELEASE^TIUT(DA)
- +110 DO VERIFY^TIUT(DA)
- +111 ; -- Get signature for DA
- +112 DO EDSIG^TIURS(DA)
- +113 ; - execute EXIT ACTION -
- +114 SET TIUEXIT=$$GETEXIT^TIUEDI2(+$PIECE(TIUTYP(1),U,2))
- +115 IF $LENGTH(TIUEXIT)
- SET TIUTDA=DA
- XECUTE TIUEXIT
- SET DA=TIUTDA
- +116 ; -- [Prompt to add ID stub] --
- +117 ; I +$P($G(TIUDPRM(0)),U,20) D ADDSTUB^TIUGEDIT(DA)
- +118 ; -- [Prompt to print DA] --
- +119 IF +$PIECE($GET(TIUDPRM(0)),U,8)
- DO PRINT^TIUEPRNT(DA)
- End DoDot:2
- +120 ; Free patient
- KILL DFN
- +121 ;IHS/ITSC/LJF 02/26/2003 clean up variable for next note
- KILL TIUTITLE
- +122 SET TIUPNAME=$$PNAME^TIULC1(TIUCLASS)
- +123 IF $$UP^XLFSTR($EXTRACT(TIUPNAME,$LENGTH(TIUPNAME)))="S"
- SET TIUPNAME=$EXTRACT(TIUPNAME,1,$LENGTH(TIUPNAME)-1)
- +124 ; -- [loop again] --
- +125 IF '+$GET(NOSAVE)
- IF '+$GET(ORVP)
- IF '+$GET(TIUSNGL)
- WRITE !!,"You may enter another ",TIUPNAME,". Press RETURN to exit.",!
- End DoDot:1
- IF +$GET(ORVP)!+$GET(TIUOUT)!+$GET(NOSAVE)!+$GET(TIUSNGL)!$GET(BTIURPT)
- QUIT
- +126 QUIT
- +127 ;
- DELETE(TIUDA,PROMPT,MSG,HUSH) ; Delete record
- +1 NEW DIDEL,DIE,DR,TIUD0,TIUVSIT,TIUVKILL,TIUDELX,TIUTYPE
- +2 SET TIUD0=$GET(^TIU(8925,+TIUDA,0))
- SET TIUVSIT=$PIECE(TIUD0,U,3)
- SET TIUTYPE=+TIUD0
- +3 IF +$GET(PROMPT)
- IF '+$$READ^TIUU("YO",MSG,"NO")
- WRITE !,"Nothing Deleted."
- QUIT
- +4 KILL ^TIU(8925,"ASAVE",DUZ,TIUDA)
- +5 DO DELIRT^TIUDIRT(TIUDA)
- +6 ; If a DELETE Action exists for the document definition, execute it
- +7 SET TIUDELX=$$DELETE^TIULC1(TIUTYPE)
- +8 IF TIUDELX]""
- XECUTE TIUDELX
- +9 SET DA=TIUDA
- SET (DIDEL,DIE)=8925
- SET DR=".01///@"
- +10 DO ^DIE
- IF '+$GET(HUSH)
- WRITE !,"<NOTHING ENTERED. "
- +11 IF '+$GET(HUSH)
- IF +TIUD0
- WRITE $$PNAME^TIULC1(+TIUD0)," DELETED>"
- +12 DO DELCOMP^TIUEDI1(TIUDA)
- DO DELAUDIT^TIUEDI1(TIUDA)
- +13 ; Remove Save Flag
- KILL ^TIU(8925,"ASAVE",DUZ,TIUDA)
- +14 DO ALERTDEL^TIUALRT(TIUDA)
- DO ADDENDEL^TIUALRT(TIUDA)
- +15 ; I +TIUVSIT S TIUVKILL=$$DELVFILE^PXAPI("ALL",TIUVSIT,"","TEXT INTEGRATION UTILITIES")
- +16 QUIT
- +17 ;