| [613] | 1 | LRAPMRL ;DALOI/WTY/KLL- AP MODIFY RELEASED REPORT;12/04/01
|
|---|
| 2 | ;;5.2;LAB SERVICE;**259,295,317,368**;Sep 27, 1994;Build 1
|
|---|
| 3 | ;
|
|---|
| 4 | MAIN ;
|
|---|
| 5 | N LRQUIT,LRMSG,LREND,LRDATA,LRREL,LRAU,LREFPD,LRWM,LRCT,LRTMP,LRGMDF
|
|---|
| 6 | N LRFLD,LRDSC,LRCHG,LRXTMP,LRYTMP,LRIENS1,LRFILE,LRFLDA,LRAD1,LRIENS
|
|---|
| 7 | N LRORIEN,LRWPROOT,LRFDA,LRDA,LRFIELD,LRFILE1,LRIENS2,LRDT0,LRESCPT
|
|---|
| 8 | N LRQUIT1,LREDIAG,LRLOCK,LRNOTXT,LRORIEN
|
|---|
| 9 | S LRESCPT=0
|
|---|
| 10 | D TITLE
|
|---|
| 11 | I LRQUIT D END Q
|
|---|
| 12 | D NOTICE
|
|---|
| 13 | I LRQUIT D END Q
|
|---|
| 14 | D SECTION
|
|---|
| 15 | I LRQUIT D END Q
|
|---|
| 16 | D WHAT
|
|---|
| 17 | I LRQUIT D END Q
|
|---|
| 18 | D CPTCHK
|
|---|
| 19 | ;D SECTION
|
|---|
| 20 | I LRQUIT D END Q
|
|---|
| 21 | D ASK
|
|---|
| 22 | I LRQUIT D END Q
|
|---|
| 23 | D SETDR^LRAPMRL1
|
|---|
| 24 | D ACCYR
|
|---|
| 25 | I LRQUIT D END Q
|
|---|
| 26 | D ACCPN
|
|---|
| 27 | D END
|
|---|
| 28 | Q
|
|---|
| 29 | ACCPN ;Prompt for accesion number or patient name
|
|---|
| 30 | F D Q:LREND
|
|---|
| 31 | .S (LRQUIT,LREND)=0
|
|---|
| 32 | .D CPTCHK
|
|---|
| 33 | .D LOOKUP^LRAPUTL(.LRDATA,LRH(0),LRO(68),LRSS,LRAD,LRAA)
|
|---|
| 34 | .I (LRDATA<1)!('$G(LRAN))!($G(LRAN)=-1) S LREND=1 Q
|
|---|
| 35 | .S LRDFN=LRDATA,LRI=LRDATA(1)
|
|---|
| 36 | .S LRLOCK="^LR(LRDFN"_$S(LRAU:")",1:",LRSS,LRI)")
|
|---|
| 37 | .L +@(LRLOCK):5 I '$T D Q
|
|---|
| 38 | ..S LRMSG="This record is locked by another user. "
|
|---|
| 39 | ..S LRMSG=LRMSG_"Please try again later."
|
|---|
| 40 | ..D EN^DDIOL(LRMSG,"","!!") K LRMSG
|
|---|
| 41 | .S LRIENS=$S('LRAU:LRI_",",1:"")_LRDFN_","
|
|---|
| 42 | .D RELCHK^LRAPMRL1
|
|---|
| 43 | .I LRQUIT D UNLOCK Q
|
|---|
| 44 | .D RELEASE^LRAPMRL1
|
|---|
| 45 | .D QUEUPD^LRAPMRL1
|
|---|
| 46 | .D:LRCAPA&'LRAU C^LRAPSWK
|
|---|
| 47 | .D:'LREDIAG SETDR^LRAPMRL1,EDIT^LRAPMRL1
|
|---|
| 48 | .I LRQUIT D UNLOCK Q
|
|---|
| 49 | .I 'LRAU D
|
|---|
| 50 | ..F LRFLD=1,1.1,1.4,1.3 D Q:LRQUIT
|
|---|
| 51 | ...Q:LREDIAG&(LRFLD'=1.4)
|
|---|
| 52 | ...Q:'LREDIAG&(LRFLD=1.4)
|
|---|
| 53 | ...Q:LRFLD=1.3&(LRSS'="SP")
|
|---|
| 54 | ...D ASK2 Q:LRQUIT!('LRGMDF)
|
|---|
| 55 | ...D SAVTXT
|
|---|
| 56 | ...K DR S DR=LRFLD
|
|---|
| 57 | ...D EDIT^LRAPMRL1
|
|---|
| 58 | ...D COMPARE Q:LRQUIT
|
|---|
| 59 | ...D AUDIT Q:LRQUIT
|
|---|
| 60 | ...D STORE
|
|---|
| 61 | .I LRAU,LREDIAG D
|
|---|
| 62 | ..S LRDSC="PATHOLOGICAL DIAGNOSIS"
|
|---|
| 63 | ..S LRFLD=32.3
|
|---|
| 64 | ..D SAVTXT
|
|---|
| 65 | ..K DR S DR=LRFLD
|
|---|
| 66 | ..D EDIT^LRAPMRL1
|
|---|
| 67 | ..D COMPARE
|
|---|
| 68 | .I $G(SEX)["F","SPCY"[LRSS D DEL^LRWOMEN
|
|---|
| 69 | .I LRQUIT D UNLOCK Q
|
|---|
| 70 | .I LREDIAG D UNLOCK Q
|
|---|
| 71 | .D:LRESCPT CPTCODE^LRAPMRL1
|
|---|
| 72 | .D UNLOCK
|
|---|
| 73 | Q
|
|---|
| 74 | TITLE ;Title
|
|---|
| 75 | S (LRQUIT,LRQUIT1)=0
|
|---|
| 76 | D CK^LRAP
|
|---|
| 77 | I Y=-1 S LRQUIT=1 Q
|
|---|
| 78 | W @IOF
|
|---|
| 79 | S LRMSG="Modify Released Pathology Reports"
|
|---|
| 80 | S LRMSG(1)=$$CJ^XLFSTR(LRMSG,IOM)
|
|---|
| 81 | S LRMSG(1,"F")="!!"
|
|---|
| 82 | S LRMSG(2)="",LRMSG(2,"F")="!"
|
|---|
| 83 | D EN^DDIOL(.LRMSG) K LRMSG
|
|---|
| 84 | Q
|
|---|
| 85 | NOTICE ;Warn the user and allow an exit
|
|---|
| 86 | K LRMSG
|
|---|
| 87 | S LRMSG="NOTICE"
|
|---|
| 88 | S LRMSG(1)=$$CJ^XLFSTR(LRMSG,IOM),LRMSG(1,"F")="!!"
|
|---|
| 89 | S LRMSG(2)="",LRMSG(2,"F")="!"
|
|---|
| 90 | S LRMSG(3)=$C(7)_"This option allows modification of a verified/"
|
|---|
| 91 | S LRMSG(3)=LRMSG(3)_"released pathology report."
|
|---|
| 92 | S LRMSG(3,"F")="!?3"
|
|---|
| 93 | S LRMSG(4)="Continuing with this option will unrelease the report "
|
|---|
| 94 | S LRMSG(4)=LRMSG(4)_"and flag the report",LRMSG(4,"F")="!?3"
|
|---|
| 95 | S LRMSG(5)="as modified even if the data is unchanged. It will "
|
|---|
| 96 | S LRMSG(5)=LRMSG(5)_"also be queued to the",LRMSG(5,"F")="!?3"
|
|---|
| 97 | S LRMSG(6)="final report queue so that it may be verified/released "
|
|---|
| 98 | S LRMSG(6)=LRMSG(6)_"again.",LRMSG(6,"F")="!?3"
|
|---|
| 99 | D EN^DDIOL(.LRMSG) K LRMSG
|
|---|
| 100 | W !!
|
|---|
| 101 | S DIR(0)="Y",DIR("A")="Do you wish to continue",DIR("B")="NO"
|
|---|
| 102 | D ^DIR
|
|---|
| 103 | S:Y<1 LRQUIT=1
|
|---|
| 104 | Q
|
|---|
| 105 | WHAT ;What is to be edited
|
|---|
| 106 | W !
|
|---|
| 107 | K DIR
|
|---|
| 108 | ;Don't ask to Edit Diagnosis if initial entry of diagnosis is turned
|
|---|
| 109 | ; off at data entry for SP, CY, EM's
|
|---|
| 110 | S LRASK=1,XASK=""
|
|---|
| 111 | I 'LRAU D
|
|---|
| 112 | .S XASK=$S(LRSS="SP":11.2,LRSS="CY":11.3,1:"")
|
|---|
| 113 | .S:XASK="" XASK=$S(LRSS="EM":11.4,1:"")
|
|---|
| 114 | .S LRASK=$$GET1^DIQ(69.9,"1,",XASK,"I")
|
|---|
| 115 | S:LRASK DIR(0)="S^1:Edit Report;2:Edit Diagnosis"
|
|---|
| 116 | S:LRASK DIR("A")="Enter selection",DIR("B")=1
|
|---|
| 117 | S:'LRASK DIR(0)="Y",DIR("B")="YES",DIR("A")="Edit Report?"
|
|---|
| 118 | D ^DIR
|
|---|
| 119 | I $D(DTOUT)!($D(DUOUT))!($D(DIRUT))!($D(DIROUT)) S LRQUIT=1 Q
|
|---|
| 120 | S:Y=0 LRQUIT=1
|
|---|
| 121 | Q:LRQUIT=1
|
|---|
| 122 | S LREDIAG=Y
|
|---|
| 123 | S LREDIAG=$S(LREDIAG=2:1,1:0)
|
|---|
| 124 | Q
|
|---|
| 125 | CPTCHK ;Determine if CPT is activated
|
|---|
| 126 | Q:$T(ES^LRCAPES)=""
|
|---|
| 127 | S LRESCPT=$$ES^LRCAPES()
|
|---|
| 128 | Q
|
|---|
| 129 | SECTION ;Choose Anatomic Pathology section (AU,SP,CY,EM)
|
|---|
| 130 | W !
|
|---|
| 131 | D ^LRAP
|
|---|
| 132 | I '$D(Y)!('$D(LRSS)) S LRQUIT=1 Q
|
|---|
| 133 | S:LRO(68)="EM" LRO(68)="ELECTRON MICROSCOPY"
|
|---|
| 134 | S LRAU=0 ; LRAU = 0 - Not Autopsy
|
|---|
| 135 | S:LRSS="AU" LRAU=1 ; = 1 - Autosy
|
|---|
| 136 | I LRCAPA D @(LRSS_"^LRAPSWK")
|
|---|
| 137 | S LRMSG(1)=LRO(68)_" ("_LRABV_")",LRMSG(1,"F")="!?20"
|
|---|
| 138 | S LRMSG(2)="",LRMSG(2,"F")="!"
|
|---|
| 139 | D EN^DDIOL(.LRMSG) K LRMSG
|
|---|
| 140 | Q
|
|---|
| 141 | ASK ;Ask etiology,function,procedure,disease,weights,measures
|
|---|
| 142 | I LREDIAG D Q
|
|---|
| 143 | .S:'LRAU LREFPD=0
|
|---|
| 144 | .S:LRAU LRWM=0
|
|---|
| 145 | W !
|
|---|
| 146 | S DIR(0)="Y",DIR("B")="NO"
|
|---|
| 147 | S DIR("A")="Edit etiology, function, procedure & disease"
|
|---|
| 148 | D ^DIR
|
|---|
| 149 | I Y="^" S LRQUIT=1 Q
|
|---|
| 150 | S LREFPD=$S(+Y:1,1:0)
|
|---|
| 151 | I LRAU D
|
|---|
| 152 | .W !
|
|---|
| 153 | .S DIR(0)="Y",DIR("B")="NO"
|
|---|
| 154 | .S DIR("A")="Edit weights and measures"
|
|---|
| 155 | .D ^DIR
|
|---|
| 156 | .I Y="^" S LRQUIT=1 Q
|
|---|
| 157 | .S LRWM=$S(+Y:1,1:0)
|
|---|
| 158 | Q
|
|---|
| 159 | ACCYR ;Determine Accession Year
|
|---|
| 160 | D ACCYR^LRAPUTL(.LRAD1,LRH(0),LRAA,LRO(68))
|
|---|
| 161 | I LRAD1=-1 S LRQUIT=1 Q
|
|---|
| 162 | I LRAD1 S LRAD=$P(LRAD1,U),LRH(0)=$P(LRAD1,U,2)
|
|---|
| 163 | Q
|
|---|
| 164 | ASK2 ;Ask about other fields
|
|---|
| 165 | S LRGMDF=0
|
|---|
| 166 | K LRDSC
|
|---|
| 167 | I LRFLD=1!(LRFLD=1.1) D
|
|---|
| 168 | .S:LRFLD=1 LRFLDA=7
|
|---|
| 169 | .S:LRFLD=1.1 LRFLDA=4
|
|---|
| 170 | .S LRDSC=$S(LRFLD=1:"GROSS",LRFLD=1.1:"MICROSCOPIC",1:"")
|
|---|
| 171 | .S LRDSC=LRDSC_" DESCRIPTION"
|
|---|
| 172 | S:LRFLD=1.4 LRDSC="DIAGNOSIS",LRFLDA=5
|
|---|
| 173 | S:LRFLD=1.3 LRDSC="FROZEN SECTION",LRFLDA=6
|
|---|
| 174 | I 'LREDIAG D
|
|---|
| 175 | .S DIR(0)="Y",DIR("B")="NO"
|
|---|
| 176 | .S DIR("A")="Edit "_LRDSC
|
|---|
| 177 | .D ^DIR
|
|---|
| 178 | .I Y="^" S LRQUIT=1 Q
|
|---|
| 179 | .S LRGMDF=$S(+Y:1,1:0)
|
|---|
| 180 | S:LREDIAG LRGMDF=1
|
|---|
| 181 | Q
|
|---|
| 182 | SAVTXT ;Save word processing field text.
|
|---|
| 183 | S LRNOTXT=0
|
|---|
| 184 | K ^TMP("DIQ1",$J)
|
|---|
| 185 | S:'LRAU LRIENS=LRI_","_LRDFN_",",LRFILE=LRSF
|
|---|
| 186 | S:LRAU LRIENS=LRDFN_",",LRFILE=63
|
|---|
| 187 | Q:LRFLD=""
|
|---|
| 188 | S LRTMP=$$GET1^DIQ(LRFILE,LRIENS,LRFLD,"","^TMP(""DIQ1"",$J)")
|
|---|
| 189 | I LRTMP="" D
|
|---|
| 190 | .K LRMSG
|
|---|
| 191 | .S LRMSG(1)="There is no "_LRDSC_" text to modify."
|
|---|
| 192 | .S LRMSG(1,"F")="!!"
|
|---|
| 193 | .S LRMSG(2)="Report was released before entering text."
|
|---|
| 194 | .S LRMSG(2,"F")="!"
|
|---|
| 195 | .D EN^DDIOL(.LRMSG)
|
|---|
| 196 | .S LRNOTXT=1
|
|---|
| 197 | Q
|
|---|
| 198 | COMPARE ;Compare report text
|
|---|
| 199 | S (LRCHG,LRQUIT,LRCT)=0
|
|---|
| 200 | S:'LRAU LRFILE="^LR(LRDFN,LRSS,LRI,LRFLD,"
|
|---|
| 201 | S:LRAU LRFILE="^LR(LRDFN,82,"
|
|---|
| 202 | I '$D(@(LRFILE_"0)")) D Q
|
|---|
| 203 | .Q:LRNOTXT
|
|---|
| 204 | .S LRQUIT=1
|
|---|
| 205 | F S LRCT=$O(@(LRFILE_"LRCT)")) Q:'LRCT D
|
|---|
| 206 | .S LRXTMP=@(LRFILE_"LRCT,0)")
|
|---|
| 207 | .I '$D(^TMP("DIQ1",$J,LRCT)) S LRCHG=1 Q
|
|---|
| 208 | .S LRYTMP=^TMP("DIQ1",$J,LRCT)
|
|---|
| 209 | .I LRXTMP'=LRYTMP S LRCHG=1
|
|---|
| 210 | I 'LRCHG D
|
|---|
| 211 | .S LRCT=0 F S LRCT=$O(^TMP("DIQ1",$J,LRCT)) Q:'LRCT D
|
|---|
| 212 | ..I '$D(@(LRFILE_"LRCT,0)")) S LRCHG=1
|
|---|
| 213 | I 'LRCHG D Q
|
|---|
| 214 | .D EN^DDIOL("No changes made to "_LRDSC_".","","!!")
|
|---|
| 215 | .W !
|
|---|
| 216 | .K ^TMP("DIQ1",$J)
|
|---|
| 217 | I LRCHG&(LRFLD=1.4!(LRFLD=32.3)) D ;Indicate that the diagnosis
|
|---|
| 218 | .K LRFDA ;has been modified.
|
|---|
| 219 | .S:'LRAU LRFDA(LRSF,LRIENS,.172)=1
|
|---|
| 220 | .;KLL-CORRECT BUG WHERE LRSF IS NULL, REPLACE LRSF WITH 63
|
|---|
| 221 | .S:LRAU LRFDA(63,LRIENS,102.2)=1
|
|---|
| 222 | .;S:LRAU LRFDA(LRSF,LRIENS,102.2)=1
|
|---|
| 223 | .D FILE^DIE("","LRFDA")
|
|---|
| 224 | Q
|
|---|
| 225 | AUDIT ;
|
|---|
| 226 | N LRNTIME
|
|---|
| 227 | K LRFDA
|
|---|
| 228 | D NOW^%DTC S LRNTIME=%
|
|---|
| 229 | S LRIENS1="+1,"_LRIENS
|
|---|
| 230 | S LRFILE=+$$GET1^DID(LRSF,LRFLDA,"","SPECIFIER")
|
|---|
| 231 | I LRFILE="" S LRQUIT=1 Q
|
|---|
| 232 | S LRFDA(1,LRFILE,LRIENS1,.01)=LRNTIME
|
|---|
| 233 | S LRFDA(1,LRFILE,LRIENS1,.02)=DUZ
|
|---|
| 234 | D UPDATE^DIE("","LRFDA(1)","LRORIEN")
|
|---|
| 235 | Q
|
|---|
| 236 | STORE ;
|
|---|
| 237 | K LRIENS1
|
|---|
| 238 | S LRIENS1=LRORIEN(1)_","_LRIENS
|
|---|
| 239 | S LRWPROOT="^TMP(""DIQ1"",$J)"
|
|---|
| 240 | D WP^DIE(LRFILE,LRIENS1,1,"",LRWPROOT)
|
|---|
| 241 | K ^TMP("DIQ1",$J)
|
|---|
| 242 | Q
|
|---|
| 243 | SUPRPT ;Supplementary Report
|
|---|
| 244 | K DIR
|
|---|
| 245 | S DIR(0)="Y",DIR("B")="NO"
|
|---|
| 246 | S DIR("A")="Edit SUPPLEMENTARY REPORTS"
|
|---|
| 247 | D ^DIR
|
|---|
| 248 | I Y="^" S LRQUIT1=1 Q
|
|---|
| 249 | Q:Y<1
|
|---|
| 250 | N LRX,LRRLS,LRA,LRFLG,LRNOW
|
|---|
| 251 | D GETRPT^LRAPDSR Q:LRQUIT
|
|---|
| 252 | S LRRLS=1,LRRLS1=0
|
|---|
| 253 | D COPY^LRAPDSR Q:LRQUIT
|
|---|
| 254 | D RPT^LRAPDSR Q:LRQUIT
|
|---|
| 255 | S Y=LRDA
|
|---|
| 256 | D RELEAS2^LRAPDSR
|
|---|
| 257 | D COMPARE^LRAPDSR Q:LRQUIT
|
|---|
| 258 | D UNRELEAS^LRAPDSR
|
|---|
| 259 | D UPDATE^LRAPDSR Q:LRQUIT
|
|---|
| 260 | D STORE^LRAPDSR
|
|---|
| 261 | Q
|
|---|
| 262 | UNLOCK ;Unlock the record
|
|---|
| 263 | D UPDATE^LRPXRM(LRDFN,$G(LRSS,"AU"),$G(LRI))
|
|---|
| 264 | L -@(LRLOCK)
|
|---|
| 265 | Q
|
|---|
| 266 | END ;Clean-up variables and quit
|
|---|
| 267 | K ^TMP("LRAPBR",$J),^TMP("TIUP",$J)
|
|---|
| 268 | D CLEAN^DILF
|
|---|
| 269 | D:$T(CLEAN^LRCAPES)'="" CLEAN^LRCAPES
|
|---|
| 270 | D V^LRU
|
|---|
| 271 | Q
|
|---|
