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

TIUFD4.m

Go to the documentation of this file. 
  1. TIUFD4 ; SLC/MAM - LM Template D Actions Edit Technical Fields, Edit Upload. LM Subtemplate DJ Action DELOBJ ;4/17/97  11:02
  1.  ;;1.0;TEXT INTEGRATION UTILITIES;**14,1001**;Jun 20, 1997
  1.  ;IHS/ITSC/LJF 01/07/2005 PATCH 1001 added code to allow App Coordinators to edit Object Method
  1.  ;
  1. DELOBJ ; Template DJ Action Delete (Object).
  1.  N FILEDA,MSG,USED,ASKOK,DA,DIK,LINENO
  1.  S FILEDA=TIUFINFO("FILEDA"),VALMBCK="R"
  1.  I ($L($P(TIUFNOD0,U,5))!$L($P(TIUFNOD0,U,6))),'$$PERSOWNS^TIUFLF2(FILEDA,DUZ) S MSG=" Only an Owner can delete a file entry" W MSG,! D PAUSE^TIUFXHLX  G DELOX
  1.  L +^TIU(8925.1,FILEDA):1 I '$T W !!," Another user is editing this entry; Please try later" H 2 G DELOX
  1.  S USED=$$OBJUSED^TIUFLJ(FILEDA)
  1.  Q:$$CANTDEL^TIUFHA1(FILEDA,USED)
  1.  H 1 S ASKOK=$$ASKOK^TIUFHA1(0,0,USED) I 'ASKOK  S MSG=" ... Object not deleted!" W !,MSG,! D PAUSE^TIUFXHLX G DELOX
  1.  ; Delete FILEDA as Docmt Def entry in file 8925.1:
  1.  S DA=FILEDA,DIK="^TIU(8925.1," D ^DIK
  1.  S LINENO=$O(^TMP("TIUF1IDX",$J,"DAF",FILEDA,0))
  1.  D UPDATE^TIUFLLM1(TIUFTMPL,-1,LINENO-1) S TIUFVCN1=TIUFVCN1-1
  1.  S MSG=" ... Object Deleted!" W !,MSG,! H 1 S VALMBCK="Q"
  1. DELOX L -^TIU(8925.1,FILEDA)
  1.  I $D(DTOUT) S VALMBCK="Q"
  1.  Q
  1.  ;
  1. EDTECH ;LM Template D Action Edit Technical Fields.
  1.  ; Requires CURRENT arrays TIUFINFO, TIUFNOD0.
  1.  ; Requires TIUFTLIN as set in DSTECH^TIUFD.
  1.  N FILEDA,DA,DIE,DR,LINENO,PFILEDA,PNODE61,PCUSTOM,TYPE,STATUS
  1.  N DIR,X,Y,TIUFY,TIUFXNOD,TIUFFULL,ICUSTOM,DTOUT,DIRUT,DIROUT
  1.  S FILEDA=TIUFINFO("FILEDA"),VALMBCK="",TYPE=$P(TIUFNOD0,U,4),TIUFXNOD=$G(XQORNOD(0))
  1.  I '$D(^TIU(8925.1,FILEDA,0)) W !!," Can't Edit Technical Fields; File Entry "_FILEDA_" does not exist; See IRM",! D PAUSE^TIUFXHLX S VALMBCK="Q" G EDTEX
  1.  S STATUS=$$STATWORD^TIUFLF5($P(TIUFNOD0,U,7)) ;e.g. INACTIVE
  1.  I STATUS="NO/BAD" W !!," Can't Edit Technical Fields; No Status/Bad Status",! D PAUSE^TIUFXHLX G EDTEX
  1.  I TYPE="O",'$$PERSOWNS^TIUFLF2(FILEDA,DUZ) W !!," Can't edit Technical Fields: Only an Owner can edit Objects",! D PAUSE^TIUFXHLX G EDTEX
  1.  I STATUS'="INACTIVE",TYPE'="O",TIUFWHO="N" K DIRUT D  G:$D(DIRUT)!(TIUFY'=1) EDTEX
  1.  . S DIR(0)="Y",DIR("A",1)=" Entry is not Inactive.  Do you want to bypass safety measures and edit"
  1.  . S DIR("A",2)="Technical Fields even though this may cause errors if e.g. a document is being"
  1.  . S DIR("A")="entered on this entry"
  1.  . S DIR("B")="NO" D ^DIR S TIUFY=Y K DIR,X,Y
  1.  I STATUS'="INACTIVE",TIUFWHO'="N" W !!," Can't edit Technical Fields; Entry is not Inactive",! D PAUSE^TIUFXHLX G EDTEX
  1.  L +^TIU(8925.1,FILEDA):1 I '$T W !!," Another user is editing this entry.",! H 2 G EDTEX
  1.  S DA=FILEDA,DIE=8925.1
  1.  S PFILEDA=+$O(^TIU(8925.1,"AD",FILEDA,0)) I 'PFILEDA S PCUSTOM=0,ICUSTOM="" G DR
  1.  ;If FILEDA is Clinical Documents, want to edit 6.14 but not 6.1, 6.12, 6.13:Type=CL so will edit 6.14; PCUSTOM undefined, so skip others:
  1.  D INHERIT^TIUFLD(PFILEDA,0,6.14,"","","",.ICUSTOM)
  1.  I TYPE="CL"!(TYPE="DC")!(TYPE="DOC") S PNODE61=$G(^TIU(8925.1,PFILEDA,6.1)),PCUSTOM=$P(PNODE61,U,4) I PCUSTOM="" S PCUSTOM=ICUSTOM
  1. DR ;
  1.  ;IHS/ITSC/LJF 01/07/2005 PATCH 1001 allow non-programmers to edit object method
  1.  ;S DR=$S(TYPE="O":9,1:"4.1:4.45;4.6;4.7;4.9;5;6;I '$G(PCUSTOM) S Y=7;6.1;6.12;6.13;7;8;S:TYPE=""DOC"" Y=0 I ICUSTOM=0 S Y=0;6.14") D ^DIE
  1.  I TYPE="O" NEW BTIUOM D  I $D(BTIUOM) S ^TIU(8925.1,FILEDA,9)=BTIUOM
  1.  . NEW DIR S DIR(0)="FAU^3:245",DIR("A")="OBJECT METHOD:  ",DIR("B")=$G(^TIU(8925.1,FILEDA,9))
  1.  . D ^DIR Q:Y=U  Q:Y=""
  1.  . S BTIUOM=Y,X=Y D ^DIM I '$D(X) K BTIUOM W !!?15,"Not Valid MUMPS Code; Try again." H 2
  1.  I TYPE'="O" S DR=$S(TYPE="O":9,1:"4.1:4.45;4.6;4.7;4.9;5;6;I '$G(PCUSTOM) S Y=7;6.1;6.12;6.13;7;8;S:TYPE=""DOC"" Y=0 I ICUSTOM=0 S Y=0;6.14") D ^DIE
  1.  ;IHS/ITSC/LJF 01/07/2005 end of PATCH 1001 changes
  1.  ;
  1.  G:$D(DTOUT) EDTEX
  1.  S LINENO=TIUFTLIN
  1.  D DSTECH^TIUFD(.LINENO) S VALMCNT=LINENO
  1.  G:$D(DTOUT) EDTEX
  1.  S VALMBCK="R"
  1. EDTEX ;
  1.  L -^TIU(8925.1,+$G(FILEDA))
  1.  I $D(DTOUT) S VALMBCK="Q" Q
  1.  I $G(TIUFFULL) S VALMBCK="R" D RESET^TIUFXHLX
  1.  Q
  1.  ;
  1. EDUPLOAD ;LM Template D Action Edit Upload.
  1.  ; Requires CURRENT arrays TIUFINFO, TIUFNOD0.
  1.  ; Requires TIUFULIN as set in DSUPLOAD^TIUFD2.
  1.  N FILEDA,DA,DIE,DR,LINENO,TIUFXNOD,STATUS,TYPE,DTOUT,DIRUT,DIROUT
  1.  S FILEDA=TIUFINFO("FILEDA"),VALMBCK="",TIUFXNOD=$G(XQORNOD(0))
  1.  I '$D(^TIU(8925.1,FILEDA,0)) W !!," Can't Edit Upload; File Entry "_FILEDA_" does not exist in the file; See IRM",! D PAUSE^TIUFXHLX S VALMBCK="Q" G EDUPX
  1.  S STATUS=$$STATWORD^TIUFLF5($P(TIUFNOD0,U,7)),TYPE=$P(TIUFNOD0,U,4)
  1.  L +^TIU(8925.1,FILEDA):1 I '$T W !," Another user is editing this entry." H 2 G EDUPX
  1.  D FULL^VALM1
  1.  N TIUX
  1.  S DA=FILEDA,DIE=8925.1
  1.  S DR="[TIUF UPLOAD FIELD EDIT]" D ^DIE G:$D(DTOUT) EDUPX
  1.  S LINENO=TIUFULIN
  1.  D DSUPLOAD^TIUFD1(.LINENO) S VALMCNT=LINENO G:$D(DTOUT) EDUPX
  1.  S VALMSG=$$VMSG^TIUFL D RE^VALM4,RESET^TIUFXHLX
  1. EDUPX ;
  1.  L -^TIU(8925.1,+$G(FILEDA))
  1.  I $D(DTOUT) S VALMBCK="Q"
  1.  Q
  1.  ;