Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: TIUGR2

TIUGR2.m

Go to the documentation of this file.
  1. TIUGR2 ; SLC/MAM - ID Note Review Screen Actions ;2/28/01
  1. ;;1.0;TEXT INTEGRATION UTILITIES;**100**;Jun 20, 1997
  1. ;
  1. 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
  1. ;when TIUGLINK exists. Needs $0(VALMY(0)).
  1. ; KIDDATA = TIUGLINK = DA^lineno^titlename for entry being attached,
  1. ; where lineno = 0 if not in current screen
  1. N LINENO,CANLINK2,DADDATA,DADDA,DADTL,CONTINUE,LINKED
  1. N TIUI,PDOCTYP,TIUCHNG
  1. S LINKED=0
  1. S LINENO=+$O(VALMY(0))
  1. S DADDATA=$G(^TMP("TIURIDX",$J,LINENO))
  1. S DADDA=+$P(DADDATA,U,2)
  1. I '$D(^TIU(8925,+DADDA,0)) G LKDADX
  1. ; -- Set can't attach msg:
  1. I +^TIU(8925,+DADDA,0)=81 S CANLINK2="0^You cannot attach ID entries to addenda."
  1. S PDOCTYP=$P(^TIU(8925,+DADDA,0),U,4)
  1. I (PDOCTYP=27)!(PDOCTYP=25)!(PDOCTYP=31)!(PDOCTYP=30) S CANLINK2="0^You cannot attach ID entries to CWAD notes."
  1. I $P(^TIU(8925,+DADDA,14),U,5) S CANLINK2="0^You cannot attach ID entries to consult results."
  1. I '$D(CANLINK2) S CANLINK2=$$CANDO^TIULP(DADDA,"ATTACH ID ENTRY")
  1. I CANLINK2 D
  1. . Q:($P(^TIU(8925,DADDA,0),U,2)=$P(^TIU(8925,+KIDDATA,0),U,2))
  1. . S $P(CANLINK2,U,2)="You cannot attach these notes; they do not have the same patient."
  1. . S $P(CANLINK2,U)=0
  1. ; -- Tell user they can't attach, and quit:
  1. I 'CANLINK2 D G LKDADX
  1. . W !!," ",$P(CANLINK2,U,2),!
  1. . W "Please reselect the child and choose a different parent."
  1. . I $$READ^TIUU("EA","Press RETURN to continue...")
  1. ; -- Attach:
  1. S DADTL=$P($$DOCTYPE^TIULF(DADDA),U,2)
  1. W !!," Attaching ",$P(KIDDATA,U,3)," to ",!,DADTL,"."
  1. S CONTINUE=$$READ^TIUU("Y"," Are you sure","YES")
  1. I 'CONTINUE!$D(DUOUT)!$D(DTOUT)!$D(DIROUT) G LKDADX
  1. S LINKED=1
  1. D LINK(+TIUGLINK,DADDA)
  1. I $L(DADTL)>26 S DADTL=$E(DADTL,1,26)
  1. LKDADX ; Exit
  1. ; -- Restore video for KID line if kid is in current screen:
  1. I $P(KIDDATA,U,2) D RESTORE^VALM10($P(KIDDATA,U,2))
  1. ; -- Set msgbar, UPRBLD parameter:
  1. I 'LINKED S VALMSG="** Note not attached **",TIUCHNG("REFRESH")=1
  1. I LINKED S VALMSG="** Note attached to "_DADTL_" **",TIUCHNG("RBLD")=1
  1. D UPRBLD^TIURL(.TIUCHNG,.VALMY) ;don't K VALMY - done in PICK^TIULM
  1. S VALMBCK="R" K TIUGLINK
  1. Q
  1. ;
  1. LINKMSG(TIUGLINK) ; Returns VALMSG displayed after LKKID.
  1. ;Used in ENTRY ACTION of protocol TIU ACTION MENU OE/RR.
  1. ; Can't just set VALMSG in LKKID because it gets overwritten by ENTRY
  1. ;ACTION if user selects item number as independent List Manager action.
  1. N KIDTL
  1. S KIDTL=$P(TIUGLINK,U,3)
  1. I $L(KIDTL)>33 S KIDTL=$E(KIDTL,1,33)
  1. Q "** Attaching "_KIDTL_" **"
  1. ;
  1. N DIE,DR
  1. S DIE=8925,DR="2101////"_DADDA
  1. D ^DIE
  1. D AUDLINK^TIUGR1(DA,"a",DADDA)
  1. D SENDID^TIUALRT1(DA)
  1. Q
  1. ;
  1. LINKQUIT ; Quit without linking
  1. ; Action QUIT Review Screen if started linking and didn't succeed
  1. ; Called by TIU ACTION QUIT from Review Screen if $G(TIUGLINK).
  1. ; Unscreens review actions
  1. N TIUI
  1. S TIUI=0
  1. F TIUI=+$O(VALMY(TIUI)) Q:'TIUI D RESTORE^VALM10(TIUI)
  1. I $P($G(TIUGLINK),U,2) D RESTORE^VALM10(+$P(TIUGLINK,U,2))
  1. S VALMSG="** Note not attached **"
  1. K VALMY,TIUGLINK
  1. S VALMBCK="R"
  1. Q
  1. ;