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

BPSRPT3A.m

Go to the documentation of this file. 
BPSRPT3A ;AITC/CKB - ECME REPORTS ;9/28/2017

 ;;1.0;E CLAIMS MGMT ENGINE;**23,24,28**;JUN 2004;Build 22

 ;;Per VA Directive 6402, this routine should not be modified.

 ;

 Q

 ;

SELPR(DFLT) ;

 ;

 ; Display (P)rescribers or (A)ll

 ; 

 ;    Input Variable -> DFLT = ALL

 ;                          

 ;     Return Value ->   1 = Prescribers

 ;                       0 = ALL

 ;                       ^ = Exit

 ;                       

 N DIR,DIRUT,DTOUT,DUOUT,X,Y

 ;

 ;Select to include (S)pecific Prescriber or (A)ll Prescribers

 ;

 S DIR(0)="S^S:SPECIFIC PRESCRIBER(S);A:ALL PRESCRIBERS"

 S DIR("A")="Select Specific Prescriber(s) or include ALL Prescribers"

 S DIR("B")="A"

 S DIR("L",1)="Select one of the following:"

 S DIR("L",2)=""

 S DIR("L",3)="     S         Specific Prescriber(s)"

 S DIR("L",4)="     A         ALL Prescribers"

 D ^DIR

 I ($G(DUOUT)=1)!($G(DTOUT)=1) S Y="^"

 S Y=$S(Y="A":0,Y="S":1,1:Y)

 Q Y

 ;

SELPRESC() ;

 ; Allow user to select a single or multiple PRESCRIBERS(s).

 ;

 ; If the users selected one or more PRESCRIBERs, the selection will be stored

 ; in BPARR("PRESC")separated by a comma. e.g. BPARR("PRESC")= ien1 , ien2

 ;

BPPRESC ;

 N DIR,DIRUT,DTOUT,DUOUT,X,Y

 N BPARR,BPSARRAY,BPSIEN

 ;

 S BPARR("PRESC")=""

 ;

 ; The SEL tag prompts user to 'Select Prescriber' and validates the selection against file #200.

 D SEL("Prescriber","^VA(200,",.BPSARRAY)

 ;

 ; If the user entered "^" quit, no longer prompting the user to 'Select Prescriber'

 I $G(BPSARRAY)="^" Q "^"

 ;

 ; If no Prescriber was selected, return the user to 'Display Selected (P)rescribers or (A)LL'

 I $G(BPSARRAY)=0 Q 0

 ;

 M BPARR("PRESC")=BPSARRAY

 ;

 ; Creates a string of all the Prescriber ien's selected separated by a comma.

 S BPSIEN=""

 F  S BPSIEN=$O(BPARR("PRESC",BPSIEN)) Q:BPSIEN=""  I BPSIEN'="B" D

 . I BPARR("PRESC")'="" S BPARR("PRESC")=BPARR("PRESC")_","

 . S BPARR("PRESC")=BPARR("PRESC")_BPSIEN

 . Q

 ;

 Q BPARR("PRESC")

 ;

SELPA(DFLT) ;

 ;

 ; Display (P)atients or (A)ll

 ; 

 ;    Input Variable -> DFLT = ALL

 ;                          

 ;     Return Value ->   1 = Patients

 ;                       0 = ALL

 ;                       ^ = Exit

 ;                       

 N DIR,DIRUT,DTOUT,DUOUT,X,Y

 S DFLT="ALL"

 S DIR(0)="S^P:Patient;A:ALL"

 S DIR("A")="Display Selected (P)atients or (A)LL"

 S DIR("B")=DFLT

 D ^DIR

 I ($G(DUOUT)=1)!($G(DTOUT)=1) S Y="^"

 S Y=$S(Y="A":0,Y="P":1,1:Y)

 Q Y

 ;

SELPAT() ;

 ; Allow user to select a single or multiple PATIENT(s).

 ;

 ; If the users selected one or more PATIENTs, the selection will be stored

 ; in BPARR("PATIENT")separated by a comma. e.g. BPARR("PATIENT")= patient ien1 , patient ien2

 ;

BPPAT ;

 N DIR,DIRUT,DTOUT,DUOUT,X,Y

 N BPARR,BPSARRAY,BPSIEN

 ;

 S BPARR("PATIENT")=""

 ;

 ; The SEL tag prompts user to 'Select Patient' and validates the selection against the PATIENT file.

 D SEL("Patient","^DPT(",.BPSARRAY)

 ;

 ; If the user entered "^" quit, no longer prompting the user to 'Select Patient'

 I $G(BPSARRAY)="^" Q "^"

 ;

 ; If no Patient was selected, return the user to 'Display Selected (P)atients or (A)LL'

 I $G(BPSARRAY)=0 Q 0

 ;

 M BPARR("PATIENT")=BPSARRAY

 ;

 ; Creates a string of all the patient ien's selected separated by a comma.

 S BPSIEN=""

 F  S BPSIEN=$O(BPARR("PATIENT",BPSIEN)) Q:BPSIEN=""  I BPSIEN'="B" D

 . I BPARR("PATIENT")'="" S BPARR("PATIENT")=BPARR("PATIENT")_","

 . S BPARR("PATIENT")=BPARR("PATIENT")_BPSIEN

 . Q

 ;

 Q BPARR("PATIENT")

 ;

SELBAMT() ;

 ;

 ; Select (R)ange for Billed Amount or (A)ll

 ; 

 ;    Input Variable -> DFLT = ALL

 ;                          

 ;     Return Value ->   1 = Billed Amt Range

 ;                       0 = ALL

 ;                       ^ = Exit

 ;                       

 N DIR,DIRUT,DTOUT,DUOUT,X,Y

 S DFLT="ALL"

 S DIR(0)="S^R:Range;A:ALL"

 S DIR("A")="Select (R)ange for Billed Amount or (A)LL"

 S DIR("B")=DFLT

 D ^DIR

 I ($G(DUOUT)=1)!($G(DTOUT)=1) S Y="^"

 S Y=$S(Y="A":0,Y="R":1,1:Y)

 Q Y

 ;

SELBMIN() ;

 N DIR,DIRUT,DTOUT,DUOUT,X,Y

 ;

 S DIR("A")="     Minimum Billed Amount: "

 S DIR("B")=0

 S DIR(0)="NA^0:999999"

 S DIR("?",1)="Enter the minimum billed amount OR press"

 S DIR("?",2)="return for a minimum billed amount of zero (0)."

 S DIR("?")=" Example: 500 - no decimal digits"

 D ^DIR

 I ($G(DUOUT)=1)!($G(DTOUT)=1) Q "^"

 Q Y

 ;

SELBMAX() ;

 N DIR,DIRUT,DTOUT,DUOUT,X,Y

 ;

 S DIR("A")="     Maximum Billed Amount: "

 S DIR("B")=999999

 S DIR(0)="NA^0:999999^I X'>$G(BPMIN) W !,""The Maximum Billed Amount must be greater than the Minimum Billed Amount."" K X"

 S DIR("?",1)="Enter the maximum billed amount. The amount"

 S DIR("?",2)="entered must be greater than the minimum billed."

 S DIR("?")=" Example: 1500 - no decimal digits"

 D ^DIR

 I ($G(DUOUT)=1)!($G(DTOUT)=1) Q "^"

 Q Y

 ;

SELDRG1() ;

 ;

 ; Allow user to select a single or multiple DRUGS.

 ;

 ; The users selection is stored in BPARR("DRUG") separated by a comma.

 ;  BPARR("DRUG")=drug ien1,drug ien2

 ;

DRG1 ;

 N BPARR,BPSIEN,BPSDRGARR

 S BPARR("DRUG")=""

 ;

 ; The SEL tag prompts user to 'Select Drug' and validates the selection against the DRUG file.

 D SEL("Drug","^PSDRUG(",.BPSDRGARR)

 ;

 ; If the user entered "^" quit, no longer prompting the user to 'Select Drug'

 I $G(BPSDRGARR)="^" Q "^"

 ;

 ; If no drug was selected, return "0" so the user will be returned to the Drug or Drug Class or All prompt.

 I $G(BPSDRGARR)=0 Q 0

 ;

 M BPARR("DRUG")=BPSDRGARR

 ;

 ; Creates a string of all the drug ien's selected separated by a comma.

 S BPSIEN=""

 F  S BPSIEN=$O(BPARR("DRUG",BPSIEN)) Q:BPSIEN=""  I BPSIEN'="B" D

 . I BPARR("DRUG")'="" S BPARR("DRUG")=BPARR("DRUG")_","

 . S BPARR("DRUG")=BPARR("DRUG")_BPSIEN

 . Q

 ;

 Q BPARR("DRUG")

 ;

SELDC() ;

 ;

 ; Allow user to select a single or multiple DRUG CLASSes,

 ;

 ; The users selection is stored in BPARR("DRUG CLASS") separated by a semi colon.

 ; BPARR("DRUG CLASS")=dc name ien ; dc name ien

 ;

DRGCL ;

 N BPARR,BPSIEN,BPSDCARR

 S BPARR("DRUG CLASS")=""

 ;

 ; The SEL tag prompts user and validates the selection against the DRUG CLASS file.

 D DCSEL("Drug Class","^PS(50.605,",.BPSDCARR)

 ;

 ; If the user entered "^" quit, no longer prompting the user to 'Select Drug Class'

 I $G(BPSDCARR)="^" Q "^"

 ;

 ; If no drug class was selected, return "0" so the user will be returned to the Drug or Drug Class or All prompt.

 I $G(BPSDCARR)=0 Q 0

 ;

 M BPARR("DRUG CLASS")=BPSDCARR

 ;

 ; Creates a string of all the drug class ien's selected separated by a comma. 

 S BPSIEN=""

 F  S BPSIEN=$O(BPARR("DRUG CLASS",BPSIEN)) Q:BPSIEN=""  I BPSIEN'="B" D

 . I BPARR("DRUG CLASS")'="" S BPARR("DRUG CLASS")=BPARR("DRUG CLASS")_";"

 . S BPARR("DRUG CLASS")=BPARR("DRUG CLASS")_$$GET1^DIQ(50.605,BPSIEN,1)

 . Q

 ;

 Q BPARR("DRUG CLASS")

 ; 

SEL(FIELD,FILE,BPSARRAY,DEFAULT) ;

 ; Provides selection of one or many Drug, Prescriber and Patients.

 ; Note: if you to make changes to this subroutine you need to check DCSEL, RCSEL^BPSRPT4, CCRSEL^BPSRPT4 

 ;       they might require the same changes.

 N DIC,DTOUT,DUOUT,QT,Y,X

 N BPSARR

 ;

 S DIC=FILE,DIC(0)="QEZAM",DIC("A")="Select "_FIELD_": "

 I FIELD="Prescriber" S DIC("S")="I +$G(^VA(200,Y,""PS""))"

 I $G(DEFAULT)'="" S DIC("B")=DEFAULT

 ;

 F  D ^DIC Q:X=""  D  Q:$G(QT)

 . ; Check for "^" or timeout, if found set BPSARRAY="^" and quit.

 . I $D(DTOUT)!$D(DUOUT) K BPSARRAY S BPSARRAY="^",QT=1 Q

 . ;

 . ; If selection already exists in BPSARRAY, ask user if they

 . ; want to Delete the entry

 . I $D(BPSARRAY(+Y)) D  Q

 . . N P

 . . S P=Y ;Save Original Value

 . . S DIR(0)="S^Y:YES;N:NO"

 . . S DIR("A")="Delete "_$P(P,U,2)_" from your list?"

 . . S DIR("B")="NO" D ^DIR

 . . I Y="Y" K BPSARRAY(+P),BPSARRAY("B",$P(P,U,2),+P)

 . . ; Display a list of current selections

 . . I $D(BPSARRAY) D

 . . . N X

 . . . W !,?2,"Selected:"

 . . . S X="" F  S X=$O(BPSARRAY("B",X)) Q:X=""  W ?12,X,!

 . E  D

 . . ;Define new entries in BPSCCR array

 . . S BPSARRAY(+Y)=$P(Y,U,2)

 . . S BPSARRAY("B",$P(Y,U,2),+Y)=""

 . ;

 . ;Display a list of current selections

 . N X

 . W !,?2,"Selected:"

 . S X="" F  S X=$O(BPSARRAY("B",X)) Q:X=""  W ?12,X,!

 . K DIC("B")

 ;

 ; If nothing was selected set BPSARRAY=0

 I '$D(BPSARRAY) S BPSARRAY=0

 Q

 ;

DCSEL(FIELD,FILE,BPSARRAY,DEFAULT) ;

 ; Provides selection of one or many for Drug Classes.

 N BPSARR,DIC,DTOUT,DUOUT,QT,Y,X

 ;

 S DIC=FILE,DIC(0)="QEZAM",DIC("A")="Select "_FIELD_": "

 I $G(DEFAULT)'="" S DIC("B")=DEFAULT

 ;

 F  D ^DIC Q:X=""  D  Q:$G(QT)

 . ;

 . ; Check for "^" or timeout, if found set BPSARRAY="^" and quit.

 . I $D(DTOUT)!$D(DUOUT) K BPSARRAY S BPSARRAY="^",QT=1 Q

 . ;

 . ; If selection already exists in BPSARRAY, ask user if they

 . ; want to Delete the entry

 . I $D(BPSARRAY(+Y)) D  Q

 . . N P

 . . S P=Y ;Save Original Value

 . . S DIR(0)="S^Y:YES;N:NO"

 . . S DIR("A")="Delete "_$$GET1^DIQ(50.605,+P,1)_" "_$$GET1^DIQ(50.605,+P,.01)_" from your list?"

 . . S DIR("B")="NO"

 . . D ^DIR

 . . I Y="Y" K BPSARRAY(+P),BPSARRAY("B",$P(P,U,2),+P)

 . . ; Display list of current selections

 . . I $D(BPSARRAY) D

 . . . N X

 . . . W !,?2,"Selected:"

 . . . S X="" F  S X=$O(BPSARRAY(X)) Q:(X="")!(X="B")  W ?12,$$GET1^DIQ(50.605,X,1)," ",$$GET1^DIQ(50.605,X,.01),!

 . E  D

 . . ;Define new entries in BPSCCR array

 . . S BPSARRAY(+Y)=$P(Y,U,2)

 . . S BPSARRAY("B",$P(Y,U,2),+Y)=""

 . ;

 . ;Display a list of current selections

 . N X

 . W !,?2,"Selected:"

 . S X="" F  S X=$O(BPSARRAY(X)) Q:(X="")!(X="B")  W ?12,$$GET1^DIQ(50.605,X,1)," ",$$GET1^DIQ(50.605,X,.01),!

 . K DIC("B")

 ;

 ; If nothing was selected set BPSARRAY=0

 I '$D(BPSARRAY) S BPSARRAY=0

 Q

 ;

SELDUP() ;

 ; Select one or more Duplicate Claim types

 ; 

 ; Return value -> BPDUP("DUP") = 0 - User Entered 'ALL'

 ;                              = 1 - contain the entries separated by comma's

 ;                              = "^" - User quit

BPSDUP ;

 K BPDUP

 N DIR,DTOUT,DUOUT,DIRUT,DIROUT,X,Y,P

 N BPDUP,BPDUPSTR,BPSERR,BPSSEL,BPSX,I

 ;

 S BPDUPSTR=",D,Q,S,A,"

 S DIR(0)="FO^0:7"

 S DIR("A",1)=""

 S DIR("A",2)="Select one or more of the following:"

 S DIR("A",3)=""

 S DIR("A",4)="     S       DUPLICATE OF APPROVED"

 S DIR("A",5)="     D       DUPLICATE OF PAID"

 S DIR("A",6)="     Q       DUPLICATE OF CAPTURED"

 S DIR("A",7)="     A       ALL"

 S DIR("A",8)=""

 S DIR("A")="Display (S)Dup of Approved or (D)Dup of Paid or (Q)Dup of Capture or (A)LL"

 S DIR("B")="A"

 S DIR("?",1)="Enter a single response or multiple responses separated by commas."

 S DIR("?",2)=" Example:"

 S DIR("?",3)=" D"

 S DIR("?")=" D,S"

 D ^DIR K DIR

 I ($G(DUOUT)=1)!($G(DTOUT)=1)!($D(DIRUT)) Q "^"

 ;

 ;Convert any lower case to upper case

 S X=$TR(X,BPSLC,BPSUC)

 S BPDUP("DUP")=X

 ;

 ;If 'A' was one of the selections, return 0 - ALL selected

 I X["A" S BPDUP("DUP")=0 G SELDUPEX

 ;

 ; Loop through user input (returned in variable X).

 ; Display warning message if any user input selection is not included

 ; in the string of acceptable codes (BPDUPSTR) and re-prompt question.

 ; Assign valid selections to BPDUP array. This array will prevent

 ; duplicate entries from being saved to the user's profile.

 ;

 ; Check for Invalid entries, if found set BPSERR=1

 S BPSERR=0

 F I=1:1:$L(X,",") D

 . S BPSSEL=$P(X,",",I)

 . I BPDUPSTR'[(","_BPSSEL_",") W !," ",BPSSEL," is not a valid entry." S BPSERR=1 Q

 ; Invalid entry found prompt again

 I BPSERR=1 G BPSDUP

 ;

 ;User selected one or more duplicate types, display the user selections

 N I F I=1:1:$L(X,",") S BPSX=$P(X,",",I) D

 . W !,?5,$S(BPSX="D":"DUPLICATE OF PAID",BPSX="Q":"DUPLICATE OF CAPTURED",BPSX="S":"DUPLICATE OF APPROVED",1:"")

 ;

SELDUPEX ;

 Q BPDUP("DUP")

 ;