LA7ADLS ;DALISC/JMC - Select Accessions for Auto Downloading ; 3/7/95 0:900;
;;5.2;LAB MESSAGING;**23,27**;Sep 27, 1994
;
EN ; Select Accessions to resend.
I '$D(^LAB(62.4,"AE")) D G EXIT
. W !,$C(7),"No instruments currently flagged for automatic downloading."
. W !,"Use build and download a load/worklist options to download."
. S DIR(0)="E",DIR("A")="Enter RETURN to continue" D ^DIR
D EXIT ; Housekeeping before we start.
S (LA7CNT,LA7QUIT)=0
S DIR(0)="SO^1:Range of Accessions;2:Selected Accessions",DIR("A")="Selection Method",DIR("B")=1
D ^DIR
I $D(DIRUT) G EXIT
S LA7TYPE=+Y
S LRACC=1,LREXMPT=1 ; Set flags used by LRWU4.
I LA7TYPE=1 D
. D ^LRWU4 ; Get list of accession numbers.
. I LRAN<1 S LA7QUIT=1 Q ; User aborted selection.
. S FIRST=LRAN,X=$O(^LRO(68,LRAA,1,LRAD,1,":"),-1)
. W !
. S DIR(0)="NO^"_LRAN_":"_X_":0",DIR("A")="Download from "_LRAN_" to",DIR("B")=LRAN
. 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
. . W:$X>(IOM-1) ! W "." ; Let user know we're looking.
. . 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($J)) LA7QUIT=1 Q
. D SETTMP
I LA7QUIT D EXIT Q
I '$D(^TMP($J)) D G EXIT
. W $C(7),!!,"No accessions found to download"
. S DIR(0)="E" D ^DIR
W !!,"Found ",LA7CNT," accessions that can be downloaded."
S DIR(0)="YO",DIR("A")="Ready to download",DIR("B")="NO" D ^DIR
I Y'=1 G EXIT ; User aborted retransmission.
W !
S LA7CNT=0,LA7UID=""
F S LA7UID=$O(^TMP($J,LA7UID)) Q:LA7UID="" D
. D EN^LA7ADL(LA7UID) S LA7CNT=LA7CNT+1
. W:$X>(IOM-1) ! W "." ; Let user know we're looking.
W !!,"Done - ",LA7CNT," accession",$S(LA7CNT>1:"s",1:"")," scheduled for downloading!",!!
D EXIT
Q
;
SETTMP ; Setup TMP global with accession to download.
S LA7UID=$P($G(^LRO(68,LRAA,1,LRAD,1,LRAN,.3)),U)
I $L(LA7UID) S LA7CNT=LA7CNT+1,^TMP($J,LA7UID)=""
Q
;
EXIT ; Housekeeping - clean up.
K ^TMP($J)
K LA7CNT,LA7QUIT,LA7TYPE,LA7UID,FIRST,LAST
K LRAA,LRACC,LRAD,LRAN,LREXMPT,LRIDIV,LRX
K %DT,DA,DIC,DIR,DIRUT,DTOUT,DUOUT,X,Y
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLA7ADLS 2214 printed Dec 13, 2024@01:38:58 Page 2
LA7ADLS ;DALISC/JMC - Select Accessions for Auto Downloading ; 3/7/95 0:900;
+1 ;;5.2;LAB MESSAGING;**23,27**;Sep 27, 1994
+2 ;
EN ; Select Accessions to resend.
+1 IF '$DATA(^LAB(62.4,"AE"))
Begin DoDot:1
+2 WRITE !,$CHAR(7),"No instruments currently flagged for automatic downloading."
+3 WRITE !,"Use build and download a load/worklist options to download."
+4 SET DIR(0)="E"
SET DIR("A")="Enter RETURN to continue"
DO ^DIR
End DoDot:1
GOTO EXIT
+5 ; Housekeeping before we start.
DO EXIT
+6 SET (LA7CNT,LA7QUIT)=0
+7 SET DIR(0)="SO^1:Range of Accessions;2:Selected Accessions"
SET DIR("A")="Selection Method"
SET DIR("B")=1
+8 DO ^DIR
+9 IF $DATA(DIRUT)
GOTO EXIT
+10 SET LA7TYPE=+Y
+11 ; Set flags used by LRWU4.
SET LRACC=1
SET LREXMPT=1
+12 IF LA7TYPE=1
Begin DoDot:1
+13 ; Get list of accession numbers.
DO ^LRWU4
+14 ; User aborted selection.
IF LRAN<1
SET LA7QUIT=1
QUIT
+15 SET FIRST=LRAN
SET X=$ORDER(^LRO(68,LRAA,1,LRAD,1,":"),-1)
+16 WRITE !
+17 SET DIR(0)="NO^"_LRAN_":"_X_":0"
SET DIR("A")="Download from "_LRAN_" to"
SET DIR("B")=LRAN
+18 DO ^DIR
KILL DIR
+19 IF $DATA(DIRUT)
SET LA7QUIT=1
QUIT
+20 SET LRAN=FIRST-1
SET LAST=Y
+21 FOR
SET LRAN=$ORDER(^LRO(68,LRAA,1,LRAD,1,LRAN))
if 'LRAN!(LRAN>LAST)
QUIT
Begin DoDot:2
+22 ; Let user know we're looking.
if $X>(IOM-1)
WRITE !
WRITE "."
+23 DO SETTMP
End DoDot:2
End DoDot:1
+24 IF LA7TYPE=2
FOR
Begin DoDot:1
+25 DO ^LRWU4
+26 IF $DATA(DTOUT)!($DATA(DUOUT))
SET LA7QUIT=1
QUIT
+27 IF LRAN<1
if '$DATA(^TMP($JOB))
SET LA7QUIT=1
QUIT
+28 DO SETTMP
End DoDot:1
if LA7QUIT!(LRAN<1)
QUIT
+29 IF LA7QUIT
DO EXIT
QUIT
+30 IF '$DATA(^TMP($JOB))
Begin DoDot:1
+31 WRITE $CHAR(7),!!,"No accessions found to download"
+32 SET DIR(0)="E"
DO ^DIR
End DoDot:1
GOTO EXIT
+33 WRITE !!,"Found ",LA7CNT," accessions that can be downloaded."
+34 SET DIR(0)="YO"
SET DIR("A")="Ready to download"
SET DIR("B")="NO"
DO ^DIR
+35 ; User aborted retransmission.
IF Y'=1
GOTO EXIT
+36 WRITE !
+37 SET LA7CNT=0
SET LA7UID=""
+38 FOR
SET LA7UID=$ORDER(^TMP($JOB,LA7UID))
if LA7UID=""
QUIT
Begin DoDot:1
+39 DO EN^LA7ADL(LA7UID)
SET LA7CNT=LA7CNT+1
+40 ; Let user know we're looking.
if $X>(IOM-1)
WRITE !
WRITE "."
End DoDot:1
+41 WRITE !!,"Done - ",LA7CNT," accession",$SELECT(LA7CNT>1:"s",1:"")," scheduled for downloading!",!!
+42 DO EXIT
+43 QUIT
+44 ;
SETTMP ; Setup TMP global with accession to download.
+1 SET LA7UID=$PIECE($GET(^LRO(68,LRAA,1,LRAD,1,LRAN,.3)),U)
+2 IF $LENGTH(LA7UID)
SET LA7CNT=LA7CNT+1
SET ^TMP($JOB,LA7UID)=""
+3 QUIT
+4 ;
EXIT ; Housekeeping - clean up.
+1 KILL ^TMP($JOB)
+2 KILL LA7CNT,LA7QUIT,LA7TYPE,LA7UID,FIRST,LAST
+3 KILL LRAA,LRACC,LRAD,LRAN,LREXMPT,LRIDIV,LRX
+4 KILL %DT,DA,DIC,DIR,DIRUT,DTOUT,DUOUT,X,Y
+5 QUIT
