272 lines
7.1 KiB
Mathematica
272 lines
7.1 KiB
Mathematica
LRAPMRL ;DALOI/WTY/KLL- AP MODIFY RELEASED REPORT;12/04/01
|
|
;;5.2;LAB SERVICE;**259,295,317,368**;Sep 27, 1994;Build 1
|
|
;
|
|
MAIN ;
|
|
N LRQUIT,LRMSG,LREND,LRDATA,LRREL,LRAU,LREFPD,LRWM,LRCT,LRTMP,LRGMDF
|
|
N LRFLD,LRDSC,LRCHG,LRXTMP,LRYTMP,LRIENS1,LRFILE,LRFLDA,LRAD1,LRIENS
|
|
N LRORIEN,LRWPROOT,LRFDA,LRDA,LRFIELD,LRFILE1,LRIENS2,LRDT0,LRESCPT
|
|
N LRQUIT1,LREDIAG,LRLOCK,LRNOTXT,LRORIEN
|
|
S LRESCPT=0
|
|
D TITLE
|
|
I LRQUIT D END Q
|
|
D NOTICE
|
|
I LRQUIT D END Q
|
|
D SECTION
|
|
I LRQUIT D END Q
|
|
D WHAT
|
|
I LRQUIT D END Q
|
|
D CPTCHK
|
|
;D SECTION
|
|
I LRQUIT D END Q
|
|
D ASK
|
|
I LRQUIT D END Q
|
|
D SETDR^LRAPMRL1
|
|
D ACCYR
|
|
I LRQUIT D END Q
|
|
D ACCPN
|
|
D END
|
|
Q
|
|
ACCPN ;Prompt for accesion number or patient name
|
|
F D Q:LREND
|
|
.S (LRQUIT,LREND)=0
|
|
.D CPTCHK
|
|
.D LOOKUP^LRAPUTL(.LRDATA,LRH(0),LRO(68),LRSS,LRAD,LRAA)
|
|
.I (LRDATA<1)!('$G(LRAN))!($G(LRAN)=-1) S LREND=1 Q
|
|
.S LRDFN=LRDATA,LRI=LRDATA(1)
|
|
.S LRLOCK="^LR(LRDFN"_$S(LRAU:")",1:",LRSS,LRI)")
|
|
.L +@(LRLOCK):5 I '$T D Q
|
|
..S LRMSG="This record is locked by another user. "
|
|
..S LRMSG=LRMSG_"Please try again later."
|
|
..D EN^DDIOL(LRMSG,"","!!") K LRMSG
|
|
.S LRIENS=$S('LRAU:LRI_",",1:"")_LRDFN_","
|
|
.D RELCHK^LRAPMRL1
|
|
.I LRQUIT D UNLOCK Q
|
|
.D RELEASE^LRAPMRL1
|
|
.D QUEUPD^LRAPMRL1
|
|
.D:LRCAPA&'LRAU C^LRAPSWK
|
|
.D:'LREDIAG SETDR^LRAPMRL1,EDIT^LRAPMRL1
|
|
.I LRQUIT D UNLOCK Q
|
|
.I 'LRAU D
|
|
..F LRFLD=1,1.1,1.4,1.3 D Q:LRQUIT
|
|
...Q:LREDIAG&(LRFLD'=1.4)
|
|
...Q:'LREDIAG&(LRFLD=1.4)
|
|
...Q:LRFLD=1.3&(LRSS'="SP")
|
|
...D ASK2 Q:LRQUIT!('LRGMDF)
|
|
...D SAVTXT
|
|
...K DR S DR=LRFLD
|
|
...D EDIT^LRAPMRL1
|
|
...D COMPARE Q:LRQUIT
|
|
...D AUDIT Q:LRQUIT
|
|
...D STORE
|
|
.I LRAU,LREDIAG D
|
|
..S LRDSC="PATHOLOGICAL DIAGNOSIS"
|
|
..S LRFLD=32.3
|
|
..D SAVTXT
|
|
..K DR S DR=LRFLD
|
|
..D EDIT^LRAPMRL1
|
|
..D COMPARE
|
|
.I $G(SEX)["F","SPCY"[LRSS D DEL^LRWOMEN
|
|
.I LRQUIT D UNLOCK Q
|
|
.I LREDIAG D UNLOCK Q
|
|
.D:LRESCPT CPTCODE^LRAPMRL1
|
|
.D UNLOCK
|
|
Q
|
|
TITLE ;Title
|
|
S (LRQUIT,LRQUIT1)=0
|
|
D CK^LRAP
|
|
I Y=-1 S LRQUIT=1 Q
|
|
W @IOF
|
|
S LRMSG="Modify Released Pathology Reports"
|
|
S LRMSG(1)=$$CJ^XLFSTR(LRMSG,IOM)
|
|
S LRMSG(1,"F")="!!"
|
|
S LRMSG(2)="",LRMSG(2,"F")="!"
|
|
D EN^DDIOL(.LRMSG) K LRMSG
|
|
Q
|
|
NOTICE ;Warn the user and allow an exit
|
|
K LRMSG
|
|
S LRMSG="NOTICE"
|
|
S LRMSG(1)=$$CJ^XLFSTR(LRMSG,IOM),LRMSG(1,"F")="!!"
|
|
S LRMSG(2)="",LRMSG(2,"F")="!"
|
|
S LRMSG(3)=$C(7)_"This option allows modification of a verified/"
|
|
S LRMSG(3)=LRMSG(3)_"released pathology report."
|
|
S LRMSG(3,"F")="!?3"
|
|
S LRMSG(4)="Continuing with this option will unrelease the report "
|
|
S LRMSG(4)=LRMSG(4)_"and flag the report",LRMSG(4,"F")="!?3"
|
|
S LRMSG(5)="as modified even if the data is unchanged. It will "
|
|
S LRMSG(5)=LRMSG(5)_"also be queued to the",LRMSG(5,"F")="!?3"
|
|
S LRMSG(6)="final report queue so that it may be verified/released "
|
|
S LRMSG(6)=LRMSG(6)_"again.",LRMSG(6,"F")="!?3"
|
|
D EN^DDIOL(.LRMSG) K LRMSG
|
|
W !!
|
|
S DIR(0)="Y",DIR("A")="Do you wish to continue",DIR("B")="NO"
|
|
D ^DIR
|
|
S:Y<1 LRQUIT=1
|
|
Q
|
|
WHAT ;What is to be edited
|
|
W !
|
|
K DIR
|
|
;Don't ask to Edit Diagnosis if initial entry of diagnosis is turned
|
|
; off at data entry for SP, CY, EM's
|
|
S LRASK=1,XASK=""
|
|
I 'LRAU D
|
|
.S XASK=$S(LRSS="SP":11.2,LRSS="CY":11.3,1:"")
|
|
.S:XASK="" XASK=$S(LRSS="EM":11.4,1:"")
|
|
.S LRASK=$$GET1^DIQ(69.9,"1,",XASK,"I")
|
|
S:LRASK DIR(0)="S^1:Edit Report;2:Edit Diagnosis"
|
|
S:LRASK DIR("A")="Enter selection",DIR("B")=1
|
|
S:'LRASK DIR(0)="Y",DIR("B")="YES",DIR("A")="Edit Report?"
|
|
D ^DIR
|
|
I $D(DTOUT)!($D(DUOUT))!($D(DIRUT))!($D(DIROUT)) S LRQUIT=1 Q
|
|
S:Y=0 LRQUIT=1
|
|
Q:LRQUIT=1
|
|
S LREDIAG=Y
|
|
S LREDIAG=$S(LREDIAG=2:1,1:0)
|
|
Q
|
|
CPTCHK ;Determine if CPT is activated
|
|
Q:$T(ES^LRCAPES)=""
|
|
S LRESCPT=$$ES^LRCAPES()
|
|
Q
|
|
SECTION ;Choose Anatomic Pathology section (AU,SP,CY,EM)
|
|
W !
|
|
D ^LRAP
|
|
I '$D(Y)!('$D(LRSS)) S LRQUIT=1 Q
|
|
S:LRO(68)="EM" LRO(68)="ELECTRON MICROSCOPY"
|
|
S LRAU=0 ; LRAU = 0 - Not Autopsy
|
|
S:LRSS="AU" LRAU=1 ; = 1 - Autosy
|
|
I LRCAPA D @(LRSS_"^LRAPSWK")
|
|
S LRMSG(1)=LRO(68)_" ("_LRABV_")",LRMSG(1,"F")="!?20"
|
|
S LRMSG(2)="",LRMSG(2,"F")="!"
|
|
D EN^DDIOL(.LRMSG) K LRMSG
|
|
Q
|
|
ASK ;Ask etiology,function,procedure,disease,weights,measures
|
|
I LREDIAG D Q
|
|
.S:'LRAU LREFPD=0
|
|
.S:LRAU LRWM=0
|
|
W !
|
|
S DIR(0)="Y",DIR("B")="NO"
|
|
S DIR("A")="Edit etiology, function, procedure & disease"
|
|
D ^DIR
|
|
I Y="^" S LRQUIT=1 Q
|
|
S LREFPD=$S(+Y:1,1:0)
|
|
I LRAU D
|
|
.W !
|
|
.S DIR(0)="Y",DIR("B")="NO"
|
|
.S DIR("A")="Edit weights and measures"
|
|
.D ^DIR
|
|
.I Y="^" S LRQUIT=1 Q
|
|
.S LRWM=$S(+Y:1,1:0)
|
|
Q
|
|
ACCYR ;Determine Accession Year
|
|
D ACCYR^LRAPUTL(.LRAD1,LRH(0),LRAA,LRO(68))
|
|
I LRAD1=-1 S LRQUIT=1 Q
|
|
I LRAD1 S LRAD=$P(LRAD1,U),LRH(0)=$P(LRAD1,U,2)
|
|
Q
|
|
ASK2 ;Ask about other fields
|
|
S LRGMDF=0
|
|
K LRDSC
|
|
I LRFLD=1!(LRFLD=1.1) D
|
|
.S:LRFLD=1 LRFLDA=7
|
|
.S:LRFLD=1.1 LRFLDA=4
|
|
.S LRDSC=$S(LRFLD=1:"GROSS",LRFLD=1.1:"MICROSCOPIC",1:"")
|
|
.S LRDSC=LRDSC_" DESCRIPTION"
|
|
S:LRFLD=1.4 LRDSC="DIAGNOSIS",LRFLDA=5
|
|
S:LRFLD=1.3 LRDSC="FROZEN SECTION",LRFLDA=6
|
|
I 'LREDIAG D
|
|
.S DIR(0)="Y",DIR("B")="NO"
|
|
.S DIR("A")="Edit "_LRDSC
|
|
.D ^DIR
|
|
.I Y="^" S LRQUIT=1 Q
|
|
.S LRGMDF=$S(+Y:1,1:0)
|
|
S:LREDIAG LRGMDF=1
|
|
Q
|
|
SAVTXT ;Save word processing field text.
|
|
S LRNOTXT=0
|
|
K ^TMP("DIQ1",$J)
|
|
S:'LRAU LRIENS=LRI_","_LRDFN_",",LRFILE=LRSF
|
|
S:LRAU LRIENS=LRDFN_",",LRFILE=63
|
|
Q:LRFLD=""
|
|
S LRTMP=$$GET1^DIQ(LRFILE,LRIENS,LRFLD,"","^TMP(""DIQ1"",$J)")
|
|
I LRTMP="" D
|
|
.K LRMSG
|
|
.S LRMSG(1)="There is no "_LRDSC_" text to modify."
|
|
.S LRMSG(1,"F")="!!"
|
|
.S LRMSG(2)="Report was released before entering text."
|
|
.S LRMSG(2,"F")="!"
|
|
.D EN^DDIOL(.LRMSG)
|
|
.S LRNOTXT=1
|
|
Q
|
|
COMPARE ;Compare report text
|
|
S (LRCHG,LRQUIT,LRCT)=0
|
|
S:'LRAU LRFILE="^LR(LRDFN,LRSS,LRI,LRFLD,"
|
|
S:LRAU LRFILE="^LR(LRDFN,82,"
|
|
I '$D(@(LRFILE_"0)")) D Q
|
|
.Q:LRNOTXT
|
|
.S LRQUIT=1
|
|
F S LRCT=$O(@(LRFILE_"LRCT)")) Q:'LRCT D
|
|
.S LRXTMP=@(LRFILE_"LRCT,0)")
|
|
.I '$D(^TMP("DIQ1",$J,LRCT)) S LRCHG=1 Q
|
|
.S LRYTMP=^TMP("DIQ1",$J,LRCT)
|
|
.I LRXTMP'=LRYTMP S LRCHG=1
|
|
I 'LRCHG D
|
|
.S LRCT=0 F S LRCT=$O(^TMP("DIQ1",$J,LRCT)) Q:'LRCT D
|
|
..I '$D(@(LRFILE_"LRCT,0)")) S LRCHG=1
|
|
I 'LRCHG D Q
|
|
.D EN^DDIOL("No changes made to "_LRDSC_".","","!!")
|
|
.W !
|
|
.K ^TMP("DIQ1",$J)
|
|
I LRCHG&(LRFLD=1.4!(LRFLD=32.3)) D ;Indicate that the diagnosis
|
|
.K LRFDA ;has been modified.
|
|
.S:'LRAU LRFDA(LRSF,LRIENS,.172)=1
|
|
.;KLL-CORRECT BUG WHERE LRSF IS NULL, REPLACE LRSF WITH 63
|
|
.S:LRAU LRFDA(63,LRIENS,102.2)=1
|
|
.;S:LRAU LRFDA(LRSF,LRIENS,102.2)=1
|
|
.D FILE^DIE("","LRFDA")
|
|
Q
|
|
AUDIT ;
|
|
N LRNTIME
|
|
K LRFDA
|
|
D NOW^%DTC S LRNTIME=%
|
|
S LRIENS1="+1,"_LRIENS
|
|
S LRFILE=+$$GET1^DID(LRSF,LRFLDA,"","SPECIFIER")
|
|
I LRFILE="" S LRQUIT=1 Q
|
|
S LRFDA(1,LRFILE,LRIENS1,.01)=LRNTIME
|
|
S LRFDA(1,LRFILE,LRIENS1,.02)=DUZ
|
|
D UPDATE^DIE("","LRFDA(1)","LRORIEN")
|
|
Q
|
|
STORE ;
|
|
K LRIENS1
|
|
S LRIENS1=LRORIEN(1)_","_LRIENS
|
|
S LRWPROOT="^TMP(""DIQ1"",$J)"
|
|
D WP^DIE(LRFILE,LRIENS1,1,"",LRWPROOT)
|
|
K ^TMP("DIQ1",$J)
|
|
Q
|
|
SUPRPT ;Supplementary Report
|
|
K DIR
|
|
S DIR(0)="Y",DIR("B")="NO"
|
|
S DIR("A")="Edit SUPPLEMENTARY REPORTS"
|
|
D ^DIR
|
|
I Y="^" S LRQUIT1=1 Q
|
|
Q:Y<1
|
|
N LRX,LRRLS,LRA,LRFLG,LRNOW
|
|
D GETRPT^LRAPDSR Q:LRQUIT
|
|
S LRRLS=1,LRRLS1=0
|
|
D COPY^LRAPDSR Q:LRQUIT
|
|
D RPT^LRAPDSR Q:LRQUIT
|
|
S Y=LRDA
|
|
D RELEAS2^LRAPDSR
|
|
D COMPARE^LRAPDSR Q:LRQUIT
|
|
D UNRELEAS^LRAPDSR
|
|
D UPDATE^LRAPDSR Q:LRQUIT
|
|
D STORE^LRAPDSR
|
|
Q
|
|
UNLOCK ;Unlock the record
|
|
D UPDATE^LRPXRM(LRDFN,$G(LRSS,"AU"),$G(LRI))
|
|
L -@(LRLOCK)
|
|
Q
|
|
END ;Clean-up variables and quit
|
|
K ^TMP("LRAPBR",$J),^TMP("TIUP",$J)
|
|
D CLEAN^DILF
|
|
D:$T(CLEAN^LRCAPES)'="" CLEAN^LRCAPES
|
|
D V^LRU
|
|
Q
|