source: FOIAVistA/trunk/r/AUTOMATED_LAB_INSTRUMENTS-LA/LA7SRR.m@ 1806

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

initial load of FOIAVistA 6/30/08 version
File size: 4.7 KB
Line 
1LA7SRR ;DALOI/JMC - Select Accessions for Resending LEDI Results ; 11/21/01
2 ;;5.2;AUTOMATED LAB INSTRUMENTS;**46,64**;Sep 27, 1994
3 ;
4EN ; Select Accessions to resend.
5 ;
6 ; Housekeeping before we start.
7 D EXIT
8 ;
9 S (LA7CNT,LA7QUIT)=0
10 ;
11 S DIR(0)="SO^1:Range of Accessions;2:Selected Accessions"
12 S DIR("A")="Selection Method",DIR("B")=1
13 D ^DIR
14 I $D(DIRUT) D EXIT Q
15 S LA7TYPE=+Y
16 ;
17 ; Get list of accession numbers, set flags used by LRWU4.
18 S LRACC=1,LREXMPT=1
19 I LA7TYPE=1 D
20 . D ^LRWU4
21 . I LRAN<1 S LA7QUIT=1 Q
22 . S FIRST=LRAN,X=$O(^LRO(68,LRAA,1,LRAD,1,":"),-1)
23 . S DIR(0)="NO^"_LRAN_":"_X_":0",DIR("B")=LRAN
24 . S DIR("A",1)="",DIR("A")="Download from "_LRAN_" to"
25 . D ^DIR K DIR
26 . I $D(DIRUT) S LA7QUIT=1 Q
27 . S LRAN=FIRST-1,LAST=Y
28 . F S LRAN=$O(^LRO(68,LRAA,1,LRAD,1,LRAN)) Q:'LRAN!(LRAN>LAST) D SETTMP
29 I LA7TYPE=2 F D Q:LA7QUIT!(LRAN<1)
30 . D ^LRWU4
31 . I $D(DTOUT)!($D(DUOUT)) S LA7QUIT=1 Q
32 . I LRAN<1 S:'$D(^TMP("LA7S-RTM",$J)) LA7QUIT=1 Q
33 . D SETTMP
34 I LA7QUIT D EXIT Q
35 ;
36 I '$D(^TMP("LA7S-RTM",$J)) D Q
37 . S DIR("A",1)="No accessions found to retransmit."
38 . S DIR("A")="Enter RETURN to continue or '^' to exit"
39 . S DIR(0)="E"
40 . D ^DIR,EXIT
41 ;
42 S DIR("A")="Ready to retransmit"
43 S DIR("A",1)="Found "_LA7CNT_" accessions that can be retransmitted."
44 S DIR(0)="YO",DIR("B")="NO"
45 D ^DIR K DIR
46 I Y'=1 D EXIT Q
47 D EN^DDIOL("Working","","!")
48 S LA7CNT=0,LA7UID=""
49 F S LA7UID=$O(^TMP("LA7S-RTM",$J,LA7UID)) Q:LA7UID="" D
50 . K LA7X
51 . S LA7X=^TMP("LA7S-RTM",$J,LA7UID)
52 . S LA7NLT="",LA7CNT=LA7CNT+1
53 . F S LA7NLT=$O(^TMP("LA7S-RTM",$J,LA7UID,LA7NLT)) Q:LA7NLT="" D
54 . . S LA764=$$FIND1^DIC(64,"","MX",LA7NLT,"C")
55 . . I 'LA764 Q
56 . . S LA7NLTN=$$GET1^DIQ(64,LA764_",",.01)
57 . . K LA7Y
58 . . M LA7Y=^TMP("LA7S-RTM",$J,LA7UID,LA7NLT)
59 . . D SET^LA7VMSG($P(LA7X,"^"),$P(LA7X,"^",2),$P(LA7X,"^",3),$P(LA7X,"^",4),LA7NLTN,LA7NLT,$P(LA7X,"^",5),$P(LA7X,"^",6),$P(LA7X,"^",7),$P(LA7X,"^",8),.LA7Y,"ORU")
60 ;
61 ; Task background job to create messages
62 S ZTIO="",ZTRTN="ORU^LA7VMSG",ZTDTH=$H
63 S ZTDESC="Resend Lab LEDI HL7 Result Message"
64 D ^%ZTLOAD
65 ;
66 K LA7X
67 S LA7X(1)="...Done",LA7X(1,"F")=""
68 I $G(ZTSK) D
69 . S LA7X(2)=LA7CNT_" accession"_$S(LA7CNT>1:"s",1:"")_" scheduled for retransmitting of results!"
70 . S LA7X(3)="Task# "_ZTSK_" queued for processing"
71 E S LA7X(2)="*** Tasking of retransmission failed ***"
72 D EN^DDIOL(.LA7X),EXIT
73 ;
74 Q
75 ;
76 ;
77SETTMP ; Setup TMP global with accession to resend.
78 ;
79 N LA763,LA768,LA7I,LA7X,LA7Y,LR60,LR61,LRDFN,LRIDT,LRODT,LRSB,LRSS
80 ;
81 S LRSS=$P(^LRO(68,LRAA,0),"^",2)
82 F LA7I=0,.2,.3,3 S LA768(LA7I)=$G(^LRO(68,LRAA,1,LRAD,1,LRAN,LA7I))
83 S LA7UID=$P(LA768(.3),"^")
84 ;
85 ; Not a LEDI specimen
86 I '$P(LA768(.3),"^",2),'$P(LA768(.3),"^",3) D Q
87 . N LA7X
88 . S LA7X="Not a LEDI specimen - Accession "_$P(LA768(.2),"^")_" ("_LA7UID_") skipped"
89 . D EN^DDIOL(LA7X,"","!")
90 ;
91 I "CHMICYEMSP"'[LRSS!(LRSS="") D
92 . N LA7X
93 . S LA7X(1)=$$GET1^DIQ(68,LRAA_",",.02)_" subscript NOT supported at this time"
94 . S LA7X(2)="Accession "_$P(LA768(.2),"^")_" ("_LA7UID_") skipped"
95 . D EN^DDIOL(.LA7X)
96 ;
97 ; Check file #63 for order codes and results
98 ; If no order NLT code found then use default NLT
99 ; Check if test has been added to order then report results using NLT
100 ; code of the added test.
101 S LRDFN=$P(LA768(0),"^"),LRODT=$P(LA768(0),"^",4),LRIDT=$P(LA768(3),"^",5)
102 ; Check for date report completed.
103 I '$P(^LR(LRDFN,LRSS,LRIDT,0),"^",3) D Q
104 . N LA7X
105 . S LA7X="No date report completed - Accession "_$P(LA768(.2),"^")_" ("_LA7UID_") skipped"
106 . D EN^DDIOL(LA7X,"","!")
107 ;
108 I LRSS="CH" D
109 . S LRSB=1
110 . F S LRSB=$O(^LR(LRDFN,LRSS,LRIDT,LRSB)) Q:'LRSB D
111 . . S X=^LR(LRDFN,LRSS,LRIDT,LRSB)
112 . . S LA7NLT=$P($P(X,"^",3),"!")
113 . . I LA7NLT'="" S LA7Y(LA7NLT,LRSB)="" Q
114 . . S LR61=+$P(^LR(LRDFN,LRSS,LRIDT,0),"^",5)
115 . . S LA7NLT=$P($$DEFCODE^LA7VHLU5(LRSS,LRSB,$P(X,"^",3),LR61),"!")
116 . . I LA7NLT'="" S LA7Y(LA7NLT,LRSB)=""
117 ;
118 I LRSS="MI" D
119 . S LR60=0
120 . F S LR60=$O(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LR60)) Q:'LR60 D
121 . . S LA764=$P($G(^LAB(60,LR60,64)),"^")
122 . . S LA7NLT=$$GET1^DIQ(64,LA764_",",1)
123 . . I LA7NLT'="" S LA7Y(LA7NLT)=""
124 ;
125 I LRSS="SP" S LA7Y("88515.0000")=""
126 I LRSS="CY" S LA7Y("88593.0000")=""
127 I LRSS="EM" S LA7Y("88597.0000")=""
128 I LRSS="AU" S LA7Y("88533.0000")=""
129 ;
130 I LA7UID'="",$D(LA7Y) D
131 . S LA7CNT=LA7CNT+1
132 . S X=$P(LA768(.3),"^",1)_"^"_$P(LA768(.3),"^",2)_"^"_$P(LA768(.3),"^",5)_"^"_$P(LA768(.3),"^",3)_"^"_LRIDT_"^"_LRSS_"^"_LRDFN_"^"_LRODT
133 . S ^TMP("LA7S-RTM",$J,LA7UID)=X
134 . S LA7I=""
135 . F S LA7I=$O(LA7Y(LA7I)) Q:LA7I="" M ^TMP("LA7S-RTM",$J,LA7UID,LA7I)=LA7Y(LA7I)
136 Q
137 ;
138 ;
139EXIT ; Housekeeping - clean up.
140 K ^TMP("LA7S-RTM",$J)
141 K LA764,LA7CNT,LA7NLT,LA7NLTN,LA7QUIT,LA7TYPE,LA7UID,LA7X,LA7Y
142 K LRAA,LRACC,LRAD,LRAN,LREXMPT,LRIDIV,LRSS,LRX
143 K %DT,DA,DIC,DIR,DIRUT,DTOUT,DUOUT,FIRST,LAST,X,Y
144 K ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK
145 Q
Note: See TracBrowser for help on using the repository browser.