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

TIUFHA1.m

Go to the documentation of this file.
  1. TIUFHA1 ; SLC/MAM - LM Templates H,A Actn Delete. CANTDEL(FILEDA,USED),ASKOK(OLDLNO,IFLAG,USED) ;1/19/06
  1. ;;1.0;TEXT INTEGRATION UTILITIES;**2,13,43,184**;Jun 20, 1997
  1. ;
  1. ;$$HASAS^USRLFF - IA 2329
  1. ;$$FNDTITLE^DGPFAPI1 - IA 4383
  1. DELETE ; Templates H and A Action Delete Entries
  1. ; Requires TIUFTMPL.
  1. ; Requires TIUFWHO, set in Options TIUF/A/C/H EDIT/SORT/CREATE DDEFS CLIN/MGR/NATL.
  1. ; Not on Clinician menu: don't worry about TIUFWHO="C".
  1. N OLDLNO,TIUFDA,FILEDA,USED,IFLAG,PFILEDA,SHARED,ANCQUIT,MSG1
  1. N ASKOK,ITEMDA,LINENO,INFO,PINFO,MSG,TIUFXNOD,TIUI,ANCESTOR,NODE0,NATL
  1. N DTOUT,DIRUT,DIROUT
  1. S VALMBCK="",TIUFXNOD=$G(XQORNOD(0))
  1. D EN^VALM2(TIUFXNOD,"O")
  1. I '$O(VALMY(0)) G DELEX
  1. S OLDLNO=0
  1. F S OLDLNO=$O(VALMY(OLDLNO)) Q:'OLDLNO D
  1. . S TIUFDA(OLDLNO)=$P(^TMP("TIUF1IDX",$J,OLDLNO),U,2)
  1. . Q
  1. S OLDLNO=0 K DIRUT
  1. F S OLDLNO=$O(TIUFDA(OLDLNO)) Q:'OLDLNO!$D(DIRUT) D L -^TIU(8925.1,+$G(FILEDA))
  1. . S MSG=" Processing Entry "_OLDLNO_"..." W !!,MSG
  1. . S FILEDA=TIUFDA(OLDLNO)
  1. . I $G(TIUFCDA) D Q:$G(ANCQUIT)
  1. . . D ANCESTOR^TIUFLF4(TIUFCDA,^TIU(8925.1,TIUFCDA,0),.ANCESTOR) S ANCQUIT=0
  1. . . F TIUI=0:1 Q:'$G(ANCESTOR(TIUI)) I FILEDA=ANCESTOR(TIUI) D Q
  1. . . . S ANCQUIT=1
  1. . . . I TIUI=0 S MSG=" This is your Current Position in the Hierarchy; Can't delete" W !!,MSG,! D PAUSE^TIUFXHLX Q
  1. . . . S MSG=" This entry is ABOVE your Current Position in the Hierarchy; Can't delete" W !!,MSG,! D PAUSE^TIUFXHLX
  1. . S NODE0=^TIU(8925.1,FILEDA,0),NATL=$P(NODE0,U,13),SHARED=$P(NODE0,U,10)
  1. . I SHARED S MSG=" Shared Components cannot be deleted; if they do not have multiple parents,",MSG1="they can be edited to NOT SHARED and then deleted" W !!,MSG,!,MSG1 D PAUSE^TIUFXHLX Q
  1. . I $P(^TIU(8925.1,FILEDA,0),U,13) S MSG=" National Entry; Can't delete" W MSG,! D PAUSE^TIUFXHLX Q
  1. . I $P(NODE0,U,4)="O" W !,"To delete an Object, please select action Detailed Display.",! D PAUSE^TIUFXHLX Q
  1. . I ($L($P(NODE0,U,5))!$L($P(NODE0,U,6))),'$$PERSOWNS^TIUFLF2(FILEDA,DUZ) S MSG=" Only an Owner can delete a file entry" W MSG,! D PAUSE^TIUFXHLX Q
  1. . L +^TIU(8925.1,FILEDA):1 I '$T W !!," Another user is editing this entry; Please try later" H 2 Q
  1. . S USED=$S($P(NODE0,U,4)="O":$$OBJUSED^TIUFLJ(FILEDA),1:$$DDEFUSED^TIUFLF(FILEDA))
  1. . Q:$$CANTDEL(FILEDA,USED)
  1. . S IFLAG=+$O(^TIU(8925.1,"AD",FILEDA,0))
  1. . I TIUFTMPL="A",IFLAG D D PAUSE^TIUFXHLX Q:$D(DIRUT)
  1. . . H 1 W !!," Entry "_OLDLNO_" has Parent:"
  1. . . S PFILEDA=0 F D Q:'PFILEDA
  1. . . . S PFILEDA=$O(^TIU(8925.1,"AD",FILEDA,PFILEDA)) Q:'PFILEDA
  1. . . . W !?5,$P(^TIU(8925.1,PFILEDA,0),U)
  1. . H 1 S ASKOK=$$ASKOK(OLDLNO,IFLAG,USED) I 'ASKOK S MSG=" ... Entry "_OLDLNO_" not deleted!" W MSG,! D PAUSE^TIUFXHLX Q
  1. . I 'IFLAG G DELENTY
  1. . ; If FILEDA is used as an item, delete it as an item:
  1. . N DA,DIK
  1. . S PFILEDA=$O(^TIU(8925.1,"AD",FILEDA,0)) Q:'PFILEDA
  1. . S ITEMDA=$O(^TIU(8925.1,"AD",FILEDA,PFILEDA,0)) Q:'ITEMDA
  1. . I TIUFTMPL="A",$E(TIUFATTR)="P" S TIUFREDO=1
  1. . S DA(1)=PFILEDA,DA=ITEMDA,DIK="^TIU(8925.1,DA(1),10," D ^DIK
  1. DELENTY . ; Delete FILEDA as Docmt Def entry in file 8925.1:
  1. . N DA,DIK
  1. . I TIUFTMPL="A",$E(TIUFATTR)="P" S TIUFREDO=1 ;Delete affects parentage globally.
  1. . S DA=FILEDA,DIK="^TIU(8925.1," D ^DIK
  1. . S LINENO=$O(^TMP("TIUF1IDX",$J,"DAF",FILEDA,0))
  1. . G:'LINENO MSG ; not there since parent was already deleted
  1. . I "AJ"[TIUFTMPL D G MSG
  1. . . I '$G(TIUFREDO) D UPDATE^TIUFLLM1(TIUFTMPL,-1,LINENO-1) S VALMCNT=VALMCNT-1
  1. . ; Update LM Template H: collapse and then delete FILEDA's LINENO.
  1. . S INFO=^TMP("TIUF1IDX",$J,LINENO) D PARSE^TIUFLLM(.INFO)
  1. . I INFO("XPDLCNT") S VALMCNT=VALMCNT-INFO("XPDLCNT") D COLLAPSE^TIUFH1(.INFO)
  1. . S PINFO=^TMP("TIUF1IDX",$J,INFO("PLINENO")) D PARSE^TIUFLLM(.PINFO)
  1. . D UPDATE^TIUFLLM1("H",-1,LINENO-1,.PINFO) S VALMCNT=VALMCNT-1
  1. MSG . S MSG=" ... Entry "_OLDLNO_" Deleted!" W MSG,! H 1 S VALMBCK="R"
  1. . Q
  1. I TIUFTMPL="C" K TIUFCMSG D
  1. . S TIUFCMSG(1)=" Select "_$S(TIUFCTYP="DC":"TITLE",1:"CLASS/DOCUMENTCLASS")_" to create a new "_TIUFCNM
  1. . S TIUFCMSG(2)="or to Go Down a Level, Select NEXT LEVEL."
  1. . I VALMCNT>VALM("LINES") S TIUFCMSG(2)="or to Go Down a Level, Screen to (+/-) Desired ",TIUFCMSG(3)=TIUFCNM_" Item, and Select NEXT LEVEL."
  1. DELEX I $D(DTOUT) S VALMBCK="Q" Q
  1. I "AJ"[TIUFTMPL,VALMBCK="R",TIUFREDO D INIT^TIUFA S:$D(DTOUT) VALMBCK="Q"
  1. Q
  1. ;
  1. ASKOK(OLDLNO,IFLAG,USED) ; Function warns user, asks if OK to continue delete. 1/OK; 0/not OK
  1. N DIR,X,Y,ANS
  1. S ANS=0
  1. I USED=0 S DIR("A")="Object has not been embedded in Boilerplate Text. Delete" G ASKOX
  1. S DIR("A",1)="Entry "_OLDLNO_" is not presently used by any documents. If entry is deleted,"
  1. I IFLAG S DIR("A",2)="any items UNDER it will be Orphans. I will delete entry as an item under its",DIR("A")="parent AND as a Document Definition. It will no longer exist. OK"
  1. E S DIR("A",2)="any items UNDER it will be Orphans. I will delete entry as a Document",DIR("A")="Definition. It will no longer exist. OK"
  1. ASKOX S DIR(0)="Y",DIR("B")="NO" D ^DIR S ANS=Y W !
  1. Q ANS
  1. ;
  1. CANTDEL(FILEDA,USED) ; Function returns 1 if FILEDA can't be deleted, else 0.
  1. N ANS,MSG
  1. S ANS=0
  1. I USED="YES" S MSG="Entry In Use by documents; Can't delete" W MSG,! S ANS=1 G CANTX
  1. I USED S MSG="Object embedded in boilerplate text; Can't delete" W !,MSG,! S ANS=1 G CANTX
  1. I $$HASAS^USRLFF(FILEDA) S MSG=" Entry has Authorizations/Subscriptions; Can't delete." W !!,MSG,! S ANS=1 G CANTX ;**43**
  1. I $$FNDTITLE^DGPFAPI1(FILEDA)>0 S MSG="Entry Associated with PRF Flag; Can't delete" W MSG,! S ANS=1 G CANTX
  1. I '$D(^TIU(8925.1,"AS",+^TMP("TIUF",$J,"STATI"),FILEDA)),$P(^TIU(8925.1,FILEDA,0),U,7) D G CANTX
  1. . S MSG=" Status not INACTIVE; Can't delete" W MSG,! S ANS=1
  1. CANTX ;
  1. I $D(MSG) D PAUSE^TIUFXHLX
  1. Q ANS
  1. ;