LRAUDA ;AVAMC/REG/WTY/KLL - AUTOPSY PATH DATA ENTRY ;08/20/01
;;5.2;LAB SERVICE;**72,248,259,322,422**;Sep 27, 1994;Build 29
;
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/ICDCM 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;"_$S($G(LRCDSYS)=30:"D EN^LRAPICD(LRDXV)",1:80)
Q
R ;Autopsy Supplementary Report
D L
I LRQUIT D END Q
S LRSOP="R",LRSFLG="S"
D EDIT
K LRSFLG
Q
I ;ICDCM coding
D L
I LRQUIT D END Q
I '$D(Y) D END Q
S DR=$S($G(LRCDSYS)=30:"D EN^LRAPICD(LRDXV)",1: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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRAUDA 2081 printed Dec 13, 2024@02:09:41 Page 2
LRAUDA ;AVAMC/REG/WTY/KLL - AUTOPSY PATH DATA ENTRY ;08/20/01
+1 ;;5.2;LAB SERVICE;**72,248,259,322,422**;Sep 27, 1994;Build 29
+2 ;
L ;Define AU Section
+1 SET LRDICS="AU"
SET LRQUIT=0
SET XPAD=""
+2 DO ^LRAP
+3 IF '$DATA(Y)
Begin DoDot:1
+4 SET LRQUIT=1
End DoDot:1
+5 QUIT
P ;Autopsy Protocol
+1 DO L
+2 IF LRQUIT
DO END
QUIT
+3 DO PDR
+4 SET LRSOP="P"
SET LR(6)=1
+5 DO EDIT
+6 QUIT
PDR ;Entry for resetting DR string
+1 KILL DR
+2 ;KLL-RESET PAD SEPARATE FROM PROTOCOL
+3 if XPAD'="D"
SET DR="13;13.01///^S X=LRWHO;32.1;32.2;32.3;99"
+4 if XPAD="D"
SET DR="13.01///^S X=LRWHO;32.2;32.3;14.9"
+5 QUIT
PAD ;Provisional Anatomic Diagnoses
+1 DO L
+2 IF LRQUIT
DO END
QUIT
+3 KILL DR
SET DR="13.01///^S X=LRWHO;32.2;32.3;14.9"
+4 ;KLL-S XPAD=D TO KEEP PAD SEPARATE FROM PROTOCOL
+5 SET XPAD="D"
+6 ;
+7 SET LRSOP="P"
SET LR(6)=1
+8 DO EDIT
+9 QUIT
+10 ;
S ;Special Studies
+1 DO L
+2 IF LRQUIT
DO END
QUIT
+3 KILL DR
+4 SET DR="N LRREL D RELEASE^LRAPUTL(.LRREL,LRDFN,LRSS) "
+5 SET DR=DR_"I LRREL(1) D VMSG^LRAUDA S Y=0;32"
+6 SET DR(2,63.2)=".01;5"
+7 DO EDIT
+8 QUIT
B ;Autopsy Report/SNOMED Coding
+1 DO L
+2 IF LRQUIT
DO END
QUIT
+3 SET LR(2)=1
+4 DO BDR
+5 DO EDIT
+6 QUIT
BDR ;Entry for resetting DR string
+1 KILL DR
SET DR="13;13.01///^S X=LRWHO;32.1;32.2;32.3;99;32"
+2 SET DR(2,63.2)=".01;I '$D(LR(1)) S Y=4;1;1.5;3;4"
+3 SET DR(3,63.21)=".01"
SET DR(3,63.22)=".01;I '$D(LR(1)) S Y=0;1"
+4 SET DR(3,63.24)=".01;S:'$P(^LAB(61.5,X,0),U,3) Y=0;.02"
+5 SET DR(4,63.23)=".01"
SET LRSOP="B"
+6 QUIT
+7 ;
A ;Autopsy Report/ICDCM Coding
+1 DO L
+2 IF LRQUIT
DO END
QUIT
+3 DO ADR
+4 SET LRSOP="A"
+5 DO EDIT
+6 QUIT
ADR ;Entry for resetting DR string
+1 KILL DR
SET DR="13;13.01///^S X=LRWHO;32.1;32.2;32.3;99;"_$SELECT($GET(LRCDSYS)=30:"D EN^LRAPICD(LRDXV)",1:80)
+2 QUIT
R ;Autopsy Supplementary Report
+1 DO L
+2 IF LRQUIT
DO END
QUIT
+3 SET LRSOP="R"
SET LRSFLG="S"
+4 DO EDIT
+5 KILL LRSFLG
+6 QUIT
I ;ICDCM coding
+1 DO L
+2 IF LRQUIT
DO END
QUIT
+3 IF '$DATA(Y)
DO END
QUIT
+4 SET DR=$SELECT($GET(LRCDSYS)=30:"D EN^LRAPICD(LRDXV)",1:80)
SET LRSOP="I"
+5 DO EDIT
+6 QUIT
F ;Final Anatomic DX Date
+1 DO L
+2 IF LRQUIT
DO END
QUIT
+3 KILL DR
SET DR="13.1;83.1;83.2"
+4 SET LRSOP="F"
+5 DO EDIT
+6 QUIT
VMSG ;Verified message
+1 NEW LRMSG
+2 SET LRMSG=$CHAR(7)_"Report verified. Cannot edit with this option."
+3 DO EN^DDIOL(LRMSG,"","!!")
+4 QUIT
EDIT ;
+1 DO ^LRAPDA
END ;
+1 KILL LRQUIT
+2 DO V^LRU
+3 QUIT
