source: FOIAVistA/tag/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIUFL1.m@ 628

Last change on this file since 628 was 628, checked in by George Lilly, 14 years ago

initial load of FOIAVistA 6/30/08 version
File size: 5.1 KB
Line 
1TIUFL1 ; SLC/MAM - Library of Modules and Functions: RIGHT, LEFT ;10/25/95 11:50
2 ;;1.0;TEXT INTEGRATION UTILITIES;;Jun 20, 1997
3 ;
4RIGHT(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.
5 ; Requires TIUFXNOD = XQORNOD(0) if doing Action Right, = 0^0^PL if doing Action Print List
6 N TYPE,MOVE,GOINGEND,RMSUFFIX,NEXTSTND,FIXED,WHO,FIELD
7 N DTOUT,DIRUT,DIROUT,DUOUT,RM
8 S WHO=$S(TIUFWHO="N":"M",1:TIUFWHO)
9 S RMSUFFIX=$S($D(TIUFSTMP):TIUFSTMP,1:TIUFTMPL),RMSUFFIX=RMSUFFIX_$S("TD"'[RMSUFFIX:WHO,1:"")
10 S GOINGEND=0,MOVE=$P($P(TIUFXNOD,U,4),"=",3)
11 I $G(TIUFSTMP)="D"!($G(TIUFSTMP)="X") W $C(7) S VALMBCK="" Q
12 S FIXED=VALM("FIXED") S:$G(TIUFSTMP)="" FIXED=20 ; Template H, A,C, or J
13 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.
14 I VALMLFT=RM W $C(7) S VALMBCK="" Q ;already at right
15 D ; Mark all cases where go to end:
16 . I MOVE?1">".E S GOINGEND=1 Q
17 . I MOVE,VALMLFT+MOVE'<RM S GOINGEND=1 Q
18 . S NEXTSTND=+$$STND("R") I 'MOVE,NEXTSTND'<RM S GOINGEND=1
19 I GOINGEND S VALMLFT=RM D G RIGHX
20 . I $G(TIUFSTMP)="" S VALM("FIXED")=20 D:(TIUFTMPL'="J") INSTYPE D:TIUFTMPL="J" INSBLNK
21 ; NOT Going to End:
22 ; 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:
23 S FIELD=$S(TIUFTMPL="J":"STATUS",1:"TYPE")
24 I $G(TIUFSTMP)="",MOVE,(VALMLFT+MOVE)'>$P(VALMDDF(FIELD),U,2) S MOVE=0
25 I $G(TIUFSTMP)="" D:(TIUFTMPL'="J") INSTYPE D:(TIUFTMPL="J") INSBLNK
26 S VALMLFT=$S(MOVE:VALMLFT+MOVE,1:NEXTSTND)
27RIGHX I $P(TIUFXNOD,U,3)=">" S VALMBCK="R"
28 I $D(TIUFTMPL),'$D(TIUFSTMP) S TIUFLFT=+$G(VALMLFT)
29 Q
30 ;
31INSTYPE ; Insert Type into end of truncated Names:
32 ; Needs GOINGEND
33 N LINENO,TIUREC
34 F LINENO=1:1:VALMCNT D S ^TMP("TIUF1",$J,LINENO,0)=TIUREC
35 . S TIUREC=^TMP("TIUF1",$J,LINENO,0),TYPE=" "_$E(TIUREC,77,80)_" "
36 . I GOINGEND S TIUREC=$$SETSTR^VALM1(TYPE,TIUREC,15,6) Q
37 . I VALMLFT=49 S TIUREC=$$SETSTR^VALM1(TYPE,TIUREC,43,6)
38 I GOINGEND D CHGCAP^VALM("NAME1","Name Type") Q
39 I VALMLFT=49 D CHGCAP^VALM("NAME1","Name Type")
40 Q
41 ;
42INSBLNK ; Insert Blank into end of truncated Names:
43 ; Needs GOINGEND
44 N LINENO,TIUREC
45 F LINENO=1:1:VALMCNT D S ^TMP("TIUF1",$J,LINENO,0)=TIUREC
46 . S TIUREC=^TMP("TIUF1",$J,LINENO,0)
47 . I GOINGEND S TIUREC=$$SETSTR^VALM1(" ",TIUREC,20,1) Q
48 . I VALMLFT=49 S TIUREC=$$SETSTR^VALM1(" ",TIUREC,48,1)
49 Q
50 ;
51LEFT(TIUFXNOD) ; Action Move View to left: resets VALM("FIXED"), VALMLFT; Takes Type out of Name, refills the hole.
52 ; Requires TIUFXNOD = XQORNOD(0) if doing Action Left, = 0^0^PL if doing Action Print List
53 N TYPE,GOINGBEG,MOVE,STND,LM,NEXTSTND,FIELD,DTOUT,DIRUT,DIROUT
54 S GOINGBEG=0,MOVE=$P($P(TIUFXNOD,U,4),"=",3)
55 I $G(TIUFSTMP)="D"!($G(TIUFSTMP)="X") W $C(7) S VALMBCK="" Q
56 S STND=$$STND("L"),NEXTSTND=+STND,LM=$P(STND,U,2) ; A kind of 'Left Margin for VALMLFT, ie, minumum value
57 I VALMLFT=LM W $C(7) S VALMBCK="" Q ;already at right
58 D ; Mark all cases where go to beg:
59 . I MOVE?1"<".E S GOINGBEG=1 Q
60 . I $P(TIUFXNOD,U,3)="PL" S GOINGBEG=1 Q
61 . ; If HACJ, if Type (J:Status) will show then move to beg to prevent NAME2 from scrolling behind NAME1:
62 . S FIELD=$S(TIUFTMPL="J":"STATUS",1:"TYPE")
63 . I $G(TIUFSTMP)="",MOVE,(VALMLFT-MOVE)<$P(VALMDDF(FIELD),U,2) S GOINGBEG=1 Q
64 . I 'MOVE,NEXTSTND=LM S GOINGBEG=1
65 I $G(TIUFSTMP)="" D REFILL
66 I VALM("FIXED")=20 S VALM("FIXED")=48
67 I GOINGBEG S VALMLFT=LM G LEFTX
68 ; NOT Going to beg:
69 S VALMLFT=$S(MOVE:VALMLFT-MOVE,1:NEXTSTND)
70LEFTX I $P(TIUFXNOD,U,3)="<" S VALMBCK="R"
71 I $D(TIUFTMPL),'$D(TIUFSTMP) S TIUFLFT=+$G(VALMLFT)
72 Q
73 ;
74STND(DIRECTN) ; Function returns NEXTSTND^STND(0), where NEXTSTND = next Standard Position to the RIGHT/LEFT, STND(0) = leftmost position for VALMLFT ( = VLAM("FIXED")+1)
75 N TIUFI,TIUFJ,NEXTSTND,STND,START,MOVE
76 S START=$S($G(TIUFSTMP)="T":34,1:49) ; "HACJ"[TIUFTMPL:49
77 S MOVE=80-START+1
78 F TIUFI=0:1:5 S STND(TIUFI)=START+(TIUFI*MOVE)
79 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
80 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
81 Q NEXTSTND_U_STND(0)
82 ;
83REFILL ; Fill in holes in Name
84 ; Needs GOINGBEG
85 N LINENO,TIUREC,HOLE
86 F LINENO=1:1:VALMCNT D S ^TMP("TIUF1",$J,LINENO,0)=TIUREC
87 . S TIUREC=^TMP("TIUF1",$J,LINENO,0)
88 . I VALM("FIXED")=20 D
89 . . 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
90 . . 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)
91 . I GOINGBEG D
92 . . I TIUFTMPL="J" S HOLE=$E(TIUREC,248),TIUREC=$$SETSTR^VALM1(HOLE,TIUREC,48,1) Q
93 . . S HOLE=$E(TIUREC,243,248),TIUREC=$$SETSTR^VALM1(HOLE,TIUREC,43,6)
94 I GOINGBEG,TIUFTMPL'="J" D CHGCAP^VALM("NAME1","Name") Q
95 I TIUFTMPL'="J" D CHGCAP^VALM("NAME1","Name Type")
96 Q
97 ;
Note: See TracBrowser for help on using the repository browser.