TIUGEDIT ; SLC/MAM - Add New ID Entry; 8/28/01
;;1.0;TEXT INTEGRATION UTILITIES;**100,123**;Jun 20, 1997
DIE(DA,TIUQUIT) ; Invoke ^DIE
N Y,DIE,DR
S ^TIU(8925,"ASAVE",DUZ,DA)=""
S DR=$$GETTMPL^TIUEDI1(+$P(^TIU(8925,+DA,0),U))
I DR']"" W !?5,$C(7),"No Edit template defined for ",$$PNAME^TIULC1(+$P(^TIU(8925,+DA,0),U)),! S TIUQUIT=2 Q
S DIE=8925 D ^DIE
S DR=".05///undictated",DIE=8925 D ^DIE
D UPDTIRT^TIUDIRT(.TIU,DA),SEND^TIUALRT(DA)
L -^TIU(8925,+DA)
Q
;
ADDSTUB(DADDA) ; Prompt user for new stub ID entries for parent DADDA
N TIUAUTH,TIUTYP,TIUDAD,DFN,TIUDPRM,DA,TIURTYP,TIUPRMT
N X,Y,DIC
S DFN=$P(^TIU(8925,DADDA,0),U,2)
W !!," If you wish you may add stub interdisciplinary entries for this note:",!
F D Q:$G(TIUAUTH)'>0 Q:$G(TIUTYP)'>0
. K TIUTYP,TIUAUTH
. S DIC=200,DIC(0)="AEMQ",DIC("A")="Select stub AUTHOR: "
. S DIC("S")="I '+$$ISTERM^USRLM(+Y)"
. D ^DIC
. ;I Y'>0 S TIUOUT=1 Q
. Q:Y'>0
. S TIUAUTH=+Y
. ; -- Get data array TIUDAD on parent note DADDA: --
. I '$D(TIUDAD) D GETTIU^TIULD(.TIUDAD,DADDA)
. D DOCSPICK^TIULA2(.TIUTYP,3,"1A","LAST","Select stub TITLE: ","+$$CANPICK^TIULP(+Y),+$$CANENTR^TIULP(+Y),$$CANLINK^TIULP(+Y)")
. ;I +$G(TIUTYP)'>0 S TIUOUT=1 Q
. Q:+$G(TIUTYP)'>0
. S TIUTYP=+$P($G(TIUTYP(1)),U,2) ; IFN. (DOCSPICK returns TIUTYP as 1.)
. ; -- Use visit of parent: --
. M TIU=TIUDAD
. ;-- Get parameters for selected title: --
. D DOCPRM^TIULC1(TIUTYP,.TIUDPRM)
. ; -- Get DA: --
. S DA=$$CREATREC^TIUEDI3(DFN,.TIU,TIUTYP(1))
. N TIUQUIT,TIUTDA
. D DIE(DA,.TIUQUIT)
. D LINK^TIUGR2(DA,DADDA)
. W !," Stub entry added",!!
Q
;
ADDDAD(DADDA,ADDED) ; Create new ID entry and link it to note DADDA
; Assumes DADDA can receive ID entries.
; Requires DADDA = parent note
; Requires DADLINE = parent note line number
; Returns ADDED > 0 if new note added (may not be linked), otherwise = 0
N TITLE,TIUD0,TITLEDA,ADDING,STATUS,KIDDA
S ADDED=0
S TIUD0=$G(^TIU(8925,+DADDA,0))
S TITLEDA=+TIUD0,STATUS=$P(TIUD0,U,5),TITLE=$$PNAME^TIULC1(TITLEDA)
I STATUS<6 Q
S ADDING=$$READ^TIUU("Y","Are you adding a new interdisciplinary entry to this note","YES")
I 'ADDING D Q
. W !!,"This note appears to be an interdisciplinary parent. Please select"
. W !,"the note you want to attach to this note FIRST, or check with IRM"
. W !,"or your clinical coordinator."
. I $$READ^TIUU("EA","Press RETURN to continue...")
D CLEAR^VALM1 W !!,"Adding a new interdisciplinary entry to",!,TITLE
D FULL^VALM1
D ADDDAD1(DADDA,.KIDDA)
I $G(KIDDA) S ADDED=1 D:$D(^TMP("TIUR",$J)) UPIDDATA^TIURL1(DADDA),UPIDDATA^TIURL1(KIDDA)
Q
;
ADDDAD1(DADDA,DA) ; Enter one new ID Document and link it to DADDA
; Call with:
; [DADDA] --> IFN of note new note will be added to,
; i.e. parent note. Required.
; [DA] --> IFN of new note or 0 if not created. Passed back.
N LINKTL,TIUVSUPP,TIULMETH,TIU,TIUVMETH,TIUOUT,TIUASK,TIUDAD
N TIUNEW,TIU,TIUTYP,DFN,EDIT,TIUCMMTX,TIUDPRM,TIUEXIT,CONTINUE
N TIUQUIT
S DA=0
; -- Get data array TIUDAD on parent note DADDA: --
D GETTIU^TIULD(.TIUDAD,DADDA)
S DFN=$P(^TIU(8925,DADDA,0),U,2)
; -- Get new title from user.
; Set info into array TIUTYP where
; TIUTYP = title DA
; TIUTYP(1) = 1^title DA^Name...
TITLE ; -- Get title. Limit titles to those user can link, at least
;for SOME status. Check again later after we know the status.
W !!,"Please select a title for your entry:"
D DOCSPICK^TIULA2(.TIUTYP,3,"1A","LAST","","+$$CANPICK^TIULP(+Y),+$$CANENTR^TIULP(+Y),$$CANLINK^TIULP(+Y)")
I +$G(TIUTYP)'>0 S TIUOUT=1 Q
S TIUTYP=+$P($G(TIUTYP(1)),U,2) ; IFN. (DOCSPICK returns TIUTYP as 1.)
VISIT ; -- Get visit (use same visit as first entry unless visit
;must be an historical event and parent visit is not hist): --
S TIUVSUPP=+$$SUPPVSIT^TIULC1(TIUTYP)
I TIUVSUPP,$P(TIUDAD("VSTR"),";",3)'="E" D EVENT^TIUSRVP1(.TIU,DFN) I 1
E M TIU=TIUDAD
VALID ; -- Validate, i.e. ask user if OK: --
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..."
; -- Ask user if proposed docmt looks OK.
; May change array TIU, gets user answer in TIUASK: --
K TIU("REFDT") ; for new ID child, want default = NOW. See TIULD
X TIUVMETH
I '$D(TIU("VSTR")) D Q
. W !,$C(7),"Patient & Visit required." H 2
; -- Go on if user answers says OK: --
Q:'TIUASK
;-- Get parameters for selected title: --
D DOCPRM^TIULC1(TIUTYP,.TIUDPRM)
; -- Get DA: new docmt for user to continue entering, or
; existing docmt for user to edit, or existing docmt for
; user to link w/o editing since they may not edit it: --
S DA=$$GETRECG^TIUGEDI1(DFN,.TIU,.TIUTYP,.TIUDPRM,.TIUNEW,.EDIT,DADDA)
I 'DA S VALMSG="** No entry added **" Q
; -- If user is attaching an existing docmt they may not edit,
; try to attach, and quit: --
I 'TIUNEW,'EDIT D TRYLINK(DA,DADDA,.TIUDAD) H 2 Q
; -- Edit new or existing DA: --
N TIUQUIT,TIUTDA
D DIE^TIUEDI4(DA,.TIUQUIT)
Q:'$G(^TIU(8925,DA,0)) ; uparrow w/ bad docmt, already deleted
I $$EMPTYDOC^TIULF(DA) D DELETE^TIUEDIT(DA,0) S:$G(VALMAR)="^TMP(""TIUVIEW"",$J)" VALMBCK="Q" S:'TIUNEW TIUCHNG("DELETE")=1 H:'TIUNEW 2 Q
I +$G(TIUQUIT),'EDIT W !,"Document not attached" H 2 Q
; -- Misc after-edit-stuff for DA --
I +$G(TIU("STOP")),(+$P($G(TIUDPRM(0)),U,14)'=1) D DEFER^TIUVSIT(DA,TIU("STOP")) I 1 ; Stop code: For stand alones, mark to get work load at signature
E D QUE^TIUPXAP1 ; Post workload now in background
S TIUCMMTX=$$COMMIT^TIULC1(TIUTYP)
I TIUCMMTX]"" X TIUCMMTX
D RELEASE^TIUT(DA)
D VERIFY^TIUT(DA)
; -- If get this far without quitting, attach entry,
; new or existing, so auto-print prints whole note:
D LINK^TIUGR2(DA,DADDA) S VALMSG="** Entry attached **"
; -- Get signature
D EDSIG^TIURS(DA) ;does auto-print
; -- execute EXIT ACTION --
S TIUEXIT=$$GETEXIT^TIUEDI2(TIUTYP)
I $L(TIUEXIT) S TIUTDA=DA X TIUEXIT S DA=TIUTDA
;I '$G(^TIU(8925,DA,21)) D TRYLINK(DA,DADDA,.TIUDAD)
; -- [Prompt to print DA] --
I +$P($G(TIUDPRM(0)),U,8) D PRINT^TIUEPRNT(DA)
Q
;
TRYLINK(DA,DADDA,TIUDAD) ; Check specific docmt now that we know
;its status, to see if user can attach it to an ID note; if so,
;attach DA to DADDA.
; Already know that DADDA can receive ID entries.
;4/11/01 not currently used
N CANLINK
S CANLINK=$$CANDO^TIULP(DA,"ATTACH TO ID NOTE")
I 'CANLINK D Q
. W !!,$P(CANLINK,U,2),!," Entry saved as a stand-alone note. Please attach it later if you are",!," authorized to do so."
. I $$READ^TIUU("EA","Press RETURN to continue...")
. I $D(DUOUT)!$D(DTOUT)!$D(DIROUT) S TIUQUIT=1
. S VALMSG="** Entry saved as a stand-alone note **"
D LINK^TIUGR2(DA,DADDA)
W !!,"Entry added to ",$P(TIUDAD("DOCTYP"),U,2)
S VALMSG="** Entry attached **"
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUGEDIT 6960 printed Nov 22, 2024@17:51:31 Page 2
TIUGEDIT ; SLC/MAM - Add New ID Entry; 8/28/01
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**100,123**;Jun 20, 1997
DIE(DA,TIUQUIT) ; Invoke ^DIE
+1 NEW Y,DIE,DR
+2 SET ^TIU(8925,"ASAVE",DUZ,DA)=""
+3 SET DR=$$GETTMPL^TIUEDI1(+$PIECE(^TIU(8925,+DA,0),U))
+4 IF DR']""
WRITE !?5,$CHAR(7),"No Edit template defined for ",$$PNAME^TIULC1(+$PIECE(^TIU(8925,+DA,0),U)),!
SET TIUQUIT=2
QUIT
+5 SET DIE=8925
DO ^DIE
+6 SET DR=".05///undictated"
SET DIE=8925
DO ^DIE
+7 DO UPDTIRT^TIUDIRT(.TIU,DA)
DO SEND^TIUALRT(DA)
+8 LOCK -^TIU(8925,+DA)
+9 QUIT
+10 ;
ADDSTUB(DADDA) ; Prompt user for new stub ID entries for parent DADDA
+1 NEW TIUAUTH,TIUTYP,TIUDAD,DFN,TIUDPRM,DA,TIURTYP,TIUPRMT
+2 NEW X,Y,DIC
+3 SET DFN=$PIECE(^TIU(8925,DADDA,0),U,2)
+4 WRITE !!," If you wish you may add stub interdisciplinary entries for this note:",!
+5 FOR
Begin DoDot:1
+6 KILL TIUTYP,TIUAUTH
+7 SET DIC=200
SET DIC(0)="AEMQ"
SET DIC("A")="Select stub AUTHOR: "
+8 SET DIC("S")="I '+$$ISTERM^USRLM(+Y)"
+9 DO ^DIC
+10 ;I Y'>0 S TIUOUT=1 Q
+11 if Y'>0
QUIT
+12 SET TIUAUTH=+Y
+13 ; -- Get data array TIUDAD on parent note DADDA: --
+14 IF '$DATA(TIUDAD)
DO GETTIU^TIULD(.TIUDAD,DADDA)
+15 DO DOCSPICK^TIULA2(.TIUTYP,3,"1A","LAST","Select stub TITLE: ","+$$CANPICK^TIULP(+Y),+$$CANENTR^TIULP(+Y),$$CANLINK^TIULP(+Y)")
+16 ;I +$G(TIUTYP)'>0 S TIUOUT=1 Q
+17 if +$GET(TIUTYP)'>0
QUIT
+18 ; IFN. (DOCSPICK returns TIUTYP as 1.)
SET TIUTYP=+$PIECE($GET(TIUTYP(1)),U,2)
+19 ; -- Use visit of parent: --
+20 MERGE TIU=TIUDAD
+21 ;-- Get parameters for selected title: --
+22 DO DOCPRM^TIULC1(TIUTYP,.TIUDPRM)
+23 ; -- Get DA: --
+24 SET DA=$$CREATREC^TIUEDI3(DFN,.TIU,TIUTYP(1))
+25 NEW TIUQUIT,TIUTDA
+26 DO DIE(DA,.TIUQUIT)
+27 DO LINK^TIUGR2(DA,DADDA)
+28 WRITE !," Stub entry added",!!
End DoDot:1
if $GET(TIUAUTH)'>0
QUIT
if $GET(TIUTYP)'>0
QUIT
+29 QUIT
+30 ;
ADDDAD(DADDA,ADDED) ; Create new ID entry and link it to note DADDA
+1 ; Assumes DADDA can receive ID entries.
+2 ; Requires DADDA = parent note
+3 ; Requires DADLINE = parent note line number
+4 ; Returns ADDED > 0 if new note added (may not be linked), otherwise = 0
+5 NEW TITLE,TIUD0,TITLEDA,ADDING,STATUS,KIDDA
+6 SET ADDED=0
+7 SET TIUD0=$GET(^TIU(8925,+DADDA,0))
+8 SET TITLEDA=+TIUD0
SET STATUS=$PIECE(TIUD0,U,5)
SET TITLE=$$PNAME^TIULC1(TITLEDA)
+9 IF STATUS<6
QUIT
+10 SET ADDING=$$READ^TIUU("Y","Are you adding a new interdisciplinary entry to this note","YES")
+11 IF 'ADDING
Begin DoDot:1
+12 WRITE !!,"This note appears to be an interdisciplinary parent. Please select"
+13 WRITE !,"the note you want to attach to this note FIRST, or check with IRM"
+14 WRITE !,"or your clinical coordinator."
+15 IF $$READ^TIUU("EA","Press RETURN to continue...")
End DoDot:1
QUIT
+16 DO CLEAR^VALM1
WRITE !!,"Adding a new interdisciplinary entry to",!,TITLE
+17 DO FULL^VALM1
+18 DO ADDDAD1(DADDA,.KIDDA)
+19 IF $GET(KIDDA)
SET ADDED=1
if $DATA(^TMP("TIUR",$JOB))
DO UPIDDATA^TIURL1(DADDA)
DO UPIDDATA^TIURL1(KIDDA)
+20 QUIT
+21 ;
ADDDAD1(DADDA,DA) ; Enter one new ID Document and link it to DADDA
+1 ; Call with:
+2 ; [DADDA] --> IFN of note new note will be added to,
+3 ; i.e. parent note. Required.
+4 ; [DA] --> IFN of new note or 0 if not created. Passed back.
+5 NEW LINKTL,TIUVSUPP,TIULMETH,TIU,TIUVMETH,TIUOUT,TIUASK,TIUDAD
+6 NEW TIUNEW,TIU,TIUTYP,DFN,EDIT,TIUCMMTX,TIUDPRM,TIUEXIT,CONTINUE
+7 NEW TIUQUIT
+8 SET DA=0
+9 ; -- Get data array TIUDAD on parent note DADDA: --
+10 DO GETTIU^TIULD(.TIUDAD,DADDA)
+11 SET DFN=$PIECE(^TIU(8925,DADDA,0),U,2)
+12 ; -- Get new title from user.
+13 ; Set info into array TIUTYP where
+14 ; TIUTYP = title DA
+15 ; TIUTYP(1) = 1^title DA^Name...
TITLE ; -- Get title. Limit titles to those user can link, at least
+1 ;for SOME status. Check again later after we know the status.
+2 WRITE !!,"Please select a title for your entry:"
+3 DO DOCSPICK^TIULA2(.TIUTYP,3,"1A","LAST","","+$$CANPICK^TIULP(+Y),+$$CANENTR^TIULP(+Y),$$CANLINK^TIULP(+Y)")
+4 IF +$GET(TIUTYP)'>0
SET TIUOUT=1
QUIT
+5 ; IFN. (DOCSPICK returns TIUTYP as 1.)
SET TIUTYP=+$PIECE($GET(TIUTYP(1)),U,2)
VISIT ; -- Get visit (use same visit as first entry unless visit
+1 ;must be an historical event and parent visit is not hist): --
+2 SET TIUVSUPP=+$$SUPPVSIT^TIULC1(TIUTYP)
+3 IF TIUVSUPP
IF $PIECE(TIUDAD("VSTR"),";",3)'="E"
DO EVENT^TIUSRVP1(.TIU,DFN)
IF 1
+4 IF '$TEST
MERGE TIU=TIUDAD
VALID ; -- Validate, i.e. ask user if OK: --
+1 SET TIUVMETH=$$GETVMETH^TIUEDI1(TIUTYP)
+2 IF '$LENGTH(TIUVMETH)
Begin DoDot:1
+3 WRITE !,$CHAR(7),"No Validation Method defined for "
+4 WRITE $$PNAME^TIULC1(TIUTYP),".",!,"Please contact IRM..."
End DoDot:1
SET TIUOUT=1
QUIT
+5 ; -- Ask user if proposed docmt looks OK.
+6 ; May change array TIU, gets user answer in TIUASK: --
+7 ; for new ID child, want default = NOW. See TIULD
KILL TIU("REFDT")
+8 XECUTE TIUVMETH
+9 IF '$DATA(TIU("VSTR"))
Begin DoDot:1
+10 WRITE !,$CHAR(7),"Patient & Visit required."
HANG 2
End DoDot:1
QUIT
+11 ; -- Go on if user answers says OK: --
+12 if 'TIUASK
QUIT
+13 ;-- Get parameters for selected title: --
+14 DO DOCPRM^TIULC1(TIUTYP,.TIUDPRM)
+15 ; -- Get DA: new docmt for user to continue entering, or
+16 ; existing docmt for user to edit, or existing docmt for
+17 ; user to link w/o editing since they may not edit it: --
+18 SET DA=$$GETRECG^TIUGEDI1(DFN,.TIU,.TIUTYP,.TIUDPRM,.TIUNEW,.EDIT,DADDA)
+19 IF 'DA
SET VALMSG="** No entry added **"
QUIT
+20 ; -- If user is attaching an existing docmt they may not edit,
+21 ; try to attach, and quit: --
+22 IF 'TIUNEW
IF 'EDIT
DO TRYLINK(DA,DADDA,.TIUDAD)
HANG 2
QUIT
+23 ; -- Edit new or existing DA: --
+24 NEW TIUQUIT,TIUTDA
+25 DO DIE^TIUEDI4(DA,.TIUQUIT)
+26 ; uparrow w/ bad docmt, already deleted
if '$GET(^TIU(8925,DA,0))
QUIT
+27 IF $$EMPTYDOC^TIULF(DA)
DO DELETE^TIUEDIT(DA,0)
if $GET(VALMAR)="^TMP(""TIUVIEW"",$J)"
SET VALMBCK="Q"
if 'TIUNEW
SET TIUCHNG("DELETE")=1
if 'TIUNEW
HANG 2
QUIT
+28 IF +$GET(TIUQUIT)
IF 'EDIT
WRITE !,"Document not attached"
HANG 2
QUIT
+29 ; -- Misc after-edit-stuff for DA --
+30 ; Stop code: For stand alones, mark to get work load at signature
IF +$GET(TIU("STOP"))
IF (+$PIECE($GET(TIUDPRM(0)),U,14)'=1)
DO DEFER^TIUVSIT(DA,TIU("STOP"))
IF 1
+31 ; Post workload now in background
IF '$TEST
DO QUE^TIUPXAP1
+32 SET TIUCMMTX=$$COMMIT^TIULC1(TIUTYP)
+33 IF TIUCMMTX]""
XECUTE TIUCMMTX
+34 DO RELEASE^TIUT(DA)
+35 DO VERIFY^TIUT(DA)
+36 ; -- If get this far without quitting, attach entry,
+37 ; new or existing, so auto-print prints whole note:
+38 DO LINK^TIUGR2(DA,DADDA)
SET VALMSG="** Entry attached **"
+39 ; -- Get signature
+40 ;does auto-print
DO EDSIG^TIURS(DA)
+41 ; -- execute EXIT ACTION --
+42 SET TIUEXIT=$$GETEXIT^TIUEDI2(TIUTYP)
+43 IF $LENGTH(TIUEXIT)
SET TIUTDA=DA
XECUTE TIUEXIT
SET DA=TIUTDA
+44 ;I '$G(^TIU(8925,DA,21)) D TRYLINK(DA,DADDA,.TIUDAD)
+45 ; -- [Prompt to print DA] --
+46 IF +$PIECE($GET(TIUDPRM(0)),U,8)
DO PRINT^TIUEPRNT(DA)
+47 QUIT
+48 ;
TRYLINK(DA,DADDA,TIUDAD) ; Check specific docmt now that we know
+1 ;its status, to see if user can attach it to an ID note; if so,
+2 ;attach DA to DADDA.
+3 ; Already know that DADDA can receive ID entries.
+4 ;4/11/01 not currently used
+5 NEW CANLINK
+6 SET CANLINK=$$CANDO^TIULP(DA,"ATTACH TO ID NOTE")
+7 IF 'CANLINK
Begin DoDot:1
+8 WRITE !!,$PIECE(CANLINK,U,2),!," Entry saved as a stand-alone note. Please attach it later if you are",!," authorized to do so."
+9 IF $$READ^TIUU("EA","Press RETURN to continue...")
+10 IF $DATA(DUOUT)!$DATA(DTOUT)!$DATA(DIROUT)
SET TIUQUIT=1
+11 SET VALMSG="** Entry saved as a stand-alone note **"
End DoDot:1
QUIT
+12 DO LINK^TIUGR2(DA,DADDA)
+13 WRITE !!,"Entry added to ",$PIECE(TIUDAD("DOCTYP"),U,2)
+14 SET VALMSG="** Entry attached **"
+15 QUIT
+16 ;
