source: WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCNBLA2.m@ 1389

Last change on this file since 1389 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.5 KB
Line 
1IBCNBLA2 ;DAOU/ESG - Ins Buffer, Multiple Selection ;09-SEP-2002
2 ;;2.0;INTEGRATED BILLING;**184**;21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5 ; Can't be called from the top
6 Q
7 ;
8 ;
9MULSEL(TMPARR,IBCNELST,GCNT) ; Multiple entry selection
10 ; This procedure is responsible for receiving multiple buffer entries
11 ; from the user. It also validates and locks the selected buffer
12 ; entries. It also reports any buffer entries that could not be
13 ; allocated and the reason why not.
14 ;
15 ; Parameters:
16 ; TMPARR - scratch global input parameter
17 ; IBCNELST - output array of entries
18 ; IBCNELST(entry#) = (OK? 0/1)^(error reason)^(buffer ien)
19 ; GCNT - output; number of buffer entries the user got OK
20 ;
21 NEW OK,ERR,VALMY,IBSELN,IBBUFDA,IBY,TCNT
22 NEW DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
23 KILL IBCNELST
24 S (TCNT,GCNT)=0
25 I $G(TMPARR)="" G MULSELX
26 D EN^VALM2($G(XQORNOD(0)),"O") ; ListMan generic selector
27 I '$D(VALMY) G MULSELX
28 S IBSELN=0
29 F S IBSELN=$O(VALMY(IBSELN)) Q:'IBSELN D S IBCNELST(IBSELN)=OK_U_ERR_U_IBBUFDA
30 . S TCNT=TCNT+1
31 . S OK=0,ERR="This entry is not valid or available."
32 . S IBBUFDA=$P($G(^TMP(TMPARR,$J,IBSELN)),U,2,99) Q:'IBBUFDA
33 . S IBY=$P($G(^IBA(355.33,IBBUFDA,0)),U,4) ; buffer status
34 . ;
35 . ; make sure buffer entry is still in an entered status
36 . 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
37 . ;
38 . ; attempt to lock the buffer entry
39 . I '$$LOCK^IBCNBU1(IBBUFDA,0,0) S ERR="Another user is currently editing this entry." Q
40 . ;
41 . ; at this point this entry is OK for processing
42 . S OK=1,ERR="",GCNT=GCNT+1
43 . Q
44 ;
45 ; Exit procedure if the user was able to get all entries
46 ; total requested = total allocated
47 I TCNT=GCNT G MULSELX
48 ;
49 ; At this point, some or all of the user selected entries are not
50 ; available; build and display a message.
51 W !!?3,$$MSG(TCNT,GCNT)
52 W !?3,"available for editing at this time:"
53 S IBSELN=0
54 F S IBSELN=$O(IBCNELST(IBSELN)) Q:'IBSELN I 'IBCNELST(IBSELN) D
55 . W !?6,"Entry ",IBSELN,": ",$P(IBCNELST(IBSELN),U,2)
56 . Q
57 ;
58 ; If the user was not able to get any entries, then kill the array
59 ; and get out
60 I 'GCNT KILL IBCNELST D PAUSE^VALM1 G MULSELX
61 ;
62 ; Ask the user if they want to continue
63 W !
64 S DIR(0)="Y",DIR("A")=" Do you want to continue anyway",DIR("B")="NO"
65 D ^DIR K DIR
66 I Y G MULSELX ; user said Yes to continue so get out
67 ;
68 ; At this point the user doesn't want to continue, so we need to
69 ; unlock any buffer entries that may have been locked and then kill
70 ; the array so no further processing happens
71 S IBSELN=0
72 F S IBSELN=$O(IBCNELST(IBSELN)) Q:'IBSELN D
73 . I 'IBCNELST(IBSELN) Q ; user could not get this one
74 . S IBBUFDA=$P(IBCNELST(IBSELN),U,3) ; buffer ien
75 . D UNLOCK^IBCNBU1(IBBUFDA) ; unlock it
76 . Q
77 KILL IBCNELST ; remove the array
78 ;
79MULSELX ;
80 Q
81 ;
82 ;
83MSG(TCNT,GCNT) ; build test message
84 ; This function builds the first line of the message when not all
85 ; selected buffer entries are available.
86 ; TCNT - total number selected
87 ; GCNT - total number allocated to user successfully
88 NEW BCNT,MSG
89 S BCNT=TCNT-GCNT ; number not available to the user
90 I TCNT=1,GCNT=0 S MSG="You selected one buffer entry, but it is not" G MSGX
91 I TCNT>1,GCNT=0 S MSG="You selected "_TCNT_" buffer entries, but none of them are" G MSGX
92 I BCNT=1 S MSG="You selected "_TCNT_" buffer entries, but one of them is not" G MSGX
93 S MSG="You selected "_TCNT_" buffer entries, but "_BCNT_" of them are not"
94MSGX ;
95 Q MSG
96 ;
Note: See TracBrowser for help on using the repository browser.