source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRAPX.m@ 1739

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

initial load of WorldVistAEHR

File size: 2.0 KB
RevLine 
[613]1LRAPX ;AVAMC/REG/WTY - AP CODING ;11/26/01
2 ;;5.2;LAB SERVICE;**72,259**;Sep 27, 1994
3 ;
4 D ^LRAP
5 I '$D(Y) D END Q
6 D @LRSS,END
7 Q
8SP ;SNOMED coding, surg path
9 S LR(2)=1,DR="K LRREL D RELCHK^LRAPX I LRREL(1) S Y=10;.03;10"
10 S DR(2,63.12)=".01;S LR(8)=$P(^LAB(61,X,0),U,4);S:'LR(8) Y=4;2;4;"
11 S DR(2,63.12)=DR(2,63.12)_"I '$D(LR(1)) S Y=0;1;1.5;3"
12 S DR(3,63.16)=".01;I '$D(LR(1)) S Y=0;1"
13 S DR(3,63.82)=".01;S:'$P(^LAB(61.5,X,0),U,3) Y=0;.02"
14 D ^LRAPDA,END
15 Q
16CY ;SNOMED coding, cytopath
17 S LR(2)=1,DR="K LRREL D RELCHK^LRAPX I LRREL(1) S Y=10;.03;10"
18 S DR(2,63.912)=".01;S LR(8)=$P(^LAB(61,X,0),U,4);S:'LR(8) Y=4;2;4;"
19 S DR(2,63.912)=DR(2,63.912)_"I '$D(LR(1)) S Y=0;1;1.5;3"
20 S DR(3,63.916)=".01;I '$D(LR(1)) S Y=0;1"
21 S DR(3,63.982)=".01;S:'$P(^LAB(61.5,X,0),U,3) Y=0;.02"
22 D ^LRAPDA,END
23 Q
24EM ;SNOMED coding, EM
25 S LR(2)=1,DR="K LRREL D RELCHK^LRAPX I LRREL(1) S Y=10;.03;10"
26 S DR(2,63.212)=".01;S LR(8)=$P(^LAB(61,X,0),U,4);S:'LR(8) Y=4;2;4;"
27 S DR(2,63.212)=DR(2,63.212)_"I '$D(LR(1)) S Y=0;1;1.5;3"
28 S DR(3,63.216)=".01;I '$D(LR(1)) S Y=0;1"
29 S DR(3,63.282)=".01;S:'$P(^LAB(61.5,X,0),U,3) Y=0;.02"
30 D ^LRAPDA,END
31 Q
32AU ;SNOMED coding, autopsy
33 S LR(2)=1
34 S DR="K LRREL D RELCHK^LRAPX I LRREL(1) S Y=13.01;13;"
35 S DR=DR_"13.01///^S X=LRWHO;32"
36 S DR(2,63.2)=".01;I '$D(LR(1)) S Y=4;1;1.5;3;4"
37 S DR(3,63.21)=".01"
38 S DR(3,63.22)=".01;I '$D(LR(1)) S Y=0;1"
39 S DR(3,63.24)=".01;S:'$P(^LAB(61.5,X,0),U,3) Y=0;.02"
40 S DR(4,63.23)=".01"
41 ;SET LRSOP="H" SO IT WILL SKIP ALL EDITS AND ONLY EXECUTE DIR
42 S LRSOP="H"
43 D ^LRAPDA,END
44 Q
45ISP ;ICD9CM coding, surg path
46 S DR="K LRREL D RELCHK^LRAPX I LRREL(1) S Y=80;.03;80"
47 D ^LRAPDA,END
48 Q
49ICY ;ICD9CM coding, cytopath
50 S DR="K LRREL D RELCHK^LRAPX I LRREL(1) S Y=80;.03;80"
51 D ^LRAPDA,END
52 Q
53IEM ;ICD9CM coding, EM
54 S DR="K LRREL D RELCHK^LRAPX I LRREL(1) S Y=80;.03;80"
55 D ^LRAPDA,END
56 Q
57IAU ;ICD9CM coding, autopsy
58 S DR=80
59 D ^LRAPDA,END
60 Q
61EN ;entry point for ICD9CM coding
62 D ^LRAP
63 I '$D(Y) D END Q
64 D @("I"_LRSS),END
65 Q
66RELCHK ;Check to see if report is released
67 D RELEASE^LRAPUTL(.LRREL,LRDFN,LRSS,LRI)
68 Q
69END ;
70 K LRREL
71 D V^LRU
72 Q
Note: See TracBrowser for help on using the repository browser.