BPSSCRDS ;BHAM ISC/SS - ECME USER SCREEN DIVISION SELECT ;05-APR-05
;;1.0;E CLAIMS MGMT ENGINE;**1**;JUN 2004
;; Per VHA Directive 10-93-142, this routine should not be modified.
;USER SCREEN
Q
;/*----------------------
;Division select for the user screen.
;Input:
; BPARR - array to return division(s) : IEN of #9002313.56
; BPDUZ7 - DUZ
;Return value:
; 0 nothing selected/
; -1 ALL
; -2 timeout or uparrow
; n number of IENs of #9002313.56 selected by the user and stored in BPARR
;Returned by reference:
; BPARR - array with user profile info to store in IENs to #9002313.56
DS(BPARR,BPDUZ7) ;
N DIR,DTOUT,BPINP
N DR,DIE,DA
N DIR
S BPINP=$$EDITFLD^BPSSCRCV(1.13,+BPDUZ7,"S^D:DIVISION;A:ALL","Select Certain Pharmacy (D)ivisions or (A)LL","ALL",.BPARR)
I BPINP=-1 Q -2 ;quit
I $P(BPINP,U,2)="A" Q -1 ;ALL
Q $$SELDIVS(BPDUZ7,.BPARR)
;
;/**
;returns back the name of the ECME pharmacy division
DIVNAME(BPDIV) ;
Q $P($G(^BPS(9002313.56,BPDIV,0)),U)
;
;/*----------------------
;Reads division selection from the USER PROFILE file
;Input:
; BPSDIVS by reference - array to return division(s) : BPSDIVS(IEN of #9002313.56)
; BPDUZ7 - DUZ
;Return value:
; 0 nothing selected
; -1 ALL
; n number of IENs of #9002313.56 selected by the user and stored in BPSDIVS
;Returned by reference:
; BPSDIVS - array with IENs to #9002313.56
GETDIVIS(BPDUZ7,BPSDIVS) ;*/
N BPDIV,BPCNT
S BPARRAY("DIVS")=$$GETPARAM^BPSSCRSL(2,BPDUZ7)
F BPCNT=1:1:20 S BPDIV=$P($G(BPARRAY("DIVS")),";",BPCNT+1) Q:+BPDIV=0 D
. S BPSDIVS(BPDIV)=""
Q BPCNT-1 ;number of items
;
;/**
;to select divisions (the user cannot select more then 20 divisions)
;Input:
; BPARRAY - array to return division(s) in BPARRAY("DIVS")
; BPDUZ7 -DUZ
;Return value:
; -2 timeout or up arrow
; n - number of divisions selected
;by reference - BPARRAY("DIVS") - the string with
; divisions ien (#9002313.56) divided by "^"
SELDIVS(BPDUZ7,BPARRAY) ;
N BPSDIVS,BPDIV1
N BP1,BPDIV,BPCNT
S BPDIV=0,BPCNT=0
;reads from file- NOT from BPARRAY !
I $$GETDIVIS(BPDUZ7,.BPSDIVS)
W !,?2,"Selected:"
F S BPDIV=$O(BPSDIVS(BPDIV)) Q:+BPDIV=0 S BPCNT=BPCNT+1 D
. W !,?10,$$DIVNAME(BPDIV)
F S BPDIV=$$DIV() Q:BPDIV=-2 Q:+BPDIV=0 D
. I $D(BPSDIVS(BPDIV)) I $$DELDIV(BPDIV)="Y" K BPSDIVS(BPDIV)
. E S BPSDIVS(BPDIV)=""
. S BPCNT=0,BPDIV1=0
. F S BPDIV1=$O(BPSDIVS(BPDIV1)) Q:+BPDIV1=0 S BPCNT=BPCNT+1 D
. . I BPCNT>20 D Q
. . . W !,"Number of selected divisions cannot exceed 20!"
. . . K BPSDIVS(BPDIV)
. S BPCNT=0,BPDIV1=0
. F S BPDIV1=$O(BPSDIVS(BPDIV1)) Q:+BPDIV1=0 S BPCNT=BPCNT+1 D
. . W !,?10,$$DIVNAME(BPDIV1)
;
I BPDIV=-2 D Q -2 ;exit
. W !,"Exit without changes..."
. N BPSDIVS
. I $$GETDIVIS(BPDUZ7,.BPSDIVS)
. S BPCNT=0,BPDIV1=0
. F S BPDIV1=$O(BPSDIVS(BPDIV1)) Q:+BPDIV1=0 S BPCNT=BPCNT+1 D
. . W !,?10,$$DIVNAME(BPDIV1)
;
;convert selection into "^div1;div2...divN;" string
S BPARRAY("DIVS")=""
F BPCNT=1:1:20 S BPDIV=$O(BPSDIVS(BPDIV)) Q:+BPDIV=0 D
. S BPARRAY("DIVS")=$G(BPARRAY("DIVS"))_";"_BPDIV
S BPARRAY("DIVS")=$G(BPARRAY("DIVS"))_";"
Q BPCNT-1
;--------
;
DIV() ;
N DIC,DIRUT,DUOUT,DTOUT
S DIC("A")="Select ECME Pharmacy Division(s): ",DIC=9002313.56,DIC(0)="AEQM" D ^DIC
I $D(DIRUT) Q -2
I ($D(DUOUT))!($D(DTOUT)) Q -2
I Y<1 Q 0
Q +Y
;
;
DELDIV(BPDIV) ;
N DIR
S DIR(0)="S^Y:YES;N:NO",DIR("A")="Delete "_$$DIVNAME(BPDIV)_" from your list?",DIR("B")="N" D ^DIR
Q Y
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HBPSSCRDS 3565 printed Dec 13, 2024@01:53:09 Page 2
BPSSCRDS ;BHAM ISC/SS - ECME USER SCREEN DIVISION SELECT ;05-APR-05
+1 ;;1.0;E CLAIMS MGMT ENGINE;**1**;JUN 2004
+2 ;; Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;USER SCREEN
+4 QUIT
+5 ;/*----------------------
+6 ;Division select for the user screen.
+7 ;Input:
+8 ; BPARR - array to return division(s) : IEN of #9002313.56
+9 ; BPDUZ7 - DUZ
+10 ;Return value:
+11 ; 0 nothing selected/
+12 ; -1 ALL
+13 ; -2 timeout or uparrow
+14 ; n number of IENs of #9002313.56 selected by the user and stored in BPARR
+15 ;Returned by reference:
+16 ; BPARR - array with user profile info to store in IENs to #9002313.56
DS(BPARR,BPDUZ7) ;
+1 NEW DIR,DTOUT,BPINP
+2 NEW DR,DIE,DA
+3 NEW DIR
+4 SET BPINP=$$EDITFLD^BPSSCRCV(1.13,+BPDUZ7,"S^D:DIVISION;A:ALL","Select Certain Pharmacy (D)ivisions or (A)LL","ALL",.BPARR)
+5 ;quit
IF BPINP=-1
QUIT -2
+6 ;ALL
IF $PIECE(BPINP,U,2)="A"
QUIT -1
+7 QUIT $$SELDIVS(BPDUZ7,.BPARR)
+8 ;
+9 ;/**
+10 ;returns back the name of the ECME pharmacy division
DIVNAME(BPDIV) ;
+1 QUIT $PIECE($GET(^BPS(9002313.56,BPDIV,0)),U)
+2 ;
+3 ;/*----------------------
+4 ;Reads division selection from the USER PROFILE file
+5 ;Input:
+6 ; BPSDIVS by reference - array to return division(s) : BPSDIVS(IEN of #9002313.56)
+7 ; BPDUZ7 - DUZ
+8 ;Return value:
+9 ; 0 nothing selected
+10 ; -1 ALL
+11 ; n number of IENs of #9002313.56 selected by the user and stored in BPSDIVS
+12 ;Returned by reference:
+13 ; BPSDIVS - array with IENs to #9002313.56
GETDIVIS(BPDUZ7,BPSDIVS) ;*/
+1 NEW BPDIV,BPCNT
+2 SET BPARRAY("DIVS")=$$GETPARAM^BPSSCRSL(2,BPDUZ7)
+3 FOR BPCNT=1:1:20
SET BPDIV=$PIECE($GET(BPARRAY("DIVS")),";",BPCNT+1)
if +BPDIV=0
QUIT
Begin DoDot:1
+4 SET BPSDIVS(BPDIV)=""
End DoDot:1
+5 ;number of items
QUIT BPCNT-1
+6 ;
+7 ;/**
+8 ;to select divisions (the user cannot select more then 20 divisions)
+9 ;Input:
+10 ; BPARRAY - array to return division(s) in BPARRAY("DIVS")
+11 ; BPDUZ7 -DUZ
+12 ;Return value:
+13 ; -2 timeout or up arrow
+14 ; n - number of divisions selected
+15 ;by reference - BPARRAY("DIVS") - the string with
+16 ; divisions ien (#9002313.56) divided by "^"
SELDIVS(BPDUZ7,BPARRAY) ;
+1 NEW BPSDIVS,BPDIV1
+2 NEW BP1,BPDIV,BPCNT
+3 SET BPDIV=0
SET BPCNT=0
+4 ;reads from file- NOT from BPARRAY !
+5 IF $$GETDIVIS(BPDUZ7,.BPSDIVS)
+6 WRITE !,?2,"Selected:"
+7 FOR
SET BPDIV=$ORDER(BPSDIVS(BPDIV))
if +BPDIV=0
QUIT
SET BPCNT=BPCNT+1
Begin DoDot:1
+8 WRITE !,?10,$$DIVNAME(BPDIV)
End DoDot:1
+9 FOR
SET BPDIV=$$DIV()
if BPDIV=-2
QUIT
if +BPDIV=0
QUIT
Begin DoDot:1
+10 IF $DATA(BPSDIVS(BPDIV))
IF $$DELDIV(BPDIV)="Y"
KILL BPSDIVS(BPDIV)
+11 IF '$TEST
SET BPSDIVS(BPDIV)=""
+12 SET BPCNT=0
SET BPDIV1=0
+13 FOR
SET BPDIV1=$ORDER(BPSDIVS(BPDIV1))
if +BPDIV1=0
QUIT
SET BPCNT=BPCNT+1
Begin DoDot:2
+14 IF BPCNT>20
Begin DoDot:3
+15 WRITE !,"Number of selected divisions cannot exceed 20!"
+16 KILL BPSDIVS(BPDIV)
End DoDot:3
QUIT
End DoDot:2
+17 SET BPCNT=0
SET BPDIV1=0
+18 FOR
SET BPDIV1=$ORDER(BPSDIVS(BPDIV1))
if +BPDIV1=0
QUIT
SET BPCNT=BPCNT+1
Begin DoDot:2
+19 WRITE !,?10,$$DIVNAME(BPDIV1)
End DoDot:2
End DoDot:1
+20 ;
+21 ;exit
IF BPDIV=-2
Begin DoDot:1
+22 WRITE !,"Exit without changes..."
+23 NEW BPSDIVS
+24 IF $$GETDIVIS(BPDUZ7,.BPSDIVS)
+25 SET BPCNT=0
SET BPDIV1=0
+26 FOR
SET BPDIV1=$ORDER(BPSDIVS(BPDIV1))
if +BPDIV1=0
QUIT
SET BPCNT=BPCNT+1
Begin DoDot:2
+27 WRITE !,?10,$$DIVNAME(BPDIV1)
End DoDot:2
End DoDot:1
QUIT -2
+28 ;
+29 ;convert selection into "^div1;div2...divN;" string
+30 SET BPARRAY("DIVS")=""
+31 FOR BPCNT=1:1:20
SET BPDIV=$ORDER(BPSDIVS(BPDIV))
if +BPDIV=0
QUIT
Begin DoDot:1
+32 SET BPARRAY("DIVS")=$GET(BPARRAY("DIVS"))_";"_BPDIV
End DoDot:1
+33 SET BPARRAY("DIVS")=$GET(BPARRAY("DIVS"))_";"
+34 QUIT BPCNT-1
+35 ;--------
+36 ;
DIV() ;
+1 NEW DIC,DIRUT,DUOUT,DTOUT
+2 SET DIC("A")="Select ECME Pharmacy Division(s): "
SET DIC=9002313.56
SET DIC(0)="AEQM"
DO ^DIC
+3 IF $DATA(DIRUT)
QUIT -2
+4 IF ($DATA(DUOUT))!($DATA(DTOUT))
QUIT -2
+5 IF Y<1
QUIT 0
+6 QUIT +Y
+7 ;
+8 ;
DELDIV(BPDIV) ;
+1 NEW DIR
+2 SET DIR(0)="S^Y:YES;N:NO"
SET DIR("A")="Delete "_$$DIVNAME(BPDIV)_" from your list?"
SET DIR("B")="N"
DO ^DIR
+3 QUIT Y
+4 ;
