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

BPSOPR.m

Go to the documentation of this file. 
  1. BPSOPR ;ALB/PHH - OPECC Productivity Report ;9/21/2015
  1.  ;;1.0;E CLAIMS MGMT ENGINE;**20**;JUN 2004;Build 27
  1.  ;;Per VA Directive 6402, this routine should not be modified.
  1.  ;
  1.  Q
  1.  ;
  1. EN ; Main report entry point
  1.  N BPGLTMP,BPNOW,X,BPPHARM,BPELIG,BPUSER,BPBEGDT,BPENDDT,BPSUMDET
  1.  N BPSSORD,BPEXCEL
  1.  ;
  1.  W @IOF,!,"OPECC Productivity Report",!!
  1.  ;
  1.  S BPGLTMP=$NA(^TMP($J,"BPSOPR"))
  1.  ;
  1.  ; Get current Date/Time
  1.  S BPNOW=$$FMTE^XLFDT($$NOW^XLFDT)
  1.  ;
  1.  ; Prompt for ECME Pharmacy Division(s)
  1.  ; Sets up BPPHARM variable and array where BPPHARM=0 for ALL
  1.  ; or BPPHARM=1 and BPPHARM(IEN) = IEN^NAME for list.
  1.  S X=$$SELPHARM(.BPPHARM)
  1.  I X="^" Q
  1.  ;
  1.  ; Prompt for Eligibility Type(s)
  1.  ; Sets up BPELIG variable and array where BPELIG=0 for ALL
  1.  ; or BPELIG=1 and BPELIG(IEN) = IEN^NAME for list.
  1.  S X=$$SELELIG(.BPELIG)
  1.  I X="^" Q
  1.  ;
  1.  ; Prompt for ECME User(s)
  1.  ; Sets up BPUSER variable and array where BPUSER=0 for ALL
  1.  ; or BPUSER=1 and BPUSER(IEN) = IEN^NAME for list.
  1.  S X=$$SELUSER(.BPUSER)
  1.  I X="^" Q
  1.  ;
  1.  ; Prompt to select Date Range
  1.  ; Returns (Start Date^End Date)
  1.  S BPBEGDT=$$SELDATE^BPSRPT3(1)
  1.  I BPBEGDT="^" Q
  1.  S BPENDDT=$P(BPBEGDT,U,2)
  1.  S BPBEGDT=$P(BPBEGDT,U)
  1.  ;
  1.  ; Prompt to Display Summary or Detail Format (Default to Detail)
  1.  ; Set to 1 for Summary, 0 for Detail
  1.  S BPSUMDET=$$SELSMDET^BPSRPT3(2)
  1.  I BPSUMDET="^" Q
  1.  ;
  1.  ; Prompt for Sort Order
  1.  ; Set to 1 for User Name, 0 for Division
  1.  S BPSSORD=$$SELSORT(1)
  1.  I BPSSORD="^" Q
  1.  ;
  1.  ; Prompt for Excel Capture
  1.  ; Set to 1 for YES (capture data), 0 for NO (DO NOT capture data)
  1.  S BPEXCEL=0
  1.  I 'BPSUMDET S BPEXCEL=$$SELEXCEL I BPEXCEL="^" Q
  1.  ;
  1.  ; Device selection
  1.  I '$$DEVICE() Q
  1.  ;
  1.  Q
  1.  ;
  1. SELSORT(DFLT) ; Select Sort Order
  1.  N DIR,DIRUT,DTOUT,DUOUT,X,Y
  1.  ;
  1.  S DFLT=$S($G(DFLT)=1:"User Name",$G(DFLT)=0:"Division",1:"User Name")
  1.  S DIR(0)="S^D:Division;U:User Name",DIR("A")="Sort:  (D/U)",DIR("B")=DFLT
  1.  ;
  1.  W !!,"Enter a code from the list to indicate the sort order."
  1.  D ^DIR
  1.  I ($G(DUOUT)=1)!($G(DTOUT)=1) S Y="^"
  1.  S Y=$S(Y="U":1,Y="D":0,1:Y)
  1.  Q Y
  1.  ;
  1. SELEXCEL() ; Select whether to capture data for Excel report.
  1.  N BPEXCEL,DIR,DIRUT,DTOUT,DUOUT,DIROUT
  1.  ;
  1.  S BPEXCEL=0
  1.  S DIR(0)="Y",DIR("B")="NO",DIR("T")=DTIME W !
  1.  S DIR("A")="Do you want to capture report data for an Excel document"
  1.  S DIR("?")="^D HEXC^BPSRPT4"
  1.  ;
  1.  D ^DIR
  1.  K DIR
  1.  I $D(DIRUT)!$D(DTOUT)!$D(DUOUT)!$D(DIROUT) Q "^"
  1.  I Y S BPEXCEL=1
  1.  ;
  1.  ;Display Excel display message
  1.  I BPEXCEL=1 D
  1.  .W !!?5,"Before continuing, please set up your terminal to capture the"
  1.  .W !?5,"detail report data and save the detail report data in a text file"
  1.  .W !?5,"to a local drive. This report may take a while to run."
  1.  .W !!?5,"Note: To avoid undesired wrapping of the data saved to the file,"
  1.  .W !?5,"      please enter '0;256;99999' at the 'DEVICE:' prompt.",!
  1.  ;
  1.  Q BPEXCEL
  1.  ;
  1. DEVICE() ; Device Selection
  1.  N ZTRTN,ZTDESC,ZTSAVE,POP,RET,ZTSK,DIR,X,Y
  1.  S RET=1
  1.  ;
  1.  I 'BPEXCEL D
  1.  .W !!,"WARNING - THIS REPORT REQUIRES THAT A DEVICE WITH 132 COLUMN WIDTH BE USED."
  1.  .W !,"IT WILL NOT DISPLAY CORRECTLY USING 80 COLUMN WIDTH DEVICES",!
  1.  ;
  1.  S ZTRTN="COMPILE^BPSOPR2"
  1.  S ZTDESC="OPECC Productivity Report"
  1.  S ZTSAVE("BPGLTMP")=""
  1.  S ZTSAVE("BPPHARM")=""
  1.  S ZTSAVE("BPELIG")=""
  1.  S ZTSAVE("BPUSER")=""
  1.  S ZTSAVE("BPBEGDT")=""
  1.  S ZTSAVE("BPENDDT")=""
  1.  S ZTSAVE("BPSUMDET")=""
  1.  S ZTSAVE("BPSSORD")=""
  1.  S ZTSAVE("BPEXCEL")=""
  1.  D EN^XUTMDEVQ(ZTRTN,ZTDESC,.ZTSAVE,"QM",1)
  1.  I POP S RET=0
  1.  I $G(ZTSK) W !!,"Report compilation has started with task# ",ZTSK,".",! S DIR(0)="E" D ^DIR
  1.  Q RET
  1.  ;
  1. SELPHARM(BPPHARM) ; Select Pharmacies
  1.  N DIR,BPSFPTR,BPSPTX,X
  1.  ;
  1.  S DIR(0)="S^D:DIVISION;A:ALL"
  1.  S DIR("A")="Select Certain Pharmacy (D)ivisions or (A)LL"
  1.  S DIR("B")="A"
  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.  S BPSFPTR=9002313.56
  1.  S BPSPTX="Select ECME Pharmacy Division(s): "
  1.  ;
  1.  S X=$$SELMULTI(.DIR,.BPPHARM,BPSFPTR,BPSPTX)
  1.  Q X
  1.  ;
  1. SELELIG(BPELIG) ;Select Eligibility Types
  1.  N DIR,X
  1.  ;
  1.  S DIR(0)="SO^V:VETERAN;T:TRICARE;C:CHAMPVA;A:ALL"
  1.  S DIR("A")="Include Certain Eligibility Type or (A)ll"
  1.  S DIR("B")="A"
  1.  ;
  1.  S X=$$SELMULTI(.DIR,.BPELIG)
  1.  Q X
  1.  ;
  1. SELUSER(BPUSER) ; Select Users
  1.  N DIR,BPSFPTR,BPSPTX,X
  1.  ;
  1.  S DIR(0)="S^U:USER;A:ALL"
  1.  S DIR("A")="Display ECME (U)ser or (A)LL"
  1.  S DIR("B")="A"
  1.  S BPSFPTR=200
  1.  S BPSPTX="Select ECME User(s): "
  1.  ;
  1.  S X=$$SELMULTI(.DIR,.BPUSER,BPSFPTR,BPSPTX)
  1.  Q X
  1.  ;
  1. SELMULTI(BPSDIR,BPSVAR,BPSFPTR,BPSPTX) ;
  1.  ; Input Variable -> BPSDIR - DIR array
  1.  ;                   BPSVAR - Variable array
  1.  ;                   BPSFPTR - File pointer (optional)
  1.  ;                   BPSPTX - Prompt text for DIC("A") (optional)
  1.  ; Return Value ->   "" = Valid Entry or Entries Selected
  1.  ;                   ^ = Exit
  1.  ;                                       
  1.  ; Output Variable -> BPSVAR = 1 One or more items selected
  1.  ;                           = 0 User entered 'ALL'
  1.  ;                            
  1.  ; If BPSVAR = 1 then the BPSVAR array will be defined where:
  1.  ;    BPSVAR(ptr) = ptr ^ NAME and
  1.  ;    ptr = Internal pointer to file passed in
  1.  ;                    
  1.  N BPDELFLG,DIR,DIC,DIRUT,DTOUT,DUOUT,X,Y
  1.  ;
  1.  S BPSFPTR=$G(BPSFPTR,"")
  1.  S BPSPTX=$G(BPSPTX,"")
  1.  ;
  1.  ;First see if they want to enter individual items or ALL
  1.  S BPDELFLG=0   ;Only used for DIR.  Not used for DIC.
  1.  M DIR=BPSDIR
  1.  D ^DIR
  1.  K DIR
  1.  ;
  1.  ;Check for "^" or timeout, otherwise define BPSVAR
  1.  I ($G(DUOUT)=1)!($G(DTOUT)=1) S Y="^"
  1.  E  S BPSVAR=$S(Y="A":0,1:1)
  1.  ;
  1.  ;If item selected, ask prompt
  1.  I $G(BPSVAR)=1 F  D  Q:Y="^"!(Y="") 
  1.  .;
  1.  .;Prompt for entry
  1.  .I BPSFPTR'="" D
  1.  ..K X
  1.  ..S DIC(0)="QEAM",DIC=BPSFPTR,DIC("A")=BPSPTX
  1.  ..W !
  1.  ..D ^DIC
  1.  .;
  1.  .I BPSFPTR="" D
  1.  ..I 'BPDELFLG D
  1.  ...S BPSVAR(Y)=Y_"^"_Y(0)
  1.  ...S BPSVAR("B",Y(0),Y)=""
  1.  ..K DIR
  1.  ..M DIR=BPSDIR
  1.  ..K DIR("B")
  1.  ..D ^DIR
  1.  .;
  1.  .;Check for "^" or timeout
  1.  .I ($G(DUOUT)=1)!($G(DTOUT)=1) K BPSVAR S Y="^" Q
  1.  .;
  1.  .;Check for blank entry, quit if no previous selections
  1.  .I $G(X)="" S Y=$S($D(BPSVAR)>9:"",1:"^") K:Y="^" BPSVAR Q
  1.  .;
  1.  .;Handle deletes
  1.  .I BPSFPTR'="" D
  1.  ..I $D(BPSVAR(+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 BPSVAR S Y="^" Q
  1.  ...I Y="Y" K BPSVAR(+P),BPSVAR("B",$P(P,U,2),+P)
  1.  ...S Y=P  ;Restore Original Value
  1.  ...K P
  1.  ..E  D
  1.  ...;Define new entries in BPSVAR array
  1.  ...S BPSVAR(+Y)=Y
  1.  ...S BPSVAR("B",$P(Y,U,2),+Y)=""
  1.  .;
  1.  .I BPSFPTR="" D
  1.  ..I $D(BPSVAR(Y)) D  Q:Y="^"  I 1
  1.  ...N P
  1.  ...S P=Y,P(0)=Y(0)  ;Save Original Value
  1.  ...S DIR(0)="S^Y:YES;N:NO",DIR("A")="Delete "_P(0)_" from your list?"
  1.  ...S DIR("B")="NO" D ^DIR
  1.  ...I ($G(DUOUT)=1)!($G(DTOUT)=1) K BPSVAR S Y="^" Q
  1.  ...S BPDELFLG=0
  1.  ...I Y="Y" S BPDELFLG=1 K BPSVAR(P),BPSVAR("B",P(0),P)
  1.  ...S Y=P,Y(0)=P(0)  ;Restore Original Value
  1.  ...K P
  1.  ..E  D
  1.  ...;Define new entries in BPSVAR array
  1.  ...S BPSVAR(Y)=Y_"^"_Y(0)
  1.  ...S BPSVAR("B",Y(0),Y)=""
  1.  .;
  1.  .;Display a list of selected items
  1.  .I $D(BPSVAR)>9 D
  1.  ..N X
  1.  ..W !,?2,"Selected:"
  1.  ..S X=""
  1.  ..F  S X=$O(BPSVAR("B",X)) Q:X=""  D
  1.  ...W !,?10,X
  1.  ..K X
  1.  ;
  1.  K BPSVAR("B")
  1.  I $G(BPSVAR)=1,$G(BPSVAR("A"))="A^ALL" K BPSVAR S BPSVAR=0
  1.  Q Y
  1.  ;