source: WorldVistAEHR/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIUGEDIT.m@ 1111

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

 ;