source: FOIAVistA/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIUPS137.m@ 1394

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

initial load of FOIAVistA 6/30/08 version
File size: 7.3 KB
Line 
1TIUPS137 ; SLC/MAM - After installing TIU*1*137;6/26/03
2 ;;1.0;Text Integration Utilities;**137**;Jun 20, 1997
3 ; Run this after installing patch 137.
4 ;Use option: TIU137 DDEFS & RULES, ANATPATH
5 ; External References
6 ; DBIA 10140 XREF^XQORM
7 ; DBIA 4119 MAIN^USRPS23
8BEGIN ; Create DDEFS
9 W !!,"This option creates Document Definitions, a User Class, and"
10 W !,"Business Rules for Laboratory Reports."
11 W ! K IOP S %ZIS="Q" D ^%ZIS I POP K POP Q
12 I $D(IO("Q")) K IO("Q") D Q
13 .S ZTRTN="MAIN^TIUPS137"
14 .S ZTDESC="Create DDefs, User Class, Rules for Laboratory Reports - TIU*1*137"
15 .D ^%ZTLOAD W !,$S($D(ZTSK):"Request Queued!",1:"Request Canceled!")
16 .K ZTSK,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE
17 .D HOME^%ZIS
18 U IO D MAIN,^%ZISC
19 Q
20 ;
21MAIN ; Create DDEFS for Laboratory Reports
22 ; -- Check for dups created after the install but before this option:
23 K ^XTMP("TIU137","DUPS"),^TMP("TIU137",$J)
24 D SETXTMP^TIUEN137
25 N TIUDUPS,TMPCNT,SILENT S TMPCNT=0
26 S TMPCNT=TMPCNT+1,^TMP("TIU137",$J,TMPCNT)=""
27 S TMPCNT=1,^TMP("TIU137",$J,TMPCNT)=" ***** Document Definitions for LABORATORY REPORTS *****"
28 S TMPCNT=TMPCNT+1,^TMP("TIU137",$J,TMPCNT)=""
29 S SILENT=1
30 D TIUDUPS^TIUEN137(.TIUDUPS,SILENT)
31 ; -- If potential duplicates exist, quit:
32 I $G(TIUDUPS) D G MAINX
33 . S ^XTMP("TIU137","DUPS")=1
34 . S TMPCNT=TMPCNT+1,^TMP("TIU137",$J,TMPCNT)="Duplicate problem. See description for patch TIU*1*137,"
35 . S TMPCNT=TMPCNT+1,^TMP("TIU137",$J,TMPCNT)="in the National Patch Module."
36 ; -- Set file data, other data for DDEFS:
37 D SETDATA^TIU137D
38 N NUM S NUM=0
39 F S NUM=$O(^XTMP("TIU137","BASICS",NUM)) Q:'NUM D
40 . N IEN,YDDEF,TIUDA
41 . ; -- If DDEF was previously created by this patch,
42 . ; say so and quit:
43 . S IEN=+$G(^XTMP("TIU137","BASICS",NUM,"DONE"))
44 . I IEN D Q
45 . . S TMPCNT=TMPCNT+1,^TMP("TIU137",$J,TMPCNT)=^XTMP("TIU137","FILEDATA",NUM,.04)_" "_^XTMP("TIU137","BASICS",NUM,"NAME")
46 . . S TMPCNT=TMPCNT+1,^TMP("TIU137",$J,TMPCNT)=" was already created in a previous install."
47 . . K ^XTMP("TIU137","FILEDATA",NUM)
48 . . K ^XTMP("TIU137","DATA",NUM)
49 . ; -- If not, create new DDEF:
50 . S YDDEF=$$CREATE(NUM)
51 . I +YDDEF'>0!($P(YDDEF,U,3)'=1) D Q
52 . . S TMPCNT=TMPCNT+1,^TMP("TIU137",$J,TMPCNT)="Couldn't create a "_^XTMP("TIU137","FILEDATA",NUM,.04)_" named "_^XTMP("TIU137","BASICS",NUM,"NAME")_".",TMPCNT=TMPCNT+1
53 . . S TMPCNT=TMPCNT+1,^TMP("TIU137",$J,TMPCNT)=" Please contact National VistA Support for help."
54 . S TMPCNT=TMPCNT+1,^TMP("TIU137",$J,TMPCNT)=^XTMP("TIU137","FILEDATA",NUM,.04)_" named "_^XTMP("TIU137","BASICS",NUM,"NAME")
55 . S TMPCNT=TMPCNT+1,^TMP("TIU137",$J,TMPCNT)=" created successfully."
56 . S TIUDA=+YDDEF
57 . ; -- File field data:
58 . D FILE(NUM,TIUDA,.TMPCNT)
59 . K ^XTMP("TIU137","FILEDATA",NUM)
60 . ; -- Add item to parent:
61 . D ADDITEM(NUM,TIUDA,.TMPCNT)
62 . K ^XTMP("TIU137","DATA",NUM)
63MAINX ;Exit
64 S TMPCNT=TMPCNT+1,^TMP("TIU137",$J,TMPCNT)=""
65 S TMPCNT=TMPCNT+1,^TMP("TIU137",$J,TMPCNT)=" *************"
66 I '$G(^XTMP("TIU137","DUPS")) D MAIN^USRPS23
67 D PRINT
68 K ^TMP("TIU137",$J),^TMP("USR23",$J)
69 Q
70 ;
71PRINT ; Print out results
72 N TIUCNT,TIUCONT
73 I $D(ZTQUEUED) S ZTREQ="@" ; Tell TaskMan to delete Task log entry
74 I $E(IOST)="C" W @IOF,!
75 S TIUCNT="",TIUCONT=1
76 F S TIUCNT=$O(^TMP("TIU137",$J,TIUCNT)) Q:TIUCNT="" D Q:'TIUCONT
77 . S TIUCONT=$$SETCONT Q:'TIUCONT
78 . W ^TMP("TIU137",$J,TIUCNT),!
79 Q:'TIUCONT
80 S TIUCNT=""
81 F S TIUCNT=$O(^TMP("USR23",$J,TIUCNT)) Q:TIUCNT="" D Q:'TIUCONT
82 . S TIUCONT=$$SETCONT Q:'TIUCONT
83 . W ^TMP("USR23",$J,TIUCNT),!
84PRINTX Q
85 ;
86STOP() ;on screen paging check
87 ; quits TIUCONT=1 if cont. ELSE quits TIUCONT=0
88 N DIR,Y,TIUCONT
89 S DIR(0)="E" D ^DIR
90 S TIUCONT=Y
91 I TIUCONT W @IOF,!
92 Q TIUCONT
93 ;
94SETCONT() ; D form feed, Set TIUCONT
95 N TIUCONT
96 S TIUCONT=1
97 I $E(IOST)="C" G SETX:$Y+5<IOSL
98 I $E(IOST)="C" S TIUCONT=$$STOP G SETX
99 G:$Y+8<IOSL SETX
100 W @IOF
101SETX Q TIUCONT
102 ;
103SERIAL ; Serialize Menu Items of Class Clinical Documents
104 ;since it has a new item under it
105 N DA,DIE,DR,X,Y,D,D0,DI,DQ
106 ; -- Reset Sequence, Mnemonic for items of Clinical Docs:
107 N TIUI,TIUFPRIV
108 S (DA,TIUI)=0,DA(1)=38,TIUFPRIV=1
109 S DIE="^TIU(8925.1,DA(1),10,"
110 F S DA=$O(^TIU(8925.1,38,10,DA)) Q:+DA'>0 D
111 . S TIUI=TIUI+1,DR="2////^S X=TIUI;3////^S X=TIUI" D ^DIE
112 ; -- Re-compile menu for Select CLINICAL DOCUMENTS Type(s),
113 ; under Multiple Patient Documents/Integrated Document Management.
114 ; Updates ^TIU(8925.1,38,99), which triggers ^XUTL update.
115 N XQORM,X,Y,ORULT
116 S XQORM="38;TIU(8925.1,"
117 D XREF^XQORM
118 Q
119 ;
120PARENT(NUM) ; Return IEN of parent new DDEF should be added to
121 N PIEN,PNUM
122 ; Parent node has form:
123 ; -- PIEN node = IEN of parent if known, or if not,
124 ; PNUM node = DDEF# of parent
125 ;^XTMP("TIU137","DATA",1,"PIEN")=38
126 S PIEN=$G(^XTMP("TIU137","DATA",NUM,"PIEN"))
127 ; -- If parent IEN is known, we're done:
128 I +PIEN G PARENTX
129 ; -- If not, get DDEF# of parent
130 S PNUM=$G(^XTMP("TIU137","DATA",NUM,"PNUM"))
131 I 'PNUM Q 0
132 ; -- Get Parent IEN from "DONE" node, which was set
133 ; when parent was created:
134 S PIEN=+$G(^XTMP("TIU137","BASICS",PNUM,"DONE"))
135PARENTX Q PIEN
136 ;
137ADDITEM(NUM,TIUDA,TMPCNT) ; Add DDEF to Parent; Set item fields
138 N PIEN,MENUTXT,TIUFPRIV,TIUFISCR
139 N DIE,DR
140 S TIUFPRIV=1
141 S PIEN=$$PARENT(NUM)
142 I 'PIEN!'$D(^TIU(8925.1,PIEN,0))!'$D(^TIU(8925.1,TIUDA,0)) K PIEN G ADDX
143 N DA,DIC,DLAYGO,X,Y
144 N I,DIY
145 S DA(1)=PIEN
146 S DIC="^TIU(8925.1,"_DA(1)_",10,",DIC(0)="LX"
147 S DLAYGO=8925.14
148 ;S X="`"_TIUDA
149 ; -- If TIUDA is say, x, and Parent has x as IFN in Item subfile,
150 ; code finds item x under parent instead of creating a new item,
151 ; so don't use "`"_TIUDA:
152 S X=^XTMP("TIU137","BASICS",NUM,"NAME")
153 ; -- Make sure the DDEF it adds is TIUDA and not another w same name:
154 S TIUFISCR=TIUDA ; activates screen on fld 10, Subfld .01 in DD
155 D ^DIC I Y'>0!($P(Y,U,3)'=1) K PIEN G ADDX
156 ; -- Set Menu Text:
157 S MENUTXT=$G(^XTMP("TIU137","DATA",NUM,"MENUTXT"))
158 I $L(MENUTXT) D
159 . N DA,DIE,DR
160 . N D,D0,DI,DQ
161 . S DA(1)=PIEN
162 . S DA=+Y,DIE=DIC
163 . S DR="4////^S X=MENUTXT"
164 . D ^DIE
165ADDX ; -- Tell user about adding to parent:
166 I '$G(PIEN) D
167 . S TMPCNT=TMPCNT+1,^TMP("TIU137",$J,TMPCNT)=" Couldn't add entry to parent. Please contact National VistA Support"
168 . S TMPCNT=TMPCNT+1,^TMP("TIU137",$J,TMPCNT)=" for help."
169 E S TMPCNT=TMPCNT+1,^TMP("TIU137",$J,TMPCNT)=" Entry added to parent."
170 ; -- If just added Class LR LABORATORY REPORTS to CLINICAL
171 ; DOCUMENTS, serialize menu items of CLIN DOC:
172 I NUM=1 D SERIAL
173 Q
174 ;
175FILE(NUM,TIUDA,TMPCNT) ; File fields for new entry TIUDA
176 ; Files ALL FIELDS set in "FILEDATA" nodes of ^XTMP:
177 ; ^XTMP("TIU137","FILEDATA",NUM,Field#)
178 N TIUFPRIV,FDA,TIUERR
179 S TIUFPRIV=1
180 M FDA(8925.1,TIUDA_",")=^XTMP("TIU137","FILEDATA",NUM)
181 D FILE^DIE("TE","FDA","TIUERR")
182 I $D(TIUERR) S TMPCNT=TMPCNT+1,^TMP("TIU137",$J,TMPCNT)=" Problem filing data for entry. Please contact National VistA Support."
183 E S TMPCNT=TMPCNT+1,^TMP("TIU137",$J,TMPCNT)=" Data for entry filed successfully."
184 Q
185 ;
186CREATE(NUM) ; Create new DDEF entry
187 N DIC,DLAYGO,DA,X,Y,TIUFPRIV
188 S TIUFPRIV=1
189 ;S (DIC,DLAYGO)="^TIU(8925.1,"
190 ;-- CACHE won't take global root for DLAYGO; use file number:
191 S DIC="^TIU(8925.1,",DLAYGO=8925.1
192 S DIC(0)="LX",X=^XTMP("TIU137","BASICS",NUM,"NAME")
193 S DIC("S")="I $P(^(0),U,4)="_""""_^XTMP("TIU137","BASICS",NUM,"INTTYPE")_""""
194 D ^DIC
195 ; -- If DDEF was just created, set "DONE" node = IEN
196 I $P(Y,U,3)=1 S ^XTMP("TIU137","BASICS",NUM,"DONE")=+$G(Y)
197 Q $G(Y)
Note: See TracBrowser for help on using the repository browser.