source: WorldVistAEHR/trunk/r/E_CLAIMS_MGMT_ENGINE-BPS/BPSSCRDS.m@ 701

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

initial load of WorldVistAEHR

File size: 3.4 KB
Line 
1BPSSCRDS ;BHAM ISC/SS - ECME USER SCREEN DIVISION SELECT ;05-APR-05
2 ;;1.0;E CLAIMS MGMT ENGINE;**1**;JUN 2004
3 ;; Per VHA Directive 10-93-142, this routine should not be modified.
4 ;USER SCREEN
5 Q
6 ;/*----------------------
7 ;Division select for the user screen.
8 ;Input:
9 ; BPARR - array to return division(s) : IEN of #9002313.56
10 ; BPDUZ7 - DUZ
11 ;Return value:
12 ; 0 nothing selected/
13 ; -1 ALL
14 ; -2 timeout or uparrow
15 ; n number of IENs of #9002313.56 selected by the user and stored in BPARR
16 ;Returned by reference:
17 ; BPARR - array with user profile info to store in IENs to #9002313.56
18DS(BPARR,BPDUZ7) ;
19 N DIR,DTOUT,BPINP
20 N DR,DIE,DA
21 N DIR
22 S BPINP=$$EDITFLD^BPSSCRCV(1.13,+BPDUZ7,"S^D:DIVISION;A:ALL","Select Certain Pharmacy (D)ivisions or (A)LL","ALL",.BPARR)
23 I BPINP=-1 Q -2 ;quit
24 I $P(BPINP,U,2)="A" Q -1 ;ALL
25 Q $$SELDIVS(BPDUZ7,.BPARR)
26 ;
27 ;/**
28 ;returns back the name of the ECME pharmacy division
29DIVNAME(BPDIV) ;
30 Q $P($G(^BPS(9002313.56,BPDIV,0)),U)
31 ;
32 ;/*----------------------
33 ;Reads division selection from the USER PROFILE file
34 ;Input:
35 ; BPSDIVS by reference - array to return division(s) : BPSDIVS(IEN of #9002313.56)
36 ; BPDUZ7 - DUZ
37 ;Return value:
38 ; 0 nothing selected
39 ; -1 ALL
40 ; n number of IENs of #9002313.56 selected by the user and stored in BPSDIVS
41 ;Returned by reference:
42 ; BPSDIVS - array with IENs to #9002313.56
43GETDIVIS(BPDUZ7,BPSDIVS) ;*/
44 N BPDIV,BPCNT
45 S BPARRAY("DIVS")=$$GETPARAM^BPSSCRSL(2,BPDUZ7)
46 F BPCNT=1:1:20 S BPDIV=$P($G(BPARRAY("DIVS")),";",BPCNT+1) Q:+BPDIV=0 D
47 . S BPSDIVS(BPDIV)=""
48 Q BPCNT-1 ;number of items
49 ;
50 ;/**
51 ;to select divisions (the user cannot select more then 20 divisions)
52 ;Input:
53 ; BPARRAY - array to return division(s) in BPARRAY("DIVS")
54 ; BPDUZ7 -DUZ
55 ;Return value:
56 ; -2 timeout or up arrow
57 ; n - number of divisions selected
58 ;by reference - BPARRAY("DIVS") - the string with
59 ; divisions ien (#9002313.56) divided by "^"
60SELDIVS(BPDUZ7,BPARRAY) ;
61 N BPSDIVS,BPDIV1
62 N BP1,BPDIV,BPCNT
63 S BPDIV=0,BPCNT=0
64 ;reads from file- NOT from BPARRAY !
65 I $$GETDIVIS(BPDUZ7,.BPSDIVS)
66 W !,?2,"Selected:"
67 F S BPDIV=$O(BPSDIVS(BPDIV)) Q:+BPDIV=0 S BPCNT=BPCNT+1 D
68 . W !,?10,$$DIVNAME(BPDIV)
69 F S BPDIV=$$DIV() Q:BPDIV=-2 Q:+BPDIV=0 D
70 . I $D(BPSDIVS(BPDIV)) I $$DELDIV(BPDIV)="Y" K BPSDIVS(BPDIV)
71 . E S BPSDIVS(BPDIV)=""
72 . S BPCNT=0,BPDIV1=0
73 . F S BPDIV1=$O(BPSDIVS(BPDIV1)) Q:+BPDIV1=0 S BPCNT=BPCNT+1 D
74 . . I BPCNT>20 D Q
75 . . . W !,"Number of selected divisions cannot exceed 20!"
76 . . . K BPSDIVS(BPDIV)
77 . S BPCNT=0,BPDIV1=0
78 . F S BPDIV1=$O(BPSDIVS(BPDIV1)) Q:+BPDIV1=0 S BPCNT=BPCNT+1 D
79 . . W !,?10,$$DIVNAME(BPDIV1)
80 ;
81 I BPDIV=-2 D Q -2 ;exit
82 . W !,"Exit without changes..."
83 . N BPSDIVS
84 . I $$GETDIVIS(BPDUZ7,.BPSDIVS)
85 . S BPCNT=0,BPDIV1=0
86 . F S BPDIV1=$O(BPSDIVS(BPDIV1)) Q:+BPDIV1=0 S BPCNT=BPCNT+1 D
87 . . W !,?10,$$DIVNAME(BPDIV1)
88 ;
89 ;convert selection into "^div1;div2...divN;" string
90 S BPARRAY("DIVS")=""
91 F BPCNT=1:1:20 S BPDIV=$O(BPSDIVS(BPDIV)) Q:+BPDIV=0 D
92 . S BPARRAY("DIVS")=$G(BPARRAY("DIVS"))_";"_BPDIV
93 S BPARRAY("DIVS")=$G(BPARRAY("DIVS"))_";"
94 Q BPCNT-1
95 ;--------
96 ;
97DIV() ;
98 N DIC,DIRUT,DUOUT,DTOUT
99 S DIC("A")="Select ECME Pharmacy Division(s): ",DIC=9002313.56,DIC(0)="AEQM" D ^DIC
100 I $D(DIRUT) Q -2
101 I ($D(DUOUT))!($D(DTOUT)) Q -2
102 I Y<1 Q 0
103 Q +Y
104 ;
105 ;
106DELDIV(BPDIV) ;
107 N DIR
108 S DIR(0)="S^Y:YES;N:NO",DIR("A")="Delete "_$$DIVNAME(BPDIV)_" from your list?",DIR("B")="N" D ^DIR
109 Q Y
110 ;
Note: See TracBrowser for help on using the repository browser.