source: WorldVistAEHR/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIUFHA1.m@ 1774

TIUFHA1 ; SLC/MAM - LM Templates H,A Actn Delete. CANTDEL(FILEDA,USED),ASKOK(OLDLNO,IFLAG,USED) ;1/19/06

 ;;1.0;TEXT INTEGRATION UTILITIES;**2,13,43,184**;Jun 20, 1997

 ;

 ;$$HASAS^USRLFF - IA 2329

 ;$$FNDTITLE^DGPFAPI1 - IA 4383

DELETE ; Templates H and A Action Delete Entries

 ; Requires TIUFTMPL.

 ; Requires TIUFWHO, set in Options TIUF/A/C/H EDIT/SORT/CREATE DDEFS CLIN/MGR/NATL.

 ; Not on Clinician menu: don't worry about TIUFWHO="C".

 N OLDLNO,TIUFDA,FILEDA,USED,IFLAG,PFILEDA,SHARED,ANCQUIT,MSG1

 N ASKOK,ITEMDA,LINENO,INFO,PINFO,MSG,TIUFXNOD,TIUI,ANCESTOR,NODE0,NATL

 N DTOUT,DIRUT,DIROUT

 S VALMBCK="",TIUFXNOD=$G(XQORNOD(0))

 D EN^VALM2(TIUFXNOD,"O")

 I '$O(VALMY(0)) G DELEX

 S OLDLNO=0

 F  S OLDLNO=$O(VALMY(OLDLNO)) Q:'OLDLNO  D

 . S TIUFDA(OLDLNO)=$P(^TMP("TIUF1IDX",$J,OLDLNO),U,2)

 . Q

 S OLDLNO=0 K DIRUT

 F  S OLDLNO=$O(TIUFDA(OLDLNO)) Q:'OLDLNO!$D(DIRUT)  D  L -^TIU(8925.1,+$G(FILEDA))

 . S MSG=" Processing Entry "_OLDLNO_"..." W !!,MSG

 . S FILEDA=TIUFDA(OLDLNO)

 . I $G(TIUFCDA) D  Q:$G(ANCQUIT)

 . . D ANCESTOR^TIUFLF4(TIUFCDA,^TIU(8925.1,TIUFCDA,0),.ANCESTOR) S ANCQUIT=0

 . . F TIUI=0:1 Q:'$G(ANCESTOR(TIUI))  I FILEDA=ANCESTOR(TIUI) D  Q

 . . . S ANCQUIT=1

 . . . I TIUI=0 S MSG=" This is your Current Position in the Hierarchy; Can't delete" W !!,MSG,! D PAUSE^TIUFXHLX Q

 . . . S MSG=" This entry is ABOVE your Current Position in the Hierarchy; Can't delete" W !!,MSG,! D PAUSE^TIUFXHLX

 . S NODE0=^TIU(8925.1,FILEDA,0),NATL=$P(NODE0,U,13),SHARED=$P(NODE0,U,10)

 . 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

 . I $P(^TIU(8925.1,FILEDA,0),U,13) S MSG=" National Entry; Can't delete" W MSG,! D PAUSE^TIUFXHLX Q

 . I $P(NODE0,U,4)="O" W !,"To delete an Object, please select action Detailed Display.",! D PAUSE^TIUFXHLX Q

 . 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

 . L +^TIU(8925.1,FILEDA):1 I '$T W !!," Another user is editing this entry; Please try later" H 2 Q

 . S USED=$S($P(NODE0,U,4)="O":$$OBJUSED^TIUFLJ(FILEDA),1:$$DDEFUSED^TIUFLF(FILEDA))

 . Q:$$CANTDEL(FILEDA,USED)

 . S IFLAG=+$O(^TIU(8925.1,"AD",FILEDA,0))

 . I TIUFTMPL="A",IFLAG D  D PAUSE^TIUFXHLX Q:$D(DIRUT)

 . . H 1 W !!,"  Entry "_OLDLNO_" has Parent:"

 . . S PFILEDA=0 F  D  Q:'PFILEDA

 . . . S PFILEDA=$O(^TIU(8925.1,"AD",FILEDA,PFILEDA)) Q:'PFILEDA

 . . . W !?5,$P(^TIU(8925.1,PFILEDA,0),U)

 . H 1 S ASKOK=$$ASKOK(OLDLNO,IFLAG,USED) I 'ASKOK  S MSG=" ... Entry "_OLDLNO_" not deleted!" W MSG,! D PAUSE^TIUFXHLX Q

 . I 'IFLAG G DELENTY

 . ; If FILEDA is used as an item, delete it as an item:

 . N DA,DIK

 . S PFILEDA=$O(^TIU(8925.1,"AD",FILEDA,0)) Q:'PFILEDA

 . S ITEMDA=$O(^TIU(8925.1,"AD",FILEDA,PFILEDA,0)) Q:'ITEMDA

 . I TIUFTMPL="A",$E(TIUFATTR)="P" S TIUFREDO=1

 . S DA(1)=PFILEDA,DA=ITEMDA,DIK="^TIU(8925.1,DA(1),10," D ^DIK

DELENTY . ; Delete FILEDA as Docmt Def entry in file 8925.1:

 . N DA,DIK

 . I TIUFTMPL="A",$E(TIUFATTR)="P" S TIUFREDO=1 ;Delete affects parentage globally.

 . S DA=FILEDA,DIK="^TIU(8925.1," D ^DIK

 . S LINENO=$O(^TMP("TIUF1IDX",$J,"DAF",FILEDA,0))

 . G:'LINENO MSG ; not there since parent was already deleted

 . I "AJ"[TIUFTMPL D  G MSG

 . . I '$G(TIUFREDO) D UPDATE^TIUFLLM1(TIUFTMPL,-1,LINENO-1) S VALMCNT=VALMCNT-1

 . ; Update LM Template H: collapse and then delete FILEDA's LINENO.

 . S INFO=^TMP("TIUF1IDX",$J,LINENO) D PARSE^TIUFLLM(.INFO)

 . I INFO("XPDLCNT") S VALMCNT=VALMCNT-INFO("XPDLCNT") D COLLAPSE^TIUFH1(.INFO)

 . S PINFO=^TMP("TIUF1IDX",$J,INFO("PLINENO")) D PARSE^TIUFLLM(.PINFO)

 . D UPDATE^TIUFLLM1("H",-1,LINENO-1,.PINFO) S VALMCNT=VALMCNT-1

MSG . S MSG=" ... Entry "_OLDLNO_" Deleted!" W MSG,! H 1 S VALMBCK="R"

 . Q

 I TIUFTMPL="C" K TIUFCMSG D

 . S TIUFCMSG(1)=" Select "_$S(TIUFCTYP="DC":"TITLE",1:"CLASS/DOCUMENTCLASS")_" to create a new "_TIUFCNM

 . S TIUFCMSG(2)="or to Go Down a Level, Select NEXT LEVEL."

 . I VALMCNT>VALM("LINES") S TIUFCMSG(2)="or to Go Down a Level, Screen to (+/-) Desired ",TIUFCMSG(3)=TIUFCNM_" Item, and Select NEXT LEVEL."

DELEX I $D(DTOUT) S VALMBCK="Q" Q

 I "AJ"[TIUFTMPL,VALMBCK="R",TIUFREDO D INIT^TIUFA S:$D(DTOUT) VALMBCK="Q"

 Q

 ;

ASKOK(OLDLNO,IFLAG,USED) ; Function warns user, asks if OK to continue delete. 1/OK; 0/not OK

 N DIR,X,Y,ANS

 S ANS=0

 I USED=0 S DIR("A")="Object has not been embedded in Boilerplate Text.  Delete" G ASKOX

 S DIR("A",1)="Entry "_OLDLNO_" is not presently used by any documents.  If entry is deleted,"

 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"

 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"

ASKOX S DIR(0)="Y",DIR("B")="NO" D ^DIR S ANS=Y W !

 Q ANS

 ;

CANTDEL(FILEDA,USED) ; Function returns 1 if FILEDA can't be deleted, else 0.

 N ANS,MSG

 S ANS=0

 I USED="YES" S MSG="Entry In Use by documents; Can't delete" W MSG,! S ANS=1 G CANTX

 I USED S MSG="Object embedded in boilerplate text; Can't delete" W !,MSG,! S ANS=1 G CANTX

 I $$HASAS^USRLFF(FILEDA) S MSG=" Entry has Authorizations/Subscriptions; Can't delete." W !!,MSG,! S ANS=1 G CANTX ;**43**

 I $$FNDTITLE^DGPFAPI1(FILEDA)>0 S MSG="Entry Associated with PRF Flag; Can't delete" W MSG,! S ANS=1 G CANTX

 I '$D(^TIU(8925.1,"AS",+^TMP("TIUF",$J,"STATI"),FILEDA)),$P(^TIU(8925.1,FILEDA,0),U,7) D  G CANTX

 . S MSG=" Status not INACTIVE; Can't delete" W MSG,! S ANS=1

CANTX ;

 I $D(MSG) D PAUSE^TIUFXHLX

 Q ANS

 ;