- TIUGR1 ; SLC/MAM - More ID Note Review Screen Actions ;4/12/01
- ;;1.0;TEXT INTEGRATION UTILITIES;**100**;Jun 20, 1997
- ;
- IDNOTEB(TIUDA) ; Browse Screen Action IN Interdisciplinary Note
- ; Requires TIUDA
- ; If editing this module, please keep TIUGR consistent with it.
- N TITLE,PREFIX,TITLEDA,CANADD,CANATT,ADDED,TIUQUIT,TIUIDDAD
- ;TIUCHNG is newed in TIURA2; Don't new it here
- S VALMBCK="R"
- ; -- If note is addendum, can't attach; say so & quit: --
- I +^TIU(8925,TIUDA,0)=81 D G IDNOTEBX
- . D CANT^TIUGR("A") S TIUCHNG("REFRESH")=1
- ; -- If note is already an entry of an ID note, unlink it: --
- S TIUIDDAD=$$HASIDDAD^TIUGBR(TIUDA)
- I TIUIDDAD D G IDNOTEBX
- . D UNLKKID(TIUDA,TIUIDDAD)
- . I $G(TIUQUIT) S TIUCHNG("REFRESH")=1 Q
- . S TIUCHNG("RBLD")=1
- . K VALMHDR ; TIUDA is no longer an ID entry so update header
- ; -- If user can add an entry to the note, do it & quit: --
- S CANADD=$$CANDO^TIULP(TIUDA,"ATTACH ID ENTRY")
- I CANADD D ADDDAD^TIUGEDIT(TIUDA,.ADDED) D G IDNOTEBX
- . I 'ADDED S TIUCHNG("REFRESH")=1 Q
- . S TIUCHNG("RBLD")=1 K VALMHDR
- ; -- 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(TIUDA) D G IDNOTEBX
- . W !!,$P(CANADD,U,2) D PAUSE^TIUGR
- . S TIUCHNG("REFRESH")=1
- ; -- Note is a possible parent: --
- S TITLEDA=+^TIU(8925,TIUDA,0)
- I 'CANADD,$$POSSPRNT^TIULP(TITLEDA) D G IDNOTEBX
- . W !!,$P(CANADD,U,2) D PAUSE^TIUGR
- . S TIUCHNG("REFRESH")=1
- ; -- See if user can attach note to an existing note: --
- S CANATT=$$CANDO^TIULP(TIUDA,"ATTACH TO ID NOTE")
- ; -- If user can attach, tell user not to use Browse:
- I CANATT W !!,"To attach this note to an ID parent, please exit Browse and try again ",!,"from a Review Screen showing a list of notes.",! H 5 S TIUCHNG("REFRESH")=1 G IDNOTEBX
- ; -- If user can't attach, say can't attach: --
- I 'CANATT W !!,$P(CANATT,U,2) D PAUSE^TIUGR S TIUCHNG("REFRESH")=1
- IDNOTEBX ;
- ; -- Rebuild browse screen for updated record: --
- ; (Review screen is updated from BROWSE^TIURA2)
- S TIUGDATA=$$IDDATA^TIURECL1(TIUDA) ;may have changed
- D BLDTMP^TIUBR(TIUDA)
- Q
- ;
- UNLKKID(KIDDA,TIUIDDAD,DETACHED) ; Unlink ID entry
- ; Check if user can unlink, and if so, unlink it.
- N CANUNLK,UNLINK,MSG,DADDA,TIUQUIT
- S DETACHED=0
- W !!,"This note is attached to an interdisciplinary note."
- ; -- Same users can unlink as can link: --
- S CANUNLK=$$CANDO^TIULP(KIDDA,"ATTACH TO ID NOTE")
- I CANUNLK S CANUNLK=$$CANDO^TIULP(TIUIDDAD,"ATTACH ID ENTRY")
- I 'CANUNLK D G UNLKKIDX
- . ;S MSG=$P(CANUNLK,U,2),MSG=$P(MSG,"You may not ATTACH this",2)
- . ;S MSG=$P(MSG,"to an ID note."),MSG=" You may not DETACH this"_MSG
- . W !,"You may not detach this note from its interdisciplinary note."
- . I $$READ^TIUU("EA","Press RETURN to continue...")
- . S TIUQUIT=1
- S UNLINK=$$READ^TIUU("Y","Do you want to detach it","NO")
- I 'UNLINK W !!,"Entry not detached." H 1 S TIUQUIT=1 G UNLKKIDX
- S DADDA=$P($G(^TMP("TIUR",$J,"IDDATA",KIDDA)),U,3)
- D UNLINK(KIDDA)
- I DADDA D UPIDDATA^TIURL1(KIDDA),UPIDDATA^TIURL1(DADDA)
- W !!,"Entry detached." H 1
- ;S VALMSG="** Entry detached **" ;4/9/01
- S TIUCHNG("RBLD")=1,DETACHED=1 ;4/9/01
- UNLKKIDX ;
- ;I $G(TIUQUIT) S VALMSG="** Entry not detached **",TIUCHNG("REFRESH")=1 Q ;4/9/01
- I $G(TIUQUIT) S TIUCHNG("REFRESH")=1 Q ;4/9/01
- Q
- ;
- UNLINK(DA) ; Unlink DA from DADDA
- N DIE,DR,IDDAD
- S IDDAD=+$G(^TIU(8925,DA,21))
- S DIE=8925,DR="2101////@"
- D ^DIE
- D AUDLINK(DA,"d",IDDAD)
- D IDDEL^TIUALRT1(DA)
- Q
- AUDLINK(TIUDA,ACTION,IDPARENT) ; Audit Attach/Detach Events
- N DIC,DIE,DA,DR,X,Y,TIUD0,TIUD21,DLAYGO
- Q:$G(ACTION)']""!(+$G(IDPARENT)'>0)
- S TIUD0=$G(^TIU(8925,TIUDA,0))
- S X=""""_"`"_TIUDA_"""",(DIC,DLAYGO)=8925.5,DIC(0)="FLX" D ^DIC Q:+Y'>0
- S DA=+Y,DIE=DIC
- S DR="3.01////"_ACTION_";3.02////"_$$NOW^XLFDT
- S DR=DR_";3.03////"_DUZ_";3.04////"_$P(TIUD0,U,5)
- S DR=DR_";3.05////"_IDPARENT
- D ^DIE
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUGR1 4015 printed Feb 19, 2025@00:08:03 Page 2
- TIUGR1 ; SLC/MAM - More ID Note Review Screen Actions ;4/12/01
- +1 ;;1.0;TEXT INTEGRATION UTILITIES;**100**;Jun 20, 1997
- +2 ;
- IDNOTEB(TIUDA) ; Browse Screen Action IN Interdisciplinary Note
- +1 ; Requires TIUDA
- +2 ; If editing this module, please keep TIUGR consistent with it.
- +3 NEW TITLE,PREFIX,TITLEDA,CANADD,CANATT,ADDED,TIUQUIT,TIUIDDAD
- +4 ;TIUCHNG is newed in TIURA2; Don't new it here
- +5 SET VALMBCK="R"
- +6 ; -- If note is addendum, can't attach; say so & quit: --
- +7 IF +^TIU(8925,TIUDA,0)=81
- Begin DoDot:1
- +8 DO CANT^TIUGR("A")
- SET TIUCHNG("REFRESH")=1
- End DoDot:1
- GOTO IDNOTEBX
- +9 ; -- If note is already an entry of an ID note, unlink it: --
- +10 SET TIUIDDAD=$$HASIDDAD^TIUGBR(TIUDA)
- +11 IF TIUIDDAD
- Begin DoDot:1
- +12 DO UNLKKID(TIUDA,TIUIDDAD)
- +13 IF $GET(TIUQUIT)
- SET TIUCHNG("REFRESH")=1
- QUIT
- +14 SET TIUCHNG("RBLD")=1
- +15 ; TIUDA is no longer an ID entry so update header
- KILL VALMHDR
- End DoDot:1
- GOTO IDNOTEBX
- +16 ; -- If user can add an entry to the note, do it & quit: --
- +17 SET CANADD=$$CANDO^TIULP(TIUDA,"ATTACH ID ENTRY")
- +18 IF CANADD
- DO ADDDAD^TIUGEDIT(TIUDA,.ADDED)
- Begin DoDot:1
- +19 IF 'ADDED
- SET TIUCHNG("REFRESH")=1
- QUIT
- +20 SET TIUCHNG("RBLD")=1
- KILL VALMHDR
- End DoDot:1
- GOTO IDNOTEBX
- +21 ; -- If user can't add entry to note, & attaching note to
- +22 ; an existing note is not permitted, say can't add & quit: --
- +23 ; -- Note itself has entries: --
- +24 IF 'CANADD
- IF $$HASIDKID^TIUGBR(TIUDA)
- Begin DoDot:1
- +25 WRITE !!,$PIECE(CANADD,U,2)
- DO PAUSE^TIUGR
- +26 SET TIUCHNG("REFRESH")=1
- End DoDot:1
- GOTO IDNOTEBX
- +27 ; -- Note is a possible parent: --
- +28 SET TITLEDA=+^TIU(8925,TIUDA,0)
- +29 IF 'CANADD
- IF $$POSSPRNT^TIULP(TITLEDA)
- Begin DoDot:1
- +30 WRITE !!,$PIECE(CANADD,U,2)
- DO PAUSE^TIUGR
- +31 SET TIUCHNG("REFRESH")=1
- End DoDot:1
- GOTO IDNOTEBX
- +32 ; -- See if user can attach note to an existing note: --
- +33 SET CANATT=$$CANDO^TIULP(TIUDA,"ATTACH TO ID NOTE")
- +34 ; -- If user can attach, tell user not to use Browse:
- +35 IF CANATT
- WRITE !!,"To attach this note to an ID parent, please exit Browse and try again ",!,"from a Review Screen showing a list of notes.",!
- HANG 5
- SET TIUCHNG("REFRESH")=1
- GOTO IDNOTEBX
- +36 ; -- If user can't attach, say can't attach: --
- +37 IF 'CANATT
- WRITE !!,$PIECE(CANATT,U,2)
- DO PAUSE^TIUGR
- SET TIUCHNG("REFRESH")=1
- IDNOTEBX ;
- +1 ; -- Rebuild browse screen for updated record: --
- +2 ; (Review screen is updated from BROWSE^TIURA2)
- +3 ;may have changed
- SET TIUGDATA=$$IDDATA^TIURECL1(TIUDA)
- +4 DO BLDTMP^TIUBR(TIUDA)
- +5 QUIT
- +6 ;
- UNLKKID(KIDDA,TIUIDDAD,DETACHED) ; Unlink ID entry
- +1 ; Check if user can unlink, and if so, unlink it.
- +2 NEW CANUNLK,UNLINK,MSG,DADDA,TIUQUIT
- +3 SET DETACHED=0
- +4 WRITE !!,"This note is attached to an interdisciplinary note."
- +5 ; -- Same users can unlink as can link: --
- +6 SET CANUNLK=$$CANDO^TIULP(KIDDA,"ATTACH TO ID NOTE")
- +7 IF CANUNLK
- SET CANUNLK=$$CANDO^TIULP(TIUIDDAD,"ATTACH ID ENTRY")
- +8 IF 'CANUNLK
- Begin DoDot:1
- +9 ;S MSG=$P(CANUNLK,U,2),MSG=$P(MSG,"You may not ATTACH this",2)
- +10 ;S MSG=$P(MSG,"to an ID note."),MSG=" You may not DETACH this"_MSG
- +11 WRITE !,"You may not detach this note from its interdisciplinary note."
- +12 IF $$READ^TIUU("EA","Press RETURN to continue...")
- +13 SET TIUQUIT=1
- End DoDot:1
- GOTO UNLKKIDX
- +14 SET UNLINK=$$READ^TIUU("Y","Do you want to detach it","NO")
- +15 IF 'UNLINK
- WRITE !!,"Entry not detached."
- HANG 1
- SET TIUQUIT=1
- GOTO UNLKKIDX
- +16 SET DADDA=$PIECE($GET(^TMP("TIUR",$JOB,"IDDATA",KIDDA)),U,3)
- +17 DO UNLINK(KIDDA)
- +18 IF DADDA
- DO UPIDDATA^TIURL1(KIDDA)
- DO UPIDDATA^TIURL1(DADDA)
- +19 WRITE !!,"Entry detached."
- HANG 1
- +20 ;S VALMSG="** Entry detached **" ;4/9/01
- +21 ;4/9/01
- SET TIUCHNG("RBLD")=1
- SET DETACHED=1
- UNLKKIDX ;
- +1 ;I $G(TIUQUIT) S VALMSG="** Entry not detached **",TIUCHNG("REFRESH")=1 Q ;4/9/01
- +2 ;4/9/01
- IF $GET(TIUQUIT)
- SET TIUCHNG("REFRESH")=1
- QUIT
- +3 QUIT
- +4 ;
- UNLINK(DA) ; Unlink DA from DADDA
- +1 NEW DIE,DR,IDDAD
- +2 SET IDDAD=+$GET(^TIU(8925,DA,21))
- +3 SET DIE=8925
- SET DR="2101////@"
- +4 DO ^DIE
- +5 DO AUDLINK(DA,"d",IDDAD)
- +6 DO IDDEL^TIUALRT1(DA)
- +7 QUIT
- AUDLINK(TIUDA,ACTION,IDPARENT) ; Audit Attach/Detach Events
- +1 NEW DIC,DIE,DA,DR,X,Y,TIUD0,TIUD21,DLAYGO
- +2 if $GET(ACTION)']""!(+$GET(IDPARENT)'>0)
- QUIT
- +3 SET TIUD0=$GET(^TIU(8925,TIUDA,0))
- +4 SET X=""""_"`"_TIUDA_""""
- SET (DIC,DLAYGO)=8925.5
- SET DIC(0)="FLX"
- DO ^DIC
- if +Y'>0
- QUIT
- +5 SET DA=+Y
- SET DIE=DIC
- +6 SET DR="3.01////"_ACTION_";3.02////"_$$NOW^XLFDT
- +7 SET DR=DR_";3.03////"_DUZ_";3.04////"_$PIECE(TIUD0,U,5)
- +8 SET DR=DR_";3.05////"_IDPARENT
- +9 DO ^DIE
- +10 QUIT