source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRAPR1.m@ 767

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

initial load of WorldVistAEHR
File size: 4.1 KB
Line 
1LRAPR1 ;AVAMC/KLL- ANAT RELEASE REPORTS CONT'D;07/26/04
2 ;;5.2;LAB SERVICE;**317**;Sep 27, 1994
3 ;
4RELCHK ;Check to make sure all supp reports are released
5 N LRFILE,LRIENS,LRIENS1,LRX,LRRLS,LRFDA,LRLKFL,LRDA,LRNOSP
6 N LRMSG,LRSRFL,LRSRMD
7 S DIC("B")=""
8 I LRSS'="AU" D
9 .S LRFILE=+$$GET1^DID(LRSF,1.2,"","SPECIFIER")
10 .S LRIENS1=LRI_","_LRDFN_","
11 .S LRX=0 F S LRX=$O(^LR(LRDFN,LRSS,LRI,1.2,LRX)) Q:'LRX D
12 ..S LRIENS=LRX_","_LRIENS1
13 ..S LRSRFL=$$GET1^DIQ(LRFILE,LRIENS,.02,"I")
14 ..;LRSRMD- if flag is true, supp rpt has been modified, needs release
15 ..S LRSRMD=$$GET1^DIQ(LRFILE,LRIENS,.03,"I")
16 ..Q:LRSRFL&('LRSRMD)
17 ..S DIC("B")=$$GET1^DIQ(LRFILE,LRIENS,.01,"I")
18 I LRSS="AU" D
19 .S LRFILE=63.324
20 .S LRX=0 F S LRX=$O(^LR(LRDFN,84,LRX)) Q:'LRX D
21 ..S LRIENS=LRX_","_LRDFN_","
22 ..S LRSRFL=$$GET1^DIQ(LRFILE,LRIENS,.02,"I")
23 ..;LRSRMD- if flag is true, supp rpt has been modified, needs release
24 ..S LRSRMD=$$GET1^DIQ(LRFILE,LRIENS,.03,"I")
25 ..Q:LRSRFL&('LRSRMD)
26 ..S DIC("B")=$$GET1^DIQ(LRFILE,LRIENS,.01,"I")
27 I $G(DIC("B")) S LRQT=1
28 Q
29CHKSUP ;Check for unreleased supp reports for E-sign switch OFF
30 N LRQT,LRZ11,LRZ15,LRIENS3
31 S (LRQT,LRZ11,LRZ15)=0
32 D RELCHK
33 I LRQT D Q
34 .W !!,"All supp repts must be released before main report can be released."
35 I 'LRQT D
36 .K LRFDA
37 .D NOW^%DTC S LRNTIME=%
38 .I 'LRAU D
39 ..S LRZ15=$P($G(^LR(LRDFN,LRSS,LRI,0)),"^",15)
40 ..S LRZ11=$P($G(^LR(LRDFN,LRSS,LRI,0)),"^",11)
41 ..S LRIENS3=LRI_","_LRDFN_","
42 ..S LRFDA(LRSF,LRIENS3,.11)=LRNTIME
43 ..S LRFDA(LRSF,LRIENS3,.13)=DUZ
44 ..I 'LRZ15 S LRFDA(LRSF,LRIENS3,.15)=LRZ11
45 .I LRAU D
46 ..S LRIENS3=LRDFN_","
47 ..S LRFDA(63,LRIENS3,14.7)=LRNTIME
48 ..S LRFDA(63,LRIENS3,14.8)=DUZ
49 .;S LRSRMD=$$GET1^DIQ(LRFILE,LRIENS,.03,"I")
50 .;If MODIFY SUPP REPORT flag is set, remove it at this point
51 .;I LRSRMD S LRFDA(LRSF,LRIENS,.03)="@"
52 .D FILE^DIE("","LRFDA")
53 .W !!,"*** Main Report Has Been Released ***",!
54 Q
55UNRLSE ;Must unrelease at this point in order to successfully release
56 ; below
57 K LRFDA
58 N LRREL,LRIENS3
59 D RELEASE^LRAPUTL(.LRREL,LRDFN,LRSS,$G(LRI))
60 I 'LRAU D
61 .S LRIENS3=LRI_","_LRDFN_","
62 .I '$G(LRREL(3)) S LRFDA(LRSF,LRIENS3,.15)=LRREL(1)
63 .S LRFDA(LRSF,LRIENS3,.11)="@"
64 .S LRFDA(LRSF,LRIENS3,.13)="@"
65 I LRAU D
66 .S LRZ(2)="" ;Must null this in order to prevent unrelease
67 .S LRFDA(63,LRDFN,14.7)="@"
68 .S LRFDA(63,LRDFN,14.8)="@"
69 D FILE^DIE("","LRFDA")
70 Q
71SUPCHK ;Check Supplementary Reports
72 N LRSR,LRSR1,LRSR2,LRFILE,LRIENS,LRIENS1
73 S LRSR=0,LRSR1=1
74 I LRSS'="AU" D
75 .Q:'+$P($G(^LR(LRDFN,LRSS,LRI,1.2,0)),U,4)
76 .S LRFILE=+$$GET1^DID(LRSF,1.2,"","SPECIFIER")
77 .S LRIENS1=LRI_","_LRDFN_","
78 .F S LRSR=$O(^LR(LRDFN,LRSS,LRI,1.2,LRSR)) Q:LRSR'>0!('LRSR1) D
79 ..S LRIENS=LRSR_","_LRIENS1
80 ..S LRSR1=+$$GET1^DIQ(LRFILE,LRIENS,.02,"I")
81 ..I 'LRSR1 S LRSR2=$$GET1^DIQ(LRFILE,LRIENS,.01)
82 I LRSS="AU" D
83 .Q:'+$P($G(^LR(LRDFN,84,0)),U,4)
84 .S LRFILE=63.324,LRIENS1=LRDFN_","
85 .F S LRSR=$O(^LR(LRDFN,84,LRSR)) Q:LRSR'>0!('LRSR1) D
86 ..S LRIENS=LRSR_","_LRIENS1
87 ..S LRSR1=+$$GET1^DIQ(LRFILE,LRIENS,.02,"I")
88 ..I 'LRSR1 S LRSR2=$$GET1^DIQ(LRFILE,LRIENS,.01)
89 I 'LRSR1 D
90 .S LRMSG="Supplementary report "_LRSR2_" has not been released. "
91 .S LRMSG=LRMSG_"Cannot release."
92 .D EN^DDIOL(LRMSG,"","!!") K LRMSG
93 .S LRQUIT=1
94 Q
95CKSIGNR ;Update supp report with Releaser ID and Date/time
96 N LRIEN2,LRFLE,LRFL3
97 S LRQT2=0
98 I LRSS'="AU" D
99 .S (A,B)=0 F S A=$O(^LR(LRDFN,LRSS,LRI,1.2,LRDA,2,A)) Q:'A D
100 ..S B=A
101 .I '$D(^LR(LRDFN,LRSS,LRI,1.2,LRDA,2,B,0)) S LRQT2=1 Q
102 .S LRIEN2=B_","_LRDA_","_LRI_","_LRDFN_","
103 .S LRFLE=$S(LRSS="SP":63.8172,LRSS="CY":63.9072,LRSS="EM":63.2072,1:"")
104 .S LRFL3=$S(LRSS="SP":63.817,LRSS="CY":63.907,LRSS="EM":63.207,1:"")
105 I LRSS="AU" D
106 .S (A,B)=0 F S A=$O(^LR(LRDFN,84,LRDA,2,A)) Q:'A D
107 ..S B=A
108 .I '$D(^LR(LRDFN,84,LRDA,2,B,0)) S LRQT2=1 Q
109 .S LRIEN2=B_","_LRDA_","_LRDFN_","
110 .S LRFLE=$S(LRSS="AU":63.3242,1:"")
111 .S LRFL3=$S(LRSS="AU":63.324,1:"")
112 Q:LRQT2
113 S LRFDA(LRFLE,LRIEN2,.03)=DUZ
114 D NOW^%DTC
115 S LRFDA(LRFLE,LRIEN2,.04)=%
116 ;Must remove supp report modified flag once supp rpt is released
117 S LRFDA(LRFL3,LRIENS,.03)="@"
118 ;Set, but don't file unless unrelease required
119 S LRFDA2(LRFLE,LRIEN2,.03)="@"
120 S LRFDA2(LRFLE,LRIEN2,.04)="@"
121 Q
Note: See TracBrowser for help on using the repository browser.