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

TIUADD.m

Go to the documentation of this file. 
  1. TIUADD ; SLC/JER - Enter/Edit an addendum online ;01-Aug-2011 11:16;MGH
  1.  ;;1.0;TEXT INTEGRATION UTILITIES;**3,88,100,112,1009**;Jun 20, 1997;Build 22
  1.  ; 2/3: Update TEXTEDIT from TIUEDIT to TIUEDI4
  1.  ;IHS/ITSC/LJF 02/21/2003 added code so user who cannot view a document,cannot
  1.  ;                           addendum to it either
  1. ADDENDUM(TIUDA,TIUADD,TIUCHNG,TIUNOASK) ; Control branching
  1.  N TIUY,TIUEDIT,TIUDADD K ^TMP("TIUADD",$J)
  1.  I '$D(TIUPRM0)!'$D(TIUPRM1) D SETPARM^TIULE
  1.  S TIUCHNG("ADDM")=1
  1.  ;
  1.  I '$$CANDO^TIULP(TIUDA,"VIEW") D  Q  ;IHS/ITSC/LJF 02/21/2003
  1.  . D MSG^BTIUU(" You may not ADD AN ADDENDUM to a document you CANNOT VIEW",2,1,1),RETURN^BTIUU  ;IHS/ITSC/LJF 02/21/2003
  1.  ;
  1.  ; -- Get list of existing addenda, edit existing one --
  1.  D ADDLIST(.TIUY,TIUDA)
  1.  I +$D(TIUY),+$D(@TIUY) D  G:$D(DIRUT) ADDENX
  1.  . W !
  1.  . S TIUEDIT=+$$READ^TIUU("YO","Do you wish to EDIT an existing ADDENDUM","YES")
  1.  . I +TIUEDIT D EDIT(TIUY) S TIUADD=1
  1.  G:+$G(TIUADD) ADDENX
  1.  ; -- Create new addendum to TIUDA: --
  1.  I +$P($G(^TIU(8925,+TIUDA,0)),U,6)'>0 D  Q:$D(DIROUT)!(+TIUDADD'>0)
  1.  . S TIUDADD=$$CANDO^TIULP(TIUDA,"MAKE ADDENDUM")
  1.  . I '+TIUDADD D  Q
  1.  . . W !!,$C(7),$P(TIUDADD,U,2),!
  1.  . . I $$READ^TIUU("EA","Press RETURN to continue...")
  1.  . I +TIUDADD D  Q:$D(DIROUT)
  1.  . . I +$G(TIUNOASK)'>0,'+$$READ^TIUU("YO","Do you wish to ADD a new ADDENDUM","NO") Q
  1.  . . D ADD(TIUDA,.TIUCHNG)
  1.  . . ; -- Update ADDENDED? if browsing ID Note
  1.  . . I TIUCHNG,$P($G(TIUGDATA),U,2) K VALMHDR
  1.  I +$P(^TIU(8925,+TIUDA,0),U,6)>0 D
  1.  . W !!,$C(7)," You may not make an ADDENDUM to an ADDENDUM.",!
  1.  . I $$READ^TIUU("EA","Press RETURN to continue...")
  1. ADDENX ;Exit for ADDENDUM
  1.  K ^TMP("TIUADD",$J)
  1.  ;I $D(VALMAR),$$READ^TIUU("EA","Press RETURN to continue...")
  1.  Q
  1. EDIT(TIUY) ;Edit existing addendum
  1.  N TIUED,TIUDA,DA,DIC,DIE,TIUDAUTH,TIUPT,TIURDOC,DR,X,Y,TIUCNT
  1.  S TIUCNT=0 F  S TIUCNT=$O(@TIUY@(TIUCNT)) Q:TIUCNT'>0  D  Q:$D(DIROUT)
  1.  . N TIUQUIT
  1.  . S TIUDA=+$G(@TIUY@(TIUCNT))
  1.  . D GETTIU^TIULD(.TIU,+TIUDA)
  1.  . W !!,"Displaying Addendum #",TIUCNT
  1.  . D EN^VALM("TIU EDIT ADDENDUM") Q:$D(DIROUT)
  1.  Q
  1. EDADD ; Edit action
  1.  N DA,DIC,DIE,DLAYGO,DIWESUB,TIUDAUTH,TIUMD,TIUPT,TIUECOS,TIUXINI,DR,X,Y
  1.  N TIUDAD,TIUD0,TIUD12,TIUD13,TIUD14,TIUQUIT,TIUTYP,TIUT0,TIU
  1.  K TIUBY,TIUCANED
  1.  S TIUCANED=$$CANDO^TIULP(TIUDA,"EDIT RECORD")
  1.  I +TIUCANED'>0 D  Q
  1.  . W !!,$P(TIUCANED,U,2)
  1.  . I $$READ^TIUU("EA","Press RETURN to continue...") ; pause
  1.  S TIUD0=$G(^TIU(8925,+TIUDA,0)),TIUD12=$G(^(12)),TIUD13=$G(^(13))
  1.  S TIUD14=$G(^TIU(8925,+TIUDA,14))
  1.  S TIUDAD=+$P($G(^TIU(8925,+TIUDA,0)),U,6)
  1.  S DA=+TIUDA
  1.  W !!,"Editing ADDENDUM"
  1.  S TIUTYP=+$G(^TIU(8925,+DA,0)),TIUT0=$G(^TIU(8925.1,+TIUTYP,0))
  1.  S TIUTYP(1)="1^"_+TIUTYP_U_$P(TIUT0,U,3)_U
  1.  S TIUMD=$$ISA^USRLM(+$G(DUZ),"PROVIDER")
  1.  S TIUPT=$P($G(^DPT(+$P(TIUD0,U,2),0)),U)
  1.  S DIWESUB="Patient: "_TIUPT
  1.  S DR=$$GETTMPL^TIUEDI1(+$P(^TIU(8925,+TIUDAD,0),U))
  1.  D GETTIU^TIULD(.TIU,TIUDAD)
  1.  ; -- Do DIE; get text, release, verify: --
  1.  D ADDDIE(DA,DR,TIUDAD)
  1.  I '$D(^TIU(8925,+DA,0)) S TIUCHNG=0,TIUCHNG("DELETE")=1 Q
  1.  ; -- Update status, visit type, visit location: --
  1.  S DR=".05///"_$$STATUS^TIULC(DA)_";.13////"_$P($G(TIU("VSTR")),";",3)_";1211////"_$P($G(TIU("VLOC")),U),DIE=8925 D ^DIE
  1.  ; -- Set TIUCHNG: e.g. TIUCHNG = 2^addmIFN  (2 for entered/edited text);
  1.  ;    TIUCHNG("EXIST") for edited EXISTING not new addm
  1.  S TIUCHNG=2_"^"_+$G(DA),TIUCHNG("EXIST")=1,VALMBCK="Q"
  1.  ; -- Sign, print: --
  1.  I +$P(TIUPRM0,U,2) D
  1.  . N TIUSIGN S TIUSIGN=$$CANDO^TIULP(DA,"SIGNATURE")
  1.  . I '+TIUSIGN D  Q
  1.  . . I +$$ISA^USRLM(+$G(DUZ),"TRANSCRIPTIONIST") Q
  1.  . . W !,$C(7),$P(TIUSIGN,U,2)
  1.  . . I '$D(VALMAR),$$READ^TIUU("EA","Press RETURN to continue...")
  1.  . I +TIUSIGN D EDSIG^TIURS(DA)
  1.  . I +$P($G(TIUDPRM(0)),U,8) D PRINT^TIUEPRNT(DA)
  1.  ; NOIS LOU-0598-40899
  1.  I $G(TIUQUIT),+$$EMPTYDOC^TIULF(DA) D DELETE^TIUEDIT(DA) S TIUCHNG=0,TIUCHNG("DELETE")=1 H 2 Q
  1.  Q
  1. ADD(TIUDA,TIUCHNG) ;Add new addendum
  1.  N DA,DIC,DIE,DLAYGO,DIWESUB,DR,TIUDAUTH,TIUMD,TIUPT,TIUECOS,TIUXINI,X,Y
  1.  N TIUD0,TIUDV,TIUD12,TIUD13,TIUD14,TIUTYP,TIUT0,TIU,TIUFPRIV,TIUQUIT
  1.  N LINENO,EXPANDED
  1.  S TIUFPRIV=1
  1.  S TIUD0=$G(^TIU(8925,+TIUDA,0)),TIUD12=$G(^(12)),TIUD13=$G(^(13))
  1.  S TIUD14=$G(^TIU(8925,+TIUDA,14)),TIUDV=$P(TIUD0,U,3)
  1.  S LINENO=+$O(^TMP("TIUR",$J,"IEN",TIUDA,0))
  1.  I LINENO,$D(^TMP("TIUR",$J,"EXPAND",LINENO)) S EXPANDED=1
  1.  I '$G(EXPANDED),$$HASIDKID^TIUGBR(TIUDA) W !!,"  You are addending an interdisciplinary note.  Your addendum will be added to",!,"the parent entry of the note." H 2
  1.  S (DIC,DLAYGO)=8925,DIC(0)="L",X=""""_"`"_$$ADDPTR_""""
  1.  D ^DIC
  1.  I +Y>0 S DA=+Y D
  1.  . W !!,"Adding ADDENDUM"
  1.  . S DIE="^TIU(8925,"
  1.  . S DR=".03////"_TIUDV_";.04////"_+$$ADDCLASS_";.05////3;.06////"_TIUDA
  1.  . S DR=DR_";1405////^S X=$P(TIUD14,U,5)"
  1.  . D ^DIE
  1.  . S TIUTYP=+$G(^TIU(8925,+DA,0)),TIUT0=$G(^TIU(8925.1,+TIUTYP,0))
  1.  . S TIUTYP(1)="1^"_+TIUTYP_U_$P(TIUT0,U,3)_U
  1.  . S TIUMD=$$ISA^USRLM(+$G(DUZ),"PROVIDER")
  1.  . S TIUPT=$P($G(^DPT(+$P(TIUD0,U,2),0)),U)
  1.  . S DIWESUB="Patient: "_TIUPT
  1.  . S DR=$$GETTMPL^TIUEDI1(+$P(^TIU(8925,+TIUDA,0),U))
  1.  . D GETTIU^TIULD(.TIU,TIUDA)
  1.  . D ADDDIE(DA,DR,TIUDA) I '$D(^TIU(8925,+DA,0)) S TIUCHNG=0,TIUCHNG("DELETE")=1 Q
  1.  . S DR=".05///"_$$STATUS^TIULC(DA),DIE=8925 D ^DIE
  1.  . S TIUCHNG=2_"^"_+$G(DA)
  1.  . I +$P(TIUPRM0,U,2) D
  1.  . . N TIUSIGN S TIUSIGN=$$CANDO^TIULP(DA,"SIGNATURE")
  1.  . . I '+TIUSIGN D  Q
  1.  . . . W !,$C(7),$P(TIUSIGN,U,2)
  1.  . . . I '$D(VALMAR),$$READ^TIUU("EA","Press RETURN to continue...")
  1.  . . I +TIUSIGN D EDSIG^TIURS(DA)
  1.  . I +$P($G(TIUDPRM(0)),U,8) D PRINT^TIUEPRNT(DA)
  1.  . I $G(TIUQUIT) D DELETE^TIUEDIT(DA) S TIUCHNG=0,TIUCHNG("DELETE")=1 Q
  1.  Q
  1. ADDPTR() ; Get record # of ADDENDUM in 8925.1
  1.  N DIC,X,Y,TIUFPRIV S TIUFPRIV=1
  1.  S DIC=8925.1,DIC(0)="FMX",X="ADDENDUM"
  1.  S DIC("S")="I $P($G(^TIU(8925.1,+Y,0)),U,4)=""DOC"""
  1.  D ^DIC K DIC("S")
  1.  Q +Y
  1. ADDCLASS() ; Get record # of ADDENDUM Document Class in 8925.1
  1.  N DIC,X,Y,TIUFPRIV S TIUFPRIV=1
  1.  S DIC=8925.1,DIC(0)="FMX",X="ADDENDUM"
  1.  S DIC("S")="I $P($G(^TIU(8925.1,+Y,0)),U,4)=""DC"""
  1.  D ^DIC K DIC("S")
  1.  Q +Y
  1. ADDDIE(DA,DR,TIUDA) ; Call DIE to conduct dialog
  1.  N TIUREL,TIUD0,TIUD12,TIUD13,TIUD14,DTOUT,Y,DWPK
  1.  S DIE=8925 D ^DIE
  1.  I $D(Y)!($D(DTOUT)) S TIUQUIT=1
  1.  D:+$G(TIUQUIT) SEND^TIUALRT(DA)
  1.  I '+$G(TIUQUIT) D
  1.  . D TEXTEDIT^TIUEDI4(DA)
  1.  . I $$EMPTYDOC^TIULF(DA) D DELETE^TIUEDIT(DA,0) Q
  1.  . ; -- Not clear why I need these nodes 0,12,13,14: --
  1.  . S TIUD0=$G(^TIU(8925,+DA,0)),TIUD12=$G(^(12)),TIUD13=$G(^(13))
  1.  . S TIUD14=$G(^TIU(8925,+DA,14))
  1.  . ; Execute RELEASE Logic
  1.  . D RELEASE^TIUT(DA) S TIUREL=""
  1.  . ; Execute VERIFY Logic
  1.  . D VERIFY^TIUT(DA)
  1.  . ; Send Addendum Alert
  1.  . D SENDADD^TIUALRT(DA)
  1.  Q
  1. ADDLIST(Y,TIUDA) ; Get list of addenda for a record
  1.  N TIUI,TIUCNT S (TIUCNT,TIUI)=0 K ^TMP("TIUADD",$J)
  1.  F  S TIUI=$O(^TIU(8925,"DAD",TIUDA,TIUI)) Q:+TIUI'>0  D
  1.  . Q:+$$ISADDNDM^TIULC1(TIUI)'>0
  1.  . Q:+$$CANDO^TIULP(TIUI,"EDIT RECORD")'>0
  1.  . S TIUCNT=TIUCNT+1,^TMP("TIUADD",$J,TIUCNT)=TIUI
  1.  I $D(^TMP("TIUADD",$J)) S Y=$NA(^TMP("TIUADD",$J))
  1.  Q