[613] | 1 | LA7SRR ;DALOI/JMC - Select Accessions for Resending LEDI Results ; 11/21/01
|
---|
| 2 | ;;5.2;AUTOMATED LAB INSTRUMENTS;**46,64**;Sep 27, 1994
|
---|
| 3 | ;
|
---|
| 4 | EN ; 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 | ;
|
---|
| 77 | SETTMP ; 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 | ;
|
---|
| 139 | EXIT ; 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
|
---|