Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: LA7SRR

LA7SRR.m

Go to the documentation of this file.
  1. LA7SRR ;DALOI/JMC - Select Accessions for Resending LEDI Results ;11/20/09 14:09
  1. ;;5.2;AUTOMATED LAB INSTRUMENTS;**46,64,74**;Sep 27, 1994;Build 229
  1. ;
  1. EN ; Select Accessions to resend.
  1. ;
  1. ; Housekeeping before we start.
  1. D EXIT
  1. ;
  1. S (LA7CNT,LA7QUIT)=0
  1. ;
  1. S DIR(0)="SO^1:Range of Accessions;2:Selected Accessions"
  1. S DIR("A")="Selection Method",DIR("B")=1
  1. D ^DIR
  1. I $D(DIRUT) D EXIT Q
  1. S LA7TYPE=+Y
  1. ;
  1. ; Get list of accession numbers, set flags used by LRWU4.
  1. S LRACC=1,LREXMPT=1
  1. I LA7TYPE=1 D
  1. . D ^LRWU4
  1. . I LRAN<1 S LA7QUIT=1 Q
  1. . S FIRST=LRAN,X=$O(^LRO(68,LRAA,1,LRAD,1,":"),-1)
  1. . S DIR(0)="NO^"_LRAN_":"_X_":0",DIR("B")=LRAN
  1. . S DIR("A",1)="",DIR("A")="Retransmit from "_LRAN_" to"
  1. . D ^DIR K DIR
  1. . I $D(DIRUT) S LA7QUIT=1 Q
  1. . S LRAN=FIRST-1,LAST=Y
  1. . F S LRAN=$O(^LRO(68,LRAA,1,LRAD,1,LRAN)) Q:'LRAN!(LRAN>LAST) D SETTMP
  1. I LA7TYPE=2 F D Q:LA7QUIT!(LRAN<1)
  1. . D ^LRWU4
  1. . I $D(DTOUT)!($D(DUOUT)) S LA7QUIT=1 Q
  1. . I LRAN<1 S:'$D(^TMP("LA7S-RTM",$J)) LA7QUIT=1 Q
  1. . D SETTMP
  1. I LA7QUIT D EXIT Q
  1. ;
  1. I '$D(^TMP("LA7S-RTM",$J)) D Q
  1. . S DIR("A",1)="No accessions found to retransmit."
  1. . S DIR("A")="Enter RETURN to continue or '^' to exit"
  1. . S DIR(0)="E"
  1. . D ^DIR,EXIT
  1. ;
  1. S DIR("A")="Ready to retransmit"
  1. S DIR("A",1)="Found "_LA7CNT_" accessions that can be retransmitted."
  1. S DIR(0)="YO",DIR("B")="NO"
  1. D ^DIR K DIR
  1. I Y'=1 D EXIT Q
  1. D EN^DDIOL("Working","","!")
  1. S LA7CNT=0,LA7UID=""
  1. F S LA7UID=$O(^TMP("LA7S-RTM",$J,LA7UID)) Q:LA7UID="" D
  1. . K LA7X
  1. . S LA7X=^TMP("LA7S-RTM",$J,LA7UID)
  1. . S LA7NLT="",LA7CNT=LA7CNT+1
  1. . F S LA7NLT=$O(^TMP("LA7S-RTM",$J,LA7UID,LA7NLT)) Q:LA7NLT="" D
  1. . . S LA764=$$FIND1^DIC(64,"","MX",LA7NLT,"C")
  1. . . I 'LA764 Q
  1. . . S LA7NLTN=$$GET1^DIQ(64,LA764_",",.01)
  1. . . K LA7Y
  1. . . M LA7Y=^TMP("LA7S-RTM",$J,LA7UID,LA7NLT)
  1. . . 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")
  1. ;
  1. ; Task background job to create messages
  1. S ZTIO="",ZTRTN="ORU^LA7VMSG",ZTDTH=$H,ZTDESC="Resend Lab LEDI HL7 Result Message"
  1. D ^%ZTLOAD
  1. ;
  1. K LA7X
  1. S LA7X(1)="...Done",LA7X(1,"F")=""
  1. I $G(ZTSK) D
  1. . S LA7X(2)=LA7CNT_" accession"_$S(LA7CNT>1:"s",1:"")_" scheduled for retransmitting of results!"
  1. . S LA7X(3)="Task# "_ZTSK_" queued for processing"
  1. E S LA7X(2)="*** Tasking of retransmission failed ***"
  1. D EN^DDIOL(.LA7X),EXIT
  1. ;
  1. Q
  1. ;
  1. ;
  1. SETTMP ; Setup TMP global with accession to resend.
  1. ;
  1. N LA763,LA768,LA7ERR,LA7I,LA7VDB,LA7X,LA7Y,LR60,LR61,LRDFN,LRIDT,LRODT,LRSB,LRSS
  1. ;
  1. S LRSS=$P(^LRO(68,LRAA,0),"^",2)
  1. F LA7I=0,.2,.3,3 S LA768(LA7I)=$G(^LRO(68,LRAA,1,LRAD,1,LRAN,LA7I))
  1. S LA7UID=$P(LA768(.3),"^")
  1. ;
  1. ; Not a LEDI specimen
  1. I '$P(LA768(.3),"^",2),'$P(LA768(.3),"^",3) D Q
  1. . N LA7X
  1. . S LA7X="Not a LEDI specimen - Accession "_$P(LA768(.2),"^")_" ("_LA7UID_") skipped"
  1. . D EN^DDIOL(LA7X,"","!")
  1. ;
  1. I LRSS'?1(1"CH",1"MI",1"SP",1"CY",1"EM") D Q
  1. . N LA7X
  1. . S LA7X(1)=$$GET1^DIQ(68,LRAA_",",.02)_" subscript NOT supported at this time"
  1. . S LA7X(2)="Accession "_$P(LA768(.2),"^")_" ("_LA7UID_") skipped"
  1. . D EN^DDIOL(.LA7X)
  1. ;
  1. ; Check file #63 for order codes and results
  1. ; If no order NLT code found then use default NLT
  1. ; Check if test has been added to order then report results using NLT code of the added test.
  1. S LRDFN=$P(LA768(0),"^"),LRODT=$P(LA768(0),"^",4),LRIDT=$P(LA768(3),"^",5)
  1. ; Check for date report completed.
  1. I '$$OK2SEND D Q
  1. . N LA7X
  1. . S LA7X="No date report completed - Accession "_$P(LA768(.2),"^")_" ("_LA7UID_") skipped"
  1. . D EN^DDIOL(LA7X,"","!")
  1. ;
  1. I LRSS="CH" D
  1. . S LRSB=1
  1. . F S LRSB=$O(^LR(LRDFN,LRSS,LRIDT,LRSB)) Q:'LRSB D
  1. . . S X=^LR(LRDFN,LRSS,LRIDT,LRSB)
  1. . . S LA7NLT=$P($P(X,"^",3),"!")
  1. . . I LA7NLT'="" S LA7Y(LA7NLT,LRSB)="" Q
  1. . . S LR61=+$P(^LR(LRDFN,LRSS,LRIDT,0),"^",5)
  1. . . S LA7NLT=$P($$DEFCODE^LA7VHLU5(LRSS,LRSB,$P(X,"^",3),LR61),"!")
  1. . . I LA7NLT'="" S LA7Y(LA7NLT,LRSB)=""
  1. ;
  1. I LRSS="MI" D
  1. . S LR60=0
  1. . F S LR60=$O(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LR60)) Q:'LR60 D
  1. . . S LA764=$P($G(^LAB(60,LR60,64)),"^")
  1. . . S LA7NLT=$$GET1^DIQ(64,LA764_",",1)
  1. . . S LA7VDB=$$GET1^DIQ(64,LA764_",",63,"I")
  1. . . I LA7VDB'="" S LA7Y(LA7NLT,LA7VDB)=""
  1. . I $D(LA7Y) Q
  1. . N LA7X
  1. . S LA7X(1)="No test on accession has an associated NLT database code"
  1. . S LA7X(2)="Accession "_$P(LA768(.2),"^")_" ("_LA7UID_") skipped"
  1. . D EN^DDIOL(.LA7X)
  1. ;
  1. ; Check ordered test multiple for dispositioned tests
  1. ; Check AP type test for database codes
  1. K LA7I
  1. S LA7I=0
  1. F S LA7I=$O(^LR(LRDFN,LRSS,LRIDT,"ORUT",LA7I)) Q:'LA7I D
  1. . S LA7I(0)=^LR(LRDFN,LRSS,LRIDT,"ORUT",LA7I,0)
  1. . S LA7NLT=$P(LA7I(0),"^"),LA764=$$FIND1^DIC(64,"","X",LA7NLT,"E","","LA7ERR")
  1. . I LRSS?1(1"SP",1"CY",1"EM") D
  1. . . S LA7Y(LA7NLT)=""
  1. . . S LA7VDB=$$GET1^DIQ(64,LA764_",",63,"I")
  1. . . I LA7VDB'="" S LA7Y(LA7NLT,LA7VDB)=""
  1. . I $P(LA7I(0),"^",10),'$D(LA7Y(LA7NLT)) S LA7Y(LA7NLT)=""
  1. ;
  1. I LRSS?1(1"SP",1"CY",1"EM"),'$D(LA7Y) D
  1. . I LRSS="SP" S LA7Y("88515.0000")="" Q
  1. . I LRSS="CY" S LA7Y("88593.0000")="" Q
  1. . I LRSS="EM" S LA7Y("88597.0000")="" Q
  1. ;
  1. I LRSS="AU" S LA7Y("88533.0000")=""
  1. ;
  1. I LA7UID'="",$D(LA7Y) D
  1. . S LA7CNT=LA7CNT+1
  1. . S X=$P(LA768(.3),"^",1)_"^"_$P(LA768(.3),"^",2)_"^"_$P(LA768(.3),"^",5)_"^"_$P(LA768(.3),"^",3)_"^"_LRIDT_"^"_LRSS_"^"_LRDFN_"^"_LRODT
  1. . S ^TMP("LA7S-RTM",$J,LA7UID)=X
  1. . S LA7I=""
  1. . F S LA7I=$O(LA7Y(LA7I)) Q:LA7I="" M ^TMP("LA7S-RTM",$J,LA7UID,LA7I)=LA7Y(LA7I)
  1. Q
  1. ;
  1. ;
  1. OK2SEND() ; Check is this accession is OK to send, i.e. approved, released (preliminary/final/corrected)
  1. ; Returns OK = 1 (true) - report can be sent
  1. ; 0 (false) - report not in a status to be sent.
  1. ;
  1. ; Called from above, LRVR0 and LA7VORU
  1. ;
  1. N LA7X,OK
  1. S OK=0
  1. ; Check 0th node for complete date
  1. I $P(^LR(LRDFN,LRSS,LRIDT,0),"^",3) S OK=1
  1. ;
  1. ; If complete and AP subscript then check RELEASE DATE/TIME
  1. I OK,LRSS?1(1"SP",1"CY",1"EM"),$P($G(^LR(LRDFN,LRSS,LRIDT,0)),"^",11)="" S OK=0
  1. ;
  1. ; If not complete and "CH" subscript then check for NP status
  1. I 'OK,LRSS="CH",'$O(^LR(LRDFN,"CH",LRIDT,1)) S OK=1
  1. ;
  1. ; If not complete and "MI" subscript then check each section of report
  1. I 'OK,LRSS="MI" F LA7X=1,5,8,11,16 I $P($G(^LR(LRDFN,LRSS,LRIDT,LA7X)),"^") S OK=1 Q
  1. ;
  1. ; Also check for test that has NP status
  1. I 'OK D NPSTATUS
  1. Q OK
  1. ;
  1. ;
  1. NPSTATUS ; Check ORUT node for test with NP status
  1. ;
  1. N LA7DISPO,LA7I
  1. S LA7DISPO=$$FIND1^DIC(64.061,"","OQX","X","D","I $P(^(0),U,5)=""0123""")
  1. S LA7I=0
  1. F S LA7I=$O(^LR(LRDFN,LRSS,LRIDT,"ORUT",LA7I)) Q:'LA7I I $P(^(LA7I,0),"^",10)=LA7DISPO S OK=1 Q
  1. Q
  1. ;
  1. ;
  1. EXIT ; Housekeeping - clean up.
  1. K ^TMP("LA7S-RTM",$J)
  1. K LA764,LA7CNT,LA7NLT,LA7NLTN,LA7QUIT,LA7TYPE,LA7UID,LA7X,LA7Y
  1. K LRAA,LRACC,LRAD,LRAN,LREXMPT,LRIDIV,LRSS,LRX
  1. K %DT,DA,DIC,DIR,DIRUT,DTOUT,DUOUT,FIRST,LAST,X,Y
  1. K ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK
  1. Q