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

PSOBORP1.m

Go to the documentation of this file.
  1. PSOBORP1 ;ALBANY/BLD - TRICARE-CHAMPVA BYPASS/OVERRIDE AUDIT REPORT (CONT) ;10/17/12 3:38pm
  1. ;;7.0;OUTPATIENT PHARMACY;**358,385,415,427,528**;DEC 1997;Build 10
  1. ;
  1. ;***********copied from routine BPSRPT3 AND BPSRPT4************
  1. ;
  1. Q
  1. ;
  1. ;
  1. ;
  1. SELPHARM(PSOSEL) N DIC,DIR,DIRUT,DTOUT,DUOUT,X,Y
  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 -> PSOPHARM = "D" One or More Pharmacies Selected
  1. ; = "A" User Entered 'ALL'
  1. ;
  1. ; If PSOPHARM = 1 then the PSOPHARM array will be defined where:
  1. ; PSOPHARM(ptr) = ptr ^ BPS PHARMACY NAME and
  1. ; ptr = Internal Pointer to OUTPATIENT SITE file (#59)
  1. ;
  1. ;Reset PSOPHARM array
  1. K PSOPHARM
  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 PSOPHARM
  1. I ($G(DUOUT)=1)!($G(DTOUT)=1) S Y="^"
  1. E S (PSOSEL("DIVISION"),PSOPHARM)=Y
  1. ;If division selected, ask prompt
  1. I $G(PSOPHARM)="D" F D Q:Y="^"!(Y="")
  1. .;
  1. .;Prompt for entry
  1. .K X S DIC(0)="QEAM",DIC=59,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 PSOPHARM S Y="^" Q
  1. .;
  1. .;Check for blank entry, quit if no previous selections
  1. .I $G(X)="" S Y=$S($D(PSOPHARM)>9:"",1:"^") K:Y="^" PSOPHARM Q
  1. .;
  1. .;Handle Deletes
  1. .I $D(PSOPHARM(+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 PSOPHARM S Y="^" Q
  1. ..I Y="Y" K PSOPHARM(+P),PSOPHARM("B",$P(P,U,2),+P)
  1. ..S Y=P ;Restore Original Value
  1. ..K P
  1. .E D
  1. ..;Define new entries in PSOPHARM array
  1. ..S PSOPHARM(+Y)=Y
  1. ..S PSOPHARM("B",$P(Y,U,2),+Y)=""
  1. .;
  1. .;Display a list of selected divisions
  1. .I $D(PSOPHARM)>9 D
  1. ..N X
  1. ..W !,?2,"Selected:"
  1. ..S X="" F S X=$O(PSOPHARM("B",X)) Q:X="" W !,?10,X
  1. ..K X
  1. .Q
  1. ;
  1. K PSOPHARM("B")
  1. M PSOSEL("DIVISION")=PSOPHARM
  1. Q Y
  1. ;
  1. ;
  1. SELSMDET(DFLT) ;
  1. ;
  1. ; Display (S)ummary or (D)etail Format
  1. ;
  1. ; Input Variable -> DFLT = 1 Summary
  1. ; 2 Detail
  1. ;
  1. ; Return Value -> "S" = Summary
  1. ; "D" = Detail
  1. ; ^ = Exit
  1. ;
  1. N DIR,DIRUT,DTOUT,DUOUT,X,Y
  1. ;
  1. S DFLT=$S($G(DFLT)=1:"Summary",$G(DFLT)=2:"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. Q Y
  1. ;
  1. ;
  1. SELDATE(TYPE) ;select begin date
  1. ; Enter Date Range
  1. ;
  1. ; Input Variable -> TYPE = TRANSACTION
  1. ;
  1. ;
  1. ; Return Value -> P1^P2
  1. ;
  1. ; where P1 = From Date
  1. ; = ^ Exit
  1. ; P2 = To Date
  1. ; = blank for Exit
  1. N PSOSIBDT,DIR,DIRUT,DTOUT,DUOUT,VAL,X,Y
  1. ;
  1. SELDATE1 ;
  1. N VAL
  1. 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. SELATYP(DFLT) ;
  1. ;
  1. ; Display (T)RICARE or (C)HAMPVA OR (A)LL Format
  1. ;
  1. ; Input Variable -> DFLT = A ALL
  1. ; T TRICARE
  1. ; C CHAMPVA
  1. ;
  1. ; Return Value -> A = ALL
  1. ; T = TRICARE
  1. ; C = CHAMPVA
  1. ; ^ = Exit
  1. ;
  1. N DIR,DIRUT,DTOUT,DUOUT,EXIT,X,Y
  1. S EXIT=0
  1. S DFLT=$S($G(DFLT)="T":"TRICARE",$G(DFLT)="C":"CHAMPVA",1:"ALL")
  1. S DIR(0)="SO^T:TRICARE;C:CHAMPVA;A:ALL",DIR("A")="Display (T)RICARE or (C)HAMPVA or (A)LL Entries",DIR("B")=DFLT
  1. D ^DIR
  1. I ($G(DUOUT)=1)!($G(DTOUT)=1) S Y="^"
  1. I Y="A" K PSOSEL("ELIG_TYPE") D
  1. .S PSOSEL("ELIG_TYPE")="A"
  1. .S PSOSEL("ELIG_TYPE","T")="TRICARE"
  1. .S PSOSEL("ELIG_TYPE","C")="CHAMPVA"
  1. .S EXIT=1
  1. I EXIT Q Y
  1. I Y'="" S PSOSEL("ELIG_TYPE")=Y,PSOSEL("ELIG_TYPE",Y)=$S(Y="T":"TRICARE",Y="C":"CHAMPVA",1:"ALL")
  1. Q Y
  1. ;
  1. SELTCCD(PSOSEL) ;
  1. ;
  1. ;Prompt to Include (I)npatient,(N)on-Billable, (R)eject, (P)artial, or A)ll: (no default)
  1. ;
  1. N DIC,DIR,DIRUT,DUOUT,EXIT,REJ,X,Y,I
  1. S EXIT=0
  1. F I=1:1:2 D Q:Y="A"!(EXIT)
  1. .S DIR(0)="SO^I:INPATIENT;N:NON-BILLABLE;R:REJECT OVERRIDE;P:PARTIAL FILL;A:ALL"
  1. .S DIR("A")="Select one of the following: **Can select multiples - limit of 2** "
  1. .D ^DIR
  1. .I ($G(DUOUT)=1)!($G(DTOUT)=1) S EXIT=1,Y="^" Q
  1. .I Y="A" K PSOSEL("REJECT CODES") D Q
  1. ..S PSOSEL("REJECT CODES")="A"
  1. ..S PSOSEL("REJECT CODES","I")="INPATIENT"
  1. ..S PSOSEL("REJECT CODES","N")="NON-BILLABLE"
  1. ..S PSOSEL("REJECT CODES","R")="REJECT OVERRIDE"
  1. ..S PSOSEL("REJECT CODES","P")="PARTIAL FILL"
  1. ..S EXIT=1
  1. .I Y="",$D(PSOSEL("REJECT CODES")) S EXIT=1 Q
  1. .I Y="",'$D(PSOSEL("REJECT CODES")) S EXIT=0,I=0 Q
  1. .I Y'="" S PSOSEL("REJECT CODES",Y)=$S(Y="I":"INPATIENT",Y="N":"NON-BILLABLE",Y="R":"REJECT OVERRIDE",Y="P":"PARTIAL FILL",1:"ALL")
  1. ;
  1. Q Y
  1. ;
  1. SELPHMST(PSOSEL) ;
  1. ;
  1. ; Select to include (S)pecific Pharmacist or (A)ll pharmacists
  1. ;
  1. N DIR,DIRUT,DTOUT,DUOUT,VAL,X,Y
  1. K PSOPHARM,DIR
  1. ;
  1. ;First see if they want to enter individual divisions or ALL
  1. S DIR(0)="S^S:SPECIFIC PHARMACIST(S);A:ALL PHARMACISTS"
  1. S DIR("A")="Select Specific Pharmacist(s) or All Pharmacists"
  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 Specific Pharmacist(s)"
  1. S DIR("L",4)=" A All Pharmacists"
  1. D ^DIR K DIR
  1. ;
  1. ;Check for "^" or timeout, otherwise define PSOPHARM
  1. I ($G(DUOUT)=1)!($G(DTOUT)=1) S Y="^"
  1. E S (PSOSEL("PHARMACIST"),PSOPHARM)=Y
  1. ;
  1. ;If pharmacist selected, ask prompt
  1. I $G(PSOPHARM)="S" F D Q:Y="^"!(Y="")
  1. .;
  1. .;Prompt for entry
  1. .K X S DIC(0)="QEAM",DIC=200,DIC("A")="Select Pharmacist: "
  1. .S DIC("S")="I $D(^XUSEC(""PSORPH"",Y))"
  1. .W ! D ^DIC
  1. .;
  1. .;Check for "^" or timeout
  1. .I ($G(DUOUT)=1)!($G(DTOUT)=1) K PSOPHARM S Y="^" Q
  1. .;
  1. .;Check for blank entry, quit if no previous selections
  1. .I $G(X)="" S Y=$S($D(PSOPHARM)>9:"",1:"^") K:Y="^" PSOPHARM Q
  1. .;
  1. .;Handle Deletes
  1. .I $D(PSOPHARM(+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 PSOPHARM S Y="^" Q
  1. ..I Y="Y" K PSOPHARM(+P),PSOPHARM("B",$P(P,U,2),+P)
  1. ..S Y=P ;Restore Original Value
  1. ..K P
  1. .E D
  1. ..;Define new entries in PSOPHARM array
  1. ..S PSOPHARM(+Y)=Y
  1. ..S PSOPHARM("B",$P(Y,U,2),+Y)=""
  1. .;
  1. .;Display a list of selected providers
  1. .I $D(PSOPHARM)>9 D
  1. ..N X
  1. ..W !,?2,"Selected:"
  1. ..S X="" F S X=$O(PSOPHARM("B",X)) Q:X="" W !,?10,X
  1. ..K X
  1. .Q
  1. ;
  1. K PSOPHARM("B")
  1. M PSOSEL("PHARMACIST")=PSOPHARM
  1. Q Y
  1. ;
  1. SELPROV(PSOSEL) ;
  1. ;
  1. ;select to include (S)pecific Provider or (A)ll Providers
  1. ;
  1. N DIR,DIRUT,DTOUT,DUOUT,VAL,X,Y
  1. K PSOPROV
  1. ;
  1. ;First see if they want to enter individual divisions or ALL
  1. S DIR(0)="S^S:SPECIFIC PROVIDER(S);A:ALL PROVIDERS"
  1. S DIR("A")="Select Specific Provider(s) or include ALL Providers"
  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 Specific Provider(s)"
  1. S DIR("L",4)=" A ALL Providers"
  1. D ^DIR K DIR
  1. ;
  1. ;Check for "^" or timeout, otherwise define PSOPROV
  1. I ($G(DUOUT)=1)!($G(DTOUT)=1) S Y="^"
  1. E S (PSOSEL("PROVIDER"),PSOPROV)=Y
  1. ;
  1. ;If provider selected, ask prompt
  1. I $G(PSOPROV)="S" F D Q:Y="^"!(Y="")
  1. .;
  1. .;Prompt for entry
  1. .K X S DIC(0)="QEAM",DIC=200,DIC("A")="Select Provider: "
  1. .S DIC("S")="I +$G(^VA(200,Y,""PS""))"
  1. .W ! D ^DIC
  1. .;
  1. .;Check for "^" or timeout
  1. .I ($G(DUOUT)=1)!($G(DTOUT)=1) K PSOPROV S Y="^" Q
  1. .;
  1. .;Check for blank entry, quit if no previous selections
  1. .I $G(X)="" S Y=$S($D(PSOPROV)>9:"",1:"^") K:Y="^" PSOPROV Q
  1. .;
  1. .;Handle Deletes
  1. .I $D(PSOPROV(+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 PSOPROV S Y="^" Q
  1. ..I Y="Y" K PSOPROV(+P),PSOPROV("B",$P(P,U,2),+P)
  1. ..S Y=P ;Restore Original Value
  1. ..K P
  1. .E D
  1. ..;Define new entries in PSOPROV array
  1. ..S PSOPROV(+Y)=Y
  1. ..S PSOPROV("B",$P(Y,U,2),+Y)=""
  1. .;
  1. .;Display a list of selected providers
  1. .I $D(PSOPROV)>9 D
  1. ..N X
  1. ..W !,?2,"Selected:"
  1. ..S X="" F S X=$O(PSOPROV("B",X)) Q:X="" W !,?10,X
  1. ..K X
  1. .Q
  1. ;
  1. K PSOPROV("B")
  1. M PSOSEL("PROVIDER")=PSOPROV
  1. Q Y
  1. ;
  1. PSOTOTAL(PSOSEL) ;
  1. ;
  1. ;Prompt to Include Group/Subtotal Report by (R) Pharmacy or (P)rovider/Provider
  1. ;ADDED BY BLD
  1. ;Returns ()
  1. ;
  1. N Y,DUOUT,DTOUT,IBQUIT,DIROUT,DIR
  1. N PSONPI
  1. S DIR(0)="S^R:Pharmacist;P:Provider/Prescriber Name"
  1. S DIR("A")="Group/Subtotal Report by (R)Pharmacist or (P)Provider"
  1. ;S DIR("B")="PHARMACIST"
  1. D ^DIR
  1. I ($G(DUOUT)=1)!($G(DTOUT)=1) S Y="^" Q Y
  1. S PSONPI=Y
  1. ;
  1. Q Y
  1. ;
  1. ;
  1. ;Print Header 2 Line 1
  1. ;
  1. ; Input variable: PSORTYPE -> Report Type (1-7)
  1. ;
  1. ;
  1. SELEXCEL() ; - Returns whether to capture data for Excel report.
  1. ; Output: EXCEL = 1 - YES (capture data) / 0 - NO (DO NOT capture data)
  1. ;
  1. Q:PSOSEL("SUM_DETAIL")="S"
  1. N EXCEL,DIR,DIRUT,DTOUT,DUOUT,DIROUT
  1. ;
  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"
  1. D ^DIR K DIR I $D(DIRUT)!$D(DTOUT)!$D(DUOUT)!$D(DIROUT) Q "^"
  1. K DIROUT,DTOUT,DUOUT,DIRUT
  1. S EXCEL=0 I Y S EXCEL=1
  1. ;
  1. ;Display Excel display message
  1. I EXCEL=1 D EXMSG
  1. ;
  1. Q EXCEL
  1. ;
  1. HEXC ; - 'Do you want to capture data...' prompt
  1. W !!," Enter: 'Y' - To capture detail report data to transfer"
  1. W !," to an Excel document"
  1. W !," '<CR>' - To skip this option"
  1. W !," '^' - To quit this option"
  1. Q
  1. ;
  1. ;Display the message about capturing to an Excel file format
  1. ;
  1. EXMSG ;
  1. W !!?5,"Before continuing, please set up your terminal to capture the"
  1. W !?5,"detail report data. On some terminals, this can be done by"
  1. W !?5,"clicking on the 'Tools' menu above, then click on 'Capture"
  1. W !?5,"Incoming Data' to save to Desktop. This report may take a"
  1. W !?5,"while to run."
  1. W !!?5,"Note: To avoid undesired wrapping of the data saved to the"
  1. W !?5," file, please enter '0;256;999' at the 'DEVICE:' prompt.",!
  1. Q
  1. ;
  1. ;
  1. ;Screen Pause
  1. ;
  1. PAUSE ;
  1. Q:$G(PSOSCR)'=1 S PSOUT=""
  1. W ! K DIR S DIR(0)="E",DIR("A")="Press Return to continue, '^' to exit" D ^DIR K DIR I 'Y S PSOUT=1
  1. Q