source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRAUDA.m@ 789

Last change on this file since 789 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.8 KB
Line 
1LRAUDA ;AVAMC/REG/WTY/KLL - AUTOPSY PATH DATA ENTRY ;08/20/01
2 ;;5.2;LAB SERVICE;**72,248,259,322**;Sep 27, 1994
3 ;
4L ;Define AU Section
5 S LRDICS="AU",LRQUIT=0,XPAD=""
6 D ^LRAP
7 I '$D(Y) D
8 .S LRQUIT=1
9 Q
10P ;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
17PDR ;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
23PAD ;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 ;
34S ;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
43B ;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
50BDR ;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 ;
58A ;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
65ADR ;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
68R ;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
75I ;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
82F ;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
89VMSG ;Verified message
90 N LRMSG
91 S LRMSG=$C(7)_"Report verified. Cannot edit with this option."
92 D EN^DDIOL(LRMSG,"","!!")
93 Q
94EDIT ;
95 D ^LRAPDA
96END ;
97 K LRQUIT
98 D V^LRU
99 Q
Note: See TracBrowser for help on using the repository browser.