source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRAPDSR.m@ 1006

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

initial load of WorldVistAEHR

File size: 4.6 KB
Line 
1LRAPDSR ;DALOI/WTY/KLL - AP SUPPLEMENTARY REPORT ENTRY;12/05/00
2 ;;5.2;LAB SERVICE;**248,259,295,317**;Sep 27, 1994
3 ;
4 N LRYTMP,LRWPROOT,LRRLS,LRRLS1,LRRLS2,LRX,LRIENS,LRFILE1,LRFILE,LRA
5 N LRIENS1,LRXTMP,LRFDA,LRNOW,LRIENS2,LRFIELD,LRORIEN,LRFLG,LRDA,LRQUIT
6 ;
7MAIN ;Main Subroutine
8 D RELEAS1
9 D GETRPT
10 Q:LRQUIT
11 D RELEAS2
12 D:LRRLS COPY
13 Q:LRQUIT
14 D RPT
15 ;Add supp report to the PRELIMINARY print queue
16 D QUESP
17 Q:LRQUIT
18 D COMPARE
19 Q:LRQUIT
20 ;If supp report is already released (LRRLS1), unrelease it,
21 ; but only if the E-Sign Switch is ON (LRESSW)
22 N LRESSW
23 D GETDATA^LRAPESON(.LRESSW)
24 I LRRLS1,LRESSW D UNRELEAS
25 D UPDATE
26 Q:LRQUIT
27 D STORE
28 Q
29RELEAS1 ;Is the ENTIRE report already released?
30 S (LRRLS,LRRLS1,LRQUIT)=0
31 I LRSS="AU" D Q
32 .S LRX=$P($G(^LR(LRDFN,LRSS)),"^",15)
33 .Q:'LRX ;Report has not been released so no audit will occur.
34 .W $C(7),!!,"This AUTOPSY has been released. Supplementary report "
35 .W "additions/modifications"
36 .W !,"will create an audit trail.",!
37 .S LRRLS=1 ;Report has been released so auditing will occur.
38 S LRX=$P($G(^LR(LRDFN,LRSS,LRI,0)),"^",11)
39 ;
40 I LRX D
41 .W $C(7),!!,"This "_$G(LRAA(1))_" report has been released."
42 .W !,"Supplementary report additions/modifications will create"
43 .W " an audit trail.",!
44 .S LRRLS=1
45 Q
46GETRPT ;First, select the report
47 S DIC(0)="QAEZL",DLAYGO=63
48 S DIC("A")="Select SUPPLEMENTARY REPORT DATE: "
49 S DIC=$S(LRSS="AU":"^LR(LRDFN,84,",1:"^LR(LRDFN,LRSS,LRI,1.2,")
50 S DIC("P")=$S(LRSS="AU":"63,32.4,0",1:"LRSF,1.2,0")
51 S DIC("P")=$P(@("^DD("_DIC("P")_")"),"^",2)
52 S DIC("B")="" S LRX=0 F S LRX=$O(@(DIC_"LRX)")) Q:'LRX D
53 .S DIC("B")=+(@(DIC_"LRX,0)"))
54 D ^DIC K DLAYGO
55 S:Y=-1 LRQUIT=1
56 Q
57RELEAS2 ;Is the supplementary report already released?
58 S LRRLS2=0
59 S:LRSS'="AU" LRX=$G(^LR(LRDFN,LRSS,LRI,1.2,+Y,0))
60 S:LRSS="AU" LRX=$G(^LR(LRDFN,84,+Y,0))
61 S LRRLS2=+$P(LRX,"^",2)
62 I LRRLS2 D
63 .W $C(7),!!,"This supplementary report has been released. Additions/"
64 .W "modifications",!,"will create an audit trail.",!
65 .S LRRLS1=1
66 Q
67COPY ;Make a copy of the current report.
68 K ^TMP("DIQ1",$J)
69 S LRIENS=+Y_","_$S(LRSS'="AU":LRI_",",1:"")_LRDFN_","
70 S LRFILE1=$S(LRSS="SP":63.817,LRSS="CY":63.907,LRSS="EM":63.207,1:"")
71 S:LRFILE1="" LRFILE1=$S(LRSS="AU":63.324,1:"")
72 I LRFILE1="" S LRQUIT=1 Q
73 D GETS^DIQ(LRFILE1,LRIENS,"**","Z","^TMP(""DIQ1"",$J)")
74 Q
75RPT ;
76 N DIE,DA,DR
77 S DIE=DIC K DIC
78 S (LRDA,DA)=+Y
79 S:LRSS="AU" DA(1)=LRDFN
80 S:LRSS'="AU" DA(1)=LRI,DA(2)=LRDFN
81 S DR=".01;1" D ^DIE
82 I 'LRRLS S LRQUIT=1
83 Q
84QUESP ;Update the preliminary report print queue
85 N LRIENS
86 I '$D(^LRO(69.2,LRAA,1,LRAN,0)) D
87 .K LRFDA
88 .L +^LRO(69.2,LRAA,1):5 I '$T D Q
89 ..S MSG(1)="The preliminary reports queue is in use. "
90 ..S MSG(1,"F")="!!"
91 ..S MSG(2)="You will need to add this accession to the queue later."
92 ..D EN^DDIOL(.MSG) K MSG
93 .S LRIENS="+1,"_LRAA_","
94 .S LRFDA(69.21,LRIENS,.01)=LRDFN
95 .S LRFDA(69.21,LRIENS,1)=LRI
96 .S LRFDA(69.21,LRIENS,2)=LRH(0)
97 .S LRORIEN(1)=LRAN
98 .D UPDATE^DIE("","LRFDA","LRORIEN")
99 .L -^LRO(69.2,LRAA,1)
100 Q
101COMPARE ;Compare reports
102 I '$D(^TMP("DIQ1",$J)) S LRQUIT=1 Q
103 S:LRSS'="AU" LRFILE="^LR(LRDFN,LRSS,LRI,1.2,LRDA,1,"
104 S:LRSS="AU" LRFILE="^LR(LRDFN,84,LRDA,1,"
105 I '$D(@(LRFILE_"0)")) D Q
106 .D:LRRLS1 UNRELEAS
107 .S LRQUIT=1
108 S LRA=0,LRFLG=1
109 F S LRA=$O(@(LRFILE_"LRA)")) Q:'LRA D
110 .S LRXTMP=@(LRFILE_"LRA,0)")
111 .S:'$D(^TMP("DIQ1",$J,LRFILE1,LRIENS,1,LRA,0)) LRFLG=0
112 .Q:'LRFLG
113 .S LRYTMP=^TMP("DIQ1",$J,LRFILE1,LRIENS,1,LRA,0)
114 .I LRXTMP'=LRYTMP S LRFLG=0
115 I LRFLG D
116 .S LRA=0 F S LRA=$O(^TMP("DIQ1",$J,LRFILE1,LRIENS,1,LRA)) Q:'LRA D
117 ..I '$D(@(LRFILE_"LRA,0)")) S LRFLG=0
118 I LRFLG D
119 .W $C(7),!!,"No changes were made to the supplementary report."
120 .K ^TMP("DIQ1",$J)
121 .S LRQUIT=1
122 Q
123UNRELEAS ;Unrelease the supplementary report.
124 K LRFDA
125 S LRFDA(1,LRFILE1,LRIENS,.02)="@"
126 D UPDATE^DIE("","LRFDA(1)")
127 Q
128UPDATE ;File changes
129 ;First, store the date of the change and user ID
130 D UPDATE^LRPXRM(LRDFN,LRSS,+$G(LRI))
131 K LRFDA
132 S X="NOW",%DT="T" D ^%DT S LRNOW=Y
133 S LRIENS1="+1,"_LRIENS
134 S LRFILE=$S(LRSS="SP":63.8172,LRSS="CY":63.9072,LRSS="EM":63.2072,1:"")
135 S:LRFILE="" LRFILE=$S(LRSS="AU":63.3242,1:"")
136 I LRFILE="" S LRQUIT=1 Q
137 S LRFDA(1,LRFILE,LRIENS1,.01)=LRNOW
138 S LRFDA(1,LRFILE,LRIENS1,.02)=DUZ,LRFIELD=1
139 D UPDATE^DIE("","LRFDA(1)","LRORIEN")
140 ;If E-Sign switch OFF,set 3rd piece .03 SUPP REPORT MODIFIED to 1
141 ; to flag the supp report so it can be released via RS
142 I 'LRESSW D
143 .S:LRSS'="AU" $P(^LR(LRDFN,LRSS,LRI,1.2,LRDA,0),"^",3)=1
144 .S:LRSS="AU" $P(^LR(LRDFN,84,LRDA,0),"^",3)=1
145 Q
146STORE ;Second, store the original report
147 S LRIENS2=LRORIEN(1)_","_LRIENS
148 S LRWPROOT="^TMP(""DIQ1"",$J,LRFILE1,LRIENS,1)"
149 D WP^DIE(LRFILE,LRIENS2,LRFIELD,"",LRWPROOT)
150 K ^TMP("DIQ1",$J)
151 Q
Note: See TracBrowser for help on using the repository browser.