TIUFLA1 ; 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
;;1.0;TEXT INTEGRATION UTILITIES;;Jun 20, 1997
;
NOINUSE ; If Type is Object for Template A,J blanks out In Use Caption. Called by protocols TIUFA ACTION MENU.
I $G(TIUFAVAL)="O^OBJECT" D CHGCAP^VALM("INUSE","")
I $G(TIUFAVAL)'="O^OBJECT" D CHGCAP^VALM("INUSE","In Use")
Q
;
AUPDATE(NODE0,FILEDA,CNTCHNG,FDALNO) ; Updates LM Template A,J (DDEFs by Attribute), (Objects)
;with one new or edited LM Line if entry FILEDA matches Template A,J
;Attribute, Attribute VAlue, and Start With/Go To Value.
; Updates Arrays TIUFINFO, TIUFNOD0 via UPDATE^TIUFLLM1.
; Requires CURRENT NODE0 = ^TIU(8925.1,FILEDA,0); Requires FILEDA.
; Requires TIUFATTR,TIUFAVAL, and TIUFSTRT. See HDR^TIUFA.
; Returns FDALNO= LM Lineno of new/updated entry FILEDA or = 0 if
;no match. Optional.
; Returns CNTCHNG = # lines added or deleted (+ or -)
;
N PREVNAME,PREVFDA,INFO,SCRNL,MATCH
; DEAL WITH $E(NAME);MAM
S MATCH=$$MATCH^TIUFLA(FILEDA)&$$STRMATCH^TIUFLA(FILEDA,NODE0)
S FDALNO=+$O(^TMP("TIUF1IDX",$J,"DAF",FILEDA,0)),INFO=$G(^TMP("TIUF1IDX",$J,FDALNO))
I INFO="" S INFO=0
; FDALNO = lineno of FILEDA's original LM entry. If no entry, FDALNO=0.
I MATCH G MATCH
NOMATCH ; If no match, FILEDA has no entry, then Quit. If no match, FILEDA
;has entry, then delete entry, reset TIUFINFO so that piece/subscript
;Lineno are 0:
I 'FDALNO S CNTCHNG=0 Q
D UPDATE^TIUFLLM1(TIUFTMPL,-1,FDALNO-1) S CNTCHNG=-1
I FILEDA=$G(TIUFINFO("FILEDA")) S $P(TIUFINFO,U)=0,TIUFINFO("LINENO")=0
G AUPDX
MATCH ;
G:FDALNO HAS
HASNO ; If match, FILEDA has no LM entry, set LM entry. (Happens if setting
;rather than updating Template A, or if LM entry was edited in such a
;way that it no longer met sort criteria and was deleted as a LM entry.)
; If entry=TIUFINFO("FILEDA"), reset lineno piece/subscript of TIUFINFO:
D SETENTYA(NODE0,FILEDA,.FDALNO) S CNTCHNG=1 G AUPDX
HAS ; I match, FILEDA has LM entry, reset entry.
D PARSE^TIUFLLM(.INFO),NODE0ARR^TIUFLF(FILEDA,.NODE0) G:$D(DTOUT) AUPDX
D BUFENTRY^TIUFLLM2(.INFO,.NODE0,TIUFTMPL)
D UPDATE^TIUFLLM1(TIUFTMPL,0,FDALNO-1)
S CNTCHNG=0
AUPDX Q
;
SETENTYA(NODE0,FILEDA,NLINENO) ; Set LM Template A,J entry w data NODE0, IFN FILEDA at NLINENO.
; Requires NODE0,FILEDA
; Returns NLINENO
N INFO
S NLINENO=$$IPOINT(NODE0,FILEDA)
D NINFO^TIUFLLM(NLINENO,FILEDA,.INFO),PARSE^TIUFLLM(.INFO)
D NODE0ARR^TIUFLF(FILEDA,.NODE0) Q:$D(DTOUT)
D BUFENTRY^TIUFLLM2(.INFO,.NODE0,TIUFTMPL)
D UPDATE^TIUFLLM1(TIUFTMPL,1,NLINENO-1)
I FILEDA=$G(TIUFINFO("FILEDA")) S $P(TIUFINFO,U)=NLINENO,TIUFINFO("LINENO")=NLINENO
Q
;
IPOINT(NODE0,FILEDA) ; Function returns Template A,J insertion point for
;entry with NODE0, FILEDA. If Name to be added is already in TIUF1 arry,
;insertion follows IFN order within Name. Else after last entry before
;Name in alphabet.
; Used for old entries as well as new. Can't assume insert entry has
;larger FILEDA than existing entries w same Name.
N LINENO,PREVNAME,NLINENO,FDA,INARRAY
S LINENO=0,PREVNAME=$P(NODE0,U)
S LINENO=$$LINENO(PREVNAME,FILEDA)
I LINENO S NLINENO=LINENO+1 G IPOIX
; If LINENO=0, go back a name:
; Need SACC exempt; MAM
F S PREVNAME=$O(^TIU(8925.1,"B",PREVNAME),-1) Q:LINENO!(PREVNAME="")!($P(TIUFSTRT,U)]PREVNAME) D
. S (FDA,INARRAY)=0
. F S FDA=$O(^TIU(8925.1,"B",PREVNAME,FDA)) Q:'FDA D
. . S INARRAY=$O(^TMP("TIUF1IDX",$J,"DAF",FDA,0))
. . I INARRAY S LINENO=INARRAY
S NLINENO=LINENO+1
IPOIX Q NLINENO
;
LINENO(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.
N FDA,LINENO,INARRAY
S FDA="",LINENO=0
F S FDA=$O(^TIU(8925.1,"B",NAME,FDA)) Q:'FDA!(FDA'<FILEDA) D
. S INARRAY=$O(^TMP("TIUF1IDX",$J,"DAF",FDA,""))
. S:INARRAY LINENO=INARRAY
LINEX Q LINENO
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUFLA1 4108 printed Dec 13, 2024@02:41:01 Page 2
TIUFLA1 ; 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
+1 ;;1.0;TEXT INTEGRATION UTILITIES;;Jun 20, 1997
+2 ;
NOINUSE ; If Type is Object for Template A,J blanks out In Use Caption. Called by protocols TIUFA ACTION MENU.
+1 IF $GET(TIUFAVAL)="O^OBJECT"
DO CHGCAP^VALM("INUSE","")
+2 IF $GET(TIUFAVAL)'="O^OBJECT"
DO CHGCAP^VALM("INUSE","In Use")
+3 QUIT
+4 ;
AUPDATE(NODE0,FILEDA,CNTCHNG,FDALNO) ; Updates LM Template A,J (DDEFs by Attribute), (Objects)
+1 ;with one new or edited LM Line if entry FILEDA matches Template A,J
+2 ;Attribute, Attribute VAlue, and Start With/Go To Value.
+3 ; Updates Arrays TIUFINFO, TIUFNOD0 via UPDATE^TIUFLLM1.
+4 ; Requires CURRENT NODE0 = ^TIU(8925.1,FILEDA,0); Requires FILEDA.
+5 ; Requires TIUFATTR,TIUFAVAL, and TIUFSTRT. See HDR^TIUFA.
+6 ; Returns FDALNO= LM Lineno of new/updated entry FILEDA or = 0 if
+7 ;no match. Optional.
+8 ; Returns CNTCHNG = # lines added or deleted (+ or -)
+9 ;
+10 NEW PREVNAME,PREVFDA,INFO,SCRNL,MATCH
+11 ; DEAL WITH $E(NAME);MAM
+12 SET MATCH=$$MATCH^TIUFLA(FILEDA)&$$STRMATCH^TIUFLA(FILEDA,NODE0)
+13 SET FDALNO=+$ORDER(^TMP("TIUF1IDX",$JOB,"DAF",FILEDA,0))
SET INFO=$GET(^TMP("TIUF1IDX",$JOB,FDALNO))
+14 IF INFO=""
SET INFO=0
+15 ; FDALNO = lineno of FILEDA's original LM entry. If no entry, FDALNO=0.
+16 IF MATCH
GOTO MATCH
NOMATCH ; If no match, FILEDA has no entry, then Quit. If no match, FILEDA
+1 ;has entry, then delete entry, reset TIUFINFO so that piece/subscript
+2 ;Lineno are 0:
+3 IF 'FDALNO
SET CNTCHNG=0
QUIT
+4 DO UPDATE^TIUFLLM1(TIUFTMPL,-1,FDALNO-1)
SET CNTCHNG=-1
+5 IF FILEDA=$GET(TIUFINFO("FILEDA"))
SET $PIECE(TIUFINFO,U)=0
SET TIUFINFO("LINENO")=0
+6 GOTO AUPDX
MATCH ;
+1 if FDALNO
GOTO HAS
HASNO ; If match, FILEDA has no LM entry, set LM entry. (Happens if setting
+1 ;rather than updating Template A, or if LM entry was edited in such a
+2 ;way that it no longer met sort criteria and was deleted as a LM entry.)
+3 ; If entry=TIUFINFO("FILEDA"), reset lineno piece/subscript of TIUFINFO:
+4 DO SETENTYA(NODE0,FILEDA,.FDALNO)
SET CNTCHNG=1
GOTO AUPDX
HAS ; I match, FILEDA has LM entry, reset entry.
+1 DO PARSE^TIUFLLM(.INFO)
DO NODE0ARR^TIUFLF(FILEDA,.NODE0)
if $DATA(DTOUT)
GOTO AUPDX
+2 DO BUFENTRY^TIUFLLM2(.INFO,.NODE0,TIUFTMPL)
+3 DO UPDATE^TIUFLLM1(TIUFTMPL,0,FDALNO-1)
+4 SET CNTCHNG=0
AUPDX QUIT
+1 ;
SETENTYA(NODE0,FILEDA,NLINENO) ; Set LM Template A,J entry w data NODE0, IFN FILEDA at NLINENO.
+1 ; Requires NODE0,FILEDA
+2 ; Returns NLINENO
+3 NEW INFO
+4 SET NLINENO=$$IPOINT(NODE0,FILEDA)
+5 DO NINFO^TIUFLLM(NLINENO,FILEDA,.INFO)
DO PARSE^TIUFLLM(.INFO)
+6 DO NODE0ARR^TIUFLF(FILEDA,.NODE0)
if $DATA(DTOUT)
QUIT
+7 DO BUFENTRY^TIUFLLM2(.INFO,.NODE0,TIUFTMPL)
+8 DO UPDATE^TIUFLLM1(TIUFTMPL,1,NLINENO-1)
+9 IF FILEDA=$GET(TIUFINFO("FILEDA"))
SET $PIECE(TIUFINFO,U)=NLINENO
SET TIUFINFO("LINENO")=NLINENO
+10 QUIT
+11 ;
IPOINT(NODE0,FILEDA) ; Function returns Template A,J insertion point for
+1 ;entry with NODE0, FILEDA. If Name to be added is already in TIUF1 arry,
+2 ;insertion follows IFN order within Name. Else after last entry before
+3 ;Name in alphabet.
+4 ; Used for old entries as well as new. Can't assume insert entry has
+5 ;larger FILEDA than existing entries w same Name.
+6 NEW LINENO,PREVNAME,NLINENO,FDA,INARRAY
+7 SET LINENO=0
SET PREVNAME=$PIECE(NODE0,U)
+8 SET LINENO=$$LINENO(PREVNAME,FILEDA)
+9 IF LINENO
SET NLINENO=LINENO+1
GOTO IPOIX
+10 ; If LINENO=0, go back a name:
+11 ; Need SACC exempt; MAM
+12 FOR
SET PREVNAME=$ORDER(^TIU(8925.1,"B",PREVNAME),-1)
if LINENO!(PREVNAME="")!($PIECE(TIUFSTRT,U)]PREVNAME)
QUIT
Begin DoDot:1
+13 SET (FDA,INARRAY)=0
+14 FOR
SET FDA=$ORDER(^TIU(8925.1,"B",PREVNAME,FDA))
if 'FDA
QUIT
Begin DoDot:2
+15 SET INARRAY=$ORDER(^TMP("TIUF1IDX",$JOB,"DAF",FDA,0))
+16 IF INARRAY
SET LINENO=INARRAY
End DoDot:2
End DoDot:1
+17 SET NLINENO=LINENO+1
IPOIX QUIT NLINENO
+1 ;
LINENO(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.
+1 NEW FDA,LINENO,INARRAY
+2 SET FDA=""
SET LINENO=0
+3 FOR
SET FDA=$ORDER(^TIU(8925.1,"B",NAME,FDA))
if 'FDA!(FDA'<FILEDA)
QUIT
Begin DoDot:1
+4 SET INARRAY=$ORDER(^TMP("TIUF1IDX",$JOB,"DAF",FDA,""))
+5 if INARRAY
SET LINENO=INARRAY
End DoDot:1
LINEX QUIT LINENO
+1 ;
