[613] | 1 | LRAUDA ;AVAMC/REG/WTY/KLL - AUTOPSY PATH DATA ENTRY ;08/20/01
|
---|
| 2 | ;;5.2;LAB SERVICE;**72,248,259,322**;Sep 27, 1994
|
---|
| 3 | ;
|
---|
| 4 | L ;Define AU Section
|
---|
| 5 | S LRDICS="AU",LRQUIT=0,XPAD=""
|
---|
| 6 | D ^LRAP
|
---|
| 7 | I '$D(Y) D
|
---|
| 8 | .S LRQUIT=1
|
---|
| 9 | Q
|
---|
| 10 | P ;Autopsy Protocol
|
---|
| 11 | D L
|
---|
| 12 | I LRQUIT D END Q
|
---|
| 13 | D PDR
|
---|
| 14 | S LRSOP="P",LR(6)=1
|
---|
| 15 | D EDIT
|
---|
| 16 | Q
|
---|
| 17 | PDR ;Entry for resetting DR string
|
---|
| 18 | K DR
|
---|
| 19 | ;KLL-RESET PAD SEPARATE FROM PROTOCOL
|
---|
| 20 | S:XPAD'="D" DR="13;13.01///^S X=LRWHO;32.1;32.2;32.3;99"
|
---|
| 21 | S:XPAD="D" DR="13.01///^S X=LRWHO;32.2;32.3;14.9"
|
---|
| 22 | Q
|
---|
| 23 | PAD ;Provisional Anatomic Diagnoses
|
---|
| 24 | D L
|
---|
| 25 | I LRQUIT D END Q
|
---|
| 26 | K DR S DR="13.01///^S X=LRWHO;32.2;32.3;14.9"
|
---|
| 27 | ;KLL-S XPAD=D TO KEEP PAD SEPARATE FROM PROTOCOL
|
---|
| 28 | S XPAD="D"
|
---|
| 29 | ;
|
---|
| 30 | S LRSOP="P",LR(6)=1
|
---|
| 31 | D EDIT
|
---|
| 32 | Q
|
---|
| 33 | ;
|
---|
| 34 | S ;Special Studies
|
---|
| 35 | D L
|
---|
| 36 | I LRQUIT D END Q
|
---|
| 37 | K DR
|
---|
| 38 | S DR="N LRREL D RELEASE^LRAPUTL(.LRREL,LRDFN,LRSS) "
|
---|
| 39 | S DR=DR_"I LRREL(1) D VMSG^LRAUDA S Y=0;32"
|
---|
| 40 | S DR(2,63.2)=".01;5"
|
---|
| 41 | D EDIT
|
---|
| 42 | Q
|
---|
| 43 | B ;Autopsy Report/SNOMED Coding
|
---|
| 44 | D L
|
---|
| 45 | I LRQUIT D END Q
|
---|
| 46 | S LR(2)=1
|
---|
| 47 | D BDR
|
---|
| 48 | D EDIT
|
---|
| 49 | Q
|
---|
| 50 | BDR ;Entry for resetting DR string
|
---|
| 51 | K DR S DR="13;13.01///^S X=LRWHO;32.1;32.2;32.3;99;32"
|
---|
| 52 | S DR(2,63.2)=".01;I '$D(LR(1)) S Y=4;1;1.5;3;4"
|
---|
| 53 | S DR(3,63.21)=".01",DR(3,63.22)=".01;I '$D(LR(1)) S Y=0;1"
|
---|
| 54 | S DR(3,63.24)=".01;S:'$P(^LAB(61.5,X,0),U,3) Y=0;.02"
|
---|
| 55 | S DR(4,63.23)=".01",LRSOP="B"
|
---|
| 56 | Q
|
---|
| 57 | ;
|
---|
| 58 | A ;Autopsy Report/ICD9CM Coding
|
---|
| 59 | D L
|
---|
| 60 | I LRQUIT D END Q
|
---|
| 61 | D ADR
|
---|
| 62 | S LRSOP="A"
|
---|
| 63 | D EDIT
|
---|
| 64 | Q
|
---|
| 65 | ADR ;Entry for resetting DR string
|
---|
| 66 | K DR S DR="13;13.01///^S X=LRWHO;32.1;32.2;32.3;99;80"
|
---|
| 67 | Q
|
---|
| 68 | R ;Autopsy Supplementary Report
|
---|
| 69 | D L
|
---|
| 70 | I LRQUIT D END Q
|
---|
| 71 | S LRSOP="R",LRSFLG="S"
|
---|
| 72 | D EDIT
|
---|
| 73 | K LRSFLG
|
---|
| 74 | Q
|
---|
| 75 | I ;ICD9CM coding
|
---|
| 76 | D L
|
---|
| 77 | I LRQUIT D END Q
|
---|
| 78 | I '$D(Y) D END Q
|
---|
| 79 | S DR=80,LRSOP="I"
|
---|
| 80 | D EDIT
|
---|
| 81 | Q
|
---|
| 82 | F ;Final Anatomic DX Date
|
---|
| 83 | D L
|
---|
| 84 | I LRQUIT D END Q
|
---|
| 85 | K DR S DR="13.1;83.1;83.2"
|
---|
| 86 | S LRSOP="F"
|
---|
| 87 | D EDIT
|
---|
| 88 | Q
|
---|
| 89 | VMSG ;Verified message
|
---|
| 90 | N LRMSG
|
---|
| 91 | S LRMSG=$C(7)_"Report verified. Cannot edit with this option."
|
---|
| 92 | D EN^DDIOL(LRMSG,"","!!")
|
---|
| 93 | Q
|
---|
| 94 | EDIT ;
|
---|
| 95 | D ^LRAPDA
|
---|
| 96 | END ;
|
---|
| 97 | K LRQUIT
|
---|
| 98 | D V^LRU
|
---|
| 99 | Q
|
---|