- 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
- ;
- 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 ;
