Changeset 623 for WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMREDF.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/PXRMREDF.m
r613 r623 1 PXRMREDF ; SLC/PJH - Edit PXRM reminder findings. ;01/09/2007 2 ;;2.0;CLINICAL REMINDERS;**4,6**;Feb 04, 2005;Build 123 3 ; 4 ; Called by PXRMREDT which newes and initialized DEF, DEF1, DEF2. 5 ; 6 SET S:'$D(^PXD(811.9,DA,20,0)) ^PXD(811.9,DA,20,0)="^811.902V" Q 7 ;Display ALL findings 8 ; 9 ;-------------------- 10 DSPALL(TYPE,NODE,DA,LIST) ; 11 N FIRST,SUB,SUB1,SUB2 12 S FIRST=1,SUB="",SUB1="",SUB2="" 13 F S SUB=$O(LIST(SUB)) Q:SUB="" D 14 .S SUB1=0 15 .F S SUB1=$O(LIST(SUB,SUB1)) Q:SUB1="" D 16 ..S SUB2=0 F S SUB2=$O(LIST(SUB,SUB1,SUB2)) Q:SUB2="" D 17 ...I FIRST S FIRST=0 W !!,"Choose from:",! 18 ...W SUB 19 ...W ?5,SUB1,?65,"Finding #: "_SUB2,! 20 I FIRST,TYPE="D" W !!,"Reminder has no findings",! 21 I FIRST,TYPE="T" W !!,"Reminder Term has no findings",! 22 ;Update 23 D LIST^PXRMREDT(NODE,DA,.LIST) 24 Q 25 ; 26 ;Edit individual FINDING entry 27 ;----------------------------- 28 FEDIT(IEN) ; 29 N CFIEN,DA,DIC,DIE,DR,ETYPE,GLOB 30 N STATUS,TERMSTAT,TIEN,TERMTYPE,VF,WPIEN,Y 31 S DA(1)=IEN 32 S DIC="^PXD(811.9,"_IEN_",20," 33 I $P(^PXD(811.9,IEN,100),U)="N",$G(PXRMINST)'=1 S DIC(0)="QEA" 34 E S DIC(0)="QEAL" 35 S DIC("A")="Select FINDING: " 36 S DIC("P")="811.902V" 37 D ^DIC I Y=-1 S DTOUT=1 Q 38 S DIE=DIC K DIC 39 S DIE("NO^")="OUTOK" 40 S DA=+Y,GLOB=$P($P(Y,U,2),";",2) Q:GLOB="" 41 S TYPE=$G(DEF1(GLOB)) 42 S SDA(2)=DA(1),SDA(1)=DA 43 ;Save term IEN 44 S STATUS=0 45 I TYPE="CF" S CFIEN=$P($P(Y,U,2),";",1) D 46 .I $D(^PXRMD(811.4,CFIEN,1))>0 D 47 ..W !!,"Computed Finding Description:" S WPIEN=0 48 ..F S WPIEN=$O(^PXRMD(811.4,CFIEN,1,WPIEN)) Q:+WPIEN'>0 D 49 ...W !,$G(^PXRMD(811.4,CFIEN,1,WPIEN,0)) 50 .E W !!,"No description defined for this computed finding" 51 I TYPE="MH" D WARN^PXRMMH 52 I TYPE="RT" S TIEN=$P($P(Y,U,2),";",1) 53 ;Finding record fields 54 W !!,"Editing Finding Number: "_$G(DA) 55 S DR=".01;3;I X=""0Y"" S Y=6;1;2;6;7;8;9;12;17" 56 ;Taxonomy - use inactive problems 57 I TYPE="TX" D 58 .S TERMSTAT=$$TAXNODE^PXRMSTA1($P($P(Y,U,2),";"),"H") 59 .I TERMSTAT="P" S DR=DR_";10" Q 60 .I TERMSTAT'=0 S DR=DR_";10",STATUS=1 61 I TYPE="RT" D 62 .S TERMTYPE=$$TERMTYPE(TIEN) 63 .I TERMTYPE["H" S DR=DR_";11" 64 ;Health Factor - within category rank 65 I TYPE="HF" S DR=DR_";11" 66 ;If V file INCLUDE VISIT DATA 67 S VF=$S(TYPE="ED":1,TYPE="EX":1,TYPE="HF":1,TYPE="IM":1,TYPE="ST":1,TYPE="TX":1,1:0) 68 I TYPE="RT",$P(TERMTYPE,U,2)="VF" S VF=1 69 I VF S DR=DR_";28" 70 ; 71 ;Mental Health - scale 72 I TYPE="MH" S DR=DR_";13" 73 ;Radiology procedure. 74 I TYPE="RP" S STATUS=1 75 ;Orderable Item 76 I TYPE="OI" S DR=DR_";27",STATUS=1 77 ;Rx Type 78 I (TYPE="DC")!(TYPE="DG")!(TYPE="DR") S DR=DR_";16;27",STATUS=1 79 ;Condition 80 S DR=DR_";14;15;18" 81 I TYPE="CF" S DR=DR_";26" 82 ;Found/not found text 83 S DR=DR_";4;5" 84 ; 85 I TYPE="RT" D 86 . I TERMTYPE["D" S DR=DR_";16;27",STATUS=1 87 . I TERMTYPE["O" S DR=DR_";27",STATUS=1 88 . I TERMTYPE["R" S STATUS=1 89 . I TERMTYPE["T" S STATUS=1 90 .I TERMTYPE[2 D 91 .. N MSG 92 .. S MSG(1)="Cannot set a status since the term contains multiple types of findings" 93 .. S MSG(2)="Edit the status field at the term level for each finding" H 2 94 .. D EN^DDIOL(.MSG) 95 ;Edit finding record 96 D ^DIE 97 S $P(^PXD(811.9,IEN,20,0),U,3)=0 98 I $D(Y) S DTOUT=1 Q 99 ;Check if deleted 100 I '$D(DA) Q 101 I STATUS=1,$D(Y)=0 D STATUS^PXRMSTA1(.DA,"D") 102 ; 103 S ETYPE=$P(^PXD(811.9,IEN,20,SDA(1),0),U,1) 104 ;Option to edit term findings 105 I $P(ETYPE,";",2)="PXRMD(811.5," D 106 . S TIEN=$P(ETYPE,";",1) 107 . D TMAP(IEN,TIEN) 108 Q 109 ; 110 ;Edit individual function finding entry 111 ;----------------------------- 112 FFEDIT(IEN) ; 113 N DA,DIC,DIE,DR,Y 114 S DA(1)=IEN 115 S DIC="^PXD(811.9,"_IEN_",25," 116 S DIC(0)="QEAL" 117 S DIC("A")="Select FUNCTION FINDING: " 118 D ^DIC 119 I Y=-1 S DTOUT=1 Q 120 S DIE=DIC K DIC 121 S DA=+Y 122 ;Finding record fields 123 S DR=".01;3" 124 ;Edit finding record 125 D ^DIE 126 I $D(Y) S DTOUT=1 Q 127 I '$D(DA) Q 128 ;If the function string is null don't do the rest of the fields. 129 I $G(^PXD(811.9,IEN,25,DA,3))="" Q 130 S DR="1;2;11;12;15;I X=""0Y"" S Y=16;13;14;16" 131 D ^DIE 132 I $D(Y) S DTOUT=1 Q 133 I '$D(DA) Q 134 ;Check if deleted 135 Q 136 ; 137 ;Edit Reminder Function Findings 138 ;---------------------- 139 FFIND ; 140 N DTOUT,DUOUT 141 F D Q:$D(DUOUT)!$D(DTOUT) 142 .D FFEDIT(DA) I $D(DUOUT)!$D(DTOUT) Q 143 K DUOUT,DTOUT 144 Q 145 ; 146 ;Edit Reminder Findings 147 ;---------------------- 148 FIND(LIST) ; 149 N DTOUT,DUOUT,NODE,SDA 150 D SET ; Check if node defined 151 S NODE="^PXD(811.9)" 152 F D Q:$D(DUOUT)!$D(DTOUT) 153 .;Display list of existing reminder findings 154 .W !!,"Reminder Definition Findings" 155 .D DSPALL("D",NODE,DA,.LIST) 156 .;Edit findings 157 .D FEDIT(DA) I $D(DUOUT)!$D(DTOUT) D LIST^PXRMREDT(NODE,DA,.LIST) Q 158 .;Update list with finding changes 159 .D LIST^PXRMREDT(NODE,DA,.LIST) 160 Q 161 ; 162 ;General help text routine 163 ;------------------------- 164 HELP(CALL) ; 165 N HTEXT 166 N DIWF,DIWL,DIWR,IC 167 S DIWF="C70",DIWL=0,DIWR=70 168 ; 169 I CALL=1 D 170 .S HTEXT(1)="Select the type of finding you wish to change or add." 171 .S HTEXT(2)="Type '?' for a list of the available finding types." 172 I CALL=2 D 173 .S HTEXT(1)="Select section of the reminder you wish to edit or 'All'" 174 .S HTEXT(2)="to step through all sections of the reminder definition." 175 I CALL=3 D 176 .S HTEXT(1)="Select 'Y' to edit the findings mapped to this term" 177 .S HTEXT(2)="or 'N' to return to select another reminder finding." 178 ; 179 K ^UTILITY($J,"W") 180 S IC="" 181 F S IC=$O(HTEXT(IC)) Q:IC="" D 182 . S X=HTEXT(IC) 183 . D ^DIWP 184 W ! 185 S IC=0 186 F S IC=$O(^UTILITY($J,"W",0,IC)) Q:IC="" D 187 . W !,^UTILITY($J,"W",0,IC,0) 188 K ^UTILITY($J,"W") 189 W ! 190 Q 191 ; 192 ;Display TERM findings 193 ;-------------------- 194 TDSP(DA) ; 195 N FIRST,SUB,TLST S FIRST=1,SUB="",SUB1="" 196 ;Build list of term findings 197 D TLST(.TLST,DA) 198 ;Display list 199 F S SUB=$O(TLST(SUB)) Q:SUB="" D 200 .S SUB1=0 201 .F S SUB1=$O(TLST(SUB,SUB1)) Q:SUB1="" D 202 ..I FIRST S FIRST=0 W !!,"Reminder Term Findings:",!! 203 ..W SUB 204 ..W ?8,SUB1,! 205 I FIRST W !!,"Term has no mapped findings",!! 206 Q 207 ; 208 ;List Reminders using this term 209 ;------------------------------ 210 TERMS(TIEN,RIEN) ; 211 ;RIEN will be the reminder ien if called from reminder edit 212 ;or zero if called from term edit 213 N ARRAY,FIND,IEN,SUB,TCNT,RNAME 214 ;Scan all reminders in file #811.9 215 S IEN=0,FIND="PXRMD(811.5,",TCNT=0 216 F S IEN=$O(^PXD(811.9,IEN)) Q:'IEN D 217 .;Exclude current reminder called in reminder edit 218 .I RIEN,IEN=RIEN Q 219 .;Check the term findings 220 .I '$D(^PXD(811.9,IEN,20,"E",FIND,TIEN)) Q 221 .;Add to reminder array 222 .S RNAME=$P($G(^PXD(811.9,IEN,0)),U) 223 .I RNAME="" S RNAME=IEN 224 .I '$D(ARRAY(RNAME)) S TCNT=TCNT+1 225 .S ARRAY(RNAME)="" 226 ; 227 ;Display list of reminders using the term 228 I TCNT D 229 .N TXT 230 .S TXT="This Reminder Term is" S:RIEN TXT=TXT_" also" 231 .S TXT=TXT_" used by the following Reminder Definition" 232 .I TCNT>1 S TXT=TXT_"s" 233 .W !!,TXT_":" 234 .S RNAME="" F S RNAME=$O(ARRAY(RNAME)) Q:RNAME="" W !," ",RNAME 235 Q 236 ; 237 ;------------------------------ 238 ;Check term for finding item to edit status item 239 TERMTYPE(TIEN) ; 240 N DRUG,FOUND,HF,ORD,OTHER,RAD,RESULT,TAX,TYPE,VF 241 S (DRUG,FOUND,HF,ORD,OTHER,RAD,RESULT,TAX,VF)=0 242 S TYPE="" F S TYPE=$O(^PXRMD(811.5,TIEN,20,"B",TYPE)) Q:TYPE="" D 243 . I TYPE["AUTTEDT(" S (OTHER,VF)=1 Q 244 . I TYPE["AUTTHF(" S (HF,OTHER,VF)=1 Q 245 . I TYPE["AUTTIMM(" S (OTHER,VF)=1 Q 246 . I TYPE["AUTTSK(" S (OTHER,VF)=1 Q 247 . I TYPE["ORD" S (ORD,FOUND)=1 Q 248 . I TYPE["PS" S (DRUG,FOUND)=1 Q 249 . I TYPE["PXD(811.2" S (FOUND,TAX,VF)=1 Q 250 . I TYPE["RAMIS" S (FOUND,RAD)=1 Q 251 . S OTHER=1 252 I RAD=1,ORD=0,TAX=0,DRUG=0,OTHER=0 S RESULT="R" 253 I RAD=0,ORD=1,TAX=0,DRUG=0,OTHER=0 S RESULT="O" 254 I RAD=0,ORD=0,TAX=1,DRUG=0,OTHER=0 S RESULT="T" 255 I RAD=0,ORD=0,TAX=0,DRUG=1,OTHER=0 S RESULT="D" 256 I OTHER=1 S RESULT=1 I FOUND=1 S RESULT=2 257 I RESULT="T" S RESULT=$$TAXTYPE^PXRMSTA1(TIEN,"") 258 I HF=1 S RESULT="H"_RESULT 259 I VF=1 S RESULT=RESULT_U_"VF" 260 Q RESULT 261 ; 262 ;Build list of mapped findings for term 263 ;-------------------------------------- 264 TLST(ARRAY,DA) ; 265 N TYPE,DATA,GLOB,IEN,NAME,NODE,SUB 266 ;Clear passed arrays 267 K ARRAY 268 ;Build cross reference global to file number 269 ;Get each finding 270 S SUB=0 F S SUB=$O(^PXRMD(811.5,DA,20,SUB)) Q:'SUB D 271 .S DATA=$G(^PXRMD(811.5,DA,20,SUB,0)) I DATA="" Q 272 .;Determine global and global ien 273 .S NODE=$P(DATA,U),GLOB=$P(NODE,";",2),IEN=$P(NODE,";") 274 .;Ignore null entries 275 .I (GLOB="")!(IEN="") Q 276 .;Work out the file type 277 .S TYPE=$G(DEF1(GLOB)) Q:TYPE="" 278 .S NAME=$P($G(@(U_GLOB_IEN_",0)")),U) 279 .S ARRAY(TYPE,NAME)="" 280 Q 281 ; 282 ;Map Term findings 283 ;----------------- 284 TMAP(RIEN,TIEN) ; 285 N TOPT,TNAM 286 ;Display any other reminders using this term 287 D TERMS(TIEN,RIEN) 288 ;Term name 289 S TNAM=$P($G(^PXRMD(811.5,TIEN,0)),U) 290 ;Give option to edit mapped findings (Y/N) 291 D TMASK(.TOPT,TNAM) Q:$D(DUOUT)!($D(DTOUT)) 292 ;Edit term findings 293 I TOPT="Y" D TRMED(TIEN) 294 Q 295 ; 296 ;Option to edit term findings 297 ;---------------------------- 298 TMASK(YESNO,TNAM) ; 299 N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y 300 S DIR(0)="YA0" 301 S DIR("A")="Do you want to edit mapped findings for "_TNAM_": " 302 S (DIR("B"),YESNO)="N" 303 S DIR("?")="Enter Y or N. For detailed help type ??" 304 S DIR("??")=U_"D HELP^PXRMREDF(3)" 305 W ! 306 D ^DIR K DIR 307 I $D(DIROUT)!$D(DIRUT) Q 308 I $D(DTOUT)!$D(DUOUT) Q 309 S YESNO=$E(Y(0)) 310 Q 311 ; 312 ;Term edit 313 ;--------- 314 TRMED(DA) ; 315 N CS1,CS2,DIC,DLAYGO,DTOUT,DUOUT,Y 316 K DLAYGO,DTOUT,DUOUT,Y 317 ;Display term findings 318 D TDSP(DA) 319 ;Initialize change history 320 S CS1=$$FILE^PXRMEXCS(811.5,DA) 321 ;Edit term findings 322 S DIC="^PXRMD(811.5," 323 D EDIT^PXRMTMED(DIC,DA) 324 ;Update change history 325 S CS2=$$FILE^PXRMEXCS(811.5,DA) 326 I CS2=0 Q 327 I CS2'=CS1 D SEHIST^PXRMUTIL(811.5,DIC,DA) 328 Q 329 ; 1 PXRMREDF ; SLC/PJH - Edit PXRM reminder findings. ;02/09/2006 2 ;;2.0;CLINICAL REMINDERS;**4**;Feb 04, 2005;Build 21 3 ; 4 ; Called by PXRMREDT which newes and initialized DEF, DEF1, DEF2. 5 ; 6 SET S:'$D(^PXD(811.9,DA,20,0)) ^PXD(811.9,DA,20,0)="^811.902V" Q 7 ;Display ALL findings 8 ; 9 ;-------------------- 10 DSPALL(TYPE,NODE,DA,LIST) ; 11 N FIRST,SUB,SUB1,SUB2 12 S FIRST=1,SUB="",SUB1="",SUB2="" 13 F S SUB=$O(LIST(SUB)) Q:SUB="" D 14 .S SUB1=0 15 .F S SUB1=$O(LIST(SUB,SUB1)) Q:SUB1="" D 16 ..S SUB2=0 F S SUB2=$O(LIST(SUB,SUB1,SUB2)) Q:SUB2="" D 17 ...I FIRST S FIRST=0 W !!,"Choose from:",! 18 ...W SUB 19 ...W ?5,SUB1,?65,"Finding #: "_SUB2,! 20 I FIRST,TYPE="D" W !!,"Reminder has no findings",! 21 I FIRST,TYPE="T" W !!,"Reminder Term has no findings",! 22 ;Update 23 D LIST^PXRMREDT(NODE,DA,.LIST) 24 Q 25 ; 26 ;Edit individual FINDING entry 27 ;----------------------------- 28 FEDIT(IEN) ; 29 N CFIEN,DA,DIC,DIE,DR,ETYPE,GLOB 30 N STATUS,TERMSTAT,TIEN,TERMTYPE,VF,WPIEN,Y 31 S DA(1)=IEN 32 S DIC="^PXD(811.9,"_IEN_",20," 33 I $P(^PXD(811.9,IEN,100),U)="N",$G(PXRMINST)'=1 S DIC(0)="QEA" 34 E S DIC(0)="QEAL" 35 S DIC("A")="Select FINDING: " 36 S DIC("P")="811.902V" 37 D ^DIC I Y=-1 S DTOUT=1 Q 38 S DIE=DIC K DIC 39 S DA=+Y,GLOB=$P($P(Y,U,2),";",2) Q:GLOB="" 40 S TYPE=$G(DEF1(GLOB)) 41 S SDA(2)=DA(1),SDA(1)=DA 42 ;Save term IEN 43 S STATUS=0 44 I TYPE="RT" S TIEN=$P($P(Y,U,2),";",1) 45 I TYPE="CF" S CFIEN=$P($P(Y,U,2),";",1) D 46 .I $D(^PXRMD(811.4,CFIEN,1))>0 D 47 ..W !!,"Computed Finding Description:" S WPIEN=0 48 ..F S WPIEN=$O(^PXRMD(811.4,CFIEN,1,WPIEN)) Q:+WPIEN'>0 D 49 ...W !,$G(^PXRMD(811.4,CFIEN,1,WPIEN,0)) 50 .E W !!,"No description defined for this computed finding" 51 ;Finding record fields 52 W !!,"Editing Finding Number: "_$G(DA) 53 S DR=".01;3;I X=""0Y"" S Y=6;1;2;6;7;8;9;12;17" 54 ;Taxonomy - use inactive problems 55 I TYPE="TX" D 56 .S TERMSTAT=$$TAXNODE^PXRMSTA1($P($P(Y,U,2),";"),"H") 57 .I TERMSTAT="P" S DR=DR_";10" Q 58 .I TERMSTAT'=0 S DR=DR_";10",STATUS=1 59 I TYPE="RT" D 60 .S TERMTYPE=$$TERMTYPE(TIEN) 61 .I TERMTYPE["H" S DR=DR_";11" 62 ;Health Factor - within category rank 63 I TYPE="HF" S DR=DR_";11" 64 ;If V file INCLUDE VISIT DATA 65 S VF=$S(TYPE="ED":1,TYPE="EX":1,TYPE="HF":1,TYPE="IM":1,TYPE="ST":1,TYPE="TX":1,1:0) 66 I TYPE="RT",$P(TERMTYPE,U,2)="VF" S VF=1 67 I VF S DR=DR_";28" 68 ; 69 ;Mental Health - scale 70 I TYPE="MH" S DR=DR_";13" 71 ;Radiology procedure. 72 I TYPE="RP" S STATUS=1 73 ;Orderable Item 74 I TYPE="OI" S DR=DR_";27",STATUS=1 75 ;Rx Type 76 I (TYPE="DC")!(TYPE="DG")!(TYPE="DR") S DR=DR_";16;27",STATUS=1 77 ;Condition 78 S DR=DR_";14;15;18" 79 I TYPE="CF" S DR=DR_";26" 80 ;Found/not found text 81 S DR=DR_";4;5" 82 ; 83 I TYPE="RT" D 84 . I TERMTYPE["D" S DR=DR_";16;27",STATUS=1 85 . I TERMTYPE["O" S DR=DR_";27",STATUS=1 86 . I TERMTYPE["R" S STATUS=1 87 . I TERMTYPE["T" S STATUS=1 88 .I TERMTYPE[2 D 89 .. N MSG 90 .. S MSG(1)="Cannot set a status since the term contains multiple types of findings" 91 .. S MSG(2)="Edit the status field at the term level for each finding" H 2 92 .. D EN^DDIOL(.MSG) 93 ;Edit finding record 94 D ^DIE 95 S $P(^PXD(811.9,IEN,20,0),U,3)=0 96 I $D(Y) S DTOUT=1 Q 97 ;Check if deleted 98 I '$D(DA) Q 99 I STATUS=1 D STATUS^PXRMSTA1(.DA,"D") 100 ; 101 S ETYPE=$P(^PXD(811.9,IEN,20,SDA(1),0),U,1) 102 ;Option to edit term findings 103 I $P(ETYPE,";",2)="PXRMD(811.5," D 104 . S TIEN=$P(ETYPE,";",1) 105 . D TMAP(IEN,TIEN) 106 Q 107 ; 108 ;Edit individual function finding entry 109 ;----------------------------- 110 FFEDIT(IEN) ; 111 N DA,DIC,DIE,DR,Y 112 S DA(1)=IEN 113 S DIC="^PXD(811.9,"_IEN_",25," 114 S DIC(0)="QEAL" 115 S DIC("A")="Select FUNCTION FINDING: " 116 D ^DIC 117 I Y=-1 S DTOUT=1 Q 118 S DIE=DIC K DIC 119 S DA=+Y 120 ;Finding record fields 121 S DR=".01;3" 122 ;Edit finding record 123 D ^DIE 124 I $D(Y) S DTOUT=1 Q 125 I '$D(DA) Q 126 ;If the function string is null don't do the rest of the fields. 127 I $G(^PXD(811.9,IEN,25,DA,3))="" Q 128 S DR="1;2;11;12;15;I X=""0Y"" S Y=16;13;14;16" 129 D ^DIE 130 I $D(Y) S DTOUT=1 Q 131 I '$D(DA) Q 132 ;Check if deleted 133 Q 134 ; 135 ;Edit Reminder Function Findings 136 ;---------------------- 137 FFIND ; 138 N DTOUT,DUOUT 139 F D Q:$D(DUOUT)!$D(DTOUT) 140 .D FFEDIT(DA) I $D(DUOUT)!$D(DTOUT) Q 141 K DUOUT,DTOUT 142 Q 143 ; 144 ;Edit Reminder Findings 145 ;---------------------- 146 FIND(LIST) ; 147 N DTOUT,DUOUT,NODE,SDA 148 D SET ; Check if node defined 149 S NODE="^PXD(811.9)" 150 F D Q:$D(DUOUT)!$D(DTOUT) 151 .;Display list of existing reminder findings 152 .W !!,"Reminder Definition Findings" 153 .D DSPALL("D",NODE,DA,.LIST) 154 .;Edit findings 155 .D FEDIT(DA) I $D(DUOUT)!$D(DTOUT) D LIST^PXRMREDT(NODE,DA,.LIST) Q 156 .;Update list with finding changes 157 .D LIST^PXRMREDT(NODE,DA,.LIST) 158 Q 159 ; 160 ;General help text routine 161 ;------------------------- 162 HELP(CALL) ; 163 N HTEXT 164 N DIWF,DIWL,DIWR,IC 165 S DIWF="C70",DIWL=0,DIWR=70 166 ; 167 I CALL=1 D 168 .S HTEXT(1)="Select the type of finding you wish to change or add." 169 .S HTEXT(2)="Type '?' for a list of the available finding types." 170 I CALL=2 D 171 .S HTEXT(1)="Select section of the reminder you wish to edit or 'All'" 172 .S HTEXT(2)="to step through all sections of the reminder definition." 173 I CALL=3 D 174 .S HTEXT(1)="Select 'Y' to edit the findings mapped to this term" 175 .S HTEXT(2)="or 'N' to return to select another reminder finding." 176 ; 177 K ^UTILITY($J,"W") 178 S IC="" 179 F S IC=$O(HTEXT(IC)) Q:IC="" D 180 . S X=HTEXT(IC) 181 . D ^DIWP 182 W ! 183 S IC=0 184 F S IC=$O(^UTILITY($J,"W",0,IC)) Q:IC="" D 185 . W !,^UTILITY($J,"W",0,IC,0) 186 K ^UTILITY($J,"W") 187 W ! 188 Q 189 ; 190 ;Display TERM findings 191 ;-------------------- 192 TDSP(DA) ; 193 N FIRST,SUB,TLST S FIRST=1,SUB="",SUB1="" 194 ;Build list of term findings 195 D TLST(.TLST,DA) 196 ;Display list 197 F S SUB=$O(TLST(SUB)) Q:SUB="" D 198 .S SUB1=0 199 .F S SUB1=$O(TLST(SUB,SUB1)) Q:SUB1="" D 200 ..I FIRST S FIRST=0 W !!,"Reminder Term Findings:",!! 201 ..W SUB 202 ..W ?8,SUB1,! 203 I FIRST W !!,"Term has no mapped findings",!! 204 Q 205 ; 206 ;List Reminders using this term 207 ;------------------------------ 208 TERMS(TIEN,RIEN) ; 209 ;RIEN will be the reminder ien if called from reminder edit 210 ;or zero if called from term edit 211 N ARRAY,FIND,IEN,SUB,TCNT,RNAME 212 ;Scan all reminders in file #811.9 213 S IEN=0,FIND="PXRMD(811.5,",TCNT=0 214 F S IEN=$O(^PXD(811.9,IEN)) Q:'IEN D 215 .;Exclude current reminder called in reminder edit 216 .I RIEN,IEN=RIEN Q 217 .;Check the term findings 218 .I '$D(^PXD(811.9,IEN,20,"E",FIND,TIEN)) Q 219 .;Add to reminder array 220 .S RNAME=$P($G(^PXD(811.9,IEN,0)),U) 221 .I RNAME="" S RNAME=IEN 222 .I '$D(ARRAY(RNAME)) S TCNT=TCNT+1 223 .S ARRAY(RNAME)="" 224 ; 225 ;Display list of reminders using the term 226 I TCNT D 227 .N TXT 228 .S TXT="This Reminder Term is" S:RIEN TXT=TXT_" also" 229 .S TXT=TXT_" used by the following Reminder Definition" 230 .I TCNT>1 S TXT=TXT_"s" 231 .W !!,TXT_":" 232 .S RNAME="" F S RNAME=$O(ARRAY(RNAME)) Q:RNAME="" W !," ",RNAME 233 Q 234 ; 235 ;------------------------------ 236 ;Check term for finding item to edit status item 237 TERMTYPE(TIEN) ; 238 N DRUG,FOUND,HF,ORD,OTHER,RAD,RESULT,TAX,TYPE,VF 239 S (DRUG,FOUND,HF,ORD,OTHER,RAD,RESULT,TAX,VF)=0 240 S TYPE="" F S TYPE=$O(^PXRMD(811.5,TIEN,20,"B",TYPE)) Q:TYPE="" D 241 . I TYPE["AUTTEDT(" S (OTHER,VF)=1 Q 242 . I TYPE["AUTTHF(" S (HF,OTHER,VF)=1 Q 243 . I TYPE["AUTTIMM(" S (OTHER,VF)=1 Q 244 . I TYPE["AUTTSK(" S (OTHER,VF)=1 Q 245 . I TYPE["ORD" S (ORD,FOUND)=1 Q 246 . I TYPE["PS" S (DRUG,FOUND)=1 Q 247 . I TYPE["PXD(811.2" S (FOUND,TAX,VF)=1 Q 248 . I TYPE["RAMIS" S (FOUND,RAD)=1 Q 249 . S OTHER=1 250 I RAD=1,ORD=0,TAX=0,DRUG=0,OTHER=0 S RESULT="R" 251 I RAD=0,ORD=1,TAX=0,DRUG=0,OTHER=0 S RESULT="O" 252 I RAD=0,ORD=0,TAX=1,DRUG=0,OTHER=0 S RESULT="T" 253 I RAD=0,ORD=0,TAX=0,DRUG=1,OTHER=0 S RESULT="D" 254 I OTHER=1 S RESULT=1 I FOUND=1 S RESULT=2 255 I RESULT="T" S RESULT=$$TAXTYPE^PXRMSTA1(TIEN,"") 256 I HF=1 S RESULT="H"_RESULT 257 I VF=1 S RESULT=RESULT_U_"VF" 258 Q RESULT 259 ; 260 ;Build list of mapped findings for term 261 ;-------------------------------------- 262 TLST(ARRAY,DA) ; 263 N TYPE,DATA,GLOB,IEN,NAME,NODE,SUB 264 ;Clear passed arrays 265 K ARRAY 266 ;Build cross reference global to file number 267 ;Get each finding 268 S SUB=0 F S SUB=$O(^PXRMD(811.5,DA,20,SUB)) Q:'SUB D 269 .S DATA=$G(^PXRMD(811.5,DA,20,SUB,0)) I DATA="" Q 270 .;Determine global and global ien 271 .S NODE=$P(DATA,U),GLOB=$P(NODE,";",2),IEN=$P(NODE,";") 272 .;Ignore null entries 273 .I (GLOB="")!(IEN="") Q 274 .;Work out the file type 275 .S TYPE=$G(DEF1(GLOB)) Q:TYPE="" 276 .S NAME=$P($G(@(U_GLOB_IEN_",0)")),U) 277 .S ARRAY(TYPE,NAME)="" 278 Q 279 ; 280 ;Map Term findings 281 ;----------------- 282 TMAP(RIEN,TIEN) ; 283 N TOPT,TNAM 284 ;Display any other reminders using this term 285 D TERMS(TIEN,RIEN) 286 ;Term name 287 S TNAM=$P($G(^PXRMD(811.5,TIEN,0)),U) 288 ;Give option to edit mapped findings (Y/N) 289 D TMASK(.TOPT,TNAM) Q:$D(DUOUT)!($D(DTOUT)) 290 ;Edit term findings 291 I TOPT="Y" D TRMED(TIEN) 292 Q 293 ; 294 ;Option to edit term findings 295 ;---------------------------- 296 TMASK(YESNO,TNAM) ; 297 N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y 298 S DIR(0)="YA0" 299 S DIR("A")="Do you want to edit mapped findings for "_TNAM_": " 300 S (DIR("B"),YESNO)="N" 301 S DIR("?")="Enter Y or N. For detailed help type ??" 302 S DIR("??")=U_"D HELP^PXRMREDF(3)" 303 W ! 304 D ^DIR K DIR 305 I $D(DIROUT)!$D(DIRUT) Q 306 I $D(DTOUT)!$D(DUOUT) Q 307 S YESNO=$E(Y(0)) 308 Q 309 ; 310 ;Term edit 311 ;--------- 312 TRMED(DA) ; 313 N CS1,CS2,DIC,DLAYGO,DTOUT,DUOUT,Y 314 K DLAYGO,DTOUT,DUOUT,Y 315 ;Display term findings 316 D TDSP(DA) 317 ;Initialize change history 318 S CS1=$$FILE^PXRMEXCS(811.5,DA) 319 ;Edit term findings 320 S DIC="^PXRMD(811.5," 321 D EDIT^PXRMTMED(DIC,DA) 322 ;Update change history 323 S CS2=$$FILE^PXRMEXCS(811.5,DA) 324 I CS2=0 Q 325 I CS2'=CS1 D SEHIST^PXRMUTIL(811.5,DIC,DA) 326 Q 327 ;
Note:
See TracChangeset
for help on using the changeset viewer.
