LRAUDA.m

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 ---LRAUDA   2081     printed  Feb 18, 2025@23:35:34                                                                                                                                                                                                      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