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

BPSRPT3.m

Go to the documentation of this file. 
  1. BPSRPT3 ;BHAM ISC/BEE - ECME REPORTS ;14-FEB-05
  1.  ;;1.0;E CLAIMS MGMT ENGINE;**1,3,5,7,11,14,19,20,23,24**;JUN 2004;Build 43
  1.  ;;Per VA Directive 6402, this routine should not be modified.
  1.  ;
  1.  ;Reference to IB NCPCP NON-BILLABLE STATUS REASONS (#366.17) supported by ICR 6136
  1.  ;
  1.  Q
  1.  ;
  1.  ; Select the ECME Pharmacy or Pharmacies
  1.  ; 
  1.  ; Input Variable -> none
  1.  ; Return Value ->   "" = Valid Entry or Entries Selected
  1.  ;                                        ^ = Exit
  1.  ;                                       
  1.  ; Output Variable -> BPPHARM = 1 One or More Pharmacies Selected
  1.  ;                          = 0 User Entered 'ALL'
  1.  ;                            
  1.  ; If BPPHARM = 1 then the BPPHARM array will be defined where:
  1.  ;    BPPHARM(ptr) = ptr ^ BPS PHARMACY NAME and
  1.  ;    ptr = Internal Pointer to BPS PHARMACIES file (#9002313.56)
  1.  ;                    
  1. SELPHARM() N DIC,DIR,DIRUT,DTOUT,DUOUT,X,Y
  1.  ;
  1.  ;Reset BPPHARM array
  1.  K BPPHARM
  1.  ;
  1.  ;First see if they want to enter individual divisions or ALL
  1.  S DIR(0)="S^D:DIVISION;A:ALL"
  1.  S DIR("A")="Select Certain Pharmacy (D)ivisions or (A)LL"
  1.  S DIR("L",1)="Select one of the following:"
  1.  S DIR("L",2)=""
  1.  S DIR("L",3)="     D         DIVISION"
  1.  S DIR("L",4)="     A         ALL"
  1.  D ^DIR K DIR
  1.  ;
  1.  ;Check for "^" or timeout, otherwise define BPPHARM
  1.  I ($G(DUOUT)=1)!($G(DTOUT)=1) S Y="^"
  1.  E  S BPPHARM=$S(Y="A":0,1:1)
  1.  ;
  1. SELPHRM1 ;
  1.  ;If division selected, ask prompt
  1.  I $G(BPPHARM)=1 F  D  Q:Y="^"!(Y="") 
  1.  .;
  1.  .;Prompt for entry
  1.  .K X S DIC(0)="QEAM",DIC=9002313.56,DIC("A")="Select ECME Pharmacy Division(s): "
  1.  .W ! D ^DIC
  1.  .;
  1.  .;Check for "^" or timeout 
  1.  .I ($G(DUOUT)=1)!($G(DTOUT)=1) K BPPHARM S Y="^" Q
  1.  .;
  1.  .;Check for blank entry, quit if no previous selections
  1.  .I $G(X)="" S Y=$S($D(BPPHARM)>9:"",1:"^") Q
  1.  .;
  1.  .;Handle Deletes
  1.  .I $D(BPPHARM(+Y)) D  Q:Y="^"  I 1
  1.  ..N P
  1.  ..S P=Y  ;Save Original Value
  1.  ..S DIR(0)="S^Y:YES;N:NO",DIR("A")="Delete "_$P(P,U,2)_" from your list?"
  1.  ..S DIR("B")="NO" D ^DIR
  1.  ..I ($G(DUOUT)=1)!($G(DTOUT)=1) K BPPHARM S Y="^" Q
  1.  ..I Y="Y" K BPPHARM(+P),BPPHARM("B",$P(P,U,2),+P)
  1.  ..S Y=P  ;Restore Original Value
  1.  ..K P
  1.  .E  D
  1.  ..;Define new entries in BPPHARM array
  1.  ..S BPPHARM(+Y)=Y
  1.  ..S BPPHARM("B",$P(Y,U,2),+Y)=""
  1.  .;
  1.  .;Display a list of selected divisions
  1.  .I $D(BPPHARM)>9 D
  1.  ..N X
  1.  ..W !,?2,"Selected:"
  1.  ..S X="" F  S X=$O(BPPHARM("B",X)) Q:X=""  W !,?10,X
  1.  ..K X
  1.  .Q
  1.  ;
  1.  K BPPHARM("B")
  1.  Q Y
  1.  ;
  1.  ; Select to Include Eligibility of (V)ETERAN, (T)RICARE, (C)HAMPVA or (A)ll
  1.  ; 
  1.  ; Input Variable -> DFLT = 0 = All
  1.  ;                          1 = VETERAN
  1.  ;                          2 = TRICARE
  1.  ;                          3 = CHAMPVA
  1.  ; 
  1.  ; Return Value ->  V, T, C or 0 for All
  1.  ;
  1. SELELIG(DFLT) N DIC,DIR,DIRUT,DUOUT,DTOUT,DIROUT,X,Y
  1.  S DFLT=$S($G(DFLT)=1:"V",$G(DFLT)=2:"T",$G(DFLT)=3:"C",1:"A")
  1.  S DIR(0)="S^V:VETERAN;T:TRICARE;C:CHAMPVA;A:ALL"
  1.  S DIR("A")="Include Certain Eligibility Type or (A)ll",DIR("B")=DFLT
  1.  D ^DIR
  1.  I ($G(DUOUT)=1)!($G(DTOUT)=1) S Y="^"
  1.  S Y=$S(Y="A":0,1:Y)
  1.  Q Y
  1.  ;
  1.  ; Display (S)ummary or (D)etail Format
  1.  ;
  1.  ; Input Variable -> DFLT = 1 Summary
  1.  ;                          2 Detail
  1.  ;
  1.  ; Return Value ->   1 = Summary
  1.  ;                   0 = Detail
  1.  ;                   ^ = Exit
  1.  ;
  1. SELSMDET(DFLT) N DIR,DIRUT,DTOUT,DUOUT,X,Y
  1.  S DFLT=$S($G(DFLT)=1:"Summary",$G(DFLT)=0:"Detail",1:"Detail")
  1.  S DIR(0)="S^S:Summary;D:Detail",DIR("A")="Display (S)ummary or (D)etail Format",DIR("B")=DFLT
  1.  D ^DIR
  1.  I ($G(DUOUT)=1)!($G(DTOUT)=1) S Y="^"
  1.  S Y=$S(Y="S":1,Y="D":0,1:Y)
  1.  Q Y
  1.  ;
  1.  ; Display (C)MOP or (M)ail or (W)indow or (A)ll
  1.  ; 
  1.  ;    Input Variable -> DFLT = C CMOP
  1.  ;                             W Window
  1.  ;                             M Mail
  1.  ;                             A All
  1.  ;                          
  1.  ;    Return Value ->   C = CMOP
  1.  ;                      W = Window
  1.  ;                      M = Mail
  1.  ;                      A = All
  1.  ;                      ^ = Exit
  1.  ; 
  1. SELMWC(DFLT) N DIR,DIRUT,DTOUT,DUOUT,X,Y
  1.  S DFLT=$S($G(DFLT)="C":"CMOP",$G(DFLT)="W":"Window",$G(DFLT)="M":"Mail",1:"ALL")
  1.  S DIR(0)="S^C:CMOP;M:Mail;W:Window;A:ALL"
  1.  S DIR("A")="Display (C)MOP or (M)ail or (W)indow or (A)LL",DIR("B")=DFLT
  1.  D ^DIR
  1.  I ($G(DUOUT)=1)!($G(DTOUT)=1) S Y="^"
  1.  Q Y
  1.  ;
  1.  ;
  1. SELMWC1(DFLT) ;
  1.  ; Upon completion of prompt, values will be placed into a string delimited
  1.  ; by commas. e.g. C,M
  1.  ; 
  1.  ; If user includes (A)ll as a code, "A" will be stored in BPARR
  1.  ; array. e.g. Entry of C,M,A will save as BPARR("MWC")="A"
  1.  ; 
  1.  ; User input values are temporary stored in array BPSMWC to eliminate duplicate 
  1.  ; entries. e.g. Entry of C,M,C will save as BPARR("MWC")="C,M"
  1.  ; 
  1. BPSMWC ;
  1.  N DIR,DIRUT,DTOUT,DUOUT,X,Y
  1.  N BPARR,BPSMWC,BPSERR,BPSMWCSTR,BPSSEL,BPSX
  1.  ;
  1.  S BPSMWCSTR=",C,M,W,A,"
  1.  S DIR(0)="FO^0:7"
  1.  S DIR("A",1)=""
  1.  S DIR("A",2)="     Select one or more of the following:"
  1.  S DIR("A",3)=""
  1.  S DIR("A",4)="          C         CMOP"
  1.  S DIR("A",5)="          M         Mail"
  1.  S DIR("A",6)="          W         Window"
  1.  S DIR("A",7)="          A         ALL"
  1.  S DIR("A",8)=""
  1.  S DIR("A")="Display (C)MOP or (M)ail or (W)indow or (A)ll"
  1.  S DIR("B")="A" S:$G(BPARR("MWC"))'="" DIR("B")=BPARR("MWC")
  1.  S DIR("?",1)="Enter a single response or multiple responses separated by commas."
  1.  S DIR("?",2)=" Example:"
  1.  S DIR("?",3)="  C"
  1.  S DIR("?")="  C,M"
  1.  D ^DIR K DIR
  1.  I ($G(DUOUT)=1)!($G(DTOUT)=1)!($D(DIRUT)) Q "^"
  1.  ;
  1.  ;Convert any lower case to upper case
  1.  S X=$TR(X,BPSLC,BPSUC)
  1.  ;
  1.  ;If 'A' was one of the selections,reset X to include all available selections.
  1.  I X[",",X["A" S X="C,M,W"
  1.  ;
  1.  ; Loop through user input (returned in variable X).
  1.  ; Display warning message if any user input selection is not included
  1.  ; in the string of acceptable codes (BPSMWCSTR) and re-prompt question.
  1.  ; Assign valid selections to BPSMWC array. This array will prevent
  1.  ; duplicate entries from being saved to the user's profile.
  1.  ;
  1.  K BPSMWC
  1.  S BPSERR=""
  1.  F BPSX=1:1:$L(X,",") D
  1.  . S BPSSEL=$P(X,",",BPSX)
  1.  . I BPSMWCSTR'[(","_BPSSEL_",") W !," ",BPSSEL," is not a valid entry." S BPSERR=1 Q
  1.  . S BPSMWC(BPSSEL)=""
  1.  ;
  1.  I $G(BPSERR)=1 G BPSMWC
  1.  ;
  1.  ; If user included (A)ll as a selection, set profile setting to "A".
  1.  ;
  1.  I $D(BPSMWC("A")) S BPARR("MWC")="A"
  1.  E  D  ; User did not enter "A".
  1.  . ;
  1.  . ; At this point user selections are valid, do not include "A".
  1.  . ; Loop through and set selections into a comma delimited
  1.  . ; string before assigning to BPARR array.
  1.  . ;
  1.  . S BPSSEL=""
  1.  . F  S BPSSEL=$O(BPSMWC(BPSSEL)) Q:BPSSEL=""  D
  1.  . . ; Display the user selections
  1.  . . W !,?10,$S(BPSSEL="C":"CMOP",BPSSEL="M":"MAIL",BPSSEL="W":"WINDOW",1:"")
  1.  . . S BPSMWC=$G(BPSMWC)_BPSSEL_","
  1.  . S BPSMWC=$E(BPSMWC,1,($L(BPSMWC)-1))
  1.  . S BPARR("MWC")=BPSMWC
  1.  ;
  1.  Q BPARR("MWC")
  1.  ;
  1.  ; Display (R)ealTime Fills or (B)ackbills or (P)RO option or Re(S)ubmission or (A)LL
  1.  ;
  1.  ;    Input Variable -> DFLT = 5 Resubmission
  1.  ;                             4 PRO Option
  1.  ;                             3 Backbill
  1.  ;                             2 Real Time Fills
  1.  ;                             1 ALL
  1.  ;                          
  1.  ;    Return Value ->   5 = Resubmision
  1.  ;                      4 = PRO Option
  1.  ;                      3 = Backbill (manually)
  1.  ;                      2 = Real Time Fills (automatically during FINISH)
  1.  ;                      1 = ALL
  1.  ;                      ^ = Exit
  1.  ;
  1. SELRTBCK(DFLT) N DIR,DIRUT,DTOUT,DUOUT,DIROUT,X,Y
  1.  S DFLT=$S($G(DFLT)=2:"Real Time",$G(DFLT)=3:"Backbill",$G(DFLT)=4:"PRO Option",$G(DFLT)=5:"Resubmission",1:"A")
  1.  S DIR(0)="S^R:Real Time Fills;B:Backbill;P:PRO Option;S:ReSubmission;A:ALL"
  1.  S DIR("A")="Display (R)ealTime, (B)ackbills, (P)RO Option, Re(S)ubmission or (A)LL",DIR("B")=DFLT
  1.  D ^DIR
  1.  I ($G(DUOUT)=1)!($G(DTOUT)=1) S Y="^"
  1.  S Y=$S(Y="A":1,Y="R":2,Y="B":3,Y="P":4,Y="S":5,1:Y)
  1.  Q Y
  1.  ;
  1. SELRBPS() ;
  1.  ;
  1.  ; BPSRBSTR = string of valid codes
  1.  ;
  1.  ; Upon completion of prompt, values will be placed into a string delimited
  1.  ; by commas. e.g. P,R
  1.  ;
  1.  ; If user selected (A)ll then 1 will be stored in BPARR
  1.  ;
  1.  ; User input values are temporary stored in array BPSRBPS to eliminate duplicate 
  1.  ; entries.
  1.  ;
  1. BPRBPS ; Realtime / Backbills / Pro Option / Resubmission / All
  1.  N BPARR,BPSRBPS,BPSERR,BPSRBSTR,BPSSEL,BPSX
  1.  N DIR,DIRUT,DTOUT,DUOUT,X,Y
  1.  ;
  1.  S BPSRBSTR=",R,B,P,S,A,"
  1.  S DIR(0)="FO^0:9"
  1.  S DIR("A",1)=""
  1.  S DIR("A",2)="     Select one or more of the following:"
  1.  S DIR("A",3)=""
  1.  S DIR("A",4)="          R         Real Time Fills"
  1.  S DIR("A",5)="          B         Backbill"
  1.  S DIR("A",6)="          P         PRO Option"
  1.  S DIR("A",7)="          S         ReSubmission"
  1.  S DIR("A",8)="          A         ALL"
  1.  S DIR("A",9)=""
  1.  S DIR("A")="Display (R)ealTime, (B)ackbills, (P)RO Option, Re(S)ubmission or (A)ll"
  1.  S DIR("B")="A" S:$G(BPARR("RBPS"))'="" DIR("B")=BPARR("RBPS")
  1.  S DIR("?",1)="Enter a single response or multiple responses separated by commas."
  1.  S DIR("?",2)=" Example:"
  1.  S DIR("?",3)="  B"
  1.  S DIR("?")="  B,P"
  1.  D ^DIR K DIR
  1.  ;
  1.  I ($G(DUOUT)=1)!($G(DTOUT)=1)!($D(DIRUT)) Q "^"
  1.  ;
  1.  ;Convert any lower case to upper case
  1.  S X=$TR(X,BPSLC,BPSUC)
  1.  ;
  1.  ;If 'A' was one of the selections,reset X to include all available selections.
  1.  I X[",",X["A" S X="R,B,P,S"
  1.  ;
  1.  ; Loop through user input (returned in variable X).
  1.  ; Display warning message if any user input selection is not included
  1.  ; in the string of acceptable codes (BPSRBSTR) and re-prompt question.
  1.  ; Assign valid selections to BPRTBCK array. This array will prevent
  1.  ; duplicate entries from being saved to the user's profile.
  1.  ;
  1.  K BPSRBPS
  1.  S (BPSSEL,BPSERR)=""
  1.  F BPSX=1:1:$L(X,",") D
  1.  . S BPSSEL=$P(X,",",BPSX)
  1.  . I BPSRBSTR'[(","_BPSSEL_",") W !," ",BPSSEL," is not a valid entry." S BPSERR=1 Q
  1.  . S BPSRBPS(BPSSEL)=""
  1.  ;
  1.  I $G(BPSERR)=1 G BPRBPS
  1.  ;
  1.  ; If user selected (A)ll, set profile setting to ALL.
  1.  I $D(BPSRBPS("A")) S BPARR("RBPS")=1
  1.  E  D  ; User did not enter "A".
  1.  . ;
  1.  . ; At this point user selections are valid and do not include "A".
  1.  . ; Loop through valid user selections. Set selections into a
  1.  . ; comma delimited string before assigning to BPARR array.
  1.  . ;
  1.  . S (BPSSEL,BPSSELN)=""
  1.  . F  S BPSSEL=$O(BPSRBPS(BPSSEL)) Q:BPSSEL=""  D
  1.  . . ; Display the user selections
  1.  . . W !,?10,$S(BPSSEL="R":"REALTIME",BPSSEL="B":"BACKBILLS",BPSSEL="P":"PRO OPTION",BPSSEL="S":"RESUBMISSION",1:"")
  1.  . . S BPSRBPS=$G(BPSRBPS)_BPSSEL_","
  1.  . S BPSRBPS=$E(BPSRBPS,1,($L(BPSRBPS)-1))
  1.  ;
  1.  ; If ALL wasn't selected convert BPSRBPS to numerical a value, like existing functionality in SELRTBCK^BPSRPT3.
  1.  I '$D(BPSRBPS("A")) D
  1.  . N RTBCKX,NRTBCK,I
  1.  . S NRTBCK=""
  1.  . I $L(BPSRBPS)=1 D
  1.  . . S NRTBCK=$S(BPSRBPS="R":2,BPSRBPS="B":3,BPSRBPS="P":4,BPSRBPS="S":5,1:"")
  1.  . . S BPARR("RBPS")=NRTBCK
  1.  . E  D
  1.  . . F I=1:1:$L(BPSRBPS,",") S RTBCKX=$P(BPSRBPS,",",I),NRTBCK=NRTBCK_$S(RTBCKX="R":2,RTBCKX="B":3,RTBCKX="P":4,RTBCKX="S":5,1:"")_","
  1.  . . S BPARR("RBPS")=$E(NRTBCK,1,$L(NRTBCK)-1)
  1.  ;
  1.  Q BPARR("RBPS")
  1.  ;
  1.  ; Display Specific (D)rug or Drug (C)lass
  1.  ; 
  1.  ;    Input Variable -> DFLT = 3 Drug Class
  1.  ;                             2 Drug
  1.  ;                             1 ALL
  1.  ;                          
  1.  ;     Return Value ->   3 = Drug Class
  1.  ;                       2 = Drug
  1.  ;                       1 = ALL
  1.  ;                       ^ = Exit
  1.  ;                       
  1. SELDRGAL(DFLT) N DIR,DIRUT,DTOUT,DUOUT,X,Y
  1.  S DFLT=$S($G(DFLT)=2:"Drug",$G(DFLT)=3:"Drug Class",1:"ALL")
  1.  S DIR(0)="S^D:Drug;C:Drug Class;A:ALL"
  1.  S DIR("A")="Display Specific (D)rug or Drug (C)lass or (A)LL",DIR("B")=DFLT
  1.  D ^DIR
  1.  I ($G(DUOUT)=1)!($G(DTOUT)=1) S Y="^"
  1.  S Y=$S(Y="A":1,Y="D":2,Y="C":3,1:Y)
  1.  Q Y
  1.  ;
  1.  ; Select Drug
  1.  ; 
  1.  ; Input Variable -> none
  1.  ; 
  1.  ; Return Value -> ptr = pointer to DRUG file (#50)
  1.  ;                   ^ = Exit
  1.  ;                   
  1. SELDRG() N DIC,DIRUT,DUOUT,X,Y
  1.  ;
  1.  ;Prompt for entry
  1.  W ! D SELDRG^BPSRPT6
  1.  ;
  1.  ;Check for "^", timeout, or blank entry
  1.  I ($G(DUOUT)=1)!($G(DTOUT)=1) S Y="^"
  1.  ;
  1.  ;Check for Valid Entry
  1.  I +Y>0 S Y=+Y
  1.  ;
  1.  Q Y
  1.  ;
  1.  ; Select Drug Class
  1.  ; 
  1.  ; Input Variable -> none
  1.  ; 
  1.  ; Return Value -> ptr = pointer to VA DRUG CLASS file (#50.605)
  1.  ;                   ^ = Exit
  1.  ;
  1. SELDRGCL() N DIC,DIRUT,DUOUT,Y
  1.  ;
  1.  ;Prompt for entry
  1.  ;Using DIC^PSNDI per ICR 4554 - BPS*1*14 ticket 313337
  1.  S DIC="50.605",DIC(0)="QEAMZ" D DIC^PSNDI(DIC,"BPS",.DIC,,,)
  1.  ;
  1.  ;call returns DRUG CLASS CODE, need to extract DRUG CLASSIFICATION
  1.  I +$G(Y)>0 S Y=$P($G(Y(0)),"^",2) I $G(Y)="" S Y=-1
  1.  ;
  1.  ;If nothing was returned set Y="-1" so report knows 
  1.  I $G(Y)=-1 S Y="^"
  1.  ;
  1.  Q Y
  1.  ;
  1.  ; Enter Date Range
  1.  ;
  1.  ; Input Variable -> TYPE = 7 CLOSE REPORT
  1.  ;                          1-6 OTHER REPORTS
  1.  ;
  1.  ; Return Value -> P1^P2
  1.  ; 
  1.  ;           where P1 = From Date
  1.  ;                    = ^ Exit
  1.  ;                 P2 = To Date
  1.  ;                    = blank for Exit
  1.  ;                 
  1. SELDATE(TYPE) N BPSIBDT,DIR,DIRUT,DTOUT,DUOUT,VAL,X,Y
  1.  S TYPE=$S($G(TYPE)=7:"CLOSE",1:"TRANSACTION")
  1. SELDATE1 S VAL="",DIR(0)="DA^:DT:EX",DIR("A")="START WITH "_TYPE_" DATE: ",DIR("B")="T-1"
  1.  W ! D ^DIR
  1.  ;
  1.  ;Check for "^", timeout, or blank entry
  1.  I ($G(DUOUT)=1)!($G(DTOUT)=1)!($G(X)="") S VAL="^"
  1.  ;
  1.  I VAL="" D
  1.  .S $P(VAL,U)=Y
  1.  .S DIR(0)="DA^"_VAL_":DT:EX",DIR("A")="  GO TO "_TYPE_" DATE: ",DIR("B")="T"
  1.  .D ^DIR
  1.  .;
  1.  .;Check for "^", timeout, or blank entry
  1.  .I ($G(DUOUT)=1)!($G(DTOUT)=1)!($G(X)="") S VAL="^" Q
  1.  .;
  1.  .;Define Entry
  1.  .S $P(VAL,U,2)=Y
  1.  ;
  1.  Q VAL
  1.  ;
  1.  ; Select to Include Open or Closed or All claims
  1.  ; 
  1.  ; Input Variable -> DFLT = 0 = All
  1.  ;                          1 = Closed
  1.  ;                          2 = Open
  1.  ; 
  1.  ; Return Value -> 0 = All, 1 = Closed, 2 = Open
  1. SELOPCL(DFLT) N DIC,DIR,DIRUT,DUOUT,X,Y
  1.  ;
  1.  S DFLT=$S($G(DFLT)=1:"C",$G(DFLT)=2:"O",1:"A")
  1.  S DIR(0)="S^O:OPEN;C:CLOSED;A:ALL"
  1.  S DIR("A")="Include (O)pen, (C)losed, or (A)ll Claims",DIR("B")=DFLT
  1.  D ^DIR
  1.  I ($G(DUOUT)=1)!($G(DTOUT)=1) S Y="^"
  1.  ;
  1.  S Y=$S(Y="C":1,Y="O":2,1:0)
  1.  Q Y
  1.  ;
  1. SELELIG1() ;
  1.  ; Select multiple Eligibilities
  1.  ; 
  1.  ; Input Variable -> none
  1.  ; Return Value   -> 0: All, 1: Selected Eligibilities; '^' = Exit
  1.  ;                                       
  1.  ; Output Variable -> BPELIG1 = 1 - One or More Eligibilities Selected
  1.  ;                            = 0 - User Entered 'ALL'
  1.  ;                            = "^" - User quit
  1.  ;                            
  1.  ; If BPELIG1 = 1 then the BPELIG1 array will be defined where:
  1.  ;    BPELIG1("C")="CHAMPVA"
  1.  ;    BPELIG1("T")="TRICARE"
  1.  ;    BPELIG1("V")="VETERAN"
  1.  ;
  1.  ;
  1. BPSELIG1 ;
  1.  ;Reset BPELIG1 array
  1.  K BPELIG1
  1.  N DIR,DTOUT,DUOUT,DIRUT,DIROUT,X,Y,P
  1.  N BPSVTC,BPSERR,BPSVTCSTR,BPSSEL,BPSX
  1.  ;
  1.  S BPSVTCSTR=",V,T,C,A,"
  1.  S DIR(0)="FO^0:7"
  1.  S DIR("A",1)=""
  1.  S DIR("A",2)="Select one or more of the following:"
  1.  S DIR("A",3)=""
  1.  S DIR("A",4)="     V         VETERAN"
  1.  S DIR("A",5)="     T         TRICARE"
  1.  S DIR("A",6)="     C         CHAMPVA"
  1.  S DIR("A",7)="     A         ALL"
  1.  S DIR("A",8)=""
  1.  S DIR("A")="Display (V)ETERAN or (T)RICARE or (C)HAMPVA or (A)LL"
  1.  S DIR("B")="A" S:$G(BPARR("ELIG"))'="" DIR("B")=BPARR("ELIG")
  1.  S DIR("?",1)="Enter a single response or multiple responses separated by commas."
  1.  S DIR("?",2)=" Example:"
  1.  S DIR("?",3)=" T"
  1.  S DIR("?")=" T,C"
  1.  D ^DIR K DIR
  1.  I ($G(DUOUT)=1)!($G(DTOUT)=1)!($D(DIRUT)) Q "^"
  1.  ;
  1.  ;Convert any lower case to upper case
  1.  S X=$TR(X,BPSLC,BPSUC)
  1.  ;
  1.  ;If 'A' was one of the selections, reset X to include all available selections.
  1.  I X[",",X["A" S X="V,T,C"
  1.  ;
  1.  ; Loop through user input (returned in variable X).
  1.  ; Display warning message if any user input selection is not included
  1.  ; in the string of acceptable codes (BPSVTCSTR) and re-prompt question.
  1.  ; Assign valid selections to BPSVTC array. This array will prevent
  1.  ; duplicate entries from being saved to the user's profile.
  1.  ;
  1.  K BPSVTC
  1.  S BPSERR=""
  1.  F BPSX=1:1:$L(X,",") D
  1.  . S BPSSEL=$P(X,",",BPSX)
  1.  . I BPSVTCSTR'[(","_BPSSEL_",") W !," ",BPSSEL," is not a valid entry." S BPSERR=1 Q
  1.  . ; if All was selected don't include in array
  1.  .   I BPSSEL'="A" S BPELIG1(BPSSEL)=$S(BPSSEL="V":"VETERAN",BPSSEL="T":"TRICARE",BPSSEL="C":"CHAMPVA",1:"")
  1.  ;
  1.  I $G(BPSERR)=1 G BPSELIG1
  1.  ;
  1.  ; ALL was selected
  1.  I X="A" S BPELIG1=0
  1.  E  D  ; 
  1.  . ;User selected one or more eligibilities
  1.  . S BPELIG1=1
  1.  . ;
  1.  . ; Display the user selections
  1.  . ;
  1.  . S BPSSEL=""
  1.  . F  S BPSSEL=$O(BPELIG1(BPSSEL)) Q:BPSSEL=""  W !,?10,BPELIG1(BPSSEL)
  1.  ;
  1.  Q BPELIG1
  1.  ;
  1. SELALRC() ; 
  1.  ; Display Most (R)ecent or (A)ll
  1.  ;
  1.  ; Return Value ->   A: All
  1.  ;                   R: Most Recent
  1.  ;                   ^: Exit
  1.  ;
  1.  N DIR,X,Y,DIRUT,DTOUT,DUOUT,DIROUT
  1.  ;
  1.  S DIR(0)="S^R:Most Recent;A:ALL"
  1.  S DIR("A")="Select Most (R)ecent or (A)ll"
  1.  S DIR("B")="MOST RECENT"
  1.  S DIR("L",1)="Select one of the following:"
  1.  S DIR("L",2)=""
  1.  S DIR("L",3)="     R         Most Recent Transaction Only"
  1.  S DIR("L",4)="     A         ALL Transactions (will list the Rx/Fill each time resubmitted)"
  1.  D ^DIR K DIR
  1.  ;
  1.  ;Check for "^" or timeout, 
  1.  I ($G(DUOUT)=1)!($G(DTOUT)=1) S Y="^"
  1.  Q Y
  1.  ;
  1. SELNBSTS() ; 
  1.  ; Select the Non-Billable Status Reason
  1.  ; 
  1.  ; Input Variable -> None
  1.  ; Return Value   -> 0: All, 1: Selected Non-Billable Status; '^' = Exit
  1.  ;                                       
  1.  ; Output Variable -> BPNBSTS = 1 - One or More Non-Billable Statuses Selected
  1.  ;                            = 0 - User Entered 'ALL'
  1.  ;                            = "" - User quit
  1.  ;                            
  1.  ; If BPNBSTS = 1 then the BPNBSTS array will be defined where:
  1.  ;    BPNBSTS(Non-Billable Status IEN)=Non-Billable Status Reason
  1.  ;
  1.  ;Reset BPNBSTS array
  1.  K BPNBSTS
  1.  N DIR,DTOUT,DUOUT,DIRUT,DIROUT,X,Y,P,DIC
  1.  ;
  1.  ;First see if they want to enter individual eligibilities or ALL
  1.  S DIR(0)="S^S:NON-BILLABLE STATUS;A:ALL"
  1.  S DIR("A")="Select Certain Non-Billable (S)tatus or (A)ll"
  1.  S DIR("B")="ALL"
  1.  S DIR("L",1)="Select one of the following:"
  1.  S DIR("L",2)=""
  1.  S DIR("L",3)="     S         NON-BILLABLE STATUS"
  1.  S DIR("L",4)="     A         ALL"
  1.  D ^DIR K DIR
  1.  ;
  1.  ;Check for "^" or timeout, otherwise define BPNBSTS
  1.  I ($G(DUOUT)=1)!($G(DTOUT)=1) S Y="^"
  1.  S BPNBSTS=$S(Y="A":0,Y="^":"^",1:1)
  1.  I BPNBSTS'=1 Q BPNBSTS
  1.  ;
  1.  ;Allow user to select multiple non-billable statuses
  1.  F  D  Q:Y="^"!(Y="")
  1.  .;Prompt for entry - ICR 6136
  1.  .K X
  1.  .S DIC(0)="QEAM",DIC=366.17,DIC("A")="Select Non-Billable Reason: "
  1.  .W ! D ^DIC
  1.  .I ($G(DUOUT)=1)!($G(DTOUT)=1) S Y="^" Q
  1.  .;
  1.  .;Check for blank entry, quit if no previous selections
  1.  .I $G(Y)=-1 S Y=$S($D(BPNBSTS)>9:"",1:"^") Q
  1.  .;
  1.  .; Add entry to array or handle duplicate entries
  1.  .I '$D(BPNBSTS($P(Y,U,1))) S BPNBSTS($P(Y,U,1))=$P(Y,U,2),BPNBSTS("B",$P(Y,U,2),$P(Y,U,1))=""
  1.  .E  D  I Y="^" Q
  1.  ..;Already in the array, so ask whether to delete
  1.  ..N P
  1.  ..S P=Y  ;Save Original Value
  1.  ..S DIR(0)="S^Y:YES;N:NO",DIR("A")="Delete "_$P(P,U,2)_" from your list?"
  1.  ..S DIR("B")="NO"
  1.  ..D ^DIR
  1.  ..I ($G(DUOUT)=1)!($G(DTOUT)=1) S Y="^" Q
  1.  ..I Y="Y" K BPNBSTS($P(P,U,1)),BPNBSTS("B",$P(P,U,2),$P(P,U,1))
  1.  ..S Y=P  ;Restore Original Value
  1.  ..K P
  1.  .;
  1.  .;Display a list of selected values
  1.  .I $D(BPNBSTS)>9 D
  1.  ..N X
  1.  ..W !,?2,"Selected:"
  1.  ..S X="" F  S X=$O(BPNBSTS("B",X)) Q:X=""  W !,?10,X
  1.  ..K X
  1.  .Q
  1.  ;
  1.  ; Reset BPNBSTS array if user exited
  1.  I Y="^" K BPNBSTS S BPNBSTS="^" Q "^"
  1.  ;
  1.  ; Deleted 'x-ref' as we don't need to return that
  1.  K BPNBSTS("B")
  1.  ; 
  1.  Q 1
  1.  ;