source: WorldVistAEHR/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIUPS165.m@ 1394

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

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