- 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 Feb 19, 2025@00:08:04 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 ;