Changeset 623 for WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMEXU4.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMEXU4.m
r613 r623 1 PXRMEXU4 ; SLC/PJH,PKR - Reminder Exchange #4, dialog changes. ;05/16/2007 2 ;;2.0;CLINICAL REMINDERS;**6**;Feb 04, 2005;Build 123 3 ;=============================================== 4 DLG(FDA,NAMECHG) ;Check the dialog for renamed entries, called by 5 ;silent installer. KIDSDONE is newed in INSDLG^PXRMEXSI. 6 N ABBR,ACTION,ALIST,DNAM,IEN,IENS,FILENUM,FINDING,NEWNAM,OFINDING 7 N ORITEM,OORITEM,PT01,RESULT,RRG,SRC,WP 8 S IENS=$O(FDA(801.41,"")) 9 ;Definition .01 10 S (PT01,DNAM)=FDA(801.41,IENS,.01) 11 I $D(NAMECHG(801.41,PT01)) D 12 .S (FDA(801.41,IENS,.01),DNAM)=NAMECHG(801.41,PT01) 13 ; 14 ;Build list of finding types 15 D BLDALIST^PXRMVPTR(801.4118,.01,.ALIST) 16 ;Plus field 15 files 17 ;S ALIST("MH")=601,ALIST("TX")=811.2 18 S ALIST("MH")=601.71,ALIST("TX")=811.2 19 S ALIST("WH")=790.404 20 ;Plus field 17 file 21 S ALIST("OI")=101.43 22 ; 23 ;Process SOURCE REMINDER 24 S SRC=$G(FDA(801.41,IENS,2)) 25 I SRC]"" D 26 .S IEN=$$EXISTS^PXRMEXIU(811.9,SRC) 27 .I IEN=0 K FDA(801.41,IENS,2) 28 ; 29 ;Clear RESULT if not defined 30 S RESULT=$G(FDA(801.41,IENS,55)) 31 I RESULT]"" D 32 .S IEN=$$EXISTS^PXRMEXIU(801.41,RESULT) 33 .I IEN=0 K FDA(801.41,IENS,55) 34 ; 35 ;Process ORDERABLE ITEM 36 S (ORITEM,OORITEM)=$G(FDA(801.41,IENS,17)),ACTION="" 37 I ORITEM'="" D I ACTION="Q" K FDA S (PXRMDONE,KIDSDONE)=1 Q 38 .S PT01=ORITEM 39 .S ABBR="OI",FILENUM=$P(ALIST(ABBR),U) 40 .I $D(NAMECHG(FILENUM,PT01)) D 41 ..S ORITEM=NAMECHG(FILENUM,PT01) 42 ..S FDA(801.41,IENS,17)=ORITEM 43 .S IEN=+$$VFIND1^PXRMEXIU(ABBR_"."_ORITEM,.ALIST) 44 .I IEN=0 D 45 ..;Get replacement 46 ..N DIC,DIR,DUOUT,MSG,X,Y 47 ..S MSG(1)=" " 48 ..S MSG(2)="ORDERABLE ITEM entry "_ORITEM_" does not exist." 49 ..D MES^XPDUTL(.MSG) 50 ..S ACTION=$$GETACT^PXRMEXIU("DPQ",.DIR) I ACTION="S" S ACTION="Q" 51 ..I ACTION="Q" Q 52 ..I ACTION="D" K FDA(801.41,IENS,17) Q 53 ..S DIC=FILENUM 54 ..S DIC(0)="AEMNQ" 55 ..S Y=-1 56 ..F Q:+Y'=-1 D 57 ...;If this is being called during a KIDS install we need echoing on. 58 ...I $D(XPDNM) X ^%ZOSF("EON") 59 ...D ^DIC 60 ...I $D(XPDNM) X ^%ZOSF("EOFF") 61 ...;If this is being called during a KIDS install we need echoing on. 62 ...I $D(DUOUT) S Y="" Q 63 ...I Y=-1 D BMES^XPDUTL("You must input a replacement!") 64 ..I Y="" S ACTION="Q" Q 65 ..S ORITEM=$P(Y,U,2) 66 ..S FDA(801.41,IENS,17)=ORITEM 67 .;Save the finding information for the history. 68 .I ORITEM'=OORITEM D 69 .. S ^TMP("PXRMEXIA",$J,"DIAF",$P(IENS,",",1),ABBR_"."_OORITEM)=ABBR_"."_ORITEM 70 ; 71 ;Process FINDING ITEM 72 S (FINDING,OFINDING)=$G(FDA(801.41,IENS,15)),ACTION="" 73 I FINDING'="" D I ACTION="Q" K FDA S (PXRMDONE,KIDSDONE)=1 Q 74 .S ABBR=$P(FINDING,".",1) 75 .S PT01=$P(FINDING,".",2) 76 .S FILENUM=$P(ALIST(ABBR),U,1) 77 .I $D(NAMECHG(FILENUM,PT01)) D 78 ..S FINDING=ABBR_"."_NAMECHG(FILENUM,PT01) 79 ..S FDA(801.41,IENS,15)=FINDING 80 .S IEN=+$$VFIND1^PXRMEXIU(FINDING,.ALIST) 81 .I IEN=0 D 82 ..;Get replacement 83 ..N DIC,DIR,DUOUT,MSG,X,Y 84 ..S MSG(1)=" " 85 ..S MSG(2)="FINDING entry "_FINDING_" does not exist." 86 ..D MES^XPDUTL(.MSG) 87 ..S ACTION=$$GETACT^PXRMEXIU("DPQ",.DIR) I ACTION="S" S ACTION="Q" 88 ..I ACTION="Q" Q 89 ..I ACTION="D" K FDA(801.41,IENS,15) Q 90 ..S DIC=FILENUM 91 ..S DIC(0)="AEMNQ" 92 ..S Y=-1 93 ..F Q:+Y'=-1 D 94 ...;If this is being called during a KIDS install we need echoing on. 95 ...I $D(XPDNM) X ^%ZOSF("EON") 96 ...D ^DIC 97 ...I $D(XPDNM) X ^%ZOSF("EOFF") 98 ...;If this is being called during a KIDS install we need echoing on. 99 ...I $D(DUOUT) S Y="" Q 100 ...I Y=-1 D BMES^XPDUTL("You must input a replacement!") 101 ..I Y="" S ACTION="Q" Q 102 ..S FINDING=ABBR_"."_$P(Y,U,2) 103 ..S FDA(801.41,IENS,15)=FINDING 104 .;Save the finding information for the history. 105 .I FINDING'=OFINDING D 106 .. S ^TMP("PXRMEXIA",$J,"DIAF",$P(IENS,",",1),OFINDING)=FINDING 107 .;Convert ICD9 codes to `ien format 108 .I $P(FINDING,".")="ICD9" S FDA(801.41,IENS,15)="ICD9."_$$ICD9(FINDING) 109 ; 110 ;Look for replacements of TIU templates. 111 I $D(NAMECHG(8927.1)) D 112 .S WP=$G(FDA(801.41,IENS,25)) 113 .I WP'="" D TIURPL("{FLD:",WP,.NAMECHG,8927.1) 114 .S WP=$G(FDA(801.41,IENS,35)) 115 ; 116 ;Process ADDITIONAL FINDINGS 117 S IENS="",ACTION="" 118 F S IENS=$O(FDA(801.4118,IENS)) Q:IENS="" D I ACTION="Q" K FDA S (PXRMDONE,KIDSDONE)=1 Q 119 . S (FINDING,OFINDING)=FDA(801.4118,IENS,.01) 120 . S ABBR=$P(FINDING,".",1) 121 . S PT01=$P(FINDING,".",2) 122 . S FILENUM=$P(ALIST(ABBR),U,1) 123 . I $D(NAMECHG(FILENUM,PT01)) D 124 .. S FINDING=ABBR_"."_NAMECHG(FILENUM,PT01) 125 .. S FDA(801.4118,IENS,.01)=FINDING 126 . S IEN=+$$VFIND1^PXRMEXIU(FINDING,.ALIST) 127 . I IEN=0 D Q:ACTION="Q" 128 ..;Get replacement 129 .. N DIC,DIR,DUOUT,MSG,X,Y 130 .. S MSG(1)=" " 131 .. S MSG(2)="ADDITIONAL FINDING entry "_FINDING_" does not exist." 132 .. D MES^XPDUTL(.MSG) 133 .. S ACTION=$$GETACT^PXRMEXIU("DPQ",.DIR) 134 .. I ACTION="S" S ACTION="Q" 135 .. I ACTION="Q" Q 136 .. I ACTION="D" K FDA(801.4118,IENS) Q 137 .. S DIC=FILENUM 138 .. S DIC(0)="AEMNQ" 139 .. S Y=-1 140 .. F Q:+Y'=-1 D 141 ...;If this is being called during a KIDS install we need echoing on. 142 ... I $D(XPDNM) X ^%ZOSF("EON") 143 ... D ^DIC 144 ... I $D(XPDNM) X ^%ZOSF("EOFF") 145 ... I $D(DUOUT) S Y="" Q 146 ... I Y=-1 D BMES^XPDUTL("You must input a replacement!") 147 .. I Y="" S ACTION="Q" Q 148 .. S FINDING=ABBR_"."_$P(Y,U,2) 149 .. S FDA(801.4118,IENS,.01)=FINDING 150 . ;Save the finding information for the history. 151 . I FINDING'=OFINDING D 152 .. S ^TMP("PXRMEXIA",$J,"DIAF",$P(IENS,",",1),OFINDING)=FINDING 153 . ;Convert ICD9 codes to `ien format 154 . I $P(FINDING,".")="ICD9" S FDA(801.4118,IENS,.01)=$$ICD9(FINDING) 155 ; 156 I ACTION="Q" S (PXRMDONE,KIDSDONE)=1 Q 157 ;Process DIALOG COMPONENT 158 S IENS="",ACTION="" 159 F S IENS=$O(FDA(801.412,IENS)) Q:IENS="" D I ACTION="Q" K FDA S (PXRMDONE,KIDSDONE)=1 Q 160 . S PT01=$G(FDA(801.412,IENS,2)) Q:PT01="" 161 . S FILENUM=801.41,NEWNAM=$G(NAMECHG(FILENUM,PT01)) 162 .I NEWNAM'="" D 163 .. S FDA(801.412,IENS,2)=NEWNAM,PT01=NEWNAM 164 .S IEN=$$EXISTS^PXRMEXIU(FILENUM,PT01) 165 .I IEN=0 D 166 ..;Get replacement 167 .. N DIC,DIR,DUOUT,MSG,X,Y 168 .. S MSG(1)=" " 169 .. S MSG(2)="COMPONENT DIALOG entry "_PT01_" does not exist." 170 .. D MES^XPDUTL(.MSG) 171 .. S ACTION=$$GETACT^PXRMEXIU("DPQ",.DIR) 172 .. I ACTION="S" S ACTION="Q" 173 .. I ACTION="Q" Q 174 .. I ACTION="D" K FDA(801.412,IENS) Q 175 .. S DIC=FILENUM 176 .. S DIC(0)="AEMNQ" 177 .. S DIC("S")="I ""EG""[$P(^PXRMD(801.41,Y,0),U,4)" 178 .. S Y=-1 179 .. F Q:+Y'=-1 D 180 ...;If this is being called during a KIDS install we need echoing on. 181 ... I $D(XPDNM) X ^%ZOSF("EON") 182 ... D ^DIC 183 ... I $D(XPDNM) X ^%ZOSF("EOFF") 184 ... I $D(DUOUT) S Y="" Q 185 ... I Y=-1 D BMES^XPDUTL("You must input a replacement!") 186 .. I Y="" S ACTION="Q" Q 187 .. I Y'="" S FDA(801.412,IENS,2)=$P(Y,U,2) 188 ;Process Result Groups 189 F S IENS=$O(FDA(801.41121,IENS)) Q:IENS="" D I ACTION="Q" K FDA S (PXRMDONE,KIDSDONE)=1 Q 190 . S PT01=$G(FDA(801.41121,IENS,.01)) Q:PT01="" 191 . S FILENUM=801.41,NEWNAM=$G(NAMECHG(FILENUM,PT01)) 192 .I NEWNAM'="" D 193 .. S FDA(801.41121,IENS,2)=NEWNAM,PT01=NEWNAM 194 .S IEN=$$EXISTS^PXRMEXIU(FILENUM,PT01) 195 .I IEN=0 D 196 ..;Get replacement 197 .. N DIC,DIR,DUOUT,MSG,X,Y 198 .. S MSG(1)=" " 199 .. S MSG(2)="RESULT GROUP entry "_PT01_" does not exist." 200 .. D MES^XPDUTL(.MSG) 201 .. S ACTION=$$GETACT^PXRMEXIU("DPQ",.DIR) 202 .. I ACTION="S" S ACTION="Q" 203 .. I ACTION="Q" Q 204 .. I ACTION="D" K FDA(801.41121,IENS) Q 205 .. S DIC=FILENUM 206 .. S DIC(0)="AEMNQ" 207 .. S DIC("S")="I ""S""[$P(^PXRMD(801.41,Y,0),U,4)" 208 .. S Y=-1 209 .. F Q:+Y'=-1 D 210 ...;If this is being called during a KIDS install we need echoing on. 211 ... I $D(XPDNM) X ^%ZOSF("EON") 212 ... D ^DIC 213 ... I $D(XPDNM) X ^%ZOSF("EOFF") 214 ... I $D(DUOUT) S Y="" Q 215 ... I Y=-1 D BMES^XPDUTL("You must input a replacement!") 216 .. I Y="" S ACTION="Q" Q 217 .. I Y'="" S FDA(801.41121,IENS,.01)=$P(Y,U,2) 218 Q 219 ; 220 ;=============================================== 221 ;Convert ICD9 codes to `ien format 222 ICD9(CODE) ; 223 N IEN 224 S IEN=$$FIND1^DIC(80,"","AMX",$P(CODE,".",2,99)) 225 I 'IEN Q "" 226 Q "`"_IEN 227 ; 228 ;=============================================== 229 TIURPL(SRCH,WP,NAMEGHC,FILENUM) ;Replace TIU templates whose names have 230 ;changed. 231 N IND,RS,TEXT,TS,TYPE 232 I FILENUM=8927.1 S TYPE="TIU TEMPLATE" 233 E S TYPE="TIU OBJECT" 234 S IND=1 235 F S TEXT=$G(@WP@(IND)) Q:TEXT="" D 236 .I TEXT[SRCH D 237 ..S TS="" 238 ..F S TS=$O(NAMECHG(FILENUM,TS)) Q:TS="" D 239 ...S RS=NAMECHG(FILENUM,TS) Q:TEXT'[TS 240 ...S @WP@(IND)=$$STRREP^PXRMUTIL(TEXT,TS,RS) 241 ...;Save the replacement information for the history. 242 ...S ^TMP("PXRMEXIA",$J,"DIATIU",TYPE,TS)=RS 243 ...S ^TMP("PXRMEXIA",$J,"DIATIU",TYPE,TS,DNAM)="" 244 .S IND=IND+1 245 Q 246 ; 1 PXRMEXU4 ; SLC/PJH,PKR - Reminder Exchange #4, dialog changes. ;01/19/2005 2 ;;2.0;CLINICAL REMINDERS;;Feb 04, 2005 3 ;=============================================== 4 DLG(FDA,NAMECHG) ;Check the dialog for renamed entries, called by 5 ;silent installer. KIDSDONE is newed in INSDLG^PXRMEXSI. 6 N ABBR,ACTION,ALIST,DNAM,IEN,IENS,FILENUM,FINDING,NEWNAM,OFINDING 7 N ORITEM,OORITEM,PT01,RESULT,RRG,SRC,WP 8 S IENS=$O(FDA(801.41,"")) 9 ;Definition .01 10 S (PT01,DNAM)=FDA(801.41,IENS,.01) 11 I $D(NAMECHG(801.41,PT01)) D 12 .S (FDA(801.41,IENS,.01),DNAM)=NAMECHG(801.41,PT01) 13 ; 14 ;Build list of finding types 15 D BLDALIST^PXRMVPTR(801.4118,.01,.ALIST) 16 ;Plus field 15 files 17 S ALIST("MH")=601,ALIST("TX")=811.2 18 S ALIST("WH")=790.404 19 ;Plus field 17 file 20 S ALIST("OI")=101.43 21 ; 22 ;Process SOURCE REMINDER 23 S SRC=$G(FDA(801.41,IENS,2)) 24 I SRC]"" D 25 .S IEN=$$EXISTS^PXRMEXIU(811.9,SRC) 26 .I IEN=0 K FDA(801.41,IENS,2) 27 ; 28 ;Clear RESULT if not defined 29 S RESULT=$G(FDA(801.41,IENS,55)) 30 I RESULT]"" D 31 .S IEN=$$EXISTS^PXRMEXIU(801.41,RESULT) 32 .I IEN=0 K FDA(801.41,IENS,55) 33 ; 34 ;Process ORDERABLE ITEM 35 S (ORITEM,OORITEM)=$G(FDA(801.41,IENS,17)),ACTION="" 36 I ORITEM'="" D I ACTION="Q" K FDA S (PXRMDONE,KIDSDONE)=1 Q 37 .S PT01=ORITEM 38 .S ABBR="OI",FILENUM=$P(ALIST(ABBR),U) 39 .I $D(NAMECHG(FILENUM,PT01)) D 40 ..S ORITEM=NAMECHG(FILENUM,PT01) 41 ..S FDA(801.41,IENS,17)=ORITEM 42 .S IEN=+$$VFIND1^PXRMEXIU(ABBR_"."_ORITEM,.ALIST) 43 .I IEN=0 D 44 ..;Get replacement 45 ..N DIC,DIR,DUOUT,MSG,X,Y 46 ..S MSG(1)=" " 47 ..S MSG(2)="ORDERABLE ITEM entry "_ORITEM_" does not exist." 48 ..D MES^XPDUTL(.MSG) 49 ..S ACTION=$$GETACT^PXRMEXIU("DPQ",.DIR) I ACTION="S" S ACTION="Q" 50 ..I ACTION="Q" Q 51 ..I ACTION="D" K FDA(801.41,IENS,17) Q 52 ..S DIC=FILENUM 53 ..S DIC(0)="AEMNQ" 54 ..S Y=-1 55 ..F Q:+Y'=-1 D 56 ...;If this is being called during a KIDS install we need echoing on. 57 ...I $D(XPDNM) X ^%ZOSF("EON") 58 ...D ^DIC 59 ...I $D(XPDNM) X ^%ZOSF("EOFF") 60 ...;If this is being called during a KIDS install we need echoing on. 61 ...I $D(DUOUT) S Y="" Q 62 ...I Y=-1 D BMES^XPDUTL("You must input a replacement!") 63 ..I Y="" S ACTION="Q" Q 64 ..S ORITEM=$P(Y,U,2) 65 ..S FDA(801.41,IENS,17)=ORITEM 66 .;Save the finding information for the history. 67 .I ORITEM'=OORITEM D 68 .. S ^TMP("PXRMEXIA",$J,"DIAF",$P(IENS,",",1),ABBR_"."_OORITEM)=ABBR_"."_ORITEM 69 ; 70 ;Process FINDING ITEM 71 S (FINDING,OFINDING)=$G(FDA(801.41,IENS,15)),ACTION="" 72 I FINDING'="" D I ACTION="Q" K FDA S (PXRMDONE,KIDSDONE)=1 Q 73 .S ABBR=$P(FINDING,".",1) 74 .S PT01=$P(FINDING,".",2) 75 .S FILENUM=$P(ALIST(ABBR),U,1) 76 .I $D(NAMECHG(FILENUM,PT01)) D 77 ..S FINDING=ABBR_"."_NAMECHG(FILENUM,PT01) 78 ..S FDA(801.41,IENS,15)=FINDING 79 .S IEN=+$$VFIND1^PXRMEXIU(FINDING,.ALIST) 80 .I IEN=0 D 81 ..;Get replacement 82 ..N DIC,DIR,DUOUT,MSG,X,Y 83 ..S MSG(1)=" " 84 ..S MSG(2)="FINDING entry "_FINDING_" does not exist." 85 ..D MES^XPDUTL(.MSG) 86 ..S ACTION=$$GETACT^PXRMEXIU("DPQ",.DIR) I ACTION="S" S ACTION="Q" 87 ..I ACTION="Q" Q 88 ..I ACTION="D" K FDA(801.41,IENS,15) Q 89 ..S DIC=FILENUM 90 ..S DIC(0)="AEMNQ" 91 ..S Y=-1 92 ..F Q:+Y'=-1 D 93 ...;If this is being called during a KIDS install we need echoing on. 94 ...I $D(XPDNM) X ^%ZOSF("EON") 95 ...D ^DIC 96 ...I $D(XPDNM) X ^%ZOSF("EOFF") 97 ...;If this is being called during a KIDS install we need echoing on. 98 ...I $D(DUOUT) S Y="" Q 99 ...I Y=-1 D BMES^XPDUTL("You must input a replacement!") 100 ..I Y="" S ACTION="Q" Q 101 ..S FINDING=ABBR_"."_$P(Y,U,2) 102 ..S FDA(801.41,IENS,15)=FINDING 103 .;Save the finding information for the history. 104 .I FINDING'=OFINDING D 105 .. S ^TMP("PXRMEXIA",$J,"DIAF",$P(IENS,",",1),OFINDING)=FINDING 106 .;Convert ICD9 codes to `ien format 107 .I $P(FINDING,".")="ICD9" S FDA(801.41,IENS,15)="ICD9."_$$ICD9(FINDING) 108 ; 109 ;Look for replacements of TIU templates. 110 I $D(NAMECHG(8927.1)) D 111 .S WP=$G(FDA(801.41,IENS,25)) 112 .I WP'="" D TIURPL("{FLD:",WP,.NAMECHG,8927.1) 113 .S WP=$G(FDA(801.41,IENS,35)) 114 ; 115 ;Process ADDITIONAL FINDINGS 116 S IENS="",ACTION="" 117 F S IENS=$O(FDA(801.4118,IENS)) Q:IENS="" D I ACTION="Q" K FDA S (PXRMDONE,KIDSDONE)=1 Q 118 . S (FINDING,OFINDING)=FDA(801.4118,IENS,.01) 119 . S ABBR=$P(FINDING,".",1) 120 . S PT01=$P(FINDING,".",2) 121 . S FILENUM=$P(ALIST(ABBR),U,1) 122 . I $D(NAMECHG(FILENUM,PT01)) D 123 .. S FINDING=ABBR_"."_NAMECHG(FILENUM,PT01) 124 .. S FDA(801.4118,IENS,.01)=FINDING 125 . S IEN=+$$VFIND1^PXRMEXIU(FINDING,.ALIST) 126 . I IEN=0 D Q:ACTION="Q" 127 ..;Get replacement 128 .. N DIC,DIR,DUOUT,MSG,X,Y 129 .. S MSG(1)=" " 130 .. S MSG(2)="ADDITIONAL FINDING entry "_FINDING_" does not exist." 131 .. D MES^XPDUTL(.MSG) 132 .. S ACTION=$$GETACT^PXRMEXIU("DPQ",.DIR) 133 .. I ACTION="S" S ACTION="Q" 134 .. I ACTION="Q" Q 135 .. I ACTION="D" K FDA(801.4118,IENS) Q 136 .. S DIC=FILENUM 137 .. S DIC(0)="AEMNQ" 138 .. S Y=-1 139 .. F Q:+Y'=-1 D 140 ...;If this is being called during a KIDS install we need echoing on. 141 ... I $D(XPDNM) X ^%ZOSF("EON") 142 ... D ^DIC 143 ... I $D(XPDNM) X ^%ZOSF("EOFF") 144 ... I $D(DUOUT) S Y="" Q 145 ... I Y=-1 D BMES^XPDUTL("You must input a replacement!") 146 .. I Y="" S ACTION="Q" Q 147 .. S FINDING=ABBR_"."_$P(Y,U,2) 148 .. S FDA(801.4118,IENS,.01)=FINDING 149 . ;Save the finding information for the history. 150 . I FINDING'=OFINDING D 151 .. S ^TMP("PXRMEXIA",$J,"DIAF",$P(IENS,",",1),OFINDING)=FINDING 152 . ;Convert ICD9 codes to `ien format 153 . I $P(FINDING,".")="ICD9" S FDA(801.4118,IENS,.01)=$$ICD9(FINDING) 154 ; 155 I ACTION="Q" S (PXRMDONE,KIDSDONE)=1 Q 156 ;Process DIALOG COMPONENT 157 S IENS="",ACTION="" 158 F S IENS=$O(FDA(801.412,IENS)) Q:IENS="" D I ACTION="Q" K FDA S (PXRMDONE,KIDSDONE)=1 Q 159 . S PT01=$G(FDA(801.412,IENS,2)) Q:PT01="" 160 . S FILENUM=801.41,NEWNAM=$G(NAMECHG(FILENUM,PT01)) 161 .I NEWNAM'="" D 162 .. S FDA(801.412,IENS,2)=NEWNAM,PT01=NEWNAM 163 .S IEN=$$EXISTS^PXRMEXIU(FILENUM,PT01) 164 .I IEN=0 D 165 ..;Get replacement 166 .. N DIC,DIR,DUOUT,MSG,X,Y 167 .. S MSG(1)=" " 168 .. S MSG(2)="COMPONENT DIALOG entry "_PT01_" does not exist." 169 .. D MES^XPDUTL(.MSG) 170 .. S ACTION=$$GETACT^PXRMEXIU("DPQ",.DIR) 171 .. I ACTION="S" S ACTION="Q" 172 .. I ACTION="Q" Q 173 .. I ACTION="D" K FDA(801.412,IENS) Q 174 .. S DIC=FILENUM 175 .. S DIC(0)="AEMNQ" 176 .. S DIC("S")="I ""EG""[$P(^PXRMD(801.41,Y,0),U,4)" 177 .. S Y=-1 178 .. F Q:+Y'=-1 D 179 ...;If this is being called during a KIDS install we need echoing on. 180 ... I $D(XPDNM) X ^%ZOSF("EON") 181 ... D ^DIC 182 ... I $D(XPDNM) X ^%ZOSF("EOFF") 183 ... I $D(DUOUT) S Y="" Q 184 ... I Y=-1 D BMES^XPDUTL("You must input a replacement!") 185 .. I Y="" S ACTION="Q" Q 186 .. I Y'="" S FDA(801.412,IENS,2)=$P(Y,U,2) 187 Q 188 ; 189 ;=============================================== 190 ;Convert ICD9 codes to `ien format 191 ICD9(CODE) ; 192 N IEN 193 S IEN=$$FIND1^DIC(80,"","AMX",$P(CODE,".",2,99)) 194 I 'IEN Q "" 195 Q "`"_IEN 196 ; 197 ;=============================================== 198 TIURPL(SRCH,WP,NAMEGHC,FILENUM) ;Replace TIU templates whose names have 199 ;changed. 200 N IND,RS,TEXT,TS,TYPE 201 I FILENUM=8927.1 S TYPE="TIU TEMPLATE" 202 E S TYPE="TIU OBJECT" 203 S IND=1 204 F S TEXT=$G(@WP@(IND)) Q:TEXT="" D 205 .I TEXT[SRCH D 206 ..S TS="" 207 ..F S TS=$O(NAMECHG(FILENUM,TS)) Q:TS="" D 208 ...S RS=NAMECHG(FILENUM,TS) Q:TEXT'[TS 209 ...S @WP@(IND)=$$STRREP^PXRMUTIL(TEXT,TS,RS) 210 ...;Save the replacement information for the history. 211 ...S ^TMP("PXRMEXIA",$J,"DIATIU",TYPE,TS)=RS 212 ...S ^TMP("PXRMEXIA",$J,"DIATIU",TYPE,TS,DNAM)="" 213 .S IND=IND+1 214 Q 215 ;
Note:
See TracChangeset
for help on using the changeset viewer.
