source: WorldVistAEHR/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIUFT1.m@ 1432

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

initial load of WorldVistAEHR
File size: 6.0 KB
Line 
1TIUFT1 ; SLC/MAM - LM Template I (Items) Actions Delete, Edit/All, Mnemonic, Sequence, Menu Text, MTXTCHEC(DA,FILEDA,SILENT) ;4/17/97 11:02
2 ;;1.0;TEXT INTEGRATION UTILITIES;**17,27,43,64**;Jun 20, 1997
3 ;
4MTXTCHEC(DA,FILEDA,SILENT,OLDMTXT,NEWMTXT) ; Check/Stuff/Inform Menu Text. **43**
5 ; If no MTXT, or MTXT starts w space, or MTXT starts with ALL, stuff
6 ;MTXT with first 20 chars of NAME (or, if NAME begins with ALL, begin
7 ;MTXT w/ ALX instead of ALL).
8 ; Requires array DA, i.e. DA(1) and DA, FILEDA, and SILENT.
9 ; Returns OLD menu text (or NOTEN) in OLDMTXT if received.
10 ; Returns NEW menu text (or NOENTRY) in NEWMTXT if received.
11 N NAMEOK
12 I $$MTXTOK(.DA,.OLDMTXT) S NEWMTXT=OLDMTXT G CHECX
13 S NAMEOK=1,NEWMTXT=$G(^TIU(8925.1,FILEDA,0),"NOENTRY^"),NEWMTXT=$P(NEWMTXT,U),NEWMTXT=$E(NEWMTXT,1,20)
14 I NEWMTXT="NOENTRY" G CHECX
15 I $E(NEWMTXT,1,3)="ALL" S NAMEOK=0
16 S NEWMTXT=$$MIXED^TIULS(NEWMTXT)
17 I 'NAMEOK S $E(NEWMTXT,3)="X"
18 D STUFF(.DA,NEWMTXT)
19 D:'SILENT MSG(NEWMTXT)
20CHECX Q
21 ;
22MTXTOK(DA,MTXT) ; Function returns 0 if Menu Text begins with space or all (any case) or if there is no Menu Text. Menu Text (or NOTEN if no ten node) is returned in MTXT.
23 ; Requires DA, DA(1)
24 N MTXTOK S MTXTOK=1
25 S MTXT=$G(^TIU(8925.1,DA(1),10,DA,0),"NOTEN")
26 I MTXT="NOTEN" S MTXTOK=0 G OKX
27 S MTXT=$P(MTXT,U,4)
28 I (MTXT="")!($E(MTXT)=" ")!($$UPPER^TIULS($E(MTXT,1,3))="ALL") S MTXTOK=0
29OKX Q MTXTOK
30 ;
31STUFF(DA,MTXT) ; Stuff MTXT
32 N DIE,DR
33 S DR="4///"_MTXT,DIE="^TIU(8925.1,DA(1),10," D ^DIE
34 Q
35 ;
36MSG(MTXT) ; Inform user
37 I MTXT="NOTEN" W !!,"Item is missing from TIU DOCUMENT DEFINITION file. See IRM.",! Q
38 W !!,"Since item's Menu Text was bad or did not exist, item has been given Menu Text:",!,?5,MTXT,!
39 I $G(TIUFSTMP)'="T" W "To edit, select 'Detailed Display' for the PARENT, then select 'Items'.",!
40 H 3
41 Q
42 ;
43EDDEL ; Template T (Items for Entry) Actions DELETE, EDIT/ ALL, MNEMONIC, SEQUENCE, MENU TEXT
44 ; Action Delete Items deletes item as an item only, NOT as a file entry.
45 ; No need to update original screen since entry collapsed, will reexpand
46 ; Requires arrays TIUFINFO, TIUFNOD0
47 N OLDLNO,SHIFT,TIUFDA10,LINENO,NODE0,NAME,INFO,TIUFERR,QUIT,TENDA
48 N DA,DIE,DR,DIR,DIK,X,Y,FILEDA,IFILEDA,DDEFUSED,INODE0,ITYPE,TIUFFULL
49 N ISTATUS,TIUFY,INATLFLG,TIUFXNOD,ISHARED,DTOUT,DIRUT,DIROUT
50 S TIUFXNOD=$G(XQORNOD(0)),VALMBCK="",TIUFFULL=0
51 S FILEDA=TIUFINFO("FILEDA")
52 I $P(TIUFXNOD,U,3)["Delete",$P(TIUFNOD0,U,13),TIUFWHO'="N",$P(TIUFNOD0,U,4)="DOC"!($P(TIUFNOD0,U,4)="CO") W !!," Parent is National, of Type TL or CO; Can't add or delete Items" D PAUSE^TIUFXHLX G EDDEX
53 L +^TIU(8925.1,FILEDA):1 I '$T W !!," Another user is editing this entry; Please try later",! H 2 G EDDEX
54 D EN^VALM2(TIUFXNOD,"O")
55 I '$O(VALMY(0)) G EDDEX
56 S OLDLNO=0,VALMBCK="R"
57 F S OLDLNO=$O(VALMY(OLDLNO)) Q:'OLDLNO D
58 . S TIUFDA10(OLDLNO)=$P(^TMP("TIUF2IDX",$J,OLDLNO),U,6)
59 . Q
60 S (OLDLNO,QUIT)=0,DA(1)=FILEDA
61 ; Delete Items
62 I $P(TIUFXNOD,U,3)["Delete" D G EDDEX
63 . S DIR(0)="Y",DIR("A")="Sure you want to delete items",DIR("B")="NO"
64 . S DIR("?",1)="Delete on Items Screen deletes entries as items from the parent ONLY; they are"
65 . S DIR("?",2)="NOT deleted from the file itself. For more, enter ?? at the Select Action"
66 . S DIR("?")="prompt and see DELETE."
67 . D ^DIR S TIUFY=Y K DIR,X,Y,DUOUT I TIUFY'=1 S VALMBCK="" W !!,"NOT Deleted!",! H 1 Q
68 . N DIRUT
69 . F S OLDLNO=$O(TIUFDA10(OLDLNO)) Q:'OLDLNO D Q:$D(DIRUT)
70 . . S TENDA=TIUFDA10(OLDLNO)
71 . . S IFILEDA=+^TIU(8925.1,DA(1),10,TENDA,0)
72 . . S INODE0=$G(^TIU(8925.1,IFILEDA,0)),ISHARED=+$P(INODE0,U,10)
73 . . I INODE0="" W !!," Entry ",OLDLNO," does not exist in File; See IRM",! D PAUSE^TIUFXHLX Q
74 . . S INATLFLG=+$P(INODE0,U,13),ITYPE=$P(INODE0,U,4),ISTATUS=$$STATWORD^TIUFLF5($P(INODE0,U,7)) ;e.g INACTIVE
75 . . I INATLFLG,ITYPE'="CO",TIUFWHO'="N" W !!," Entry ",OLDLNO," can't be deleted from parent: Entry is National",! D PAUSE^TIUFXHLX Q ;P64 prohibit deletion of natl entries as items except for natl components
76 . . I TIUFWHO="C",'ISHARED W !!," Entry ",OLDLNO," can't be deleted from parent:",!,"Only Shared Components can be added/deleted.",! D PAUSE^TIUFXHLX Q
77 . . ; If not CO, don't permit Item delete if Used by Docmts
78 . . I ITYPE'="CO" D I DDEFUSED="YES",'$$OVERRIDE^TIUFHA2("delete entry "_OLDLNO_" from parent even though it is IN USE by documents") W !," Entry ",OLDLNO," NOT deleted" H 3 Q
79 . . . S DDEFUSED=$$DDEFUSED^TIUFLF(IFILEDA)
80 . . . I DDEFUSED="YES" W !!," Entry ",OLDLNO," can't be deleted from parent: In Use by documents",! I TIUFWHO="N" D FULL^VALM1,OVERWARN^TIUFHA2 S TIUFFULL=1
81 . . I ISTATUS'="INACTIVE" W !!," Entry ",OLDLNO," can't be deleted from parent: not INACTIVE",! D PAUSE^TIUFXHLX Q
82 . . I TIUFTMPL="A",$E(TIUFATTR)="P",$$ORPHAN^TIUFLF4(FILEDA,TIUFNOD0)="NO" S TIUFREDO=1 ;orphaning items below item
83 . . S DA=TENDA,DIK="^TIU(8925.1,DA(1),10," D ^DIK
84 . . W !!," Entry ",OLDLNO," Deleted from parent",! H 2
85 . . S LINENO=$O(^TMP("TIUF2IDX",$J,"DA10",TENDA,0))
86 . . S SHIFT=-1
87 . . D UPDATE^TIUFLLM1("T",SHIFT,LINENO-1) S VALMCNT=VALMCNT+SHIFT
88 . . I $G(TIUFERR) S QUIT=1
89 . . ; D screen will be updated when return from T to D.
90 . . Q
91 . D NODE0ARR^TIUFLF(FILEDA,.TIUFNOD0)
92 . Q
93 ; Edit Items
94 D FULL^VALM1 S TIUFFULL=1
95 F S OLDLNO=$O(TIUFDA10(OLDLNO)) Q:'OLDLNO!QUIT D
96 . S QUIT=0
97 . S TENDA=TIUFDA10(OLDLNO)
98 . S LINENO=$O(^TMP("TIUF2IDX",$J,"DA10",TENDA,0))
99 . S INFO=^TMP("TIUF2IDX",$J,LINENO)
100 . S IFILEDA=$P(INFO,U,2),INODE0=$G(^TIU(8925.1,IFILEDA,0))
101 . I INODE0="" W !!," Item ",OLDLNO," Not in File! See IRM.",! D PAUSE^TIUFXHLX Q
102 . S ITYPE=$P(INODE0,U,4)
103 . W !!," Editing Entry ",OLDLNO
104 . I $P(TIUFXNOD,U,3)="Mnemonic" S DR="2"
105 . I $P(TIUFXNOD,U,3)="Sequence" S DR="3"
106 . I $P(TIUFXNOD,U,3)="Menu Text" S DR="4"
107 . I $P(TIUFXNOD,U,3)["All" S DR="3;2;4" I ITYPE'="CL",ITYPE'="DC" S DR="3;4"
108 . S DA=TENDA
109 . S DIE="^TIU(8925.1,DA(1),10," D ^DIE I $D(Y)!$D(DTOUT) S QUIT=1
110 . D MTXTCHEC(.DA,IFILEDA,0) H 4 ;If user left bad Menu Text by accepting bad existing value, stuff and inform user.
111 . Q
112 G:$D(DTOUT) EDDEX
113 D INIT^TIUFT
114EDDEX I $D(DTOUT) S VALMBCK="Q"
115 L -^TIU(8925.1,+$G(FILEDA))
116 I $G(TIUFFULL) S VALMBCK="R" D RESET^TIUFXHLX
117 Q
Note: See TracBrowser for help on using the repository browser.