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

Last change on this file since 949 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 5.5 KB
RevLine 
[613]1TIUFHA1 ; SLC/MAM - LM Templates H,A Actn Delete. CANTDEL(FILEDA,USED),ASKOK(OLDLNO,IFLAG,USED) ;1/19/06
2 ;;1.0;TEXT INTEGRATION UTILITIES;**2,13,43,184**;Jun 20, 1997
3 ;
4 ;$$HASAS^USRLFF - IA 2329
5 ;$$FNDTITLE^DGPFAPI1 - IA 4383
6DELETE ; Templates H and A Action Delete Entries
7 ; Requires TIUFTMPL.
8 ; Requires TIUFWHO, set in Options TIUF/A/C/H EDIT/SORT/CREATE DDEFS CLIN/MGR/NATL.
9 ; Not on Clinician menu: don't worry about TIUFWHO="C".
10 N OLDLNO,TIUFDA,FILEDA,USED,IFLAG,PFILEDA,SHARED,ANCQUIT,MSG1
11 N ASKOK,ITEMDA,LINENO,INFO,PINFO,MSG,TIUFXNOD,TIUI,ANCESTOR,NODE0,NATL
12 N DTOUT,DIRUT,DIROUT
13 S VALMBCK="",TIUFXNOD=$G(XQORNOD(0))
14 D EN^VALM2(TIUFXNOD,"O")
15 I '$O(VALMY(0)) G DELEX
16 S OLDLNO=0
17 F S OLDLNO=$O(VALMY(OLDLNO)) Q:'OLDLNO D
18 . S TIUFDA(OLDLNO)=$P(^TMP("TIUF1IDX",$J,OLDLNO),U,2)
19 . Q
20 S OLDLNO=0 K DIRUT
21 F S OLDLNO=$O(TIUFDA(OLDLNO)) Q:'OLDLNO!$D(DIRUT) D L -^TIU(8925.1,+$G(FILEDA))
22 . S MSG=" Processing Entry "_OLDLNO_"..." W !!,MSG
23 . S FILEDA=TIUFDA(OLDLNO)
24 . I $G(TIUFCDA) D Q:$G(ANCQUIT)
25 . . D ANCESTOR^TIUFLF4(TIUFCDA,^TIU(8925.1,TIUFCDA,0),.ANCESTOR) S ANCQUIT=0
26 . . F TIUI=0:1 Q:'$G(ANCESTOR(TIUI)) I FILEDA=ANCESTOR(TIUI) D Q
27 . . . S ANCQUIT=1
28 . . . I TIUI=0 S MSG=" This is your Current Position in the Hierarchy; Can't delete" W !!,MSG,! D PAUSE^TIUFXHLX Q
29 . . . S MSG=" This entry is ABOVE your Current Position in the Hierarchy; Can't delete" W !!,MSG,! D PAUSE^TIUFXHLX
30 . S NODE0=^TIU(8925.1,FILEDA,0),NATL=$P(NODE0,U,13),SHARED=$P(NODE0,U,10)
31 . 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
32 . I $P(^TIU(8925.1,FILEDA,0),U,13) S MSG=" National Entry; Can't delete" W MSG,! D PAUSE^TIUFXHLX Q
33 . I $P(NODE0,U,4)="O" W !,"To delete an Object, please select action Detailed Display.",! D PAUSE^TIUFXHLX Q
34 . 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
35 . L +^TIU(8925.1,FILEDA):1 I '$T W !!," Another user is editing this entry; Please try later" H 2 Q
36 . S USED=$S($P(NODE0,U,4)="O":$$OBJUSED^TIUFLJ(FILEDA),1:$$DDEFUSED^TIUFLF(FILEDA))
37 . Q:$$CANTDEL(FILEDA,USED)
38 . S IFLAG=+$O(^TIU(8925.1,"AD",FILEDA,0))
39 . I TIUFTMPL="A",IFLAG D D PAUSE^TIUFXHLX Q:$D(DIRUT)
40 . . H 1 W !!," Entry "_OLDLNO_" has Parent:"
41 . . S PFILEDA=0 F D Q:'PFILEDA
42 . . . S PFILEDA=$O(^TIU(8925.1,"AD",FILEDA,PFILEDA)) Q:'PFILEDA
43 . . . W !?5,$P(^TIU(8925.1,PFILEDA,0),U)
44 . H 1 S ASKOK=$$ASKOK(OLDLNO,IFLAG,USED) I 'ASKOK S MSG=" ... Entry "_OLDLNO_" not deleted!" W MSG,! D PAUSE^TIUFXHLX Q
45 . I 'IFLAG G DELENTY
46 . ; If FILEDA is used as an item, delete it as an item:
47 . N DA,DIK
48 . S PFILEDA=$O(^TIU(8925.1,"AD",FILEDA,0)) Q:'PFILEDA
49 . S ITEMDA=$O(^TIU(8925.1,"AD",FILEDA,PFILEDA,0)) Q:'ITEMDA
50 . I TIUFTMPL="A",$E(TIUFATTR)="P" S TIUFREDO=1
51 . S DA(1)=PFILEDA,DA=ITEMDA,DIK="^TIU(8925.1,DA(1),10," D ^DIK
52DELENTY . ; Delete FILEDA as Docmt Def entry in file 8925.1:
53 . N DA,DIK
54 . I TIUFTMPL="A",$E(TIUFATTR)="P" S TIUFREDO=1 ;Delete affects parentage globally.
55 . S DA=FILEDA,DIK="^TIU(8925.1," D ^DIK
56 . S LINENO=$O(^TMP("TIUF1IDX",$J,"DAF",FILEDA,0))
57 . G:'LINENO MSG ; not there since parent was already deleted
58 . I "AJ"[TIUFTMPL D G MSG
59 . . I '$G(TIUFREDO) D UPDATE^TIUFLLM1(TIUFTMPL,-1,LINENO-1) S VALMCNT=VALMCNT-1
60 . ; Update LM Template H: collapse and then delete FILEDA's LINENO.
61 . S INFO=^TMP("TIUF1IDX",$J,LINENO) D PARSE^TIUFLLM(.INFO)
62 . I INFO("XPDLCNT") S VALMCNT=VALMCNT-INFO("XPDLCNT") D COLLAPSE^TIUFH1(.INFO)
63 . S PINFO=^TMP("TIUF1IDX",$J,INFO("PLINENO")) D PARSE^TIUFLLM(.PINFO)
64 . D UPDATE^TIUFLLM1("H",-1,LINENO-1,.PINFO) S VALMCNT=VALMCNT-1
65MSG . S MSG=" ... Entry "_OLDLNO_" Deleted!" W MSG,! H 1 S VALMBCK="R"
66 . Q
67 I TIUFTMPL="C" K TIUFCMSG D
68 . S TIUFCMSG(1)=" Select "_$S(TIUFCTYP="DC":"TITLE",1:"CLASS/DOCUMENTCLASS")_" to create a new "_TIUFCNM
69 . S TIUFCMSG(2)="or to Go Down a Level, Select NEXT LEVEL."
70 . I VALMCNT>VALM("LINES") S TIUFCMSG(2)="or to Go Down a Level, Screen to (+/-) Desired ",TIUFCMSG(3)=TIUFCNM_" Item, and Select NEXT LEVEL."
71DELEX I $D(DTOUT) S VALMBCK="Q" Q
72 I "AJ"[TIUFTMPL,VALMBCK="R",TIUFREDO D INIT^TIUFA S:$D(DTOUT) VALMBCK="Q"
73 Q
74 ;
75ASKOK(OLDLNO,IFLAG,USED) ; Function warns user, asks if OK to continue delete. 1/OK; 0/not OK
76 N DIR,X,Y,ANS
77 S ANS=0
78 I USED=0 S DIR("A")="Object has not been embedded in Boilerplate Text. Delete" G ASKOX
79 S DIR("A",1)="Entry "_OLDLNO_" is not presently used by any documents. If entry is deleted,"
80 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"
81 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"
82ASKOX S DIR(0)="Y",DIR("B")="NO" D ^DIR S ANS=Y W !
83 Q ANS
84 ;
85CANTDEL(FILEDA,USED) ; Function returns 1 if FILEDA can't be deleted, else 0.
86 N ANS,MSG
87 S ANS=0
88 I USED="YES" S MSG="Entry In Use by documents; Can't delete" W MSG,! S ANS=1 G CANTX
89 I USED S MSG="Object embedded in boilerplate text; Can't delete" W !,MSG,! S ANS=1 G CANTX
90 I $$HASAS^USRLFF(FILEDA) S MSG=" Entry has Authorizations/Subscriptions; Can't delete." W !!,MSG,! S ANS=1 G CANTX ;**43**
91 I $$FNDTITLE^DGPFAPI1(FILEDA)>0 S MSG="Entry Associated with PRF Flag; Can't delete" W MSG,! S ANS=1 G CANTX
92 I '$D(^TIU(8925.1,"AS",+^TMP("TIUF",$J,"STATI"),FILEDA)),$P(^TIU(8925.1,FILEDA,0),U,7) D G CANTX
93 . S MSG=" Status not INACTIVE; Can't delete" W MSG,! S ANS=1
94CANTX ;
95 I $D(MSG) D PAUSE^TIUFXHLX
96 Q ANS
97 ;
Note: See TracBrowser for help on using the repository browser.