- LA7SRR ;DALOI/JMC - Select Accessions for Resending LEDI Results ;11/20/09 14:09
- ;;5.2;AUTOMATED LAB INSTRUMENTS;**46,64,74**;Sep 27, 1994;Build 229
- ;
- EN ; Select Accessions to resend.
- ;
- ; Housekeeping before we start.
- D EXIT
- ;
- S (LA7CNT,LA7QUIT)=0
- ;
- S DIR(0)="SO^1:Range of Accessions;2:Selected Accessions"
- S DIR("A")="Selection Method",DIR("B")=1
- D ^DIR
- I $D(DIRUT) D EXIT Q
- S LA7TYPE=+Y
- ;
- ; Get list of accession numbers, set flags used by LRWU4.
- S LRACC=1,LREXMPT=1
- I LA7TYPE=1 D
- . D ^LRWU4
- . I LRAN<1 S LA7QUIT=1 Q
- . S FIRST=LRAN,X=$O(^LRO(68,LRAA,1,LRAD,1,":"),-1)
- . S DIR(0)="NO^"_LRAN_":"_X_":0",DIR("B")=LRAN
- . S DIR("A",1)="",DIR("A")="Retransmit from "_LRAN_" to"
- . D ^DIR K DIR
- . I $D(DIRUT) S LA7QUIT=1 Q
- . S LRAN=FIRST-1,LAST=Y
- . F S LRAN=$O(^LRO(68,LRAA,1,LRAD,1,LRAN)) Q:'LRAN!(LRAN>LAST) D SETTMP
- I LA7TYPE=2 F D Q:LA7QUIT!(LRAN<1)
- . D ^LRWU4
- . I $D(DTOUT)!($D(DUOUT)) S LA7QUIT=1 Q
- . I LRAN<1 S:'$D(^TMP("LA7S-RTM",$J)) LA7QUIT=1 Q
- . D SETTMP
- I LA7QUIT D EXIT Q
- ;
- I '$D(^TMP("LA7S-RTM",$J)) D Q
- . S DIR("A",1)="No accessions found to retransmit."
- . S DIR("A")="Enter RETURN to continue or '^' to exit"
- . S DIR(0)="E"
- . D ^DIR,EXIT
- ;
- S DIR("A")="Ready to retransmit"
- S DIR("A",1)="Found "_LA7CNT_" accessions that can be retransmitted."
- S DIR(0)="YO",DIR("B")="NO"
- D ^DIR K DIR
- I Y'=1 D EXIT Q
- D EN^DDIOL("Working","","!")
- S LA7CNT=0,LA7UID=""
- F S LA7UID=$O(^TMP("LA7S-RTM",$J,LA7UID)) Q:LA7UID="" D
- . K LA7X
- . S LA7X=^TMP("LA7S-RTM",$J,LA7UID)
- . S LA7NLT="",LA7CNT=LA7CNT+1
- . F S LA7NLT=$O(^TMP("LA7S-RTM",$J,LA7UID,LA7NLT)) Q:LA7NLT="" D
- . . S LA764=$$FIND1^DIC(64,"","MX",LA7NLT,"C")
- . . I 'LA764 Q
- . . S LA7NLTN=$$GET1^DIQ(64,LA764_",",.01)
- . . K LA7Y
- . . M LA7Y=^TMP("LA7S-RTM",$J,LA7UID,LA7NLT)
- . . 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")
- ;
- ; Task background job to create messages
- S ZTIO="",ZTRTN="ORU^LA7VMSG",ZTDTH=$H,ZTDESC="Resend Lab LEDI HL7 Result Message"
- D ^%ZTLOAD
- ;
- K LA7X
- S LA7X(1)="...Done",LA7X(1,"F")=""
- I $G(ZTSK) D
- . S LA7X(2)=LA7CNT_" accession"_$S(LA7CNT>1:"s",1:"")_" scheduled for retransmitting of results!"
- . S LA7X(3)="Task# "_ZTSK_" queued for processing"
- E S LA7X(2)="*** Tasking of retransmission failed ***"
- D EN^DDIOL(.LA7X),EXIT
- ;
- Q
- ;
- ;
- SETTMP ; Setup TMP global with accession to resend.
- ;
- N LA763,LA768,LA7ERR,LA7I,LA7VDB,LA7X,LA7Y,LR60,LR61,LRDFN,LRIDT,LRODT,LRSB,LRSS
- ;
- S LRSS=$P(^LRO(68,LRAA,0),"^",2)
- F LA7I=0,.2,.3,3 S LA768(LA7I)=$G(^LRO(68,LRAA,1,LRAD,1,LRAN,LA7I))
- S LA7UID=$P(LA768(.3),"^")
- ;
- ; Not a LEDI specimen
- I '$P(LA768(.3),"^",2),'$P(LA768(.3),"^",3) D Q
- . N LA7X
- . S LA7X="Not a LEDI specimen - Accession "_$P(LA768(.2),"^")_" ("_LA7UID_") skipped"
- . D EN^DDIOL(LA7X,"","!")
- ;
- I LRSS'?1(1"CH",1"MI",1"SP",1"CY",1"EM") D Q
- . N LA7X
- . S LA7X(1)=$$GET1^DIQ(68,LRAA_",",.02)_" subscript NOT supported at this time"
- . S LA7X(2)="Accession "_$P(LA768(.2),"^")_" ("_LA7UID_") skipped"
- . D EN^DDIOL(.LA7X)
- ;
- ; Check file #63 for order codes and results
- ; If no order NLT code found then use default NLT
- ; Check if test has been added to order then report results using NLT code of the added test.
- S LRDFN=$P(LA768(0),"^"),LRODT=$P(LA768(0),"^",4),LRIDT=$P(LA768(3),"^",5)
- ; Check for date report completed.
- I '$$OK2SEND D Q
- . N LA7X
- . S LA7X="No date report completed - Accession "_$P(LA768(.2),"^")_" ("_LA7UID_") skipped"
- . D EN^DDIOL(LA7X,"","!")
- ;
- I LRSS="CH" D
- . S LRSB=1
- . F S LRSB=$O(^LR(LRDFN,LRSS,LRIDT,LRSB)) Q:'LRSB D
- . . S X=^LR(LRDFN,LRSS,LRIDT,LRSB)
- . . S LA7NLT=$P($P(X,"^",3),"!")
- . . I LA7NLT'="" S LA7Y(LA7NLT,LRSB)="" Q
- . . S LR61=+$P(^LR(LRDFN,LRSS,LRIDT,0),"^",5)
- . . S LA7NLT=$P($$DEFCODE^LA7VHLU5(LRSS,LRSB,$P(X,"^",3),LR61),"!")
- . . I LA7NLT'="" S LA7Y(LA7NLT,LRSB)=""
- ;
- I LRSS="MI" D
- . S LR60=0
- . F S LR60=$O(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LR60)) Q:'LR60 D
- . . S LA764=$P($G(^LAB(60,LR60,64)),"^")
- . . S LA7NLT=$$GET1^DIQ(64,LA764_",",1)
- . . S LA7VDB=$$GET1^DIQ(64,LA764_",",63,"I")
- . . I LA7VDB'="" S LA7Y(LA7NLT,LA7VDB)=""
- . I $D(LA7Y) Q
- . N LA7X
- . S LA7X(1)="No test on accession has an associated NLT database code"
- . S LA7X(2)="Accession "_$P(LA768(.2),"^")_" ("_LA7UID_") skipped"
- . D EN^DDIOL(.LA7X)
- ;
- ; Check ordered test multiple for dispositioned tests
- ; Check AP type test for database codes
- K LA7I
- S LA7I=0
- F S LA7I=$O(^LR(LRDFN,LRSS,LRIDT,"ORUT",LA7I)) Q:'LA7I D
- . S LA7I(0)=^LR(LRDFN,LRSS,LRIDT,"ORUT",LA7I,0)
- . S LA7NLT=$P(LA7I(0),"^"),LA764=$$FIND1^DIC(64,"","X",LA7NLT,"E","","LA7ERR")
- . I LRSS?1(1"SP",1"CY",1"EM") D
- . . S LA7Y(LA7NLT)=""
- . . S LA7VDB=$$GET1^DIQ(64,LA764_",",63,"I")
- . . I LA7VDB'="" S LA7Y(LA7NLT,LA7VDB)=""
- . I $P(LA7I(0),"^",10),'$D(LA7Y(LA7NLT)) S LA7Y(LA7NLT)=""
- ;
- I LRSS?1(1"SP",1"CY",1"EM"),'$D(LA7Y) D
- . I LRSS="SP" S LA7Y("88515.0000")="" Q
- . I LRSS="CY" S LA7Y("88593.0000")="" Q
- . I LRSS="EM" S LA7Y("88597.0000")="" Q
- ;
- I LRSS="AU" S LA7Y("88533.0000")=""
- ;
- I LA7UID'="",$D(LA7Y) D
- . S LA7CNT=LA7CNT+1
- . S X=$P(LA768(.3),"^",1)_"^"_$P(LA768(.3),"^",2)_"^"_$P(LA768(.3),"^",5)_"^"_$P(LA768(.3),"^",3)_"^"_LRIDT_"^"_LRSS_"^"_LRDFN_"^"_LRODT
- . S ^TMP("LA7S-RTM",$J,LA7UID)=X
- . S LA7I=""
- . F S LA7I=$O(LA7Y(LA7I)) Q:LA7I="" M ^TMP("LA7S-RTM",$J,LA7UID,LA7I)=LA7Y(LA7I)
- Q
- ;
- ;
- OK2SEND() ; Check is this accession is OK to send, i.e. approved, released (preliminary/final/corrected)
- ; Returns OK = 1 (true) - report can be sent
- ; 0 (false) - report not in a status to be sent.
- ;
- ; Called from above, LRVR0 and LA7VORU
- ;
- N LA7X,OK
- S OK=0
- ; Check 0th node for complete date
- I $P(^LR(LRDFN,LRSS,LRIDT,0),"^",3) S OK=1
- ;
- ; If complete and AP subscript then check RELEASE DATE/TIME
- I OK,LRSS?1(1"SP",1"CY",1"EM"),$P($G(^LR(LRDFN,LRSS,LRIDT,0)),"^",11)="" S OK=0
- ;
- ; If not complete and "CH" subscript then check for NP status
- I 'OK,LRSS="CH",'$O(^LR(LRDFN,"CH",LRIDT,1)) S OK=1
- ;
- ; If not complete and "MI" subscript then check each section of report
- I 'OK,LRSS="MI" F LA7X=1,5,8,11,16 I $P($G(^LR(LRDFN,LRSS,LRIDT,LA7X)),"^") S OK=1 Q
- ;
- ; Also check for test that has NP status
- I 'OK D NPSTATUS
- Q OK
- ;
- ;
- NPSTATUS ; Check ORUT node for test with NP status
- ;
- N LA7DISPO,LA7I
- S LA7DISPO=$$FIND1^DIC(64.061,"","OQX","X","D","I $P(^(0),U,5)=""0123""")
- S LA7I=0
- F S LA7I=$O(^LR(LRDFN,LRSS,LRIDT,"ORUT",LA7I)) Q:'LA7I I $P(^(LA7I,0),"^",10)=LA7DISPO S OK=1 Q
- Q
- ;
- ;
- EXIT ; Housekeeping - clean up.
- K ^TMP("LA7S-RTM",$J)
- K LA764,LA7CNT,LA7NLT,LA7NLTN,LA7QUIT,LA7TYPE,LA7UID,LA7X,LA7Y
- K LRAA,LRACC,LRAD,LRAN,LREXMPT,LRIDIV,LRSS,LRX
- K %DT,DA,DIC,DIR,DIRUT,DTOUT,DUOUT,FIRST,LAST,X,Y
- K ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLA7SRR 6986 printed Jan 18, 2025@02:40:57 Page 2
- 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
- +2 ;
- EN ; Select Accessions to resend.
- +1 ;
- +2 ; Housekeeping before we start.
- +3 DO EXIT
- +4 ;
- +5 SET (LA7CNT,LA7QUIT)=0
- +6 ;
- +7 SET DIR(0)="SO^1:Range of Accessions;2:Selected Accessions"
- +8 SET DIR("A")="Selection Method"
- SET DIR("B")=1
- +9 DO ^DIR
- +10 IF $DATA(DIRUT)
- DO EXIT
- QUIT
- +11 SET LA7TYPE=+Y
- +12 ;
- +13 ; Get list of accession numbers, set flags used by LRWU4.
- +14 SET LRACC=1
- SET LREXMPT=1
- +15 IF LA7TYPE=1
- Begin DoDot:1
- +16 DO ^LRWU4
- +17 IF LRAN<1
- SET LA7QUIT=1
- QUIT
- +18 SET FIRST=LRAN
- SET X=$ORDER(^LRO(68,LRAA,1,LRAD,1,":"),-1)
- +19 SET DIR(0)="NO^"_LRAN_":"_X_":0"
- SET DIR("B")=LRAN
- +20 SET DIR("A",1)=""
- SET DIR("A")="Retransmit from "_LRAN_" to"
- +21 DO ^DIR
- KILL DIR
- +22 IF $DATA(DIRUT)
- SET LA7QUIT=1
- QUIT
- +23 SET LRAN=FIRST-1
- SET LAST=Y
- +24 FOR
- SET LRAN=$ORDER(^LRO(68,LRAA,1,LRAD,1,LRAN))
- if 'LRAN!(LRAN>LAST)
- QUIT
- DO SETTMP
- End DoDot:1
- +25 IF LA7TYPE=2
- FOR
- Begin DoDot:1
- +26 DO ^LRWU4
- +27 IF $DATA(DTOUT)!($DATA(DUOUT))
- SET LA7QUIT=1
- QUIT
- +28 IF LRAN<1
- if '$DATA(^TMP("LA7S-RTM",$JOB))
- SET LA7QUIT=1
- QUIT
- +29 DO SETTMP
- End DoDot:1
- if LA7QUIT!(LRAN<1)
- QUIT
- +30 IF LA7QUIT
- DO EXIT
- QUIT
- +31 ;
- +32 IF '$DATA(^TMP("LA7S-RTM",$JOB))
- Begin DoDot:1
- +33 SET DIR("A",1)="No accessions found to retransmit."
- +34 SET DIR("A")="Enter RETURN to continue or '^' to exit"
- +35 SET DIR(0)="E"
- +36 DO ^DIR
- DO EXIT
- End DoDot:1
- QUIT
- +37 ;
- +38 SET DIR("A")="Ready to retransmit"
- +39 SET DIR("A",1)="Found "_LA7CNT_" accessions that can be retransmitted."
- +40 SET DIR(0)="YO"
- SET DIR("B")="NO"
- +41 DO ^DIR
- KILL DIR
- +42 IF Y'=1
- DO EXIT
- QUIT
- +43 DO EN^DDIOL("Working","","!")
- +44 SET LA7CNT=0
- SET LA7UID=""
- +45 FOR
- SET LA7UID=$ORDER(^TMP("LA7S-RTM",$JOB,LA7UID))
- if LA7UID=""
- QUIT
- Begin DoDot:1
- +46 KILL LA7X
- +47 SET LA7X=^TMP("LA7S-RTM",$JOB,LA7UID)
- +48 SET LA7NLT=""
- SET LA7CNT=LA7CNT+1
- +49 FOR
- SET LA7NLT=$ORDER(^TMP("LA7S-RTM",$JOB,LA7UID,LA7NLT))
- if LA7NLT=""
- QUIT
- Begin DoDot:2
- +50 SET LA764=$$FIND1^DIC(64,"","MX",LA7NLT,"C")
- +51 IF 'LA764
- QUIT
- +52 SET LA7NLTN=$$GET1^DIQ(64,LA764_",",.01)
- +53 KILL LA7Y
- +54 MERGE LA7Y=^TMP("LA7S-RTM",$JOB,LA7UID,LA7NLT)
- +55 DO SET^LA7VMSG($PIECE(LA7X,"^"),$PIECE(LA7X,"^",2),$PIECE(LA7X,"^",3),$PIECE(LA7X,"^",4),LA7NLTN,LA7NLT,$PIECE(LA7X,"^",5),$PIECE(LA7X,"^",6),$PIECE(LA7X,"^",7),$PIECE(LA7X,"^",8),.LA7Y,"ORU")
- End DoDot:2
- End DoDot:1
- +56 ;
- +57 ; Task background job to create messages
- +58 SET ZTIO=""
- SET ZTRTN="ORU^LA7VMSG"
- SET ZTDTH=$HOROLOG
- SET ZTDESC="Resend Lab LEDI HL7 Result Message"
- +59 DO ^%ZTLOAD
- +60 ;
- +61 KILL LA7X
- +62 SET LA7X(1)="...Done"
- SET LA7X(1,"F")=""
- +63 IF $GET(ZTSK)
- Begin DoDot:1
- +64 SET LA7X(2)=LA7CNT_" accession"_$SELECT(LA7CNT>1:"s",1:"")_" scheduled for retransmitting of results!"
- +65 SET LA7X(3)="Task# "_ZTSK_" queued for processing"
- End DoDot:1
- +66 IF '$TEST
- SET LA7X(2)="*** Tasking of retransmission failed ***"
- +67 DO EN^DDIOL(.LA7X)
- DO EXIT
- +68 ;
- +69 QUIT
- +70 ;
- +71 ;
- SETTMP ; Setup TMP global with accession to resend.
- +1 ;
- +2 NEW LA763,LA768,LA7ERR,LA7I,LA7VDB,LA7X,LA7Y,LR60,LR61,LRDFN,LRIDT,LRODT,LRSB,LRSS
- +3 ;
- +4 SET LRSS=$PIECE(^LRO(68,LRAA,0),"^",2)
- +5 FOR LA7I=0,.2,.3,3
- SET LA768(LA7I)=$GET(^LRO(68,LRAA,1,LRAD,1,LRAN,LA7I))
- +6 SET LA7UID=$PIECE(LA768(.3),"^")
- +7 ;
- +8 ; Not a LEDI specimen
- +9 IF '$PIECE(LA768(.3),"^",2)
- IF '$PIECE(LA768(.3),"^",3)
- Begin DoDot:1
- +10 NEW LA7X
- +11 SET LA7X="Not a LEDI specimen - Accession "_$PIECE(LA768(.2),"^")_" ("_LA7UID_") skipped"
- +12 DO EN^DDIOL(LA7X,"","!")
- End DoDot:1
- QUIT
- +13 ;
- +14 IF LRSS'?1(1"CH",1"MI",1"SP",1"CY",1"EM")
- Begin DoDot:1
- +15 NEW LA7X
- +16 SET LA7X(1)=$$GET1^DIQ(68,LRAA_",",.02)_" subscript NOT supported at this time"
- +17 SET LA7X(2)="Accession "_$PIECE(LA768(.2),"^")_" ("_LA7UID_") skipped"
- +18 DO EN^DDIOL(.LA7X)
- End DoDot:1
- QUIT
- +19 ;
- +20 ; Check file #63 for order codes and results
- +21 ; If no order NLT code found then use default NLT
- +22 ; Check if test has been added to order then report results using NLT code of the added test.
- +23 SET LRDFN=$PIECE(LA768(0),"^")
- SET LRODT=$PIECE(LA768(0),"^",4)
- SET LRIDT=$PIECE(LA768(3),"^",5)
- +24 ; Check for date report completed.
- +25 IF '$$OK2SEND
- Begin DoDot:1
- +26 NEW LA7X
- +27 SET LA7X="No date report completed - Accession "_$PIECE(LA768(.2),"^")_" ("_LA7UID_") skipped"
- +28 DO EN^DDIOL(LA7X,"","!")
- End DoDot:1
- QUIT
- +29 ;
- +30 IF LRSS="CH"
- Begin DoDot:1
- +31 SET LRSB=1
- +32 FOR
- SET LRSB=$ORDER(^LR(LRDFN,LRSS,LRIDT,LRSB))
- if 'LRSB
- QUIT
- Begin DoDot:2
- +33 SET X=^LR(LRDFN,LRSS,LRIDT,LRSB)
- +34 SET LA7NLT=$PIECE($PIECE(X,"^",3),"!")
- +35 IF LA7NLT'=""
- SET LA7Y(LA7NLT,LRSB)=""
- QUIT
- +36 SET LR61=+$PIECE(^LR(LRDFN,LRSS,LRIDT,0),"^",5)
- +37 SET LA7NLT=$PIECE($$DEFCODE^LA7VHLU5(LRSS,LRSB,$PIECE(X,"^",3),LR61),"!")
- +38 IF LA7NLT'=""
- SET LA7Y(LA7NLT,LRSB)=""
- End DoDot:2
- End DoDot:1
- +39 ;
- +40 IF LRSS="MI"
- Begin DoDot:1
- +41 SET LR60=0
- +42 FOR
- SET LR60=$ORDER(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LR60))
- if 'LR60
- QUIT
- Begin DoDot:2
- +43 SET LA764=$PIECE($GET(^LAB(60,LR60,64)),"^")
- +44 SET LA7NLT=$$GET1^DIQ(64,LA764_",",1)
- +45 SET LA7VDB=$$GET1^DIQ(64,LA764_",",63,"I")
- +46 IF LA7VDB'=""
- SET LA7Y(LA7NLT,LA7VDB)=""
- End DoDot:2
- +47 IF $DATA(LA7Y)
- QUIT
- +48 NEW LA7X
- +49 SET LA7X(1)="No test on accession has an associated NLT database code"
- +50 SET LA7X(2)="Accession "_$PIECE(LA768(.2),"^")_" ("_LA7UID_") skipped"
- +51 DO EN^DDIOL(.LA7X)
- End DoDot:1
- +52 ;
- +53 ; Check ordered test multiple for dispositioned tests
- +54 ; Check AP type test for database codes
- +55 KILL LA7I
- +56 SET LA7I=0
- +57 FOR
- SET LA7I=$ORDER(^LR(LRDFN,LRSS,LRIDT,"ORUT",LA7I))
- if 'LA7I
- QUIT
- Begin DoDot:1
- +58 SET LA7I(0)=^LR(LRDFN,LRSS,LRIDT,"ORUT",LA7I,0)
- +59 SET LA7NLT=$PIECE(LA7I(0),"^")
- SET LA764=$$FIND1^DIC(64,"","X",LA7NLT,"E","","LA7ERR")
- +60 IF LRSS?1(1"SP",1"CY",1"EM")
- Begin DoDot:2
- +61 SET LA7Y(LA7NLT)=""
- +62 SET LA7VDB=$$GET1^DIQ(64,LA764_",",63,"I")
- +63 IF LA7VDB'=""
- SET LA7Y(LA7NLT,LA7VDB)=""
- End DoDot:2
- +64 IF $PIECE(LA7I(0),"^",10)
- IF '$DATA(LA7Y(LA7NLT))
- SET LA7Y(LA7NLT)=""
- End DoDot:1
- +65 ;
- +66 IF LRSS?1(1"SP",1"CY",1"EM")
- IF '$DATA(LA7Y)
- Begin DoDot:1
- +67 IF LRSS="SP"
- SET LA7Y("88515.0000")=""
- QUIT
- +68 IF LRSS="CY"
- SET LA7Y("88593.0000")=""
- QUIT
- +69 IF LRSS="EM"
- SET LA7Y("88597.0000")=""
- QUIT
- End DoDot:1
- +70 ;
- +71 IF LRSS="AU"
- SET LA7Y("88533.0000")=""
- +72 ;
- +73 IF LA7UID'=""
- IF $DATA(LA7Y)
- Begin DoDot:1
- +74 SET LA7CNT=LA7CNT+1
- +75 SET X=$PIECE(LA768(.3),"^",1)_"^"_$PIECE(LA768(.3),"^",2)_"^"_$PIECE(LA768(.3),"^",5)_"^"_$PIECE(LA768(.3),"^",3)_"^"_LRIDT_"^"_LRSS_"^"_LRDFN_"^"_LRODT
- +76 SET ^TMP("LA7S-RTM",$JOB,LA7UID)=X
- +77 SET LA7I=""
- +78 FOR
- SET LA7I=$ORDER(LA7Y(LA7I))
- if LA7I=""
- QUIT
- MERGE ^TMP("LA7S-RTM",$JOB,LA7UID,LA7I)=LA7Y(LA7I)
- End DoDot:1
- +79 QUIT
- +80 ;
- +81 ;
- 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
- +2 ; 0 (false) - report not in a status to be sent.
- +3 ;
- +4 ; Called from above, LRVR0 and LA7VORU
- +5 ;
- +6 NEW LA7X,OK
- +7 SET OK=0
- +8 ; Check 0th node for complete date
- +9 IF $PIECE(^LR(LRDFN,LRSS,LRIDT,0),"^",3)
- SET OK=1
- +10 ;
- +11 ; If complete and AP subscript then check RELEASE DATE/TIME
- +12 IF OK
- IF LRSS?1(1"SP",1"CY",1"EM")
- IF $PIECE($GET(^LR(LRDFN,LRSS,LRIDT,0)),"^",11)=""
- SET OK=0
- +13 ;
- +14 ; If not complete and "CH" subscript then check for NP status
- +15 IF 'OK
- IF LRSS="CH"
- IF '$ORDER(^LR(LRDFN,"CH",LRIDT,1))
- SET OK=1
- +16 ;
- +17 ; If not complete and "MI" subscript then check each section of report
- +18 IF 'OK
- IF LRSS="MI"
- FOR LA7X=1,5,8,11,16
- IF $PIECE($GET(^LR(LRDFN,LRSS,LRIDT,LA7X)),"^")
- SET OK=1
- QUIT
- +19 ;
- +20 ; Also check for test that has NP status
- +21 IF 'OK
- DO NPSTATUS
- +22 QUIT OK
- +23 ;
- +24 ;
- NPSTATUS ; Check ORUT node for test with NP status
- +1 ;
- +2 NEW LA7DISPO,LA7I
- +3 SET LA7DISPO=$$FIND1^DIC(64.061,"","OQX","X","D","I $P(^(0),U,5)=""0123""")
- +4 SET LA7I=0
- +5 FOR
- SET LA7I=$ORDER(^LR(LRDFN,LRSS,LRIDT,"ORUT",LA7I))
- if 'LA7I
- QUIT
- IF $PIECE(^(LA7I,0),"^",10)=LA7DISPO
- SET OK=1
- QUIT
- +6 QUIT
- +7 ;
- +8 ;
- EXIT ; Housekeeping - clean up.
- +1 KILL ^TMP("LA7S-RTM",$JOB)
- +2 KILL LA764,LA7CNT,LA7NLT,LA7NLTN,LA7QUIT,LA7TYPE,LA7UID,LA7X,LA7Y
- +3 KILL LRAA,LRACC,LRAD,LRAN,LREXMPT,LRIDIV,LRSS,LRX
- +4 KILL %DT,DA,DIC,DIR,DIRUT,DTOUT,DUOUT,FIRST,LAST,X,Y
- +5 KILL ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK
- +6 QUIT