TIUGR ; SLC/MAM - ID Note Review Screen Actions ; IDNOTE; 4/12/01
;;1.0;TEXT INTEGRATION UTILITIES;**100**;Jun 20, 1997
;
IDNOTE ; Review Screen Action IN Interdisciplinary Note
;If editing this module, please keep TIUGR1 consistent with it.
; -- Sets TIUGLINK if user starts attaching
; the note to an existing note: --
; TIUGLINK = IFN of ID entry^Lineno^Title.
; (If ID entry is chosen via browse instead of review, Lineno=0)
N LINENO,NTDATA,NTDA,ADDED,TIUQUIT,TITLE,TITLEDA
N CANATT,CANADD,PDOCTYP,TIUCHNG,LNO
N TIUDAARY,DETACHED,TIUACT,TIULST,TIUIDDAD
; -- If user has already selected note to attach, but not note
; to attach it to, write msg and quit: --
;I $G(TIUGLINK) D ATTCHMSG(TIUGLINK) S TIUQUIT=1 G IDNOTEX
; -- If user has already selected note to attach, but not note
; to attach it to, and reselects IN, quit attach action: --
I $G(TIUGLINK) D LINKQUIT^TIUGR2 S TIUQUIT=1 G IDNOTEX
; -- Select note to act on, if not already selected: --
I '$D(VALMY) D I $G(TIUQUIT) G IDNOTEX
. I $P($G(XQORNOD(0)),U,4)'["=" D
. . W !!," To ADD a new entry to an interdisciplinary note, please select the",!,"interdisciplinary note."
. . W !," To ATTACH an existing stand-alone note to an interdisciplinary note,",!,"please select the note you want to attach."
. D EN^VALM2(XQORNOD(0),"S") S LINENO=+$O(VALMY(0))
. I 'LINENO S TIUQUIT=1 Q
. ; -- Reverse video selected note: --
. D RESTORE^VALM10(LINENO),CNTRL^VALM10(LINENO,6,VALM("RM"),IORVON,IORVOFF),WRITE^VALM10(LINENO)
; -- In case note was already selected: --
S LINENO=+$O(VALMY(0))
; -- Set notedata NTDATA = lineno^IFN^? --
S NTDATA=$G(^TMP("TIURIDX",$J,LINENO))
S NTDA=+$P(NTDATA,U,2)
I '$D(^TIU(8925,+NTDA,0)) S TIUCHNG("REFRESH")=1,TIUQUIT=1 G IDNOTEX
S TITLE=$$DOCTYPE^TIULF(NTDA)
I $O(VALMY(LINENO)) D
. W !!,"Notes must be selected one at a time for interdisciplinary"
. W !,"note actions. Acting on your FIRST selection,"
. W !?3,$P(TITLE,U,2) H 5
. S LNO=LINENO F S LNO=$O(VALMY(LNO)) Q:'LNO D
. . D RESTORE^VALM10(LNO)
. . D WRITE^VALM10(LNO)
. . K VALMY(LNO)
; -- If note is addendum, CWAD, or consult result,
; user can't detach/attach it or add new entry to it.
; Say so & quit: --
I +^TIU(8925,+NTDA,0)=81 D CANT("A") S TIUCHNG("REFRESH")=1 G IDNOTEX
S PDOCTYP=$P(^TIU(8925,+NTDA,0),U,4)
I (PDOCTYP=27)!(PDOCTYP=25)!(PDOCTYP=31)!(PDOCTYP=30) D G IDNOTEX
. D CANT("CWAD") S TIUCHNG("REFRESH")=1
I $P($G(^TIU(8925,+NTDA,14)),U,5) D G IDNOTEX
. D CANT("CR") S TIUCHNG("REFRESH")=1
; -- If note is already an entry of an ID note, unlink it: --
S TIUIDDAD=$$HASIDDAD^TIUGBR(NTDA)
I TIUIDDAD D G IDNOTEX
. S TIUACT="DETACHED",TIUDAARY(LINENO)=NTDA
. D UNLKKID^TIUGR1(NTDA,TIUIDDAD,.DETACHED)
. I '$G(DETACHED) S TIUCHNG("REFRESH")=1,TIULST="" Q
. S TIUCHNG("RBLD")=1,TIULST=LINENO
; -- If user can add an entry to the note, do it & quit: --
S CANADD=$$CANDO^TIULP(NTDA,"ATTACH ID ENTRY")
I CANADD D G IDNOTEX
. D ADDDAD^TIUGEDIT(NTDA,.ADDED)
. I 'ADDED S TIUCHNG("REFRESH")=1 Q
. S TIUCHNG("RBLD")=1
; -- If user can't add entry to note, & attaching note to
; an existing note is not permitted, say can't add & quit: --
; -- Note itself has entries: --
I 'CANADD,$$HASIDKID^TIUGBR(NTDA) D G IDNOTEX
. W !!,$P(CANADD,U,2) D PAUSE S TIUCHNG("REFRESH")=1
; -- Note is a possible parent: --
S TITLEDA=+^TIU(8925,NTDA,0)
I 'CANADD,$$POSSPRNT^TIULP(TITLEDA) D G IDNOTEX
. W !!,$P(CANADD,U,2) D PAUSE S TIUCHNG("REFRESH")=1
; -- See if user can attach note to an existing note: --
S CANATT=$$CANDO^TIULP(NTDA,"ATTACH TO ID NOTE")
; -- If user can attach note, set TIUGLINK,
; write "Attaching...", and quit: --
I CANATT D G IDNOTEX
. S TIUGLINK=NTDA_U_LINENO_U_$P(TITLE,U,2)
. D ATTCHMSG(TIUGLINK) ; User is mid-attach, don't set TIUCHNG
; -- If user can't attach, say can't attach, and quit
I 'CANATT D
. W !!,$P(CANATT,U,2) D PAUSE
. S TIUCHNG("REFRESH")=1
IDNOTEX ; Restore video for selected line and refresh/update/rebuild list:
I $G(TIUCHNG("REFRESH"))!$G(TIUCHNG("UPDATE"))!$G(TIUCHNG("RBLD")) D
. S VALMY(LINENO)=""
. D UPRBLD^TIURL(.TIUCHNG,.VALMY)
S VALMBCK="R" K VALMY
I $G(TIUACT)="DETACHED" D VMSG^TIURS1(TIULST,.TIUDAARY,"DETACHED")
Q
;
PAUSE ;Wait til user hits return
I $$READ^TIUU("EA","Press RETURN to continue...")
Q
;
CANT(TYPE) ; Tell user they can't act on addendum, CWAD, or
;Consult result
I TYPE="A" D
. W !!," An addendum is linked to its parent when it is first made and"
. W !,"cannot be attached or detached like an interdisciplinary note."
. W !,"To add an addendum to a note, use action 'Make Addendum.'"
I TYPE="CWAD" D
. W !!," CWAD notes cannot be used as interdisciplinary notes."
I TYPE="CR" D
. W !!," Consult results cannot be used as interdisciplinary notes."
D PAUSE
Q
;
ATTCHMSG(KIDDATA) ; Offer instructions when user has selected
;the note to attach but not the note to attach it to.
W !!," Attaching ",$P(KIDDATA,U,3),"."
W !," Please select the note you want to attach it to."
W !," Or, reselect action IN if you no longer wish to attach the note."
I $$READ^TIUU("EA","Press RETURN when you have finished reading this message...")
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUGR 5332 printed Oct 16, 2024@18:42:11 Page 2
TIUGR ; SLC/MAM - ID Note Review Screen Actions ; IDNOTE; 4/12/01
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**100**;Jun 20, 1997
+2 ;
IDNOTE ; Review Screen Action IN Interdisciplinary Note
+1 ;If editing this module, please keep TIUGR1 consistent with it.
+2 ; -- Sets TIUGLINK if user starts attaching
+3 ; the note to an existing note: --
+4 ; TIUGLINK = IFN of ID entry^Lineno^Title.
+5 ; (If ID entry is chosen via browse instead of review, Lineno=0)
+6 NEW LINENO,NTDATA,NTDA,ADDED,TIUQUIT,TITLE,TITLEDA
+7 NEW CANATT,CANADD,PDOCTYP,TIUCHNG,LNO
+8 NEW TIUDAARY,DETACHED,TIUACT,TIULST,TIUIDDAD
+9 ; -- If user has already selected note to attach, but not note
+10 ; to attach it to, write msg and quit: --
+11 ;I $G(TIUGLINK) D ATTCHMSG(TIUGLINK) S TIUQUIT=1 G IDNOTEX
+12 ; -- If user has already selected note to attach, but not note
+13 ; to attach it to, and reselects IN, quit attach action: --
+14 IF $GET(TIUGLINK)
DO LINKQUIT^TIUGR2
SET TIUQUIT=1
GOTO IDNOTEX
+15 ; -- Select note to act on, if not already selected: --
+16 IF '$DATA(VALMY)
Begin DoDot:1
+17 IF $PIECE($GET(XQORNOD(0)),U,4)'["="
Begin DoDot:2
+18 WRITE !!," To ADD a new entry to an interdisciplinary note, please select the",!,"interdisciplinary note."
+19 WRITE !," To ATTACH an existing stand-alone note to an interdisciplinary note,",!,"please select the note you want to attach."
End DoDot:2
+20 DO EN^VALM2(XQORNOD(0),"S")
SET LINENO=+$ORDER(VALMY(0))
+21 IF 'LINENO
SET TIUQUIT=1
QUIT
+22 ; -- Reverse video selected note: --
+23 DO RESTORE^VALM10(LINENO)
DO CNTRL^VALM10(LINENO,6,VALM("RM"),IORVON,IORVOFF)
DO WRITE^VALM10(LINENO)
End DoDot:1
IF $GET(TIUQUIT)
GOTO IDNOTEX
+24 ; -- In case note was already selected: --
+25 SET LINENO=+$ORDER(VALMY(0))
+26 ; -- Set notedata NTDATA = lineno^IFN^? --
+27 SET NTDATA=$GET(^TMP("TIURIDX",$JOB,LINENO))
+28 SET NTDA=+$PIECE(NTDATA,U,2)
+29 IF '$DATA(^TIU(8925,+NTDA,0))
SET TIUCHNG("REFRESH")=1
SET TIUQUIT=1
GOTO IDNOTEX
+30 SET TITLE=$$DOCTYPE^TIULF(NTDA)
+31 IF $ORDER(VALMY(LINENO))
Begin DoDot:1
+32 WRITE !!,"Notes must be selected one at a time for interdisciplinary"
+33 WRITE !,"note actions. Acting on your FIRST selection,"
+34 WRITE !?3,$PIECE(TITLE,U,2)
HANG 5
+35 SET LNO=LINENO
FOR
SET LNO=$ORDER(VALMY(LNO))
if 'LNO
QUIT
Begin DoDot:2
+36 DO RESTORE^VALM10(LNO)
+37 DO WRITE^VALM10(LNO)
+38 KILL VALMY(LNO)
End DoDot:2
End DoDot:1
+39 ; -- If note is addendum, CWAD, or consult result,
+40 ; user can't detach/attach it or add new entry to it.
+41 ; Say so & quit: --
+42 IF +^TIU(8925,+NTDA,0)=81
DO CANT("A")
SET TIUCHNG("REFRESH")=1
GOTO IDNOTEX
+43 SET PDOCTYP=$PIECE(^TIU(8925,+NTDA,0),U,4)
+44 IF (PDOCTYP=27)!(PDOCTYP=25)!(PDOCTYP=31)!(PDOCTYP=30)
Begin DoDot:1
+45 DO CANT("CWAD")
SET TIUCHNG("REFRESH")=1
End DoDot:1
GOTO IDNOTEX
+46 IF $PIECE($GET(^TIU(8925,+NTDA,14)),U,5)
Begin DoDot:1
+47 DO CANT("CR")
SET TIUCHNG("REFRESH")=1
End DoDot:1
GOTO IDNOTEX
+48 ; -- If note is already an entry of an ID note, unlink it: --
+49 SET TIUIDDAD=$$HASIDDAD^TIUGBR(NTDA)
+50 IF TIUIDDAD
Begin DoDot:1
+51 SET TIUACT="DETACHED"
SET TIUDAARY(LINENO)=NTDA
+52 DO UNLKKID^TIUGR1(NTDA,TIUIDDAD,.DETACHED)
+53 IF '$GET(DETACHED)
SET TIUCHNG("REFRESH")=1
SET TIULST=""
QUIT
+54 SET TIUCHNG("RBLD")=1
SET TIULST=LINENO
End DoDot:1
GOTO IDNOTEX
+55 ; -- If user can add an entry to the note, do it & quit: --
+56 SET CANADD=$$CANDO^TIULP(NTDA,"ATTACH ID ENTRY")
+57 IF CANADD
Begin DoDot:1
+58 DO ADDDAD^TIUGEDIT(NTDA,.ADDED)
+59 IF 'ADDED
SET TIUCHNG("REFRESH")=1
QUIT
+60 SET TIUCHNG("RBLD")=1
End DoDot:1
GOTO IDNOTEX
+61 ; -- If user can't add entry to note, & attaching note to
+62 ; an existing note is not permitted, say can't add & quit: --
+63 ; -- Note itself has entries: --
+64 IF 'CANADD
IF $$HASIDKID^TIUGBR(NTDA)
Begin DoDot:1
+65 WRITE !!,$PIECE(CANADD,U,2)
DO PAUSE
SET TIUCHNG("REFRESH")=1
End DoDot:1
GOTO IDNOTEX
+66 ; -- Note is a possible parent: --
+67 SET TITLEDA=+^TIU(8925,NTDA,0)
+68 IF 'CANADD
IF $$POSSPRNT^TIULP(TITLEDA)
Begin DoDot:1
+69 WRITE !!,$PIECE(CANADD,U,2)
DO PAUSE
SET TIUCHNG("REFRESH")=1
End DoDot:1
GOTO IDNOTEX
+70 ; -- See if user can attach note to an existing note: --
+71 SET CANATT=$$CANDO^TIULP(NTDA,"ATTACH TO ID NOTE")
+72 ; -- If user can attach note, set TIUGLINK,
+73 ; write "Attaching...", and quit: --
+74 IF CANATT
Begin DoDot:1
+75 SET TIUGLINK=NTDA_U_LINENO_U_$PIECE(TITLE,U,2)
+76 ; User is mid-attach, don't set TIUCHNG
DO ATTCHMSG(TIUGLINK)
End DoDot:1
GOTO IDNOTEX
+77 ; -- If user can't attach, say can't attach, and quit
+78 IF 'CANATT
Begin DoDot:1
+79 WRITE !!,$PIECE(CANATT,U,2)
DO PAUSE
+80 SET TIUCHNG("REFRESH")=1
End DoDot:1
IDNOTEX ; Restore video for selected line and refresh/update/rebuild list:
+1 IF $GET(TIUCHNG("REFRESH"))!$GET(TIUCHNG("UPDATE"))!$GET(TIUCHNG("RBLD"))
Begin DoDot:1
+2 SET VALMY(LINENO)=""
+3 DO UPRBLD^TIURL(.TIUCHNG,.VALMY)
End DoDot:1
+4 SET VALMBCK="R"
KILL VALMY
+5 IF $GET(TIUACT)="DETACHED"
DO VMSG^TIURS1(TIULST,.TIUDAARY,"DETACHED")
+6 QUIT
+7 ;
PAUSE ;Wait til user hits return
+1 IF $$READ^TIUU("EA","Press RETURN to continue...")
+2 QUIT
+3 ;
CANT(TYPE) ; Tell user they can't act on addendum, CWAD, or
+1 ;Consult result
+2 IF TYPE="A"
Begin DoDot:1
+3 WRITE !!," An addendum is linked to its parent when it is first made and"
+4 WRITE !,"cannot be attached or detached like an interdisciplinary note."
+5 WRITE !,"To add an addendum to a note, use action 'Make Addendum.'"
End DoDot:1
+6 IF TYPE="CWAD"
Begin DoDot:1
+7 WRITE !!," CWAD notes cannot be used as interdisciplinary notes."
End DoDot:1
+8 IF TYPE="CR"
Begin DoDot:1
+9 WRITE !!," Consult results cannot be used as interdisciplinary notes."
End DoDot:1
+10 DO PAUSE
+11 QUIT
+12 ;
ATTCHMSG(KIDDATA) ; Offer instructions when user has selected
+1 ;the note to attach but not the note to attach it to.
+2 WRITE !!," Attaching ",$PIECE(KIDDATA,U,3),"."
+3 WRITE !," Please select the note you want to attach it to."
+4 WRITE !," Or, reselect action IN if you no longer wish to attach the note."
+5 IF $$READ^TIUU("EA","Press RETURN when you have finished reading this message...")
+6 QUIT
+7 ;
