source: WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMP6IM.m@ 789

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

initial load of WorldVistAEHR
File size: 7.5 KB
Line 
1PXRMP6IM ; SLC/PKR - Inits for PXRM*2.0*6 ;11/08/2007
2 ;;2.0;CLINICAL REMINDERS;**6**;Feb 04, 2005;Build 123
3 ;========================
4ENVCHK ;Environment check.
5 I '$$PATCH^XPDUTL("YS*5.01*85") D Q
6 . W !,"The required patch YS*5.01*85 is not installed, therefore PXRM*2.0*6 cannot"
7 . W !,"be installed."
8 . S XPDABORT=1
9 N NLINES
10 D HMHPTRS^PXRMP6IM(.NLINES,0)
11 I NLINES>0 D
12 . W !,"There are MH findings that cannot be converted; reminders, terms, and"
13 . W !,"dialogs using these findings will not work properly."
14 . W !!,"A message giving the details has been sent to the reminders mail group."
15 . N ANS
16 . S ANS=$$ASKYN^PXRMEUT("Y","Continue the installation")
17 . I ANS=0 S XPDABORT=1
18 ;Don't ask about disabling options and protocols since we are taking
19 ;care of them automatically.
20 S XPDDIQ("XPZ1")=0
21 ;Make the default for inhibiting logins NO.
22 S XPDDIQ("XPI1","B")="NO"
23 Q
24 ;
25 ;========================
26HMHPTRS(NLINES,REPOINT) ;Handle MH pointers. Check for 601 tests that are
27 ;obsolete and change existing MH pointers in definitions, terms,
28 ;and dialogs to point the new global 601.71.
29 N DNAME,DTYPE,EM,FI,IEN,IENS,MHNAME,MSG,NEWPTR,NEWSC,NNCONV
30 N OLDPTR,OLDSC,RNAME
31 N STATUS,TEMP,TERMNAME,TEXT,TNAME,YS,YSCODE,YSDATA
32 K ^TMP($J,"MH"),^TMP("PXRMXMZ",$J)
33 ;Check definitions.
34 S (IEN,NLINES,NNCONV)=0
35 F S IEN=+$O(^PXD(811.9,IEN)) Q:IEN=0 D
36 . I '$D(^PXD(811.9,IEN,20,"E","YTT(601,")) Q
37 . S TEMP=^PXD(811.9,IEN,0)
38 . S RNAME=$P(TEMP,U,1)
39 . I REPOINT D
40 .. S TEXT="Changing MH pointers in reminder definition "_RNAME_" IEN="_IEN
41 .. D BMES^XPDUTL(.TEXT)
42 . S STATUS=$S($P(TEMP,U,6)=1:"INACTIVE",1:"ACTIVE")
43 . S ^TMP($J,"MH",RNAME)=STATUS
44 . S OLDPTR=""
45 . F S OLDPTR=$O(^PXD(811.9,IEN,20,"E","YTT(601,",OLDPTR)) Q:OLDPTR="" D
46 .. S FI=0
47 .. F S FI=$O(^PXD(811.9,IEN,20,"E","YTT(601,",OLDPTR,FI)) Q:FI="" D
48 ... K YS,YSDATA
49 ... S YS("YS601")=OLDPTR
50 ...;DBIA #5043
51 ... D CONVERT^YTQPXRM6(.YSDATA,.YS)
52 ... S NEWPTR=$P(YSDATA(2),U,1)
53 ... I YSDATA(1)="[ERROR]" D
54 .... S NEWPTR=109
55 .... S MHNAME=$$GET1^DIQ(601,OLDPTR,.01,"","","")
56 .... S NNCONV=NNCONV+1
57 .... S ^TMP($J,"MH",RNAME,"FINDING",FI)=MHNAME
58 ... I REPOINT D
59 .... S TEXT="Converting finding number "_FI
60 .... D MES^XPDUTL(.TEXT)
61 .... S IENS=FI_","_IEN_","
62 .... D UPDATE(811.902,IENS,.01,NEWPTR)
63 ....;Convert the scale.
64 .... S OLDSC=$P(^PXD(811.9,IEN,20,FI,0),U,12)
65 ....;DBIA #5042
66 .... S NEWSC=$S(OLDSC'="":$$OLDNEW^YTQPXRM3(NEWPTR,OLDSC),1:"")
67 .... S $P(^PXD(811.9,IEN,20,FI,0),U,12)=NEWSC
68 ;Format the message.
69 I NNCONV>0 D
70 . S NLINES=0,RNAME=""
71 . F S RNAME=$O(^TMP($J,"MH",RNAME)) Q:RNAME="" D
72 .. I '$D(^TMP($J,"MH",RNAME,"FINDING")) Q
73 .. S TEXT="Reminder "_RNAME_", status "_^TMP($J,"MH",RNAME)_", has the following MH findings which cannot be converted:"
74 .. S NLINES=NLINES+1,^TMP("PXRMXMZ",$J,NLINES,0)=TEXT
75 .. S FI=""
76 .. F S FI=$O(^TMP($J,"MH",RNAME,"FINDING",FI)) Q:FI="" D
77 ... S TEXT=" Finding number "_FI_", MH instrument "_^TMP($J,"MH",RNAME,"FINDING",FI)
78 ... S NLINES=NLINES+1,^TMP("PXRMXMZ",$J,NLINES,0)=TEXT
79 .. S TEXT="This reminder will not function properly until it is repaired."
80 .. S NLINES=NLINES+1,^TMP("PXRMXMZ",$J,NLINES,0)=TEXT
81 .. S NLINES=NLINES+1,^TMP("PXRMXMZ",$J,NLINES,0)=" "
82 ;
83 ;Check terms.
84 K ^TMP($J,"MH")
85 S (IEN,NNCONV)=0
86 F S IEN=+$O(^PXRMD(811.5,IEN)) Q:IEN=0 D
87 . I '$D(^PXRMD(811.5,IEN,20,"E","YTT(601,")) Q
88 . S TEMP=^PXRMD(811.5,IEN,0)
89 . S TERMNAME=$P(TEMP,U,1)
90 . I REPOINT D
91 .. S TEXT="Changing MH pointers in reminder term "_TERMNAME_" IEN="_IEN
92 .. D BMES^XPDUTL(.TEXT)
93 . S STATUS=$S($P(TEMP,U,6)=1:"INACTIVE",1:"ACTIVE")
94 . S ^TMP($J,"MH",TERMNAME)=STATUS
95 . S OLDPTR=""
96 . F S OLDPTR=$O(^PXRMD(811.5,IEN,20,"E","YTT(601,",OLDPTR)) Q:OLDPTR="" D
97 .. S FI=0
98 .. F S FI=$O(^PXRMD(811.5,IEN,20,"E","YTT(601,",OLDPTR,FI)) Q:FI="" D
99 ... K YS,YSDATA
100 ... S YS("YS601")=OLDPTR
101 ... D CONVERT^YTQPXRM6(.YSDATA,.YS)
102 ... S NEWPTR=$P(YSDATA(2),U,1)
103 ... I YSDATA(1)="[ERROR]" D
104 .... S NEWPTR=109
105 .... S MHNAME=$$GET1^DIQ(601,OLDPTR,.01,"","","")
106 .... S NNCONV=NNCONV+1
107 .... S ^TMP($J,"MH",TERMNAME,"FINDING",FI)=MHNAME
108 ... I REPOINT D
109 .... S TEXT="Converting finding number "_FI
110 .... D MES^XPDUTL(.TEXT)
111 .... S IENS=FI_","_IEN_","
112 .... D UPDATE(811.52,IENS,.01,NEWPTR)
113 ....;Convert the scale.
114 .... S OLDSC=$P(^PXRMD(811.5,IEN,20,FI,0),U,12)
115 ....;DBIA #5042
116 .... S NEWSC=$S(OLDSC'="":$$OLDNEW^YTQPXRM3(NEWPTR,OLDSC),1:"")
117 .... S $P(^PXRMD(811.5,IEN,20,FI,0),U,12)=NEWSC
118 ;Format the message.
119 I NNCONV>0 D
120 . S TERMNAME=""
121 . F S TERMNAME=$O(^TMP($J,"MH",TERMNAME)) Q:TERMNAME="" D
122 .. I '$D(^TMP($J,"MH",TERMNAME,"FINDING")) Q
123 .. S TEXT="Term "_TERMNAME_", status "_^TMP($J,"MH",TERMNAME)_", has the following MH findings which cannot be converted:"
124 .. S NLINES=NLINES+1,^TMP("PXRMXMZ",$J,NLINES,0)=TEXT
125 .. S FI=""
126 .. F S FI=$O(^TMP($J,"MH",TERMNAME,"FINDING",FI)) Q:FI="" D
127 ... S TEXT=" Finding number "_FI_", MH instrument "_^TMP($J,"MH",TERMNAME,"FINDING",FI)
128 ... S NLINES=NLINES+1,^TMP("PXRMXMZ",$J,NLINES,0)=TEXT
129 .. S TEXT="This term will not function properly until it is repaired."
130 .. S NLINES=NLINES+1,^TMP("PXRMXMZ",$J,NLINES,0)=TEXT
131 .. S NLINES=NLINES+1,^TMP("PXRMXMZ",$J,NLINES,0)=" "
132 ;
133 ;Check dialogs.
134 N PXRMINST
135 S PXRMINST=1
136 K ^TMP($J,"MH")
137 S (IEN,NNCONV)=0
138 F S IEN=+$O(^PXRMD(801.41,IEN)) Q:IEN=0 D
139 . I $P($G(^PXRMD(801.41,IEN,1)),U,5)'["YTT(601," Q
140 . S TEMP=^PXRMD(801.41,IEN,0)
141 . S DNAME=$P(TEMP,U,1)
142 . S DTYPE=$P(TEMP,U,4)
143 . S STATUS=$S($P(TEMP,U,3)=1:"DISABLE",1:"ACTIVE")
144 . S ^TMP($J,"MH",DNAME)=STATUS_U_DTYPE
145 . I REPOINT D
146 .. S TEXT="Changing MH pointers in reminder dialog "_DNAME_" IEN="_IEN
147 .. D BMES^XPDUTL(.TEXT)
148 . S OLDPTR=$P($P(^PXRMD(801.41,IEN,1),U,5),";")
149 . K YS,YSDATA
150 . S YS("YS601")=OLDPTR
151 . D CONVERT^YTQPXRM6(.YSDATA,.YS)
152 . S NEWPTR=$P(YSDATA(2),U,1)
153 . I (YSDATA(1)="[ERROR]")!(NEWPTR="dropped") D
154 .. S NEWPTR=109
155 .. S MHNAME=$$GET1^DIQ(601,OLDPTR,.01,"","","")
156 .. S NNCONV=NNCONV+1
157 .. S ^TMP($J,"MH",DNAME,"FINDING",1)=MHNAME
158 . I REPOINT D
159 .. S IENS=IEN_","
160 .. D UPDATE(801.41,IENS,15,NEWPTR)
161 ;Format the message.
162 I NNCONV>0 D
163 . S DNAME=""
164 . F S DNAME=$O(^TMP($J,"MH",DNAME)) Q:DNAME="" D
165 .. I '$D(^TMP($J,"MH",DNAME,"FINDING")) Q
166 .. S STATUS=$P(^TMP($J,"MH",DNAME),U,1)
167 .. S DTYPE=$P(^TMP($J,"MH",DNAME),U,2)
168 .. S DTYPE=$$EXTERNAL^DILFD(801.41,4,"",DTYPE,.EM)
169 .. S TEXT="Dialog entry "_DNAME_", type "_DTYPE_", status "_STATUS_", has the following MH findings which cannot be converted:"
170 .. S NLINES=NLINES+1,^TMP("PXRMXMZ",$J,NLINES,0)=TEXT
171 .. S FI=""
172 .. F S FI=$O(^TMP($J,"MH",DNAME,"FINDING",FI)) Q:FI="" D
173 ... S TEXT=" Finding number "_FI_", MH instrument "_^TMP($J,"MH",DNAME,"FINDING",FI)
174 ... S NLINES=NLINES+1,^TMP("PXRMXMZ",$J,NLINES,0)=TEXT
175 .. S TEXT="This dialog will not function properly until it is repaired."
176 .. S NLINES=NLINES+1,^TMP("PXRMXMZ",$J,NLINES,0)=TEXT
177 .. S NLINES=NLINES+1,^TMP("PXRMXMZ",$J,NLINES,0)=" "
178 . S TEXT="For instructions on what to do with these entries see the PXRM*2*6"
179 . S NLINES=NLINES+1,^TMP("PXRMXMZ",$J,NLINES,0)=TEXT
180 . S TEXT="Installation Guide."
181 . S NLINES=NLINES+1,^TMP("PXRMXMZ",$J,NLINES,0)=TEXT
182 . S NLINES=NLINES+1,^TMP("PXRMXMZ",$J,NLINES,0)=" "
183 I NLINES=0 Q
184 K ^TMP($J,"MH")
185 D SEND^PXRMMSG("MH findings that cannot be converted")
186 K ^TMP("PXRMXMZ",$J)
187 Q
188 ;
189 ;========================
190UPDATE(FILENUM,IENS,FIELD,IEN) ;Update an MH finding.
191 N FDA,MSG
192 S FDA(FILENUM,IENS,FIELD)="MH.`"_IEN
193 D UPDATE^DIE("E","FDA","","MSG")
194 I $D(MSG) D
195 . N TEXT
196 . D ACOPY^PXRMUTIL("MSG","TEXT()")
197 . D BMES^XPDUTL("The MH update failed, UPDATE^DIE returned the following error message:")
198 . D MES^XPDUTL(.TEXT)
199 . D MES^XPDUTL("Examine the above error message for the reason.")
200 Q
201 ;
Note: See TracBrowser for help on using the repository browser.