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