source: WorldVistAEHR/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIUP171P.m@ 975

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

initial load of WorldVistAEHR

File size: 7.8 KB
Line 
1TIUP171P ; SLC/JMH - Post install for TIU*1.0*171 [12/7/04 8:19am]
2 ;;1.0;TEXT INTEGRATION UTILITIES;**171**;Jun 20,1997
3 D ENV
4 Q
5POST ;
6 N TIUFPRIV S TIUFPRIV=1
7 D ENV
8 I $G(XPDQUIT)=2
9 W !
10 N TIUQ,X,X1,X2
11 S TIUQ=0
12 K ^TMP("TIUP171",$J)
13 S X1=DT,X2=90 D C^%DTC
14 S ^XTMP("TIUP171",0)=X_"^"_DT
15 F NUM=1:1:21 D Q:+TIUQ
16 . N TIUDA
17 . ;set data array
18 . I '$$SETDATA(NUM) S TIUQ="1^SETDATA^"_NUM Q
19 . ;check if patch already installed this one
20 . I $$ALREADY(NUM) W NUM,":" D UPDATE(NUM) Q
21 . ;get new ddef ien
22 . I '$$CREATE(NUM) S TIUQ="1^CREATE^"_NUM Q
23 . ;file data
24 . I '$$FILE(NUM) S TIUQ="1^FILE^"_NUM Q
25 . ;add item to parent class
26 . I '$$ADDITEM(NUM) S TIUQ="1^ADDITEM^"_NUM Q
27POSTX ;
28 I +TIUQ D MESSAGE(TIUQ)
29 K ^TMP("TIUP171",$J)
30 W "...DONE"
31 Q
32ALREADY(NUM) ;
33 N NAME,IEN
34 S NAME=^TMP("TIUP171",$J,NUM,"DATA",.01)
35 S IEN=$O(^TIU(8925.1,"B",NAME,0))
36 I 'IEN Q 0
37 I $D(^XTMP("TIUP171",IEN)) Q 1
38 Q 0
39MESSAGE(TIUQ) ;
40 N CNT,NUM,LINE
41 S CNT="",NUM=$P(TIUQ,U,3)
42 S LINE=$P($T(DATA+NUM),";;",2,99)
43 W !!,"Error while creating Document Definition"
44 W !," ",$P(LINE,U)
45 W !!,$G(^TMP("TIUP171",$J,"ERROR"))
46 W !!,"The Document Definitions that were already created by this "
47 W !," patch will remain on your system. You will need to"
48 W !," resolve the above error(s) and reinstall the patch to"
49 W !," get the remaining Document Definitions."
50 Q
51SETDATA(NUM) ;
52 N LINE,PIEN
53 S LINE=$P($T(DATA+NUM),";;",2,99)
54 I '$D(LINE) Q 0
55 S ^TMP("TIUP171",$J,NUM,"DATA",.01)=$P(LINE,U,1)
56 S ^TMP("TIUP171",$J,NUM,"DATA",.02)=$P(LINE,U,2)
57 S ^TMP("TIUP171",$J,NUM,"DATA",.03)=$P(LINE,U,4)
58 S ^TMP("TIUP171",$J,NUM,"DATA",.04)=$P(LINE,U,5)
59 S ^TMP("TIUP171",$J,NUM,"DATA",.06)="CLINICAL COORDINATOR"
60 S ^TMP("TIUP171",$J,NUM,"DATA",.07)="ACTIVE"
61 S ^TMP("TIUP171",$J,NUM,"DATA",.13)="YES"
62 I $P(LINE,U,5)="O" D
63 . N CODE S CODE=$P(LINE,U,6)
64 . S ^TMP("TIUP171",$J,NUM,"DATA",9)=$TR(CODE,"#","^")
65 I $P(LINE,U,5)'="O" D
66 . S ^TMP("TIUP171",$J,NUM,"ITEM",4)=$P(LINE,U,7)
67 I +$$PARENT(NUM)=0 D Q 0
68 . N PARENT,TYPE
69 . S TYPE="DOCUMENT CLASS"
70 . I NUM=1 S TYPE="CLASS"
71 . S PARENT=$P(LINE,U,3)
72 . S ^TMP("TIUP171",$J,"ERROR")="Could not locate "_PARENT_" "_TYPE_" while attempting to create Document Definition."
73 Q 1
74CREATE(NUM) ;
75 N DIC,DLAYGO,DA,X,Y
76 S DIC="^TIU(8925.1,",DLAYGO=8925.1
77 S DIC(0)="LX",X=^TMP("TIUP171",$J,NUM,"DATA",.01)
78 S DIC("S")="I $P(^(0),U,4)="_""""_^TMP("TIUP171",$J,NUM,"DATA",.04)_""""
79 D ^DIC
80 I $P($G(Y),U,3)'=1 D Q 0
81 . S ^TMP("TIUP171",$J,"ERROR")="Could not create the Document Definition. There could be another entry with the same name that already exists."
82 S ^TMP("TIUP171",$J,NUM,"TIUDA")=+Y
83 S ^XTMP("TIUP171",+Y)=""
84 Q 1
85FILE(NUM) ;
86 N TIUFPRIV,FDA,TIUDA,ERROR
87 K ^TMP("DIERR",$J)
88 S TIUDA=$G(^TMP("TIUP171",$J,NUM,"TIUDA"))
89 S TIUFPRIV=1
90 M FDA(8925.1,TIUDA_",")=^TMP("TIUP171",$J,NUM,"DATA")
91 D FILE^DIE("TE","FDA","ERROR")
92 I $D(ERROR) D Q 0
93 . S ^TMP("TIUP171",$J,"ERROR")="Could not file the Document Definition. Fileman error message: "_$G(ERROR("DIERR",1))
94 Q 1
95ADDITEM(NUM) ;
96 N DA,DIC,DLAYGO,X,TIUDA,TIUFISC,Y,TIUFPRIV,DIE,DR
97 I '$D(^TMP("TIUP171",$J,NUM,"PARENT")) Q 1
98 S TIUFPRIV=1
99 S DA(1)=^TMP("TIUP171",$J,NUM,"PARENT")
100 S DIC="^TIU(8925.1,"_DA(1)_",10,",DIC(0)="LX"
101 S DLAYGO=8925.14
102 S X=^TMP("TIUP171",$J,NUM,"DATA",.01)
103 S TIUDA=^TMP("TIUP171",$J,NUM,"TIUDA")
104 S TIUFISC=TIUDA
105 D ^DIC
106 I Y'>0!($P(Y,U,3)'=1) D Q 0
107 . S ^TMP("TIUP171",$J,"ERROR")="Could not add the item parent."
108 I $D(^TMP("TIUP171",$J,NUM,"ITEM",4)) D
109 . N SUB,ROOT,IENS,FDA
110 . S SUB=$O(^TIU(8925.1,DA(1),10,"B",TIUDA,""))
111 . S IENS=SUB_","_DA(1)
112 . S ROOT(8925.14,IENS,4)=^TMP("TIUP171",$J,NUM,"ITEM",4)
113 . S FDA="ROOT"
114 . D FILE^DIE("ET",FDA)
115 Q 1
116PARENT(NUM) ;
117 N NAME,PIEN
118 S LINE=$P($T(DATA+NUM),";;",2,99)
119 S NAME=$P(LINE,U,3)
120 I NAME="" Q -1
121 S PIEN=$O(^TIU(8925.1,"B",NAME,""))
122 S ^TMP("TIUP171",$J,NUM,"PARENT")=PIEN
123 Q PIEN
124ROLLBACK ;
125 N TIUIEN
126 S TIUIEN=""
127 F S TIUIEN=$O(^XTMP("TIUP171",TIUIEN),-1) Q:'TIUIEN D
128 . D ITEMRB(TIUIEN)
129 . S DIK="^TIU(8925.1,",DA=TIUIEN
130 . D ^DIK
131 . K ^XTMP("TIUP171",TIUIEN)
132 Q
133ITEMRB(TIUDA) ;
134 N DA,DIK
135 S DA(1)=$O(^TIU(8925.1,"AD",TIUDA,""))
136 Q:'DA(1)
137 S DA=$O(^TIU(8925.1,DA(1),10,"B",TIUDA,""))
138 Q:'DA
139 S DIK="^TIU(8925.1,"_DA(1)_",10,"
140 D ^DIK
141 Q
142ENV ;
143 N CNT,NUM,X,X1,X2
144 K ^TMP("TIUP171",$J)
145 S X1=DT,X2=90 D C^%DTC
146 S ^XTMP("TIUP171",0)=X_"^"_DT
147 S CNT=0
148 ;check for the ASU Class "CLINICAL COORDINATOR"
149 I $O(^USR(8930,"B","CLINICAL COORDINATOR",""))="" D
150 . S CNT=CNT+1
151 . S ^TMP("TIUP171",$J,"ENV",CNT)="Cannot Find the CLINICAL COORDINATOR User Class"
152 ;check for the Class "PROGRESS NOTES"
153 I $O(^TIU(8925.1,"B","PROGRESS NOTES",""))="" D
154 . S CNT=CNT+1
155 . S ^TMP("TIUP171",$J,"ENV",CNT)="Cannot Find the PROGRESS NOTES Document Definition CLASS"
156 ;look for duplicates of entries this patch will add
157 F NUM=1:1:21 D
158 . N LINE,NAME,DA
159 . S DA=""
160 . S LINE=$P($T(DATA+NUM),";;",2,99)
161 . S NAME=$P(LINE,U,1)
162 . F S DA=$O(^TIU(8925.1,"B",NAME,DA)) Q:'DA D
163 . . I $D(^XTMP("TIUP171",DA)) Q
164 . . I $P(LINE,U,5)=$P($G(^TIU(8925.1,DA,0)),U,4) D
165 . . . I $P($G(^TIU(8925.1,DA,0)),U,13) S ^XTMP("TIUP171",DA)="" Q
166 . . . S CNT=CNT+1
167 . . . S ^TMP("TIUP171",$J,"ENV",CNT)="A Doc. Definition of type "_$P(LINE,U,5)_" named "_NAME_" already exists."
168 I $D(^TMP("TIUP171",$J,"ENV")) D
169 . S XPDQUIT=2
170 . W !!,"ENVIRONMENTAL CHECK - PROBLEMS REPORT FOR TIU*1*171"
171 . W !,"========================================================"
172 . W !!,"Patch TIU*1*171 cannot complete installation due to the following issue(s):",!
173 . N DA
174 . S DA=""
175 . F S DA=$O(^TMP("TIUP171",$J,"ENV",DA)) Q:'DA D
176 . . W !,^TMP("TIUP171",$J,"ENV",DA)
177 . W !!,"These issues must be addressed before the patch can be installed."
178 . W !!,"Please share this report with the Clinical Applications Coordinator"
179 . W !,"responsible for the TIU application so that he/she can make the"
180 . W !,"necessary corrections."
181 I '$D(^TMP("TIUP171",$J,"ENV")) W !!,"Environmental Check Results: No Problems"
182 K ^TMP("TIUP171",$J)
183 Q
184UPDATE(NUM) ;
185 N DA,NAME
186 S NAME=^TMP("TIUP171",$J,NUM,"DATA",.01)
187 S DA=$O(^TIU(8925.1,"B",NAME,0))
188 I 'DA Q
189 N DIE,DR
190 S DIE=8925.1,DR=".03///"_$G(^TMP("TIUP171",$J,NUM,"DATA",.03)) D ^DIE
191 W " ",DA," UPDATED "_$G(^TMP("TIUP171",$J,NUM,"DATA",.03)),!
192 Q
193DATA ;
194 ;;SCI OUTCOMES^SCIO^PROGRESS NOTES^SCI OUTCOMES^DC^^SCI-OUTCOMES
195 ;;SCI FUNCTIONAL INDEPENDENCE MEASURE^SCIF^SCI OUTCOMES^SCI FUNCTIONAL INDEPENDENCE MEASURE^DOC^^SCI FIM
196 ;;SCI GENERAL NOTE^SCIG^SCI OUTCOMES^SCI GENERAL NOTE^DOC^^SCI General Note
197 ;;SCI CRAIG HANDICAP ASSESSMENT&REPORTING TECHNIQUE-SHORT FORM^SCIC^SCI OUTCOMES^SCI CRAIG HANDICAP ASSESSMENT&REPORTING TECHNIQUE-SHORT FORM^DOC^^SCI CHARTSF
198 ;;SCI DIENER SATISFACTION WITH LIFE SCALE^SCIS^SCI OUTCOMES^SCI DIENER SATISFACTION WITH LIFE SCALE^DOC^^SCI Diener SWLS
199 ;;SCI BOWEL CARE DATE CERTIFIED^BCDC^^SCI BOWEL CARE DATE CERTIFIED^O^S X=$$BCDC#SPNOBJ(DFN)
200 ;;SCI BOWEL CARE PROVIDER^BCP^^SCI BOWEL CARE PROVIDER^O^S X=$$BCPROV#SPNOBJ(DFN)
201 ;;SCI BOWEL CARE REIMBURSEMENT^BCR^^SCI BOWEL CARE REIMBURSEMENT^O^S X=$$BCREIMB#SPNOBJ(DFN)
202 ;;SCI ENROLLMENT PRIORITY^ENPR^^SCI ENROLLMENT PRIORITY^O^S X=$$EP#SPNOBJ(DFN)
203 ;;SCI ETIOLOGY^ETIO^^SCI ETIOLOGY^O^S X=$$EN#SPNETOBJ(DFN)
204 ;;SCI EXTENT OF SCI^ESCI^^SCI EXTENT OF SCI^O^S X=$$EXTNT#SPNOBJ(DFN)
205 ;;SCI LAST ANNUAL EVAL OFFERED^LAEO^^SCI LAST ANNUAL EVAL OFFERED^O^S X=$$LOFF#SPNOBJ(DFN)
206 ;;SCI LAST ANNUAL EVAL RECEIVED^LAER^^SCI LAST ANNUAL EVAL RECEIVED^O^S X=$$LREC#SPNOBJ(DFN)
207 ;;SCI MARITAL STATUS^MARS^^SCI MARITAL STATUS^O^S X=$$MAR#SPNOBJ(DFN)
208 ;;SCI MULTIPLE SCLEROSIS SUB TYPE^MSST^^SCI MULTIPLE SCLEROSIS SUB TYPE^O^S X=$$MSSUBT#SPNOBJ(DFN)
209 ;;SCI PRIMARY CARE PROVIDER^PCP^^SCI PRIMARY CARE PROVIDER^O^S X=$$PCPROV#SPNOBJ(DFN)
210 ;;SCI REGISTRATION STATUS^REGS^^SCI REGISTRATION STATUS^O^S X=$$RSTAT#SPNOBJ(DFN)
211 ;;SCI REMARKS^RMKS^^SCI REMARKS^O^S X=$$REMARKS#SPNOBJ(DFN)
212 ;;SCI SCD COORDINATOR^SCRD^^SCI SCD COORDINATOR^O^S X=$$SCDCOOR#SPNOBJ(DFN)
213 ;;SCI LEVEL^SLEV^^SCI LEVEL^O^S X=$$SCILEV#SPNOBJ(DFN)
214 ;;SCI VA SCI STATUS^VAST^^SCI VA SCI STATUS^O^S X=$$VASCI#SPNOBJ(DFN)
215 Q
Note: See TracBrowser for help on using the repository browser.