100 lines
1.8 KiB
Mathematica
100 lines
1.8 KiB
Mathematica
LRAUDA ;AVAMC/REG/WTY/KLL - AUTOPSY PATH DATA ENTRY ;08/20/01
|
|
;;5.2;LAB SERVICE;**72,248,259,322**;Sep 27, 1994
|
|
;
|
|
L ;Define AU Section
|
|
S LRDICS="AU",LRQUIT=0,XPAD=""
|
|
D ^LRAP
|
|
I '$D(Y) D
|
|
.S LRQUIT=1
|
|
Q
|
|
P ;Autopsy Protocol
|
|
D L
|
|
I LRQUIT D END Q
|
|
D PDR
|
|
S LRSOP="P",LR(6)=1
|
|
D EDIT
|
|
Q
|
|
PDR ;Entry for resetting DR string
|
|
K DR
|
|
;KLL-RESET PAD SEPARATE FROM PROTOCOL
|
|
S:XPAD'="D" DR="13;13.01///^S X=LRWHO;32.1;32.2;32.3;99"
|
|
S:XPAD="D" DR="13.01///^S X=LRWHO;32.2;32.3;14.9"
|
|
Q
|
|
PAD ;Provisional Anatomic Diagnoses
|
|
D L
|
|
I LRQUIT D END Q
|
|
K DR S DR="13.01///^S X=LRWHO;32.2;32.3;14.9"
|
|
;KLL-S XPAD=D TO KEEP PAD SEPARATE FROM PROTOCOL
|
|
S XPAD="D"
|
|
;
|
|
S LRSOP="P",LR(6)=1
|
|
D EDIT
|
|
Q
|
|
;
|
|
S ;Special Studies
|
|
D L
|
|
I LRQUIT D END Q
|
|
K DR
|
|
S DR="N LRREL D RELEASE^LRAPUTL(.LRREL,LRDFN,LRSS) "
|
|
S DR=DR_"I LRREL(1) D VMSG^LRAUDA S Y=0;32"
|
|
S DR(2,63.2)=".01;5"
|
|
D EDIT
|
|
Q
|
|
B ;Autopsy Report/SNOMED Coding
|
|
D L
|
|
I LRQUIT D END Q
|
|
S LR(2)=1
|
|
D BDR
|
|
D EDIT
|
|
Q
|
|
BDR ;Entry for resetting DR string
|
|
K DR S DR="13;13.01///^S X=LRWHO;32.1;32.2;32.3;99;32"
|
|
S DR(2,63.2)=".01;I '$D(LR(1)) S Y=4;1;1.5;3;4"
|
|
S DR(3,63.21)=".01",DR(3,63.22)=".01;I '$D(LR(1)) S Y=0;1"
|
|
S DR(3,63.24)=".01;S:'$P(^LAB(61.5,X,0),U,3) Y=0;.02"
|
|
S DR(4,63.23)=".01",LRSOP="B"
|
|
Q
|
|
;
|
|
A ;Autopsy Report/ICD9CM Coding
|
|
D L
|
|
I LRQUIT D END Q
|
|
D ADR
|
|
S LRSOP="A"
|
|
D EDIT
|
|
Q
|
|
ADR ;Entry for resetting DR string
|
|
K DR S DR="13;13.01///^S X=LRWHO;32.1;32.2;32.3;99;80"
|
|
Q
|
|
R ;Autopsy Supplementary Report
|
|
D L
|
|
I LRQUIT D END Q
|
|
S LRSOP="R",LRSFLG="S"
|
|
D EDIT
|
|
K LRSFLG
|
|
Q
|
|
I ;ICD9CM coding
|
|
D L
|
|
I LRQUIT D END Q
|
|
I '$D(Y) D END Q
|
|
S DR=80,LRSOP="I"
|
|
D EDIT
|
|
Q
|
|
F ;Final Anatomic DX Date
|
|
D L
|
|
I LRQUIT D END Q
|
|
K DR S DR="13.1;83.1;83.2"
|
|
S LRSOP="F"
|
|
D EDIT
|
|
Q
|
|
VMSG ;Verified message
|
|
N LRMSG
|
|
S LRMSG=$C(7)_"Report verified. Cannot edit with this option."
|
|
D EN^DDIOL(LRMSG,"","!!")
|
|
Q
|
|
EDIT ;
|
|
D ^LRAPDA
|
|
END ;
|
|
K LRQUIT
|
|
D V^LRU
|
|
Q
|