source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRAPMRL1.m@ 1258

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

initial load of WorldVistAEHR
File size: 4.3 KB
Line 
1LRAPMRL1 ;DALOI/WTY/KLL- AP MODIFY RELEASED REPORT CONT'D;12/04/01
2 ;;5.2;LAB SERVICE;**259,317**;Sep 27, 1994
3 ;
4 Q
5RELCHK ;Perform series of checks
6 S LRQUIT=0
7 I LRAU,$G(^LR(LRDFN,"AU"))="" D Q
8 .S LRMSG="No information found for this accession in the "
9 .S LRMSG=LRMSG_"LAB DATA file (#63)."
10 .D EN^DDIOL(LRMSG,"","!!") K LRMSG
11 .S LRQUIT=1
12 Q:LRQUIT
13 K LRREL
14 D RELEASE^LRAPUTL(.LRREL,LRDFN,LRSS,$G(LRI))
15 I 'LRREL(1) D
16 .Q:'LRAU&($G(LRREL(3)))
17 .;KLL-SKIP THIS MSG IF AU RPT COMP DATE IS SET
18 .S RPCOMDT=$$GET1^DIQ(63,LRDFN,13,"I")
19 .Q:LRAU&($G(RPCOMDT))
20 .S LRMSG=$C(7)_"Report has not been released. Do not use this "
21 .S LRMSG=LRMSG_"option."
22 .D EN^DDIOL(LRMSG,"","!!") K LRMSG
23 .S LRQUIT=1
24 ;Has a supplemental rept been entered, but not yet released? Don't
25 ; allow modifications until supplemental rept. is released.
26 N LRSR,LRSR1,LRSR2
27 S LRSR=0,LRSR1=1
28 I LRREL(1),'LRAU D
29 .Q:'+$P($G(^LR(LRDFN,LRSS,LRI,1.2,0)),U,4)
30 .F S LRSR=$O(^LR(LRDFN,LRSS,LRI,1.2,LRSR)) Q:LRSR'>0!('LRSR1) D
31 ..S LRSR1=+$P(^LR(LRDFN,LRSS,LRI,1.2,LRSR,0),U,2)
32 ..I 'LRSR1 D
33 ...S Y=+$P(^LR(LRDFN,LRSS,LRI,1.2,LRSR,0),U)
34 ...D DD^%DT S LRSR2=Y
35 I LRREL(1),LRAU D
36 .S RPCOMDT=$$GET1^DIQ(63,LRDFN,13,"I")
37 .Q:'RPCOMDT
38 .Q:'+$P($G(^LR(LRDFN,84,0)),U,4)
39 .F S LRSR=$O(^LR(LRDFN,84,LRSR)) Q:LRSR'>0!('LRSR1) D
40 ..S LRSR1=+$P(^LR(LRDFN,84,LRSR,0),U,2)
41 ..I 'LRSR1 D
42 ...S Y=+$P(^LR(LRDFN,84,LRSR,0),U)
43 ...D DD^%DT S LRSR2=Y
44 I 'LRSR1 D
45 .S LRQUIT=1
46 .W $C(7),!,"Supplementary report "_LRSR2_" has not been released. "
47 .W !,"Cannot modify the report."
48 .S Y=0
49 Q
50RELEASE ;Unrelease report
51 N LRNTIME
52 D NOW^%DTC S LRNTIME=%
53 K LRFDA
54 I 'LRAU D
55 .I '$G(LRREL(3)) S LRFDA(LRSF,LRIENS,.15)=LRREL(1)
56 .S LRFDA(LRSF,LRIENS,.11)="@"
57 .S LRFDA(LRSF,LRIENS,.13)="@"
58 .S LRFDA(LRSF,LRIENS,.17)=LRNTIME
59 .S LRFDA(LRSF,LRIENS,.171)=DUZ
60 I LRAU D
61 .S LRFDA(63,LRIENS,14.7)="@"
62 .S LRFDA(63,LRIENS,14.8)="@"
63 .;KLL-ONLY IF REPT COMP DATE IS SET,OK TO MARK AS MODIFIED
64 .S RPCOMDT=$$GET1^DIQ(63,LRIENS,13,"I")
65 .I RPCOMDT D
66 ..S LRFDA(63,LRIENS,102)=LRNTIME
67 ..S LRFDA(63,LRIENS,102.1)=DUZ
68 D FILE^DIE("","LRFDA")
69 Q
70QUEUPD ;Update the final report print queue
71 I '$D(^LRO(69.2,LRAA,2,LRAN,0)) D
72 .K LRFDA
73 .L +^LRO(69.2,LRAA,2):5 I '$T D Q
74 ..S MSG(1)="The final reports queue is in use by another person. "
75 ..S MSG(1,"F")="!!"
76 ..S MSG(2)="You will need to add this accession to the queue later."
77 ..D EN^DDIOL(.MSG) K MSG
78 .S LRIENS="+1,"_LRAA_","
79 .S LRFDA(69.23,LRIENS,.01)=LRDFN
80 .S LRFDA(69.23,LRIENS,1)=LRI
81 .S LRFDA(69.23,LRIENS,2)=LRH(0)
82 .S LRORIEN(1)=LRAN
83 .D UPDATE^DIE("","LRFDA","LRORIEN")
84 .L -^LRO(69.2,LRAA,2)
85 Q
86EDIT ;
87 W !
88 I 'LRAU D
89 .S DA=LRI,DA(1)=LRDFN,DIE="^LR("_LRDFN_","""_LRSS_""","
90 S:LRAU DIE="^LR(",DA=LRDFN
91 D ^DIE
92 S:$D(Y) LRQUIT=1
93 S:$G(DTOUT) LRQUIT=1
94 Q
95SETDR ;Set the DR string
96 I LRAU D
97 .K DR
98 .S DR="13;13.01///^S X=LRWHO;32.1;99;11;14.1;14.5;14.6;12.1;"
99 .S DR=DR_"13.5;13.6;13.8;32;80;"
100 .S:LRWM DR=DR_"16:24;26:31;25;31.1;31.4;25.1;25.9"
101 .S DR(2,63.2)=".01;I 'LREFPD S Y=4;1;1.5;3;4;5"
102 .S DR(3,63.21)=".01",DR(3,63.22)=".01;I 'LREFPD S Y=0;1"
103 .S DR(3,63.24)=".01;S:'$P(^LAB(61.5,X,0),U,3) Y=0;.02"
104 .S DR(4,63.23)=".01"
105 I 'LRAU D
106 .S LRV=+$P($G(^LRO(69.2,LRAA,0)),U,10) ;Ask TC codes?
107 .K DR
108 .S DR=".08;.07;.011;.012;.013;.014;.015;.016;.1;.02;.021;.99;.97;"
109 .S DR=DR_"10;80;.09///^S X=LRWHO;.03"
110 .I LRSS="SP" D
111 ..S DR(2,63.12)=".01;S LR(8)=$P(^LAB(61,X,0),U,4);S:'LR(8) Y=4;2;4;"
112 ..S DR(2,63.12)=DR(2,63.12)_"I 'LREFPD S Y=5;1;1.5;3;5"
113 ..S DR(2,63.812)=".01"
114 ..S DR(3,63.16)=".01;I 'LREFPD S Y=0;1"
115 ..S DR(3,63.82)=".01;D R^LRAPD;.02"
116 .I LRSS="CY" D
117 ..S DR(2,63.902)=".01;.02"
118 ..S DR(2,63.912)=".01;S LR(8)=$P(^LAB(61,X,0),U,4);S:'LR(8) Y=4;2;4;"
119 ..S DR(2,63.912)=DR(2,63.912)_"I 'LREFPD S Y=5;1;1.5;3;5"
120 ..S DR(3,63.916)=".01;I 'LREFPD S Y=0;1"
121 ..S DR(3,63.982)=".01;D R^LRAPD;.02"
122 .I LRSS="EM" D
123 ..S DR(2,63.202)=".01"
124 ..S DR(2,63.212)=".01;S LR(8)=$P(^LAB(61,X,0),U,4);S:'LR(8) Y=4;2;4;"
125 ..S DR(2,63.212)=DR(2,63.212)_"I 'LREFPD S Y=5;1;1.5;3;5"
126 ..S DR(3,63.216)=".01;I 'LREFPD S Y=0;1"
127 ..S DR(3,63.282)=".01;S:'$P(^LAB(61.5,X,0),U,3) Y=0;.02"
128 Q
129CPTCODE ;Enter CPT codes
130 K DIR
131 S DIR(0)="Y",DIR("B")="NO"
132 S DIR("A")="Enter CPT CODING"
133 D ^DIR
134 I Y="^"!(Y<1) S LRQUIT=1 Q
135 N LRPRO
136 ;SET PROVIDER=CURRENT USER, ALLOW UPDATES
137 S LRPRO=DUZ
138 D PROVIDR^LRAPUTL
139 Q:LRQUIT
140 D CPT^LRCAPES(LRAA,LRAD,LRAN,LRPRO)
141 Q
Note: See TracBrowser for help on using the repository browser.