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

IBCNBLA2.m

Go to the documentation of this file. 
  1. IBCNBLA2 ;DAOU/ESG - Ins Buffer, Multiple Selection ;09-SEP-2002
  1.  ;;2.0;INTEGRATED BILLING;**184**;21-MAR-94
  1.  ;;Per VHA Directive 10-93-142, this routine should not be modified.
  1.  ;
  1.  ; Can't be called from the top
  1.  Q
  1.  ;
  1.  ;
  1. MULSEL(TMPARR,IBCNELST,GCNT) ; Multiple entry selection
  1.  ; This procedure is responsible for receiving multiple buffer entries
  1.  ; from the user.  It also validates and locks the selected buffer
  1.  ; entries.  It also reports any buffer entries that could not be
  1.  ; allocated and the reason why not.
  1.  ;
  1.  ; Parameters:
  1.  ;   TMPARR - scratch global input parameter
  1.  ; IBCNELST - output array of entries
  1.  ;            IBCNELST(entry#) = (OK? 0/1)^(error reason)^(buffer ien)
  1.  ;     GCNT - output; number of buffer entries the user got OK
  1.  ;
  1.  NEW OK,ERR,VALMY,IBSELN,IBBUFDA,IBY,TCNT
  1.  NEW DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
  1.  KILL IBCNELST
  1.  S (TCNT,GCNT)=0
  1.  I $G(TMPARR)="" G MULSELX
  1.  D EN^VALM2($G(XQORNOD(0)),"O")     ; ListMan generic selector
  1.  I '$D(VALMY) G MULSELX
  1.  S IBSELN=0
  1.  F  S IBSELN=$O(VALMY(IBSELN)) Q:'IBSELN  D  S IBCNELST(IBSELN)=OK_U_ERR_U_IBBUFDA
  1.  . S TCNT=TCNT+1
  1.  . S OK=0,ERR="This entry is not valid or available."
  1.  . S IBBUFDA=$P($G(^TMP(TMPARR,$J,IBSELN)),U,2,99) Q:'IBBUFDA
  1.  . S IBY=$P($G(^IBA(355.33,IBBUFDA,0)),U,4)    ; buffer status
  1.  . ;
  1.  . ; make sure buffer entry is still in an entered status
  1.  . I IBY'="E" S ERR="This entry has a status of "_$S(IBY="A":"ACCEPTED",IBY="R":"REJECTED",1:"UNKNOWN")_" and cannot be modified." Q
  1.  . ;
  1.  . ; attempt to lock the buffer entry
  1.  . I '$$LOCK^IBCNBU1(IBBUFDA,0,0) S ERR="Another user is currently editing this entry." Q
  1.  . ;
  1.  . ; at this point this entry is OK for processing
  1.  . S OK=1,ERR="",GCNT=GCNT+1
  1.  . Q
  1.  ;
  1.  ; Exit procedure if the user was able to get all entries
  1.  ; total requested = total allocated
  1.  I TCNT=GCNT G MULSELX
  1.  ;
  1.  ; At this point, some or all of the user selected entries are not
  1.  ; available; build and display a message.
  1.  W !!?3,$$MSG(TCNT,GCNT)
  1.  W !?3,"available for editing at this time:"
  1.  S IBSELN=0
  1.  F  S IBSELN=$O(IBCNELST(IBSELN)) Q:'IBSELN  I 'IBCNELST(IBSELN) D
  1.  . W !?6,"Entry ",IBSELN,": ",$P(IBCNELST(IBSELN),U,2)
  1.  . Q
  1.  ;
  1.  ; If the user was not able to get any entries, then kill the array
  1.  ; and get out
  1.  I 'GCNT KILL IBCNELST D PAUSE^VALM1 G MULSELX
  1.  ;
  1.  ; Ask the user if they want to continue
  1.  W !
  1.  S DIR(0)="Y",DIR("A")="   Do you want to continue anyway",DIR("B")="NO"
  1.  D ^DIR K DIR
  1.  I Y G MULSELX     ; user said Yes to continue so get out
  1.  ;
  1.  ; At this point the user doesn't want to continue, so we need to 
  1.  ; unlock any buffer entries that may have been locked and then kill
  1.  ; the array so no further processing happens
  1.  S IBSELN=0
  1.  F  S IBSELN=$O(IBCNELST(IBSELN)) Q:'IBSELN  D
  1.  . I 'IBCNELST(IBSELN) Q               ; user could not get this one
  1.  . S IBBUFDA=$P(IBCNELST(IBSELN),U,3)  ; buffer ien
  1.  . D UNLOCK^IBCNBU1(IBBUFDA)           ; unlock it
  1.  . Q
  1.  KILL IBCNELST                         ; remove the array
  1.  ;
  1. MULSELX ;
  1.  Q
  1.  ;
  1.  ;
  1. MSG(TCNT,GCNT) ; build test message
  1.  ; This function builds the first line of the message when not all 
  1.  ; selected buffer entries are available.
  1.  ; TCNT - total number selected
  1.  ; GCNT - total number allocated to user successfully
  1.  NEW BCNT,MSG
  1.  S BCNT=TCNT-GCNT     ; number not available to the user
  1.  I TCNT=1,GCNT=0 S MSG="You selected one buffer entry, but it is not" G MSGX
  1.  I TCNT>1,GCNT=0 S MSG="You selected "_TCNT_" buffer entries, but none of them are" G MSGX
  1.  I BCNT=1 S MSG="You selected "_TCNT_" buffer entries, but one of them is not" G MSGX
  1.  S MSG="You selected "_TCNT_" buffer entries, but "_BCNT_" of them are not"
  1. MSGX ;
  1.  Q MSG
  1.  ;