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

LRUTIL1.m

Go to the documentation of this file. 
  1. LRUTIL1 ;DALOI/JDB -- Lab Utilities ;06/12/09  15:31
  1.  ;;5.2;LAB SERVICE;**350**;Sep 27, 1994;Build 230
  1.  ;
  1.  Q
  1.  ;
  1. SELECT(DIC,OUT,FNAME,SELS,SORT,NOALL,MODE) ;
  1.  ; Package replacement for FIRST^VAUTOMA
  1.  ; Allows user to select multiple entries from a file.
  1.  ; Inputs
  1.  ;    DIC :<byref> Standard DIC array
  1.  ;    OUT :<byref> See Outputs below
  1.  ;  FNAME :<opt> Filename to use for "Select " prompt
  1.  ;         : FNAME="" and DIC=# then uses File's Name
  1.  ;   SELS :<opt> How many selections user may make. dflt=20
  1.  ;   SORT :<opt> Numeric or Alpha sort? N or A -or- 0 or 1
  1.  ;  NOALL ;<opt> If 1 then user cannot select "ALL"
  1.  ;   MODE :<opt> Behave like FIRST^VAUTOMA or not (1 or 0)
  1.  ;        : dflt=0 (not) (see Outputs below for info)
  1.  ; Outputs
  1.  ;    Returns the # of records selected
  1.  ;    OUT : Array that holds the records selected
  1.  ;        : MODE=0   OUT=total selected  or  OUT="*" (ALL)
  1.  ;        :  SORT=0 -> OUT(select seq)=IEN
  1.  ;        :  SORT=1 -> OUT(alpha seq)=IEN
  1.  ;        :
  1.  ;        : MODE=1 (VAUTOMA mode) OUT=""  or  OUT=1 (ALL)
  1.  ;        :  SORT=0 -> OUT(IEN)=.01 field
  1.  ;        :  SORT=1 -> OUT(.01 field)=IEN
  1.  ;
  1.  N X,Y,CNT,STOP,DIR,DELSEL,NODE,I,TMPNM,LRDIC
  1.  N DTOUT,DUOUT,DIRUT,DIROUT,DIERR
  1.  ;
  1.  S FNAME=$G(FNAME)
  1.  S SELS=$G(SELS,20)
  1.  S NOALL=$G(NOALL)
  1.  S SORT=$G(SORT)
  1.  S MODE=$G(MODE)
  1.  I SORT="A" S SORT=1
  1.  I SORT="N" S SORT=0
  1.  K OUT
  1.  K DIC("B")
  1.  S (STOP,CNT)=0
  1.  S TMPNM="LRUTIL1"
  1.  I FNAME="" I DIC D  ;
  1.  . K DATA,DIERR
  1.  . D FILE^DID(DIC,"","NAME","DATA","ERR")
  1.  . Q:'$D(DATA)
  1.  . S FNAME=DATA("NAME")
  1.  . K DATA,DIERR
  1.  ;
  1.  K ^TMP(TMPNM,$J)
  1.  I 'NOALL S DIC("B")="ALL" S DIR("B")=DIC("B")
  1.  I $G(DIC(0))="" S DIC(0)="EQMZ"
  1.  F  D  Q:STOP  Q:CNT'<SELS  ;
  1.  . I 'CNT D  ;
  1.  . . S X=$G(DIC("A"))
  1.  . . I X="" S X="Select "_FNAME
  1.  . . S DIR("A")=X
  1.  . . S DIR(0)="FO"
  1.  . . S DIR("?")="^D HELP^LRUTIL1"
  1.  . ;
  1.  . I CNT=1 D  ;
  1.  . . K DIR("B")
  1.  . . S DIR(0)="FAO"
  1.  . . S X=$G(DIC("A"))
  1.  . . I X="" S X=FNAME
  1.  . . Q:X?1"Select another "0.E
  1.  . . S DIR("A")="Select another "_X_": "
  1.  . ;
  1.  . K LRDIC M LRDIC=DIC ;save DIC for ^DIR's help processor
  1.  . D ^DIR
  1.  . I $D(DTOUT)!$D(DUOUT)!$D(DIROUT) K OUT S CNT=0 S STOP=1 Q
  1.  . I 'NOALL I Y="ALL" K OUT S CNT="*" S STOP=1 Q
  1.  . S DELSEL=0
  1.  . I $E(Y)="-" D  ;
  1.  . . S DELSEL=1
  1.  . . S Y=$E(X,2,$L(Y))
  1.  . I Y="" S STOP=1 Q
  1.  . S X=Y
  1.  . D ^DIC
  1.  . I $D(LRDIC("W")) S DIC("W")=LRDIC("W") ; restore DIC("W") - it's killed in DIC calls.
  1.  . I $D(DTOUT)!$D(DUOUT) K OUT S CNT=0 S STOP=1 Q
  1.  . I Y>0 D  ;
  1.  . . S NODE="^TMP(TMPNM,$J,1,0,+Y)"
  1.  . . I SORT=1 S NODE="^TMP(TMPNM,$J,1,$P(Y,""^"",2),+Y)"
  1.  . . I 'DELSEL I '$D(@NODE) D  ;
  1.  . . . S CNT=CNT+1
  1.  . . . S @NODE=CNT
  1.  . . . S ^TMP(TMPNM,$J,2,"B",$P(Y,"^",2),+Y)=""
  1.  . . . S ^TMP(TMPNM,$J,2,"C",+Y)=$P(Y,"^",2)
  1.  . . I DELSEL D  ;
  1.  . . . I $D(@NODE) S CNT=CNT-1 S:CNT<0 CNT=0
  1.  . . . K @NODE
  1.  . . . K ^TMP(TMPNM,$J,2,"B",$P(Y,"^",2),+Y)
  1.  . . . K ^TMP(TMPNM,$J,2,"C",+Y)
  1.  . . ;
  1.  . ;
  1.  ;
  1.  I $D(^TMP(TMPNM,$J,1)) D  ;
  1.  . S NODE="^TMP(TMPNM,$J,1)"
  1.  . S I=0
  1.  . F  S NODE=$Q(@NODE) Q:NODE=""  Q:$QS(NODE,3)'=1  Q:$QS(NODE,2)'=$J  Q:$QS(NODE,1)'=TMPNM  D  ;
  1.  . . S I=I+1
  1.  . . I 'MODE I SORT S OUT(I)=$QS(NODE,5) Q
  1.  . . I MODE I SORT S OUT($QS(NODE,4))=$QS(NODE,5) Q
  1.  . . I 'SORT S OUT(0,@NODE)=$QS(NODE,5)
  1.  . ;
  1.  ;
  1.  I $D(OUT(0)) D  ;
  1.  . S I=0
  1.  . F  S I=$O(OUT(0,I)) Q:'I  D  ; I=CNT
  1.  . . S X=OUT(0,I) ;IEN
  1.  . . I 'MODE S OUT(I)=X
  1.  . . I MODE S OUT(X)=^TMP(TMPNM,$J,2,"C",X)
  1.  . ;
  1.  ;
  1.  K OUT(0)
  1.  K ^TMP(TMPNM,$J)
  1.  ;
  1.  ; Update OUT with status based on value of MODE.
  1.  I MODE D  ;
  1.  . I CNT=0 K OUT S OUT=""
  1.  . I CNT>0 S OUT=""
  1.  . I CNT="*" K OUT S OUT=1
  1.  ;
  1.  I 'MODE D
  1.  . I CNT=0 K OUT S OUT=""
  1.  . I CNT>0 S OUT=CNT
  1.  . I CNT="*" K OUT S OUT=CNT
  1.  ;
  1.  Q CNT
  1.  ;
  1.  ;
  1. HELP ;
  1.  ; Displays "?" help info. For use with above.
  1.  ; Expects SELS,NOALL,FNAME,CNT,TMPNM,LRDIC
  1.  N LRX,DIC
  1.  W !,"ENTER up to ",SELS,":"
  1.  I 'CNT&'NOALL W !?5,"- <return> for all ",FNAME,"s, or"
  1.  W !?5,"- a ",FNAME," or <return> after all selections made."
  1.  I CNT D  ;
  1.  . W !?5,"- An entry preceded by a minus [-] sign to remove entry from list."
  1.  . W !,"NOTE, you have already selected:"
  1.  . S LRX=""
  1.  . F  S LRX=$O(^TMP(TMPNM,$J,2,"B",LRX)) Q:LRX=""  D  ;
  1.  . . W !?8,LRX
  1.  . W !
  1.  . ;
  1.  ; now show selectable entries
  1.  ; X is from the ^DIR call ($E(X)="?")
  1.  ; DIC isnt avail here because ^DIR News it.
  1.  I $D(LRDIC) M DIC=LRDIC
  1.  D ^DIC
  1.  Q