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

TIURB3.m

Go to the documentation of this file. 
  1. 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
  1.  ;
  1. AD2RAD(NOTEDA,SELNEWTL) ; Is this note being changed from ADVANCE DIRECTIVE to RESCINDED ADVANCE DIRECTIVE?
  1.  N TITLIEN,TITLNM,SELTLNM
  1.  S TITLIEN=+^TIU(8925,NOTEDA,0),TITLNM=$P(^TIU(8925.1,TITLIEN,0),U)
  1.  I TITLNM'="ADVANCE DIRECTIVE" Q 0
  1.  S SELTLNM=$P(^TIU(8925.1,SELNEWTL,0),U)
  1.  I SELTLNM'="RESCINDED ADVANCE DIRECTIVE" Q 0
  1.  Q 1
  1.  ;
  1. OK2MARK() ; Returns 1 if user oks changing Title to RESCINDED ADVANCE DIRECTIVE; Else 0
  1.  N DIR,X,Y
  1.  S DIR("A",1)="  The title of this note will be changed to RESCINDED ADVANCE DIRECTIVE and "
  1.  S DIR("A")="linked images will be watermarked 'RESCINDED'.  OK"
  1.  S DIR(0)="Y",DIR("B")="NO" D ^DIR W !
  1.  Q Y
  1.  ;
  1. WTRMARK(TIUDA,SELTITL,TLCHNGD) ; Watermark image of TIUDA 'Rescinded'
  1.  N OK2MARK,TIUY
  1.  S (OK2MARK,TLCHNGD)=0
  1.  I $$AD2RAD(TIUDA,SELTITL) D  I $$READ^TIUU("EA","Press RETURN to continue...")
  1.  . I '$$HASIMG^TIURB2(TIUDA) D   Q
  1.  . . D TLDIE^TIURS1(TIUDA,SELTITL) S TLCHNGD=1
  1.  . . W !,"  Title changed.  Note has no image to watermark."
  1.  . . D CKADDA(TIUDA)
  1.  . I '$$OK2MARK W !,"  Title not changed; image not watermarked." S TIUQUIT=1 Q
  1.  . N X
  1.  . D TLDIE^TIURS1(TIUDA,SELTITL) S TLCHNGD=1 S X="MAGGSIU4" X ^%ZOSF("TEST") I $T D RESCIND^MAGGSIU4(.TIUY,TIUDA)
  1.  . I +TIUY(0)=0 D  Q
  1.  . . W !,"  Title changed.  Image for note #",TIUDA," could not be queued for watermarking. Please see"
  1.  . . W !,"Imaging Manager."
  1.  . . D CKADDA(TIUDA)
  1.  . W !,"  Title changed; Image queued for watermarking."
  1.  . D CKADDA(TIUDA)
  1.  Q
  1.  ;
  1. CKADDA(TIUDA) ; Watermark addendum images
  1.  N ADDMIEN,ARRADDA,TIUI,ARRCAN,TIUJ,HASIMG,IMAGERR,IMAGQUED
  1.  S (TIUI,TIUJ,HASIMG,IMAGERR,IMAGQUED)=0
  1.  ; -- Set array of adda:
  1.  S ADDMIEN=0 F  S ADDMIEN=$O(^TIU(8925,"DAD",TIUDA,ADDMIEN)) Q:'ADDMIEN  D
  1.  . Q:+$$ISADDNDM^TIULC1(ADDMIEN)'>0
  1.  . S ARRADDA(ADDMIEN)=0
  1.  Q:'$D(ARRADDA)  ;note has no adda
  1.  ; -- Is DUZ authorized to watermark an image of this addm? [Authorization to CT of an Adv Dir
  1.  ;    implies authorization to watermark its image, including adda images.  Some sites may permit
  1.  ;    changing title of UNCOS Adv Dirs as well as COMPLETED ones.]
  1.  S TIUI=0 F  S TIUI=$O(ARRADDA(TIUI)) Q:+TIUI'>0  D
  1.  . I $$CANDO^TIULP(TIUI,"CHANGE TITLE")'>0 Q
  1.  . S ARRCAN(TIUI)=0
  1.  Q:'$D(ARRCAN)
  1.  W !,"Checking signed addenda for images to watermark. . ."
  1.  ; -- If addm has image, watermark it:
  1.  S TIUJ=0 F  S TIUJ=$O(ARRCAN(TIUJ)) Q:+TIUJ'>0  D
  1.  . I '$$HASIMG^TIURB2(TIUJ) Q
  1.  . S HASIMG=1
  1.  . N TIUY D RESCIND^MAGGSIU4(.TIUY,TIUJ)
  1.  . I +TIUY(0)=0 S IMAGERR=IMAGERR+1 Q
  1.  . S IMAGQUED=IMAGQUED+1
  1.  ; -- Feedback to user:
  1.  I 'HASIMG W !,"No addendum images to watermark." Q
  1.  I IMAGQUED D
  1.  . N NUMADDA
  1.  . S NUMADDA=$S(IMAGQUED=1:"ONE",IMAGQUED=2:"TWO",1:"Multiple")
  1.  . W !,NUMADDA," addendum image(s) queued for watermarking."
  1.  I IMAGERR D
  1.  . N NUMADDA
  1.  . S NUMADDA=$S(IMAGERR=1:"ONE",IMAGERR=2:"TWO",1:"Multiple")
  1.  . W !,NUMADDA," addendum image(s) could not be queued for watermarking. Please"
  1.  . W !,"see Imaging Manager."
  1.  Q