source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRAPD1.m@ 1801

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

initial load of WorldVistAEHR
File size: 5.2 KB
Line 
1LRAPD1 ;AVAMC/REG/WTY/KLL - AP DATA ENTRY ;9/25/00
2 ;;5.2;LAB SERVICE;**41,91,248,259,317**;Sep 27, 1994
3 ;
4 ;WTY;17-AUG-01;Unwrapped text and add kills for DR string
5 ;
6SP ;Gross Desc/Clinical Hx, Surg Path
7 S LRSOP="G"
8 K DR S DR=".09///^S X=LRWHO;.012;.013;.014;.015;.016;"
9 S DR=DR_".021//^S X=LR(""TR"");1;S:'LR(""FS"") Y=0;1.3"
10 S LR(6)=1,DR(2,63.812)=.01
11 Q
12MSP ;Micro Description/Gross Review, Surg Path
13 S LRSOP="M"
14 K DR S DR=".09///^S X=LRWHO;S:'LR(""FS"") Y=1;1.3;1;1.1;"
15 S DR=DR_"S:'LR(""DX"") Y=.02;1.4;.02;.03;S:'LRV Y=0;.14"
16 S (LR(7),LR(6))=1
17 Q
18BSP ;Micro Description/Snomed Coding
19 S LRSOP="B",(LR(2),LR(7),LR(6))=1
20 K DR S DR=".09///^S X=LRWHO;S:'LR(""FS"") Y=1;1.3;1;1.1;"
21 S DR=DR_"S:'LR(""DX"") Y=.02;1.4;.02;.03;S:'LRV Y=10;.14;10"
22 S DR(2,63.12)=".01;D T^LRAPD;S:'LR(8) Y=4;2;4;I '$D(LR(1)) S Y=0;"
23 S DR(2,63.12)=DR(2,63.12)_"1;1.5;3"
24 S DR(3,63.16)=".01;I '$D(LR(1)) S Y=0;1"
25 S DR(3,63.82)=".01;D R^LRAPD;.02"
26 Q
27ASP ;Micro Description/ICD9CM Coding
28 S LRSOP="A",(LR(7),LR(6))=1
29 K DR S DR=".09///^S X=LRWHO;S:'LR(""FS"") Y=1;1.3;1;1.1;"
30 S DR=DR_"S:'LR(""DX"") Y=.02;1.4;.02;.03;S:'LRV Y=80;.14;80"
31 Q
32SSP ;Supplementary Report, Surg Path
33 S (LRSOP,LRSFLG)="S",(LR(2),LR(7),LR(6))=1
34 K DR
35 ;Entry of Supp rept must be allowed on released reports
36 ;S DR="N LRREL D RELEASE^LRAPUTL(.LRREL,LRDFN,LRSS,LRI) "
37 ;S DR=DR_"I LRREL(1) D VMSG^LRAPD1 S LRSFLG="""",Y=0;"
38 ;S DR=DR_".09///^S X=LRWHO;.03;10"
39 S DR=".09///^S X=LRWHO;.03;10"
40 S DR(2,63.12)=".01;D T^LRAPD;S:'LR(8) Y=4;2;4;I '$D(LR(1)) "
41 S DR(2,63.12)=DR(2,63.12)_"S Y=0;1;1.5;3"
42 S DR(3,63.16)=".01;I '$D(LR(1)) S Y=0;1"
43 S DR(3,63.82)=".01;D R^LRAPD;.02"
44 Q
45PSP ;Special Studies, Surg Path
46 S LRSOP="P"
47 K DR
48 S DR="N LRREL D RELEASE^LRAPUTL(.LRREL,LRDFN,LRSS,LRI) "
49 S DR=DR_"I LRREL(1) D VMSG^LRAPD1 S Y=0;.03;10"
50 S DR(2,63.12)="5;1.5"
51 S DR(3,63.82)=".01;D R^LRAPD;.02",LR(7)=1
52 Q
53CY ;Gross Desc/Clinic Hx, Cytopath
54 S LRSOP="G"
55 K DR S DR=".09///^S X=LRWHO;.012;.013;.014;.015;.016;"
56 S DR=DR_".021//^S X=LR(""TR"");1"
57 S LR(6)=1,DR(2,63.902)=".01;.02"
58 Q
59MCY ;Micro Desc/Gross Review, Cytopath
60 S LRSOP="M"
61 K DR S DR=".09///^S X=LRWHO;1;1.1;S:'LR(""DX"") Y=.021;1.4;"
62 S DR=DR_".021//^S X=LR(""TR"");.02;.03;.101;S:'LRV Y=0;.14"
63 S (LR(7),LR(6))=1
64 Q
65BCY ;Micro Desc/SNOMED Coding, Cytopath
66 S LRSOP="B",DIC(0)="M"
67 S (LR(2),LR(7),LR(6))=1
68 K DR S DR=".09///^S X=LRWHO;1;1.1;S:'LR(""DX"") Y=.021;1.4;"
69 S DR=DR_".021//^S X=LR(""TR"");.02;.03;.101;S:'LRV Y=10;.14;10"
70 S DR(2,63.912)=".01;D T^LRAPD;S:'LR(8) Y=4;2;4;"
71 S DR(2,63.912)=DR(2,63.912)_"I '$D(LR(1)) S Y=0;1;1.5;3"
72 S DR(3,63.916)=".01;I '$D(LR(1)) S Y=0;1"
73 S DR(3,63.982)=".01;D R^LRAPD;.02"
74 Q
75ACY ;Micro Desc/ICD9CM Coding
76 S LRSOP="A"
77 S (LR(7),LR(6))=1
78 K DR S DR=".09///^S X=LRWHO;1;1.1;S:'LR(""DX"") Y=.021;1.4;"
79 S DR=DR_".021//^S X=LR(""TR"");.02;.03;.101;S:'LRV Y=80;.14;80"
80 Q
81SCY ;Supplementary Report, Cyto
82 S LRSFLG="S"
83 S (LR(2),LR(7),LR(6))=1
84 K DR
85 ;Entry of Supp rept must be allowed on released reports
86 ;S DR="N LRREL D RELEASE^LRAPUTL(.LRREL,LRDFN,LRSS,LRI) "
87 ;S DR=DR_"I LRREL(1) D VMSG^LRAPD1 S LRSFLG="""",Y=0;"
88 ;S DR=DR_".09///^S X=LRWHO;.03;10"
89 S DR=".09///^S X=LRWHO;.03;10"
90 S DR(2,63.912)=".01;D T^LRAPD;S:'LR(8) Y=4;2;4;I '$D(LR(1)) "
91 S DR(2,63.912)=DR(2,63.912)_"S Y=0;1;1.5;3"
92 S DR(3,63.916)=".01;I '$D(LR(1)) S Y=0;1"
93 S DR(3,63.982)=".01;D R^LRAPD;.02"
94 Q
95PCY ;Special Studies, Cyto
96 K DR
97 S DR="N LRREL D RELEASE^LRAPUTL(.LRREL,LRDFN,LRSS,LRI) "
98 S DR=DR_"I LRREL(1) D VMSG^LRAPD1 S Y=0;.03;10"
99 S DR(2,63.912)="5;1.5"
100 S DR(3,63.982)=".01;D R^LRAPD;.02"
101 S LR(7)=1
102 Q
103EM ;Gross Desc/Clinical Hx, Em
104 S LRSOP="G",LR(6)=1
105 K DR S DR=".09///^S X=LRWHO;.012;.013;.014;.015;.016;"
106 S DR=DR_".021//^S X=LR(""TR"");1"
107 S DR(2,63.202)=.01
108 Q
109MEM ;Micro Desc/Gross Review, EM
110 S LRSOP="M"
111 K DR S DR=".09///^S X=LRWHO;1;1.1;S:'LR(""DX"") Y=.021;1.4;"
112 S DR=DR_".021//^S X=LR(""TR"");.02;.03;S:'LRV Y=0;.14"
113 S (LR(7),LR(6))=1
114 Q
115BEM ;Micro Desc/SNOMED Coding
116 S LRSOP="B",(LR(2),LR(7),LR(6))=1
117 K DR S DR=".09///^S X=LRWHO;1;1.1;S:'LR(""DX"") Y=.021;1.4;"
118 S DR=DR_".021//^S X=LR(""TR"");.02;.03;S:'LRV Y=10;.14;10"
119 S DR(2,63.212)=".01;D T^LRAPD;S:'LR(8) Y=4;2;4;"
120 S DR(2,63.212)=DR(2,63.212)_"I '$D(LR(1)) S Y=0;1;1.5;3"
121 S DR(3,63.216)=".01;I '$D(LR(1)) S Y=0;1"
122 S DR(3,63.282)=".01;D R^LRAPD;.02"
123 Q
124AEM ;Micro Desc/ICD9CM Coding
125 S LRSOP="A"
126 S (LR(7),LR(6))=1
127 K DR S DR=".09///^S X=LRWHO;1;1.1;S:'LR(""DX"") Y=.021;1.4;"
128 S DR=DR_".021//^S X=LR(""TR"");.02;.03;S:'LRV Y=80;.14;80"
129 Q
130SEM ;Supplementary Report, EM
131 S LRSFLG="S"
132 S (LR(2),LR(7),LR(6))=1
133 K DR
134 ;Entry of Supp rept must be allowed on released reports
135 ;S DR="N LRREL D RELEASE^LRAPUTL(.LRREL,LRDFN,LRSS,LRI) "
136 ;S DR=DR_"I LRREL(1) D VMSG^LRAPD1 S LRSFLG="""",Y=0;"
137 ;S DR=DR_".09///^S X=LRWHO;.03;10"
138 S DR=".09///^S X=LRWHO;.03;10"
139 S DR(2,63.212)=".01;D T^LRAPD;S:'LR(8) Y=4;2;4;I '$D(LR(1)) "
140 S DR(2,63.212)=DR(2,63.212)_"S Y=0;1;1.5;3"
141 S DR(3,63.216)=".01;I '$D(LR(1)) S Y=0;1"
142 S DR(3,63.282)=".01;D R^LRAPD;.02"
143 Q
144PEM ;Special Studies, EM
145 K DR
146 S DR="N LRREL D RELEASE^LRAPUTL(.LRREL,LRDFN,LRSS,LRI) "
147 S DR=DR_"I LRREL(1) D VMSG^LRAPD1 S Y=0;.03;10"
148 S DR(2,63.212)=5,LR(7)=1
149 Q
150VMSG ;Verified message
151 N LRMSG
152 S LRMSG=$C(7)_"Report verified. Cannot edit with this option."
153 D EN^DDIOL(LRMSG,"","!!")
154 Q
Note: See TracBrowser for help on using the repository browser.