TIURB3 ; SLC/JER - Review Action, Change Advance Directive Title Submodules ;23-Jan-2014 17:11;DU
;;1.0;TEXT INTEGRATION UTILITIES;**261,1013**;Jun 20, 1997;Build 33
;
AD2RAD(NOTEDA,SELNEWTL) ; Is this note being changed from ADVANCE DIRECTIVE to RESCINDED ADVANCE DIRECTIVE?
N TITLIEN,TITLNM,SELTLNM
S TITLIEN=+^TIU(8925,NOTEDA,0),TITLNM=$P(^TIU(8925.1,TITLIEN,0),U)
I TITLNM'="ADVANCE DIRECTIVE" Q 0
S SELTLNM=$P(^TIU(8925.1,SELNEWTL,0),U)
I SELTLNM'="RESCINDED ADVANCE DIRECTIVE" Q 0
Q 1
;
OK2MARK() ; Returns 1 if user oks changing Title to RESCINDED ADVANCE DIRECTIVE; Else 0
N DIR,X,Y
S DIR("A",1)=" The title of this note will be changed to RESCINDED ADVANCE DIRECTIVE and "
S DIR("A")="linked images will be watermarked 'RESCINDED'. OK"
S DIR(0)="Y",DIR("B")="NO" D ^DIR W !
Q Y
;
WTRMARK(TIUDA,SELTITL,TLCHNGD) ; Watermark image of TIUDA 'Rescinded'
N OK2MARK,TIUY
S (OK2MARK,TLCHNGD)=0
I $$AD2RAD(TIUDA,SELTITL) D I $$READ^TIUU("EA","Press RETURN to continue...")
. I '$$HASIMG^TIURB2(TIUDA) D Q
. . D TLDIE^TIURS1(TIUDA,SELTITL) S TLCHNGD=1
. . W !," Title changed. Note has no image to watermark."
. . D CKADDA(TIUDA)
. I '$$OK2MARK W !," Title not changed; image not watermarked." S TIUQUIT=1 Q
. N X
. D TLDIE^TIURS1(TIUDA,SELTITL) S TLCHNGD=1 S X="MAGGSIU4" X ^%ZOSF("TEST") I $T D RESCIND^MAGGSIU4(.TIUY,TIUDA)
. I +TIUY(0)=0 D Q
. . W !," Title changed. Image for note #",TIUDA," could not be queued for watermarking. Please see"
. . W !,"Imaging Manager."
. . D CKADDA(TIUDA)
. W !," Title changed; Image queued for watermarking."
. D CKADDA(TIUDA)
Q
;
CKADDA(TIUDA) ; Watermark addendum images
N ADDMIEN,ARRADDA,TIUI,ARRCAN,TIUJ,HASIMG,IMAGERR,IMAGQUED
S (TIUI,TIUJ,HASIMG,IMAGERR,IMAGQUED)=0
; -- Set array of adda:
S ADDMIEN=0 F S ADDMIEN=$O(^TIU(8925,"DAD",TIUDA,ADDMIEN)) Q:'ADDMIEN D
. Q:+$$ISADDNDM^TIULC1(ADDMIEN)'>0
. S ARRADDA(ADDMIEN)=0
Q:'$D(ARRADDA) ;note has no adda
; -- Is DUZ authorized to watermark an image of this addm? [Authorization to CT of an Adv Dir
; implies authorization to watermark its image, including adda images. Some sites may permit
; changing title of UNCOS Adv Dirs as well as COMPLETED ones.]
S TIUI=0 F S TIUI=$O(ARRADDA(TIUI)) Q:+TIUI'>0 D
. I $$CANDO^TIULP(TIUI,"CHANGE TITLE")'>0 Q
. S ARRCAN(TIUI)=0
Q:'$D(ARRCAN)
W !,"Checking signed addenda for images to watermark. . ."
; -- If addm has image, watermark it:
S TIUJ=0 F S TIUJ=$O(ARRCAN(TIUJ)) Q:+TIUJ'>0 D
. I '$$HASIMG^TIURB2(TIUJ) Q
. S HASIMG=1
. N TIUY D RESCIND^MAGGSIU4(.TIUY,TIUJ)
. I +TIUY(0)=0 S IMAGERR=IMAGERR+1 Q
. S IMAGQUED=IMAGQUED+1
; -- Feedback to user:
I 'HASIMG W !,"No addendum images to watermark." Q
I IMAGQUED D
. N NUMADDA
. S NUMADDA=$S(IMAGQUED=1:"ONE",IMAGQUED=2:"TWO",1:"Multiple")
. W !,NUMADDA," addendum image(s) queued for watermarking."
I IMAGERR D
. N NUMADDA
. S NUMADDA=$S(IMAGERR=1:"ONE",IMAGERR=2:"TWO",1:"Multiple")
. W !,NUMADDA," addendum image(s) could not be queued for watermarking. Please"
. W !,"see Imaging Manager."
Q
TIURB3 ; SLC/JER - Review Action, Change Advance Directive Title Submodules ;23-Jan-2014 17:11;DU
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**261,1013**;Jun 20, 1997;Build 33
+2 ;
AD2RAD(NOTEDA,SELNEWTL) ; Is this note being changed from ADVANCE DIRECTIVE to RESCINDED ADVANCE DIRECTIVE?
+1 NEW TITLIEN,TITLNM,SELTLNM
+2 SET TITLIEN=+^TIU(8925,NOTEDA,0)
SET TITLNM=$PIECE(^TIU(8925.1,TITLIEN,0),U)
+3 IF TITLNM'="ADVANCE DIRECTIVE"
QUIT 0
+4 SET SELTLNM=$PIECE(^TIU(8925.1,SELNEWTL,0),U)
+5 IF SELTLNM'="RESCINDED ADVANCE DIRECTIVE"
QUIT 0
+6 QUIT 1
+7 ;
OK2MARK() ; Returns 1 if user oks changing Title to RESCINDED ADVANCE DIRECTIVE; Else 0
+1 NEW DIR,X,Y
+2 SET DIR("A",1)=" The title of this note will be changed to RESCINDED ADVANCE DIRECTIVE and "
+3 SET DIR("A")="linked images will be watermarked 'RESCINDED'. OK"
+4 SET DIR(0)="Y"
SET DIR("B")="NO"
DO ^DIR
WRITE !
+5 QUIT Y
+6 ;
WTRMARK(TIUDA,SELTITL,TLCHNGD) ; Watermark image of TIUDA 'Rescinded'
+1 NEW OK2MARK,TIUY
+2 SET (OK2MARK,TLCHNGD)=0
+3 IF $$AD2RAD(TIUDA,SELTITL)
Begin DoDot:1
+4 IF '$$HASIMG^TIURB2(TIUDA)
Begin DoDot:2
+5 DO TLDIE^TIURS1(TIUDA,SELTITL)
SET TLCHNGD=1
+6 WRITE !," Title changed. Note has no image to watermark."
+7 DO CKADDA(TIUDA)
End DoDot:2
QUIT
+8 IF '$$OK2MARK
WRITE !," Title not changed; image not watermarked."
SET TIUQUIT=1
QUIT
+9 NEW X
+10 DO TLDIE^TIURS1(TIUDA,SELTITL)
SET TLCHNGD=1
SET X="MAGGSIU4"
XECUTE ^%ZOSF("TEST")
IF $TEST
DO RESCIND^MAGGSIU4(.TIUY,TIUDA)
+11 IF +TIUY(0)=0
Begin DoDot:2
+12 WRITE !," Title changed. Image for note #",TIUDA," could not be queued for watermarking. Please see"
+13 WRITE !,"Imaging Manager."
+14 DO CKADDA(TIUDA)
End DoDot:2
QUIT
+15 WRITE !," Title changed; Image queued for watermarking."
+16 DO CKADDA(TIUDA)
End DoDot:1
IF $$READ^TIUU("EA","Press RETURN to continue...")
+17 QUIT
+18 ;
CKADDA(TIUDA) ; Watermark addendum images
+1 NEW ADDMIEN,ARRADDA,TIUI,ARRCAN,TIUJ,HASIMG,IMAGERR,IMAGQUED
+2 SET (TIUI,TIUJ,HASIMG,IMAGERR,IMAGQUED)=0
+3 ; -- Set array of adda:
+4 SET ADDMIEN=0
FOR
SET ADDMIEN=$ORDER(^TIU(8925,"DAD",TIUDA,ADDMIEN))
IF 'ADDMIEN
QUIT
Begin DoDot:1
+5 IF +$$ISADDNDM^TIULC1(ADDMIEN)'>0
QUIT
+6 SET ARRADDA(ADDMIEN)=0
End DoDot:1
+7 ;note has no adda
IF '$DATA(ARRADDA)
QUIT
+8 ; -- Is DUZ authorized to watermark an image of this addm? [Authorization to CT of an Adv Dir
+9 ; implies authorization to watermark its image, including adda images. Some sites may permit
+10 ; changing title of UNCOS Adv Dirs as well as COMPLETED ones.]
+11 SET TIUI=0
FOR
SET TIUI=$ORDER(ARRADDA(TIUI))
IF +TIUI'>0
QUIT
Begin DoDot:1
+12 IF $$CANDO^TIULP(TIUI,"CHANGE TITLE")'>0
QUIT
+13 SET ARRCAN(TIUI)=0
End DoDot:1
+14 IF '$DATA(ARRCAN)
QUIT
+15 WRITE !,"Checking signed addenda for images to watermark. . ."
+16 ; -- If addm has image, watermark it:
+17 SET TIUJ=0
FOR
SET TIUJ=$ORDER(ARRCAN(TIUJ))
IF +TIUJ'>0
QUIT
Begin DoDot:1
+18 IF '$$HASIMG^TIURB2(TIUJ)
QUIT
+19 SET HASIMG=1
+20 NEW TIUY
DO RESCIND^MAGGSIU4(.TIUY,TIUJ)
+21 IF +TIUY(0)=0
SET IMAGERR=IMAGERR+1
QUIT
+22 SET IMAGQUED=IMAGQUED+1
End DoDot:1
+23 ; -- Feedback to user:
+24 IF 'HASIMG
WRITE !,"No addendum images to watermark."
QUIT
+25 IF IMAGQUED
Begin DoDot:1
+26 NEW NUMADDA
+27 SET NUMADDA=$SELECT(IMAGQUED=1:"ONE",IMAGQUED=2:"TWO",1:"Multiple")
+28 WRITE !,NUMADDA," addendum image(s) queued for watermarking."
End DoDot:1
+29 IF IMAGERR
Begin DoDot:1
+30 NEW NUMADDA
+31 SET NUMADDA=$SELECT(IMAGERR=1:"ONE",IMAGERR=2:"TWO",1:"Multiple")
+32 WRITE !,NUMADDA," addendum image(s) could not be queued for watermarking. Please"
+33 WRITE !,"see Imaging Manager."
End DoDot:1
+34 QUIT
