TIUFL1 ; SLC/MAM - Library of Modules and Functions: RIGHT, LEFT ;10/25/95 11:50
;;1.0;TEXT INTEGRATION UTILITIES;;Jun 20, 1997
;
RIGHT(TIUFXNOD) ; Action Move View to right: resets VALM("FIXED"), VALMLFT; Sets Type into truncated Name. If in a template, not a subtemplate, sets TIUFLFT to VALMLFT for the template.
; Requires TIUFXNOD = XQORNOD(0) if doing Action Right, = 0^0^PL if doing Action Print List
N TYPE,MOVE,GOINGEND,RMSUFFIX,NEXTSTND,FIXED,WHO,FIELD
N DTOUT,DIRUT,DIROUT,DUOUT,RM
S WHO=$S(TIUFWHO="N":"M",1:TIUFWHO)
S RMSUFFIX=$S($D(TIUFSTMP):TIUFSTMP,1:TIUFTMPL),RMSUFFIX=RMSUFFIX_$S("TD"'[RMSUFFIX:WHO,1:"")
S GOINGEND=0,MOVE=$P($P(TIUFXNOD,U,4),"=",3)
I $G(TIUFSTMP)="D"!($G(TIUFSTMP)="X") W $C(7) S VALMBCK="" Q
S FIXED=VALM("FIXED") S:$G(TIUFSTMP)="" FIXED=20 ; Template H, A,C, or J
S RM=TIUF("RM"_RMSUFFIX)-80+FIXED ;RM= a sort of 'right margin' for VALMLFT, ie Max that VALMLFT can be without going beyond LM Template RM.
I VALMLFT=RM W $C(7) S VALMBCK="" Q ;already at right
D ; Mark all cases where go to end:
. I MOVE?1">".E S GOINGEND=1 Q
. I MOVE,VALMLFT+MOVE'<RM S GOINGEND=1 Q
. S NEXTSTND=+$$STND("R") I 'MOVE,NEXTSTND'<RM S GOINGEND=1
I GOINGEND S VALMLFT=RM D G RIGHX
. I $G(TIUFSTMP)="" S VALM("FIXED")=20 D:(TIUFTMPL'="J") INSTYPE D:TIUFTMPL="J" INSBLNK
; NOT Going to End:
; If HACJ, if move just a bit from beg so Type (J:Status) will still show, then move to next stnd position to prevent NAME2 from scrolling behind NAME1:
S FIELD=$S(TIUFTMPL="J":"STATUS",1:"TYPE")
I $G(TIUFSTMP)="",MOVE,(VALMLFT+MOVE)'>$P(VALMDDF(FIELD),U,2) S MOVE=0
I $G(TIUFSTMP)="" D:(TIUFTMPL'="J") INSTYPE D:(TIUFTMPL="J") INSBLNK
S VALMLFT=$S(MOVE:VALMLFT+MOVE,1:NEXTSTND)
RIGHX I $P(TIUFXNOD,U,3)=">" S VALMBCK="R"
I $D(TIUFTMPL),'$D(TIUFSTMP) S TIUFLFT=+$G(VALMLFT)
Q
;
INSTYPE ; Insert Type into end of truncated Names:
; Needs GOINGEND
N LINENO,TIUREC
F LINENO=1:1:VALMCNT D S ^TMP("TIUF1",$J,LINENO,0)=TIUREC
. S TIUREC=^TMP("TIUF1",$J,LINENO,0),TYPE=" "_$E(TIUREC,77,80)_" "
. I GOINGEND S TIUREC=$$SETSTR^VALM1(TYPE,TIUREC,15,6) Q
. I VALMLFT=49 S TIUREC=$$SETSTR^VALM1(TYPE,TIUREC,43,6)
I GOINGEND D CHGCAP^VALM("NAME1","Name Type") Q
I VALMLFT=49 D CHGCAP^VALM("NAME1","Name Type")
Q
;
INSBLNK ; Insert Blank into end of truncated Names:
; Needs GOINGEND
N LINENO,TIUREC
F LINENO=1:1:VALMCNT D S ^TMP("TIUF1",$J,LINENO,0)=TIUREC
. S TIUREC=^TMP("TIUF1",$J,LINENO,0)
. I GOINGEND S TIUREC=$$SETSTR^VALM1(" ",TIUREC,20,1) Q
. I VALMLFT=49 S TIUREC=$$SETSTR^VALM1(" ",TIUREC,48,1)
Q
;
LEFT(TIUFXNOD) ; Action Move View to left: resets VALM("FIXED"), VALMLFT; Takes Type out of Name, refills the hole.
; Requires TIUFXNOD = XQORNOD(0) if doing Action Left, = 0^0^PL if doing Action Print List
N TYPE,GOINGBEG,MOVE,STND,LM,NEXTSTND,FIELD,DTOUT,DIRUT,DIROUT
S GOINGBEG=0,MOVE=$P($P(TIUFXNOD,U,4),"=",3)
I $G(TIUFSTMP)="D"!($G(TIUFSTMP)="X") W $C(7) S VALMBCK="" Q
S STND=$$STND("L"),NEXTSTND=+STND,LM=$P(STND,U,2) ; A kind of 'Left Margin for VALMLFT, ie, minumum value
I VALMLFT=LM W $C(7) S VALMBCK="" Q ;already at right
D ; Mark all cases where go to beg:
. I MOVE?1"<".E S GOINGBEG=1 Q
. I $P(TIUFXNOD,U,3)="PL" S GOINGBEG=1 Q
. ; If HACJ, if Type (J:Status) will show then move to beg to prevent NAME2 from scrolling behind NAME1:
. S FIELD=$S(TIUFTMPL="J":"STATUS",1:"TYPE")
. I $G(TIUFSTMP)="",MOVE,(VALMLFT-MOVE)<$P(VALMDDF(FIELD),U,2) S GOINGBEG=1 Q
. I 'MOVE,NEXTSTND=LM S GOINGBEG=1
I $G(TIUFSTMP)="" D REFILL
I VALM("FIXED")=20 S VALM("FIXED")=48
I GOINGBEG S VALMLFT=LM G LEFTX
; NOT Going to beg:
S VALMLFT=$S(MOVE:VALMLFT-MOVE,1:NEXTSTND)
LEFTX I $P(TIUFXNOD,U,3)="<" S VALMBCK="R"
I $D(TIUFTMPL),'$D(TIUFSTMP) S TIUFLFT=+$G(VALMLFT)
Q
;
STND(DIRECTN) ; Function returns NEXTSTND^STND(0), where NEXTSTND = next Standard Position to the RIGHT/LEFT, STND(0) = leftmost position for VALMLFT ( = VLAM("FIXED")+1)
N TIUFI,TIUFJ,NEXTSTND,STND,START,MOVE
S START=$S($G(TIUFSTMP)="T":34,1:49) ; "HACJ"[TIUFTMPL:49
S MOVE=80-START+1
F TIUFI=0:1:5 S STND(TIUFI)=START+(TIUFI*MOVE)
I DIRECTN="R" F TIUFJ=1:1:5 S STND=STND(TIUFJ) S:TIUFJ=5 NEXTSTND=STND I STND>VALMLFT S NEXTSTND=STND_U_STND(0) Q
I DIRECTN="L" F TIUFJ=5:-1:0 S STND=STND(TIUFJ) S:'TIUFJ NEXTSTND=STND I STND<VALMLFT S NEXTSTND=STND_U_STND(0) Q
Q NEXTSTND_U_STND(0)
;
REFILL ; Fill in holes in Name
; Needs GOINGBEG
N LINENO,TIUREC,HOLE
F LINENO=1:1:VALMCNT D S ^TMP("TIUF1",$J,LINENO,0)=TIUREC
. S TIUREC=^TMP("TIUF1",$J,LINENO,0)
. I VALM("FIXED")=20 D
. . I TIUFTMPL="J" S HOLE=$E(TIUREC,220),TIUREC=$$SETSTR^VALM1(HOLE,TIUREC,20,1) I 'GOINGBEG S TIUREC=$$SETSTR^VALM1(" ",TIUREC,48,1) Q
. . S HOLE=$E(TIUREC,215,220),TIUREC=$$SETSTR^VALM1(HOLE,TIUREC,15,6) I 'GOINGBEG S TYPE=" "_$E(TIUREC,77,80)_" ",TIUREC=$$SETSTR^VALM1(TYPE,TIUREC,43,6)
. I GOINGBEG D
. . I TIUFTMPL="J" S HOLE=$E(TIUREC,248),TIUREC=$$SETSTR^VALM1(HOLE,TIUREC,48,1) Q
. . S HOLE=$E(TIUREC,243,248),TIUREC=$$SETSTR^VALM1(HOLE,TIUREC,43,6)
I GOINGBEG,TIUFTMPL'="J" D CHGCAP^VALM("NAME1","Name") Q
I TIUFTMPL'="J" D CHGCAP^VALM("NAME1","Name Type")
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUFL1 5273 printed Dec 13, 2024@02:40:59 Page 2
TIUFL1 ; SLC/MAM - Library of Modules and Functions: RIGHT, LEFT ;10/25/95 11:50
+1 ;;1.0;TEXT INTEGRATION UTILITIES;;Jun 20, 1997
+2 ;
RIGHT(TIUFXNOD) ; Action Move View to right: resets VALM("FIXED"), VALMLFT; Sets Type into truncated Name. If in a template, not a subtemplate, sets TIUFLFT to VALMLFT for the template.
+1 ; Requires TIUFXNOD = XQORNOD(0) if doing Action Right, = 0^0^PL if doing Action Print List
+2 NEW TYPE,MOVE,GOINGEND,RMSUFFIX,NEXTSTND,FIXED,WHO,FIELD
+3 NEW DTOUT,DIRUT,DIROUT,DUOUT,RM
+4 SET WHO=$SELECT(TIUFWHO="N":"M",1:TIUFWHO)
+5 SET RMSUFFIX=$SELECT($DATA(TIUFSTMP):TIUFSTMP,1:TIUFTMPL)
SET RMSUFFIX=RMSUFFIX_$SELECT("TD"'[RMSUFFIX:WHO,1:"")
+6 SET GOINGEND=0
SET MOVE=$PIECE($PIECE(TIUFXNOD,U,4),"=",3)
+7 IF $GET(TIUFSTMP)="D"!($GET(TIUFSTMP)="X")
WRITE $CHAR(7)
SET VALMBCK=""
QUIT
+8 ; Template H, A,C, or J
SET FIXED=VALM("FIXED")
if $GET(TIUFSTMP)=""
SET FIXED=20
+9 ;RM= a sort of 'right margin' for VALMLFT, ie Max that VALMLFT can be without going beyond LM Template RM.
SET RM=TIUF("RM"_RMSUFFIX)-80+FIXED
+10 ;already at right
IF VALMLFT=RM
WRITE $CHAR(7)
SET VALMBCK=""
QUIT
+11 ; Mark all cases where go to end:
Begin DoDot:1
+12 IF MOVE?1">".E
SET GOINGEND=1
QUIT
+13 IF MOVE
IF VALMLFT+MOVE'<RM
SET GOINGEND=1
QUIT
+14 SET NEXTSTND=+$$STND("R")
IF 'MOVE
IF NEXTSTND'<RM
SET GOINGEND=1
End DoDot:1
+15 IF GOINGEND
SET VALMLFT=RM
Begin DoDot:1
+16 IF $GET(TIUFSTMP)=""
SET VALM("FIXED")=20
if (TIUFTMPL'="J")
DO INSTYPE
if TIUFTMPL="J"
DO INSBLNK
End DoDot:1
GOTO RIGHX
+17 ; NOT Going to End:
+18 ; If HACJ, if move just a bit from beg so Type (J:Status) will still show, then move to next stnd position to prevent NAME2 from scrolling behind NAME1:
+19 SET FIELD=$SELECT(TIUFTMPL="J":"STATUS",1:"TYPE")
+20 IF $GET(TIUFSTMP)=""
IF MOVE
IF (VALMLFT+MOVE)'>$PIECE(VALMDDF(FIELD),U,2)
SET MOVE=0
+21 IF $GET(TIUFSTMP)=""
if (TIUFTMPL'="J")
DO INSTYPE
if (TIUFTMPL="J")
DO INSBLNK
+22 SET VALMLFT=$SELECT(MOVE:VALMLFT+MOVE,1:NEXTSTND)
RIGHX IF $PIECE(TIUFXNOD,U,3)=">"
SET VALMBCK="R"
+1 IF $DATA(TIUFTMPL)
IF '$DATA(TIUFSTMP)
SET TIUFLFT=+$GET(VALMLFT)
+2 QUIT
+3 ;
INSTYPE ; Insert Type into end of truncated Names:
+1 ; Needs GOINGEND
+2 NEW LINENO,TIUREC
+3 FOR LINENO=1:1:VALMCNT
Begin DoDot:1
+4 SET TIUREC=^TMP("TIUF1",$JOB,LINENO,0)
SET TYPE=" "_$EXTRACT(TIUREC,77,80)_" "
+5 IF GOINGEND
SET TIUREC=$$SETSTR^VALM1(TYPE,TIUREC,15,6)
QUIT
+6 IF VALMLFT=49
SET TIUREC=$$SETSTR^VALM1(TYPE,TIUREC,43,6)
End DoDot:1
SET ^TMP("TIUF1",$JOB,LINENO,0)=TIUREC
+7 IF GOINGEND
DO CHGCAP^VALM("NAME1","Name Type")
QUIT
+8 IF VALMLFT=49
DO CHGCAP^VALM("NAME1","Name Type")
+9 QUIT
+10 ;
INSBLNK ; Insert Blank into end of truncated Names:
+1 ; Needs GOINGEND
+2 NEW LINENO,TIUREC
+3 FOR LINENO=1:1:VALMCNT
Begin DoDot:1
+4 SET TIUREC=^TMP("TIUF1",$JOB,LINENO,0)
+5 IF GOINGEND
SET TIUREC=$$SETSTR^VALM1(" ",TIUREC,20,1)
QUIT
+6 IF VALMLFT=49
SET TIUREC=$$SETSTR^VALM1(" ",TIUREC,48,1)
End DoDot:1
SET ^TMP("TIUF1",$JOB,LINENO,0)=TIUREC
+7 QUIT
+8 ;
LEFT(TIUFXNOD) ; Action Move View to left: resets VALM("FIXED"), VALMLFT; Takes Type out of Name, refills the hole.
+1 ; Requires TIUFXNOD = XQORNOD(0) if doing Action Left, = 0^0^PL if doing Action Print List
+2 NEW TYPE,GOINGBEG,MOVE,STND,LM,NEXTSTND,FIELD,DTOUT,DIRUT,DIROUT
+3 SET GOINGBEG=0
SET MOVE=$PIECE($PIECE(TIUFXNOD,U,4),"=",3)
+4 IF $GET(TIUFSTMP)="D"!($GET(TIUFSTMP)="X")
WRITE $CHAR(7)
SET VALMBCK=""
QUIT
+5 ; A kind of 'Left Margin for VALMLFT, ie, minumum value
SET STND=$$STND("L")
SET NEXTSTND=+STND
SET LM=$PIECE(STND,U,2)
+6 ;already at right
IF VALMLFT=LM
WRITE $CHAR(7)
SET VALMBCK=""
QUIT
+7 ; Mark all cases where go to beg:
Begin DoDot:1
+8 IF MOVE?1"<".E
SET GOINGBEG=1
QUIT
+9 IF $PIECE(TIUFXNOD,U,3)="PL"
SET GOINGBEG=1
QUIT
+10 ; If HACJ, if Type (J:Status) will show then move to beg to prevent NAME2 from scrolling behind NAME1:
+11 SET FIELD=$SELECT(TIUFTMPL="J":"STATUS",1:"TYPE")
+12 IF $GET(TIUFSTMP)=""
IF MOVE
IF (VALMLFT-MOVE)<$PIECE(VALMDDF(FIELD),U,2)
SET GOINGBEG=1
QUIT
+13 IF 'MOVE
IF NEXTSTND=LM
SET GOINGBEG=1
End DoDot:1
+14 IF $GET(TIUFSTMP)=""
DO REFILL
+15 IF VALM("FIXED")=20
SET VALM("FIXED")=48
+16 IF GOINGBEG
SET VALMLFT=LM
GOTO LEFTX
+17 ; NOT Going to beg:
+18 SET VALMLFT=$SELECT(MOVE:VALMLFT-MOVE,1:NEXTSTND)
LEFTX IF $PIECE(TIUFXNOD,U,3)="<"
SET VALMBCK="R"
+1 IF $DATA(TIUFTMPL)
IF '$DATA(TIUFSTMP)
SET TIUFLFT=+$GET(VALMLFT)
+2 QUIT
+3 ;
STND(DIRECTN) ; Function returns NEXTSTND^STND(0), where NEXTSTND = next Standard Position to the RIGHT/LEFT, STND(0) = leftmost position for VALMLFT ( = VLAM("FIXED")+1)
+1 NEW TIUFI,TIUFJ,NEXTSTND,STND,START,MOVE
+2 ; "HACJ"[TIUFTMPL:49
SET START=$SELECT($GET(TIUFSTMP)="T":34,1:49)
+3 SET MOVE=80-START+1
+4 FOR TIUFI=0:1:5
SET STND(TIUFI)=START+(TIUFI*MOVE)
+5 IF DIRECTN="R"
FOR TIUFJ=1:1:5
SET STND=STND(TIUFJ)
if TIUFJ=5
SET NEXTSTND=STND
IF STND>VALMLFT
SET NEXTSTND=STND_U_STND(0)
QUIT
+6 IF DIRECTN="L"
FOR TIUFJ=5:-1:0
SET STND=STND(TIUFJ)
if 'TIUFJ
SET NEXTSTND=STND
IF STND<VALMLFT
SET NEXTSTND=STND_U_STND(0)
QUIT
+7 QUIT NEXTSTND_U_STND(0)
+8 ;
REFILL ; Fill in holes in Name
+1 ; Needs GOINGBEG
+2 NEW LINENO,TIUREC,HOLE
+3 FOR LINENO=1:1:VALMCNT
Begin DoDot:1
+4 SET TIUREC=^TMP("TIUF1",$JOB,LINENO,0)
+5 IF VALM("FIXED")=20
Begin DoDot:2
+6 IF TIUFTMPL="J"
SET HOLE=$EXTRACT(TIUREC,220)
SET TIUREC=$$SETSTR^VALM1(HOLE,TIUREC,20,1)
IF 'GOINGBEG
SET TIUREC=$$SETSTR^VALM1(" ",TIUREC,48,1)
QUIT
+7 SET HOLE=$EXTRACT(TIUREC,215,220)
SET TIUREC=$$SETSTR^VALM1(HOLE,TIUREC,15,6)
IF 'GOINGBEG
SET TYPE=" "_$EXTRACT(TIUREC,77,80)_" "
SET TIUREC=$$SETSTR^VALM1(TYPE,TIUREC,43,6)
End DoDot:2
+8 IF GOINGBEG
Begin DoDot:2
+9 IF TIUFTMPL="J"
SET HOLE=$EXTRACT(TIUREC,248)
SET TIUREC=$$SETSTR^VALM1(HOLE,TIUREC,48,1)
QUIT
+10 SET HOLE=$EXTRACT(TIUREC,243,248)
SET TIUREC=$$SETSTR^VALM1(HOLE,TIUREC,43,6)
End DoDot:2
End DoDot:1
SET ^TMP("TIUF1",$JOB,LINENO,0)=TIUREC
+11 IF GOINGBEG
IF TIUFTMPL'="J"
DO CHGCAP^VALM("NAME1","Name")
QUIT
+12 IF TIUFTMPL'="J"
DO CHGCAP^VALM("NAME1","Name Type")
+13 QUIT
+14 ;
