TIUGR2 ; SLC/MAM - ID Note Review Screen Actions ;2/28/01
;;1.0;TEXT INTEGRATION UTILITIES;**100**;Jun 20, 1997
;
LKDAD(KIDDATA) ; Select DAD ID note to attach KID to, and attach it.
; Called by PICK^TIULM when user selects line at action prompt
;when TIUGLINK exists. Needs $0(VALMY(0)).
; KIDDATA = TIUGLINK = DA^lineno^titlename for entry being attached,
; where lineno = 0 if not in current screen
N LINENO,CANLINK2,DADDATA,DADDA,DADTL,CONTINUE,LINKED
N TIUI,PDOCTYP,TIUCHNG
S LINKED=0
S LINENO=+$O(VALMY(0))
S DADDATA=$G(^TMP("TIURIDX",$J,LINENO))
S DADDA=+$P(DADDATA,U,2)
I '$D(^TIU(8925,+DADDA,0)) G LKDADX
; -- Set can't attach msg:
I +^TIU(8925,+DADDA,0)=81 S CANLINK2="0^You cannot attach ID entries to addenda."
S PDOCTYP=$P(^TIU(8925,+DADDA,0),U,4)
I (PDOCTYP=27)!(PDOCTYP=25)!(PDOCTYP=31)!(PDOCTYP=30) S CANLINK2="0^You cannot attach ID entries to CWAD notes."
I $P(^TIU(8925,+DADDA,14),U,5) S CANLINK2="0^You cannot attach ID entries to consult results."
I '$D(CANLINK2) S CANLINK2=$$CANDO^TIULP(DADDA,"ATTACH ID ENTRY")
I CANLINK2 D
. Q:($P(^TIU(8925,DADDA,0),U,2)=$P(^TIU(8925,+KIDDATA,0),U,2))
. S $P(CANLINK2,U,2)="You cannot attach these notes; they do not have the same patient."
. S $P(CANLINK2,U)=0
; -- Tell user they can't attach, and quit:
I 'CANLINK2 D G LKDADX
. W !!," ",$P(CANLINK2,U,2),!
. W "Please reselect the child and choose a different parent."
. I $$READ^TIUU("EA","Press RETURN to continue...")
; -- Attach:
S DADTL=$P($$DOCTYPE^TIULF(DADDA),U,2)
W !!," Attaching ",$P(KIDDATA,U,3)," to ",!,DADTL,"."
S CONTINUE=$$READ^TIUU("Y"," Are you sure","YES")
I 'CONTINUE!$D(DUOUT)!$D(DTOUT)!$D(DIROUT) G LKDADX
S LINKED=1
D LINK(+TIUGLINK,DADDA)
I $L(DADTL)>26 S DADTL=$E(DADTL,1,26)
LKDADX ; Exit
; -- Restore video for KID line if kid is in current screen:
I $P(KIDDATA,U,2) D RESTORE^VALM10($P(KIDDATA,U,2))
; -- Set msgbar, UPRBLD parameter:
I 'LINKED S VALMSG="** Note not attached **",TIUCHNG("REFRESH")=1
I LINKED S VALMSG="** Note attached to "_DADTL_" **",TIUCHNG("RBLD")=1
D UPRBLD^TIURL(.TIUCHNG,.VALMY) ;don't K VALMY - done in PICK^TIULM
S VALMBCK="R" K TIUGLINK
Q
;
LINKMSG(TIUGLINK) ; Returns VALMSG displayed after LKKID.
;Used in ENTRY ACTION of protocol TIU ACTION MENU OE/RR.
; Can't just set VALMSG in LKKID because it gets overwritten by ENTRY
;ACTION if user selects item number as independent List Manager action.
N KIDTL
S KIDTL=$P(TIUGLINK,U,3)
I $L(KIDTL)>33 S KIDTL=$E(KIDTL,1,33)
Q "** Attaching "_KIDTL_" **"
;
LINK(DA,DADDA) ; Link DA to parent ID note DADDA
N DIE,DR
S DIE=8925,DR="2101////"_DADDA
D ^DIE
D AUDLINK^TIUGR1(DA,"a",DADDA)
D SENDID^TIUALRT1(DA)
Q
;
LINKQUIT ; Quit without linking
; Action QUIT Review Screen if started linking and didn't succeed
; Called by TIU ACTION QUIT from Review Screen if $G(TIUGLINK).
; Unscreens review actions
N TIUI
S TIUI=0
F TIUI=+$O(VALMY(TIUI)) Q:'TIUI D RESTORE^VALM10(TIUI)
I $P($G(TIUGLINK),U,2) D RESTORE^VALM10(+$P(TIUGLINK,U,2))
S VALMSG="** Note not attached **"
K VALMY,TIUGLINK
S VALMBCK="R"
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUGR2 3189 printed Dec 13, 2024@02:41:36 Page 2
TIUGR2 ; SLC/MAM - ID Note Review Screen Actions ;2/28/01
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**100**;Jun 20, 1997
+2 ;
LKDAD(KIDDATA) ; Select DAD ID note to attach KID to, and attach it.
+1 ; Called by PICK^TIULM when user selects line at action prompt
+2 ;when TIUGLINK exists. Needs $0(VALMY(0)).
+3 ; KIDDATA = TIUGLINK = DA^lineno^titlename for entry being attached,
+4 ; where lineno = 0 if not in current screen
+5 NEW LINENO,CANLINK2,DADDATA,DADDA,DADTL,CONTINUE,LINKED
+6 NEW TIUI,PDOCTYP,TIUCHNG
+7 SET LINKED=0
+8 SET LINENO=+$ORDER(VALMY(0))
+9 SET DADDATA=$GET(^TMP("TIURIDX",$JOB,LINENO))
+10 SET DADDA=+$PIECE(DADDATA,U,2)
+11 IF '$DATA(^TIU(8925,+DADDA,0))
GOTO LKDADX
+12 ; -- Set can't attach msg:
+13 IF +^TIU(8925,+DADDA,0)=81
SET CANLINK2="0^You cannot attach ID entries to addenda."
+14 SET PDOCTYP=$PIECE(^TIU(8925,+DADDA,0),U,4)
+15 IF (PDOCTYP=27)!(PDOCTYP=25)!(PDOCTYP=31)!(PDOCTYP=30)
SET CANLINK2="0^You cannot attach ID entries to CWAD notes."
+16 IF $PIECE(^TIU(8925,+DADDA,14),U,5)
SET CANLINK2="0^You cannot attach ID entries to consult results."
+17 IF '$DATA(CANLINK2)
SET CANLINK2=$$CANDO^TIULP(DADDA,"ATTACH ID ENTRY")
+18 IF CANLINK2
Begin DoDot:1
+19 if ($PIECE(^TIU(8925,DADDA,0),U,2)=$PIECE(^TIU(8925,+KIDDATA,0),U,2))
QUIT
+20 SET $PIECE(CANLINK2,U,2)="You cannot attach these notes; they do not have the same patient."
+21 SET $PIECE(CANLINK2,U)=0
End DoDot:1
+22 ; -- Tell user they can't attach, and quit:
+23 IF 'CANLINK2
Begin DoDot:1
+24 WRITE !!," ",$PIECE(CANLINK2,U,2),!
+25 WRITE "Please reselect the child and choose a different parent."
+26 IF $$READ^TIUU("EA","Press RETURN to continue...")
End DoDot:1
GOTO LKDADX
+27 ; -- Attach:
+28 SET DADTL=$PIECE($$DOCTYPE^TIULF(DADDA),U,2)
+29 WRITE !!," Attaching ",$PIECE(KIDDATA,U,3)," to ",!,DADTL,"."
+30 SET CONTINUE=$$READ^TIUU("Y"," Are you sure","YES")
+31 IF 'CONTINUE!$DATA(DUOUT)!$DATA(DTOUT)!$DATA(DIROUT)
GOTO LKDADX
+32 SET LINKED=1
+33 DO LINK(+TIUGLINK,DADDA)
+34 IF $LENGTH(DADTL)>26
SET DADTL=$EXTRACT(DADTL,1,26)
LKDADX ; Exit
+1 ; -- Restore video for KID line if kid is in current screen:
+2 IF $PIECE(KIDDATA,U,2)
DO RESTORE^VALM10($PIECE(KIDDATA,U,2))
+3 ; -- Set msgbar, UPRBLD parameter:
+4 IF 'LINKED
SET VALMSG="** Note not attached **"
SET TIUCHNG("REFRESH")=1
+5 IF LINKED
SET VALMSG="** Note attached to "_DADTL_" **"
SET TIUCHNG("RBLD")=1
+6 ;don't K VALMY - done in PICK^TIULM
DO UPRBLD^TIURL(.TIUCHNG,.VALMY)
+7 SET VALMBCK="R"
KILL TIUGLINK
+8 QUIT
+9 ;
LINKMSG(TIUGLINK) ; Returns VALMSG displayed after LKKID.
+1 ;Used in ENTRY ACTION of protocol TIU ACTION MENU OE/RR.
+2 ; Can't just set VALMSG in LKKID because it gets overwritten by ENTRY
+3 ;ACTION if user selects item number as independent List Manager action.
+4 NEW KIDTL
+5 SET KIDTL=$PIECE(TIUGLINK,U,3)
+6 IF $LENGTH(KIDTL)>33
SET KIDTL=$EXTRACT(KIDTL,1,33)
+7 QUIT "** Attaching "_KIDTL_" **"
+8 ;
LINK(DA,DADDA) ; Link DA to parent ID note DADDA
+1 NEW DIE,DR
+2 SET DIE=8925
SET DR="2101////"_DADDA
+3 DO ^DIE
+4 DO AUDLINK^TIUGR1(DA,"a",DADDA)
+5 DO SENDID^TIUALRT1(DA)
+6 QUIT
+7 ;
LINKQUIT ; Quit without linking
+1 ; Action QUIT Review Screen if started linking and didn't succeed
+2 ; Called by TIU ACTION QUIT from Review Screen if $G(TIUGLINK).
+3 ; Unscreens review actions
+4 NEW TIUI
+5 SET TIUI=0
+6 FOR TIUI=+$ORDER(VALMY(TIUI))
if 'TIUI
QUIT
DO RESTORE^VALM10(TIUI)
+7 IF $PIECE($GET(TIUGLINK),U,2)
DO RESTORE^VALM10(+$PIECE(TIUGLINK,U,2))
+8 SET VALMSG="** Note not attached **"
+9 KILL VALMY,TIUGLINK
+10 SET VALMBCK="R"
+11 QUIT
+12 ;
