IBCNBLA2 ;DAOU/ESG - Ins Buffer, Multiple Selection ;09-SEP-2002
;;2.0;INTEGRATED BILLING;**184**;21-MAR-94
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
; Can't be called from the top
Q
;
;
MULSEL(TMPARR,IBCNELST,GCNT) ; Multiple entry selection
; This procedure is responsible for receiving multiple buffer entries
; from the user. It also validates and locks the selected buffer
; entries. It also reports any buffer entries that could not be
; allocated and the reason why not.
;
; Parameters:
; TMPARR - scratch global input parameter
; IBCNELST - output array of entries
; IBCNELST(entry#) = (OK? 0/1)^(error reason)^(buffer ien)
; GCNT - output; number of buffer entries the user got OK
;
NEW OK,ERR,VALMY,IBSELN,IBBUFDA,IBY,TCNT
NEW DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
KILL IBCNELST
S (TCNT,GCNT)=0
I $G(TMPARR)="" G MULSELX
D EN^VALM2($G(XQORNOD(0)),"O") ; ListMan generic selector
I '$D(VALMY) G MULSELX
S IBSELN=0
F S IBSELN=$O(VALMY(IBSELN)) Q:'IBSELN D S IBCNELST(IBSELN)=OK_U_ERR_U_IBBUFDA
. S TCNT=TCNT+1
. S OK=0,ERR="This entry is not valid or available."
. S IBBUFDA=$P($G(^TMP(TMPARR,$J,IBSELN)),U,2,99) Q:'IBBUFDA
. S IBY=$P($G(^IBA(355.33,IBBUFDA,0)),U,4) ; buffer status
. ;
. ; make sure buffer entry is still in an entered status
. 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
. ;
. ; attempt to lock the buffer entry
. I '$$LOCK^IBCNBU1(IBBUFDA,0,0) S ERR="Another user is currently editing this entry." Q
. ;
. ; at this point this entry is OK for processing
. S OK=1,ERR="",GCNT=GCNT+1
. Q
;
; Exit procedure if the user was able to get all entries
; total requested = total allocated
I TCNT=GCNT G MULSELX
;
; At this point, some or all of the user selected entries are not
; available; build and display a message.
W !!?3,$$MSG(TCNT,GCNT)
W !?3,"available for editing at this time:"
S IBSELN=0
F S IBSELN=$O(IBCNELST(IBSELN)) Q:'IBSELN I 'IBCNELST(IBSELN) D
. W !?6,"Entry ",IBSELN,": ",$P(IBCNELST(IBSELN),U,2)
. Q
;
; If the user was not able to get any entries, then kill the array
; and get out
I 'GCNT KILL IBCNELST D PAUSE^VALM1 G MULSELX
;
; Ask the user if they want to continue
W !
S DIR(0)="Y",DIR("A")=" Do you want to continue anyway",DIR("B")="NO"
D ^DIR K DIR
I Y G MULSELX ; user said Yes to continue so get out
;
; At this point the user doesn't want to continue, so we need to
; unlock any buffer entries that may have been locked and then kill
; the array so no further processing happens
S IBSELN=0
F S IBSELN=$O(IBCNELST(IBSELN)) Q:'IBSELN D
. I 'IBCNELST(IBSELN) Q ; user could not get this one
. S IBBUFDA=$P(IBCNELST(IBSELN),U,3) ; buffer ien
. D UNLOCK^IBCNBU1(IBBUFDA) ; unlock it
. Q
KILL IBCNELST ; remove the array
;
MULSELX ;
Q
;
;
MSG(TCNT,GCNT) ; build test message
; This function builds the first line of the message when not all
; selected buffer entries are available.
; TCNT - total number selected
; GCNT - total number allocated to user successfully
NEW BCNT,MSG
S BCNT=TCNT-GCNT ; number not available to the user
I TCNT=1,GCNT=0 S MSG="You selected one buffer entry, but it is not" G MSGX
I TCNT>1,GCNT=0 S MSG="You selected "_TCNT_" buffer entries, but none of them are" G MSGX
I BCNT=1 S MSG="You selected "_TCNT_" buffer entries, but one of them is not" G MSGX
S MSG="You selected "_TCNT_" buffer entries, but "_BCNT_" of them are not"
MSGX ;
Q MSG
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCNBLA2 3710 printed Jun 11, 2024@22:09:36 Page 2
IBCNBLA2 ;DAOU/ESG - Ins Buffer, Multiple Selection ;09-SEP-2002
+1 ;;2.0;INTEGRATED BILLING;**184**;21-MAR-94
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
+4 ; Can't be called from the top
+5 QUIT
+6 ;
+7 ;
MULSEL(TMPARR,IBCNELST,GCNT) ; Multiple entry selection
+1 ; This procedure is responsible for receiving multiple buffer entries
+2 ; from the user. It also validates and locks the selected buffer
+3 ; entries. It also reports any buffer entries that could not be
+4 ; allocated and the reason why not.
+5 ;
+6 ; Parameters:
+7 ; TMPARR - scratch global input parameter
+8 ; IBCNELST - output array of entries
+9 ; IBCNELST(entry#) = (OK? 0/1)^(error reason)^(buffer ien)
+10 ; GCNT - output; number of buffer entries the user got OK
+11 ;
+12 NEW OK,ERR,VALMY,IBSELN,IBBUFDA,IBY,TCNT
+13 NEW DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
+14 KILL IBCNELST
+15 SET (TCNT,GCNT)=0
+16 IF $GET(TMPARR)=""
GOTO MULSELX
+17 ; ListMan generic selector
DO EN^VALM2($GET(XQORNOD(0)),"O")
+18 IF '$DATA(VALMY)
GOTO MULSELX
+19 SET IBSELN=0
+20 FOR
SET IBSELN=$ORDER(VALMY(IBSELN))
if 'IBSELN
QUIT
Begin DoDot:1
+21 SET TCNT=TCNT+1
+22 SET OK=0
SET ERR="This entry is not valid or available."
+23 SET IBBUFDA=$PIECE($GET(^TMP(TMPARR,$JOB,IBSELN)),U,2,99)
if 'IBBUFDA
QUIT
+24 ; buffer status
SET IBY=$PIECE($GET(^IBA(355.33,IBBUFDA,0)),U,4)
+25 ;
+26 ; make sure buffer entry is still in an entered status
+27 IF IBY'="E"
SET ERR="This entry has a status of "_$SELECT(IBY="A":"ACCEPTED",IBY="R":"REJECTED",1:"UNKNOWN")_" and cannot be modified."
QUIT
+28 ;
+29 ; attempt to lock the buffer entry
+30 IF '$$LOCK^IBCNBU1(IBBUFDA,0,0)
SET ERR="Another user is currently editing this entry."
QUIT
+31 ;
+32 ; at this point this entry is OK for processing
+33 SET OK=1
SET ERR=""
SET GCNT=GCNT+1
+34 QUIT
End DoDot:1
SET IBCNELST(IBSELN)=OK_U_ERR_U_IBBUFDA
+35 ;
+36 ; Exit procedure if the user was able to get all entries
+37 ; total requested = total allocated
+38 IF TCNT=GCNT
GOTO MULSELX
+39 ;
+40 ; At this point, some or all of the user selected entries are not
+41 ; available; build and display a message.
+42 WRITE !!?3,$$MSG(TCNT,GCNT)
+43 WRITE !?3,"available for editing at this time:"
+44 SET IBSELN=0
+45 FOR
SET IBSELN=$ORDER(IBCNELST(IBSELN))
if 'IBSELN
QUIT
IF 'IBCNELST(IBSELN)
Begin DoDot:1
+46 WRITE !?6,"Entry ",IBSELN,": ",$PIECE(IBCNELST(IBSELN),U,2)
+47 QUIT
End DoDot:1
+48 ;
+49 ; If the user was not able to get any entries, then kill the array
+50 ; and get out
+51 IF 'GCNT
KILL IBCNELST
DO PAUSE^VALM1
GOTO MULSELX
+52 ;
+53 ; Ask the user if they want to continue
+54 WRITE !
+55 SET DIR(0)="Y"
SET DIR("A")=" Do you want to continue anyway"
SET DIR("B")="NO"
+56 DO ^DIR
KILL DIR
+57 ; user said Yes to continue so get out
IF Y
GOTO MULSELX
+58 ;
+59 ; At this point the user doesn't want to continue, so we need to
+60 ; unlock any buffer entries that may have been locked and then kill
+61 ; the array so no further processing happens
+62 SET IBSELN=0
+63 FOR
SET IBSELN=$ORDER(IBCNELST(IBSELN))
if 'IBSELN
QUIT
Begin DoDot:1
+64 ; user could not get this one
IF 'IBCNELST(IBSELN)
QUIT
+65 ; buffer ien
SET IBBUFDA=$PIECE(IBCNELST(IBSELN),U,3)
+66 ; unlock it
DO UNLOCK^IBCNBU1(IBBUFDA)
+67 QUIT
End DoDot:1
+68 ; remove the array
KILL IBCNELST
+69 ;
MULSELX ;
+1 QUIT
+2 ;
+3 ;
MSG(TCNT,GCNT) ; build test message
+1 ; This function builds the first line of the message when not all
+2 ; selected buffer entries are available.
+3 ; TCNT - total number selected
+4 ; GCNT - total number allocated to user successfully
+5 NEW BCNT,MSG
+6 ; number not available to the user
SET BCNT=TCNT-GCNT
+7 IF TCNT=1
IF GCNT=0
SET MSG="You selected one buffer entry, but it is not"
GOTO MSGX
+8 IF TCNT>1
IF GCNT=0
SET MSG="You selected "_TCNT_" buffer entries, but none of them are"
GOTO MSGX
+9 IF BCNT=1
SET MSG="You selected "_TCNT_" buffer entries, but one of them is not"
GOTO MSGX
+10 SET MSG="You selected "_TCNT_" buffer entries, but "_BCNT_" of them are not"
MSGX ;
+1 QUIT MSG
+2 ;
