source: FOIAVistA/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIUFLLM2.m@ 1397

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

initial load of FOIAVistA 6/30/08 version
File size: 6.6 KB
Line 
1TIUFLLM2 ; SLC/MAM - Library; LM Related: BUFENTRY(INFO,NODE0,CONTENT,PFILEDA), CONTENT params: 80,N,H,B,I,W ;4/28/97 21:21
2 ;;1.0;TEXT INTEGRATION UTILITIES;**6,43**;Jun 20, 1997
3 ;
4BUFENTRY(INFO,NODE0,CONTENT,PFILEDA) ;Get data for FILEDA; set Docmt
5 ;Def entry INFO("FILEDA") into buffer array, inserting it at lineno
6 ;+INFO with Lineno +INFO.
7 ; This module adds ONE line to buffer array and is called multiple
8 ;times to complete buffer array. When finished, buffer array is
9 ;inserted AS IS into LM array ^TMP("TIUF1/2/or3" for LM Sub/Template
10 ;TIUFTMPL/TIUFSTMP (unless CONTENT contains W, in which case Buffer
11 ;Array is written to screen.)
12 ; Buffer array does NOT necessarily start with line 1, but with line
13 ;0 if CONTENT contains W, or with number appropriate for where it will
14 ;be inserted into LM array.
15 ;
16 ; Requires INFO array, where INFO is either as set in NINFO^TIUFLLM if
17 ;entry is not yet in LM array, or is = ^TMP("TIUF*IDX,$J,LINENO) if
18 ;entry is already in LM array, and where INFO array is as set in
19 ;PARSE^TIUFLLM(INFO). FILEDA = INFO("FILEDA"), is entry in 8925.1.
20 ; Requires Array NODE0, set as TIUFNOD0 in NODE0ARR^TIUFLF. NODE0 is
21 ;enhanced 0 node of FILEDA.
22 ; Requires CONTENT = String of flags defining what information is set
23 ;into buffer array for FILEDA: parameters allowed: 80, H, C, A, J, D, O,
24 ;T, W. For more info on CONTENT see rtn TIUFLLM3.
25 ; Requires PFILEDA if CONTENT contains D, or T, where
26 ;PFILEDA=FILEDA of (anticipated) parent of entry.
27 ; Requires TIUFWHO, set in Options TIUF/A/C/H EDIT/SORT/CREATE DDEFS CLIN/MGR/NATL.
28 ; Can't use VALMDDEF since called by nontarget Template.
29 ;
30 N DIC,DIQ,DA,DR,MNEM,MENUTEXT,SEQUENCE,NUMBER,NAME,TIUREC,IFN
31 N TYPE,LP,LC,OWNER,TIUREC,STATUS,DDEFUSED,INUSE
32 N MNWIDTH,RESTCOL,NMCOLUMN,TIUFI,FILEDA,BOILPT,SHARE,POWNER,COWNER,ITEMS
33 N CONT80,CONTH,CONTC,CONTA,CONTJ,CONTD,CONTT,CONTW,CONTO
34 N PRINTNM,NATIONAL,FRACTION,BLANKS
35 ; If already had LM array node for entry and saved it (nothing changed except lineno) then put IT in buffer instead of getting all data again:
36 I $D(TIUFSAVE(INFO("FILEDA"))) D Q
37 . S TIUREC=TIUFSAVE(INFO("FILEDA")) S BLANKS=$L(+INFO)-$L(+TIUFSAVE(INFO("FILEDA")))
38 . S TIUREC=+INFO_$S(BLANKS=2:"",BLANKS:" ",1:" ")_$E(TIUREC,$L(+TIUFSAVE(INFO("FILEDA")))+3,500)
39 . S ^TMP("TIUFB",$J,+INFO,0)=TIUREC
40 . S ^TMP("TIUFBIDX",$J,+INFO)=INFO
41 S CONTH=$S(CONTENT["H":1,1:0),CONTC=$S(CONTENT["C":1,1:0),CONTA=$S(CONTENT["A":1,1:0)
42 S CONTJ=$S(CONTENT["J":1,1:0),CONTD=$S(CONTENT["D":1,1:0),CONTT=$S(CONTENT["T":1,1:0),CONTW=$S(CONTENT["W":1,1:0),CONT80=$S(+CONTENT:1,1:0),CONTO=$S(CONTENT["O":1,1:0)
43NUM ; Set Entry number
44 I CONTH!CONTA!CONTC!CONTJ!CONTT S NUMBER=$S(+INFO:+INFO,1:""),TIUREC=$$SETSTR^VALM1(NUMBER,"",1,5),NMCOLUMN=8
45 E S TIUREC="",NMCOLUMN=2
46NAME ; Set DDEF Name, Type into TIUREC:
47 S NAME=$P(NODE0,U),TYPE=$P(NODE0,U,4) S:TYPE="DOC" TYPE="TL"
48 I CONTH!CONTC S NAME=$J(NAME,$L(NAME)+(2*(INFO("LEVEL"))))
49 S TIUREC=$$SETSTR^VALM1(NAME,TIUREC,NMCOLUMN,$S(CONTD:37,CONTO:55,1:67))
50 I CONTH!CONTA!CONTC D
51 . I TYPE'="",NODE0("SHARE")="Yes" S TYPE=$E(TYPE,1,2)_" S"
52 . S TIUREC=$$SETSTR^VALM1(TYPE,TIUREC,77,4) Q
53 I CONTJ S STATUS=$E(NODE0("STATUS")),STATUS=$J(STATUS,6) S TIUREC=$$SETSTR^VALM1(STATUS,TIUREC,75,6)
54 ;
55 I $D(PFILEDA),CONTD!CONTT D
56 . K TIUFQ S DIC=8925.1,DA=PFILEDA,DIQ="TIUFQ",DR="10",DA(8925.14)=INFO("TENDA"),DR(8925.14)=".01:4" D EN^DIQ1
57 . S MNEM=TIUFQ(8925.14,INFO("TENDA"),2),MNEM=$J(MNEM,4)
58 . I TYPE'="CL",(TYPE'="DC") S MNEM=" "
59 . S MENUTEXT=TIUFQ(8925.14,INFO("TENDA"),4),SEQUENCE=TIUFQ(8925.14,INFO("TENDA"),3),FRACTION=$P(SEQUENCE,".",2),SEQUENCE=$S(FRACTION="":SEQUENCE_" ",$L(FRACTION)=1:SEQUENCE_" ",1:SEQUENCE_""),SEQUENCE=$J(SEQUENCE,6)
60 . K TIUFQ
61 I CONTT,SEQUENCE'="" S TIUREC=$$SETSTR^VALM1(SEQUENCE,TIUREC,75,6)
62 ;
63 S FILEDA=INFO("FILEDA")
64GET ; Get/Set the rest of the line:
65 S IFN=FILEDA,IFN=$J(IFN,7)
66 I CONT80!CONTH!CONTA!CONTC!CONTJ!CONTW D
67 . S NATIONAL=NODE0("NATL"),NATIONAL=$J(NATIONAL,4)
68 . S:TIUFTMPL'["J" INUSE=NODE0("INUSE"),INUSE=$J(INUSE,6)
69 . I TIUFTMPL'["J" S STATUS=$E(NODE0("STATUS")),STATUS=$J(STATUS,6) I $P(NODE0,U,10) S STATUS=" "
70 . S:TIUFTMPL'["J" BOILPT=NODE0("BOILPT"),BOILPT=$J(BOILPT,4)
71 . S:TIUFTMPL'["J" ITEMS=NODE0("ITEMS"),ITEMS=$J(ITEMS,5)
72 . S PRINTNM=$P(NODE0,U,3)
73 I CONT80!CONTH!CONTA!CONTC!CONTJ!CONTW!CONTO D
74 . S POWNER=$P(NODE0,U,5),LP=$L(POWNER)
75 . S COWNER=$P(NODE0,U,6),LC=$L(COWNER)
76 . I LP D
77 . . S POWNER=$G(^VA(200,POWNER,0))
78 . . I POWNER="" S POWNER="ERROR" Q
79 . . S POWNER=$S($L($P(POWNER,U,2)):$P(POWNER,U,2),1:$E($P(POWNER,U),1,7))
80 . I LC D
81 . . S COWNER=$$USRCLASS^USRLFF(COWNER) ; **43**
82 . . I COWNER="" S COWNER="ERROR" Q
83 . . S COWNER=$S($L($P(COWNER,U,2)):$P(COWNER,U,2),1:$E($P(COWNER,U),1,7))
84 . S OWNER=$S(LP&'LC:POWNER,LC&'LP:COWNER,LP&LC:$E(POWNER,1,3)_","_$E(COWNER,1,4),1:"")
85SET S RESTCOL=$S(CONT80:45,"NM"[TIUFWHO&CONTD:30,CONTD:41,CONTO:57,"C"[TIUFWHO&CONTT:91,1:82)
86 I CONT80 D G PLUS
87 . S TIUREC=$$SETSTR^VALM1(" "_TYPE,TIUREC,RESTCOL-1,5),RESTCOL=RESTCOL+6 ;RESTCOL=RESTCOL+LASTWIDTH +2
88 . S TIUREC=$$SETSTR^VALM1(" "_IFN,TIUREC,RESTCOL-2,9),RESTCOL=RESTCOL+9
89 . S TIUREC=$$SETSTR^VALM1(" "_NATIONAL,TIUREC,RESTCOL-2,6),RESTCOL=RESTCOL+6
90 . S TIUREC=$$SETSTR^VALM1(" "_STATUS,TIUREC,RESTCOL-2,8),RESTCOL=RESTCOL+8
91 . S TIUREC=$$SETSTR^VALM1(" "_OWNER,TIUREC,RESTCOL-2,9),RESTCOL=RESTCOL+9
92 I CONTO D
93 . S STATUS=$E(NODE0("STATUS")),STATUS=$J(STATUS,6) S TIUREC=$$SETSTR^VALM1(STATUS,TIUREC,RESTCOL,6),RESTCOL=RESTCOL+8
94 . S TIUREC=$$SETSTR^VALM1(OWNER,TIUREC,RESTCOL,7),RESTCOL=RESTCOL+9
95 I "NM"[TIUFWHO D
96 . I CONTD S TIUREC=$$SETSTR^VALM1(" ",TIUREC,RESTCOL,2),RESTCOL=RESTCOL+2
97 . S TIUREC=$$SETSTR^VALM1(IFN,TIUREC,RESTCOL,7),RESTCOL=RESTCOL+9 ;RESTCOL=RESTCOL+LASTWIDTH +2
98 I CONTH!CONTA!CONTC!CONTJ!CONTW D G PLUS
99 . S TIUREC=$$SETSTR^VALM1(NATIONAL,TIUREC,RESTCOL,4),RESTCOL=RESTCOL+6
100 . S:TIUFTMPL'["J" TIUREC=$$SETSTR^VALM1(STATUS,TIUREC,RESTCOL,6),RESTCOL=RESTCOL+8
101 . S TIUREC=$$SETSTR^VALM1(OWNER,TIUREC,RESTCOL,7),RESTCOL=RESTCOL+9
102 . S:TIUFTMPL'["J" TIUREC=$$SETSTR^VALM1($G(INUSE),TIUREC,RESTCOL,6),RESTCOL=RESTCOL+8
103 . S:TIUFTMPL'["J" TIUREC=$$SETSTR^VALM1(BOILPT,TIUREC,RESTCOL,4),RESTCOL=RESTCOL+6
104 . I CONTA S TIUREC=$$SETSTR^VALM1(ITEMS,TIUREC,RESTCOL,5),RESTCOL=RESTCOL+7
105 . S TIUREC=$$SETSTR^VALM1(PRINTNM,TIUREC,RESTCOL,60)
106 I CONTD!CONTT D
107 . S:CONTD TIUREC=$$SETSTR^VALM1(SEQUENCE,TIUREC,RESTCOL,6),RESTCOL=RESTCOL+8
108 . S TIUREC=$$SETSTR^VALM1(MNEM,TIUREC,RESTCOL,4),RESTCOL=RESTCOL+6
109 . S TIUREC=$$SETSTR^VALM1(MENUTEXT,TIUREC,RESTCOL,26)
110PLUS I CONTH S TIUREC=$$PLUSUP^TIUFLLM(.INFO,TIUREC)
111 I 'CONT80,'CONTO,'CONTD,'CONTT D RTSCROLL^TIUFLLM(.TIUREC,TYPE)
112 S ^TMP("TIUFB",$J,+INFO,0)=TIUREC
113 I 'CONTW D
114 . S ^TMP("TIUFBIDX",$J,+INFO)=INFO
115BUFEX Q
116 ;
Note: See TracBrowser for help on using the repository browser.