[628] | 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 | ;
|
---|