TIUFLLM1 ; SLC/MAM - Library; LM Related: LINEUP(INFO,TEMPLATE), UPDATE(TMPLATE,SHIFT,LASTLIN,PINFO), AINUSE(LINENO), INUSEUP(FILEDA,LINENO) ;8/27/97 18:47
;;1.0;TEXT INTEGRATION UTILITIES;**11**;Jun 20, 1997
;
LINEUP(INFO,TEMPLATE) ; Update Line +INFO. Line must be updated, NOT added or deleted.
; Requires INFO,TEMPLATE
N NODE0
D:$D(INFO)<10 PARSE^TIUFLLM(.INFO) D:$D(NODE0)<10 NODE0ARR^TIUFLF($P(INFO,U,2),.NODE0) G:$D(DTOUT) LINEX
D BUFENTRY^TIUFLLM2(.INFO,.NODE0,TEMPLATE)
D UPDATE(TEMPLATE,0,INFO-1)
LINEX Q
;
UPDATE(TMPLATE,SHIFT,LASTLIN,PINFO) ; Update LM TMPLATE using Buffer Array.
; TMPLATE lines may be inserted, deleted, or reset. Resets 1 line;
;inserts or deletes a continuous chunk of lines.
; Lines to be inserted must be in buffer array ^TMP("TIUFB", starting
;with line # LASTLIN+1 and running for SHIFT continuous lines.
; Line to be reset must be in Buffer Array at line # LASTLIN+1,
;with SHIFT = 0.
; Lines to be deleted must be continuous lines starting with line #
;LASTLIN+1 and running for -SHIFT lines, where SHIFT is negative.
; Requires TMPLATE = LM Sub/Template H, A, I, T, D, O, or P; If TMPLATE
; = H (Hierarchy), then lines to be added/deleted
; must all be items under the same parent.
; SHIFT is >0 for add; >0 for delete; =0 for reset.
; |SHIFT| is Length of addition/deletion; a reset does not
; add or delete, so SHIFT is 0 for reset.
; LASTLIN = Line BEFORE Insertion/del/update point as above.
;
; Requires PINFO and PINFO array IF TMPLATE = "H" AND adding/deleting
; (but NOT resetting) lines AND LASTLIN'=0 (Clinical Documents
; HAS NO parent).
; PINFO = ^TMP("TIUF1IDX,$J,LINENO), where LINENO is LM
; Lineno of LM PARENT of lines added/deleted.
; PINFO Array is as set in PARSE^TIUFLLM for PINFO.
; PINFO is used to:
; Update ^TMP("TIUF*IDX" for ancestors of lines
; added/deleted (3rd piece, XPDLCNT);
; Update the + preceeding Name of parent
; of lines added/deleted.
; If PINFO is received, routine returns updated PINFO array.
; (Updates PINFO("XPDLCNT").
; DOESN'T update VALMCNT. (Don't try it: may be updating template other than the one you're presently in.)
;do I need "DAF" for all templates?;MAM
N LINENO,TIUI,TIUJ,OLDINFO,BEG,INC,END,BINFO,ARR,ARRIDX,ARRNO,VCNT
N INUSE,INUSE1,INUSECOL,PLINENO
S ARRNO=^TMP("TIUF",$J,"ARRNO"_TMPLATE)
S ARR="TIUF"_ARRNO,ARRIDX="TIUF"_ARRNO_"IDX"
I SHIFT'>0 D
. ;Delete lines to be deleted/updated
. S BEG=LASTLIN+1,END=$S(SHIFT=0:BEG,1:BEG-1-SHIFT)
. F TIUI=BEG:1:END D
. . S OLDINFO=^TMP(ARRIDX,$J,TIUI)
. . K ^TMP(ARR,$J,TIUI,0),^TMP(ARR,$J,"IDX",TIUI)
. . K ^TMP(ARRIDX,$J,"DAF",$P(OLDINFO,U,2),TIUI)
. . I TMPLATE="T" K ^TMP(ARRIDX,$J,"DA10",$P(OLDINFO,U,6),TIUI)
. . K ^TMP(ARRIDX,$J,TIUI)
. . Q
. Q
I SHIFT'=0 D
. ; Move lines starting w LASTLIN+1 down, creating gap to add entries
. ; OR Move lines after deleted lines up to fill in gap.
. S VCNT=$O(^TMP(ARR,$J,1000000),-1)
. I SHIFT>0 S BEG=VCNT,INC=-1,END=LASTLIN+1
. E S BEG=LASTLIN+1-SHIFT,INC=1,END=VCNT
. F LINENO=BEG:INC:END Q:INC>0&(BEG>END) Q:INC<0&(BEG<END) D
. . S ^TMP(ARR,$J,LINENO+SHIFT,0)=$$SETSTR^VALM1(LINENO+SHIFT,^TMP(ARR,$J,LINENO,0),1,5) ; SETFLD doesn't work since called by nontarget template.
. . I SHIFT>5!(SHIFT<-5) W "."
. . I ARR'="TIUF3" S ^TMP(ARR,$J,"IDX",LINENO+SHIFT,LINENO+SHIFT)=""
. . S OLDINFO=^TMP(ARRIDX,$J,LINENO)
. . S $P(OLDINFO,U)=LINENO+SHIFT
. . S PLINENO=$P(OLDINFO,U,5) I PLINENO>LASTLIN S $P(OLDINFO,U,5)=PLINENO+SHIFT
. . S ^TMP(ARRIDX,$J,"DAF",$P(OLDINFO,U,2),LINENO+SHIFT)=""
. . I TMPLATE="T" S ^TMP(ARRIDX,$J,"DA10",$P(OLDINFO,U,6),LINENO+SHIFT)=""
. . S ^TMP(ARRIDX,$J,LINENO+SHIFT)=OLDINFO
. . K ^TMP(ARR,$J,LINENO,0),^TMP(ARR,$J,"IDX",LINENO,LINENO)
. . K ^TMP(ARRIDX,$J,LINENO),^TMP(ARRIDX,$J,"DAF",$P(OLDINFO,U,2),LINENO)
. . I TMPLATE="T" K ^TMP(ARRIDX,$J,"DA10",$P(OLDINFO,U,6),LINENO)
. . Q
. Q
I SHIFT'<0 D
. ; Fill LM space with buffer array to add/update entries.
. S TIUJ=0 F S TIUJ=$O(^TMP("TIUFB",$J,TIUJ)) Q:'TIUJ D
. . S ^TMP(ARR,$J,TIUJ,0)=^TMP("TIUFB",$J,TIUJ,0)
. . I SHIFT>5 W "."
. . I ARR'="TIUF3" S ^TMP(ARR,$J,"IDX",TIUJ,TIUJ)=""
. . S BINFO=^TMP("TIUFBIDX",$J,TIUJ)
. . S ^TMP(ARRIDX,$J,"DAF",$P(BINFO,U,2),TIUJ)=""
. . I TMPLATE="T" S ^TMP(ARRIDX,$J,"DA10",$P(BINFO,U,6),TIUJ)=""
. . S ^TMP(ARRIDX,$J,TIUJ)=BINFO
. . Q
. K ^TMP("TIUFB",$J),^TMP("TIUFBIDX",$J)
. Q
I $G(PINFO),SHIFT,"HC"[TMPLATE D
. ; For Template H or C:
. ; Updates 3rd piece of ^TMP("TIUF1IDX",$J,LINENO) (XPDLCNT) for mutual
. ; parent and ancestors of entries to be added/deleted;
. ; Updates PINFO, array PINFO;
. ; Updates + in front of parent for template H
. N ANCLNO,XPDLCNT,AINFO
. S ANCLNO=+PINFO
. F S AINFO=$G(^TMP("TIUF1IDX",$J,ANCLNO)) Q:'AINFO D
. . S XPDLCNT=$P(AINFO,U,3)+SHIFT,$P(^TMP("TIUF1IDX",$J,ANCLNO),U,3)=XPDLCNT
. . S ANCLNO=+$P(AINFO,U,5)
. S PINFO("XPDLCNT")=$P(PINFO,U,3)+SHIFT
. S $P(PINFO,U,3)=PINFO("XPDLCNT")
. I TMPLATE="H" S ^TMP("TIUF1",$J,+PINFO,0)=$$PLUSUP^TIUFLLM(.PINFO,^TMP("TIUF1",$J,+PINFO,0))
UPDAX Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUFLLM1 5370 printed Dec 13, 2024@02:41:15 Page 2
TIUFLLM1 ; SLC/MAM - Library; LM Related: LINEUP(INFO,TEMPLATE), UPDATE(TMPLATE,SHIFT,LASTLIN,PINFO), AINUSE(LINENO), INUSEUP(FILEDA,LINENO) ;8/27/97 18:47
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**11**;Jun 20, 1997
+2 ;
LINEUP(INFO,TEMPLATE) ; Update Line +INFO. Line must be updated, NOT added or deleted.
+1 ; Requires INFO,TEMPLATE
+2 NEW NODE0
+3 if $DATA(INFO)<10
DO PARSE^TIUFLLM(.INFO)
if $DATA(NODE0)<10
DO NODE0ARR^TIUFLF($PIECE(INFO,U,2),.NODE0)
if $DATA(DTOUT)
GOTO LINEX
+4 DO BUFENTRY^TIUFLLM2(.INFO,.NODE0,TEMPLATE)
+5 DO UPDATE(TEMPLATE,0,INFO-1)
LINEX QUIT
+1 ;
UPDATE(TMPLATE,SHIFT,LASTLIN,PINFO) ; Update LM TMPLATE using Buffer Array.
+1 ; TMPLATE lines may be inserted, deleted, or reset. Resets 1 line;
+2 ;inserts or deletes a continuous chunk of lines.
+3 ; Lines to be inserted must be in buffer array ^TMP("TIUFB", starting
+4 ;with line # LASTLIN+1 and running for SHIFT continuous lines.
+5 ; Line to be reset must be in Buffer Array at line # LASTLIN+1,
+6 ;with SHIFT = 0.
+7 ; Lines to be deleted must be continuous lines starting with line #
+8 ;LASTLIN+1 and running for -SHIFT lines, where SHIFT is negative.
+9 ; Requires TMPLATE = LM Sub/Template H, A, I, T, D, O, or P; If TMPLATE
+10 ; = H (Hierarchy), then lines to be added/deleted
+11 ; must all be items under the same parent.
+12 ; SHIFT is >0 for add; >0 for delete; =0 for reset.
+13 ; |SHIFT| is Length of addition/deletion; a reset does not
+14 ; add or delete, so SHIFT is 0 for reset.
+15 ; LASTLIN = Line BEFORE Insertion/del/update point as above.
+16 ;
+17 ; Requires PINFO and PINFO array IF TMPLATE = "H" AND adding/deleting
+18 ; (but NOT resetting) lines AND LASTLIN'=0 (Clinical Documents
+19 ; HAS NO parent).
+20 ; PINFO = ^TMP("TIUF1IDX,$J,LINENO), where LINENO is LM
+21 ; Lineno of LM PARENT of lines added/deleted.
+22 ; PINFO Array is as set in PARSE^TIUFLLM for PINFO.
+23 ; PINFO is used to:
+24 ; Update ^TMP("TIUF*IDX" for ancestors of lines
+25 ; added/deleted (3rd piece, XPDLCNT);
+26 ; Update the + preceeding Name of parent
+27 ; of lines added/deleted.
+28 ; If PINFO is received, routine returns updated PINFO array.
+29 ; (Updates PINFO("XPDLCNT").
+30 ; DOESN'T update VALMCNT. (Don't try it: may be updating template other than the one you're presently in.)
+31 ;do I need "DAF" for all templates?;MAM
+32 NEW LINENO,TIUI,TIUJ,OLDINFO,BEG,INC,END,BINFO,ARR,ARRIDX,ARRNO,VCNT
+33 NEW INUSE,INUSE1,INUSECOL,PLINENO
+34 SET ARRNO=^TMP("TIUF",$JOB,"ARRNO"_TMPLATE)
+35 SET ARR="TIUF"_ARRNO
SET ARRIDX="TIUF"_ARRNO_"IDX"
+36 IF SHIFT'>0
Begin DoDot:1
+37 ;Delete lines to be deleted/updated
+38 SET BEG=LASTLIN+1
SET END=$SELECT(SHIFT=0:BEG,1:BEG-1-SHIFT)
+39 FOR TIUI=BEG:1:END
Begin DoDot:2
+40 SET OLDINFO=^TMP(ARRIDX,$JOB,TIUI)
+41 KILL ^TMP(ARR,$JOB,TIUI,0),^TMP(ARR,$JOB,"IDX",TIUI)
+42 KILL ^TMP(ARRIDX,$JOB,"DAF",$PIECE(OLDINFO,U,2),TIUI)
+43 IF TMPLATE="T"
KILL ^TMP(ARRIDX,$JOB,"DA10",$PIECE(OLDINFO,U,6),TIUI)
+44 KILL ^TMP(ARRIDX,$JOB,TIUI)
+45 QUIT
End DoDot:2
+46 QUIT
End DoDot:1
+47 IF SHIFT'=0
Begin DoDot:1
+48 ; Move lines starting w LASTLIN+1 down, creating gap to add entries
+49 ; OR Move lines after deleted lines up to fill in gap.
+50 SET VCNT=$ORDER(^TMP(ARR,$JOB,1000000),-1)
+51 IF SHIFT>0
SET BEG=VCNT
SET INC=-1
SET END=LASTLIN+1
+52 IF '$TEST
SET BEG=LASTLIN+1-SHIFT
SET INC=1
SET END=VCNT
+53 FOR LINENO=BEG:INC:END
if INC>0&(BEG>END)
QUIT
if INC<0&(BEG<END)
QUIT
Begin DoDot:2
+54 ; SETFLD doesn't work since called by nontarget template.
SET ^TMP(ARR,$JOB,LINENO+SHIFT,0)=$$SETSTR^VALM1(LINENO+SHIFT,^TMP(ARR,$JOB,LINENO,0),1,5)
+55 IF SHIFT>5!(SHIFT<-5)
WRITE "."
+56 IF ARR'="TIUF3"
SET ^TMP(ARR,$JOB,"IDX",LINENO+SHIFT,LINENO+SHIFT)=""
+57 SET OLDINFO=^TMP(ARRIDX,$JOB,LINENO)
+58 SET $PIECE(OLDINFO,U)=LINENO+SHIFT
+59 SET PLINENO=$PIECE(OLDINFO,U,5)
IF PLINENO>LASTLIN
SET $PIECE(OLDINFO,U,5)=PLINENO+SHIFT
+60 SET ^TMP(ARRIDX,$JOB,"DAF",$PIECE(OLDINFO,U,2),LINENO+SHIFT)=""
+61 IF TMPLATE="T"
SET ^TMP(ARRIDX,$JOB,"DA10",$PIECE(OLDINFO,U,6),LINENO+SHIFT)=""
+62 SET ^TMP(ARRIDX,$JOB,LINENO+SHIFT)=OLDINFO
+63 KILL ^TMP(ARR,$JOB,LINENO,0),^TMP(ARR,$JOB,"IDX",LINENO,LINENO)
+64 KILL ^TMP(ARRIDX,$JOB,LINENO),^TMP(ARRIDX,$JOB,"DAF",$PIECE(OLDINFO,U,2),LINENO)
+65 IF TMPLATE="T"
KILL ^TMP(ARRIDX,$JOB,"DA10",$PIECE(OLDINFO,U,6),LINENO)
+66 QUIT
End DoDot:2
+67 QUIT
End DoDot:1
+68 IF SHIFT'<0
Begin DoDot:1
+69 ; Fill LM space with buffer array to add/update entries.
+70 SET TIUJ=0
FOR
SET TIUJ=$ORDER(^TMP("TIUFB",$JOB,TIUJ))
if 'TIUJ
QUIT
Begin DoDot:2
+71 SET ^TMP(ARR,$JOB,TIUJ,0)=^TMP("TIUFB",$JOB,TIUJ,0)
+72 IF SHIFT>5
WRITE "."
+73 IF ARR'="TIUF3"
SET ^TMP(ARR,$JOB,"IDX",TIUJ,TIUJ)=""
+74 SET BINFO=^TMP("TIUFBIDX",$JOB,TIUJ)
+75 SET ^TMP(ARRIDX,$JOB,"DAF",$PIECE(BINFO,U,2),TIUJ)=""
+76 IF TMPLATE="T"
SET ^TMP(ARRIDX,$JOB,"DA10",$PIECE(BINFO,U,6),TIUJ)=""
+77 SET ^TMP(ARRIDX,$JOB,TIUJ)=BINFO
+78 QUIT
End DoDot:2
+79 KILL ^TMP("TIUFB",$JOB),^TMP("TIUFBIDX",$JOB)
+80 QUIT
End DoDot:1
+81 IF $GET(PINFO)
IF SHIFT
IF "HC"[TMPLATE
Begin DoDot:1
+82 ; For Template H or C:
+83 ; Updates 3rd piece of ^TMP("TIUF1IDX",$J,LINENO) (XPDLCNT) for mutual
+84 ; parent and ancestors of entries to be added/deleted;
+85 ; Updates PINFO, array PINFO;
+86 ; Updates + in front of parent for template H
+87 NEW ANCLNO,XPDLCNT,AINFO
+88 SET ANCLNO=+PINFO
+89 FOR
SET AINFO=$GET(^TMP("TIUF1IDX",$JOB,ANCLNO))
if 'AINFO
QUIT
Begin DoDot:2
+90 SET XPDLCNT=$PIECE(AINFO,U,3)+SHIFT
SET $PIECE(^TMP("TIUF1IDX",$JOB,ANCLNO),U,3)=XPDLCNT
+91 SET ANCLNO=+$PIECE(AINFO,U,5)
End DoDot:2
+92 SET PINFO("XPDLCNT")=$PIECE(PINFO,U,3)+SHIFT
+93 SET $PIECE(PINFO,U,3)=PINFO("XPDLCNT")
+94 IF TMPLATE="H"
SET ^TMP("TIUF1",$JOB,+PINFO,0)=$$PLUSUP^TIUFLLM(.PINFO,^TMP("TIUF1",$JOB,+PINFO,0))
End DoDot:1
UPDAX QUIT
+1 ;