source: WorldVistAEHR/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIUFLA1.m@ 1361

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

initial load of WorldVistAEHR

File size: 3.9 KB
RevLine 
[613]1TIUFLA1 ; SLC/MAM - Library; Template A,J (DDEFs by Attribute), (Objects) Related: AUPDATE(NODE0,FILEDA,CNTCHNG,NLINENO), SETENTYA(NODE0,FILEDA,FDALNO), IPOINT(NODE0), NOINUSE ;4/6/95 11:02
2 ;;1.0;TEXT INTEGRATION UTILITIES;;Jun 20, 1997
3 ;
4NOINUSE ; If Type is Object for Template A,J blanks out In Use Caption. Called by protocols TIUFA ACTION MENU.
5 I $G(TIUFAVAL)="O^OBJECT" D CHGCAP^VALM("INUSE","")
6 I $G(TIUFAVAL)'="O^OBJECT" D CHGCAP^VALM("INUSE","In Use")
7 Q
8 ;
9AUPDATE(NODE0,FILEDA,CNTCHNG,FDALNO) ; Updates LM Template A,J (DDEFs by Attribute), (Objects)
10 ;with one new or edited LM Line if entry FILEDA matches Template A,J
11 ;Attribute, Attribute VAlue, and Start With/Go To Value.
12 ; Updates Arrays TIUFINFO, TIUFNOD0 via UPDATE^TIUFLLM1.
13 ; Requires CURRENT NODE0 = ^TIU(8925.1,FILEDA,0); Requires FILEDA.
14 ; Requires TIUFATTR,TIUFAVAL, and TIUFSTRT. See HDR^TIUFA.
15 ; Returns FDALNO= LM Lineno of new/updated entry FILEDA or = 0 if
16 ;no match. Optional.
17 ; Returns CNTCHNG = # lines added or deleted (+ or -)
18 ;
19 N PREVNAME,PREVFDA,INFO,SCRNL,MATCH
20 ; DEAL WITH $E(NAME);MAM
21 S MATCH=$$MATCH^TIUFLA(FILEDA)&$$STRMATCH^TIUFLA(FILEDA,NODE0)
22 S FDALNO=+$O(^TMP("TIUF1IDX",$J,"DAF",FILEDA,0)),INFO=$G(^TMP("TIUF1IDX",$J,FDALNO))
23 I INFO="" S INFO=0
24 ; FDALNO = lineno of FILEDA's original LM entry. If no entry, FDALNO=0.
25 I MATCH G MATCH
26NOMATCH ; If no match, FILEDA has no entry, then Quit. If no match, FILEDA
27 ;has entry, then delete entry, reset TIUFINFO so that piece/subscript
28 ;Lineno are 0:
29 I 'FDALNO S CNTCHNG=0 Q
30 D UPDATE^TIUFLLM1(TIUFTMPL,-1,FDALNO-1) S CNTCHNG=-1
31 I FILEDA=$G(TIUFINFO("FILEDA")) S $P(TIUFINFO,U)=0,TIUFINFO("LINENO")=0
32 G AUPDX
33MATCH ;
34 G:FDALNO HAS
35HASNO ; If match, FILEDA has no LM entry, set LM entry. (Happens if setting
36 ;rather than updating Template A, or if LM entry was edited in such a
37 ;way that it no longer met sort criteria and was deleted as a LM entry.)
38 ; If entry=TIUFINFO("FILEDA"), reset lineno piece/subscript of TIUFINFO:
39 D SETENTYA(NODE0,FILEDA,.FDALNO) S CNTCHNG=1 G AUPDX
40HAS ; I match, FILEDA has LM entry, reset entry.
41 D PARSE^TIUFLLM(.INFO),NODE0ARR^TIUFLF(FILEDA,.NODE0) G:$D(DTOUT) AUPDX
42 D BUFENTRY^TIUFLLM2(.INFO,.NODE0,TIUFTMPL)
43 D UPDATE^TIUFLLM1(TIUFTMPL,0,FDALNO-1)
44 S CNTCHNG=0
45AUPDX Q
46 ;
47SETENTYA(NODE0,FILEDA,NLINENO) ; Set LM Template A,J entry w data NODE0, IFN FILEDA at NLINENO.
48 ; Requires NODE0,FILEDA
49 ; Returns NLINENO
50 N INFO
51 S NLINENO=$$IPOINT(NODE0,FILEDA)
52 D NINFO^TIUFLLM(NLINENO,FILEDA,.INFO),PARSE^TIUFLLM(.INFO)
53 D NODE0ARR^TIUFLF(FILEDA,.NODE0) Q:$D(DTOUT)
54 D BUFENTRY^TIUFLLM2(.INFO,.NODE0,TIUFTMPL)
55 D UPDATE^TIUFLLM1(TIUFTMPL,1,NLINENO-1)
56 I FILEDA=$G(TIUFINFO("FILEDA")) S $P(TIUFINFO,U)=NLINENO,TIUFINFO("LINENO")=NLINENO
57 Q
58 ;
59IPOINT(NODE0,FILEDA) ; Function returns Template A,J insertion point for
60 ;entry with NODE0, FILEDA. If Name to be added is already in TIUF1 arry,
61 ;insertion follows IFN order within Name. Else after last entry before
62 ;Name in alphabet.
63 ; Used for old entries as well as new. Can't assume insert entry has
64 ;larger FILEDA than existing entries w same Name.
65 N LINENO,PREVNAME,NLINENO,FDA,INARRAY
66 S LINENO=0,PREVNAME=$P(NODE0,U)
67 S LINENO=$$LINENO(PREVNAME,FILEDA)
68 I LINENO S NLINENO=LINENO+1 G IPOIX
69 ; If LINENO=0, go back a name:
70 ; Need SACC exempt; MAM
71 F S PREVNAME=$O(^TIU(8925.1,"B",PREVNAME),-1) Q:LINENO!(PREVNAME="")!($P(TIUFSTRT,U)]PREVNAME) D
72 . S (FDA,INARRAY)=0
73 . F S FDA=$O(^TIU(8925.1,"B",PREVNAME,FDA)) Q:'FDA D
74 . . S INARRAY=$O(^TMP("TIUF1IDX",$J,"DAF",FDA,0))
75 . . I INARRAY S LINENO=INARRAY
76 S NLINENO=LINENO+1
77IPOIX Q NLINENO
78 ;
79LINENO(NAME,FILEDA) ; Function returns Lineno of last entry with name NAME in LM Array TIUF1 whose IFN is less than FILEDA. If no such entry (EITHER no TIUFI entries with Name OR none with IFN<FILEDA), returns 0.
80 N FDA,LINENO,INARRAY
81 S FDA="",LINENO=0
82 F S FDA=$O(^TIU(8925.1,"B",NAME,FDA)) Q:'FDA!(FDA'<FILEDA) D
83 . S INARRAY=$O(^TMP("TIUF1IDX",$J,"DAF",FDA,""))
84 . S:INARRAY LINENO=INARRAY
85LINEX Q LINENO
86 ;
Note: See TracBrowser for help on using the repository browser.