- 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 Feb 18, 2025@23:05:21 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