PSOBORP1 ;ALBANY/BLD - TRICARE-CHAMPVA BYPASS/OVERRIDE AUDIT REPORT (CONT) ;10/17/12 3:38pm
;;7.0;OUTPATIENT PHARMACY;**358,385,415,427,528**;DEC 1997;Build 10
;
;***********copied from routine BPSRPT3 AND BPSRPT4************
;
Q
;
;
;
SELPHARM(PSOSEL) N DIC,DIR,DIRUT,DTOUT,DUOUT,X,Y
;
; Select the ECME Pharmacy or Pharmacies
;
; Input Variable -> none
; Return Value -> "" = Valid Entry or Entries Selected
; ^ = Exit
;
; Output Variable -> PSOPHARM = "D" One or More Pharmacies Selected
; = "A" User Entered 'ALL'
;
; If PSOPHARM = 1 then the PSOPHARM array will be defined where:
; PSOPHARM(ptr) = ptr ^ BPS PHARMACY NAME and
; ptr = Internal Pointer to OUTPATIENT SITE file (#59)
;
;Reset PSOPHARM array
K PSOPHARM
;
;First see if they want to enter individual divisions or ALL
S DIR(0)="S^D:DIVISION;A:ALL"
S DIR("A")="Select Certain Pharmacy (D)ivisions or (A)LL"
S DIR("L",1)="Select one of the following:"
S DIR("L",2)=""
S DIR("L",3)=" D DIVISION"
S DIR("L",4)=" A ALL"
D ^DIR K DIR
;
;Check for "^" or timeout, otherwise define PSOPHARM
I ($G(DUOUT)=1)!($G(DTOUT)=1) S Y="^"
E S (PSOSEL("DIVISION"),PSOPHARM)=Y
;If division selected, ask prompt
I $G(PSOPHARM)="D" F D Q:Y="^"!(Y="")
.;
.;Prompt for entry
.K X S DIC(0)="QEAM",DIC=59,DIC("A")="Select ECME Pharmacy Division(s): "
.W ! D ^DIC
.;
.;Check for "^" or timeout
.I ($G(DUOUT)=1)!($G(DTOUT)=1) K PSOPHARM S Y="^" Q
.;
.;Check for blank entry, quit if no previous selections
.I $G(X)="" S Y=$S($D(PSOPHARM)>9:"",1:"^") K:Y="^" PSOPHARM Q
.;
.;Handle Deletes
.I $D(PSOPHARM(+Y)) D Q:Y="^" I 1
..N P
..S P=Y ;Save Original Value
..S DIR(0)="S^Y:YES;N:NO",DIR("A")="Delete "_$P(P,U,2)_" from your list?"
..S DIR("B")="NO" D ^DIR
..I ($G(DUOUT)=1)!($G(DTOUT)=1) K PSOPHARM S Y="^" Q
..I Y="Y" K PSOPHARM(+P),PSOPHARM("B",$P(P,U,2),+P)
..S Y=P ;Restore Original Value
..K P
.E D
..;Define new entries in PSOPHARM array
..S PSOPHARM(+Y)=Y
..S PSOPHARM("B",$P(Y,U,2),+Y)=""
.;
.;Display a list of selected divisions
.I $D(PSOPHARM)>9 D
..N X
..W !,?2,"Selected:"
..S X="" F S X=$O(PSOPHARM("B",X)) Q:X="" W !,?10,X
..K X
.Q
;
K PSOPHARM("B")
M PSOSEL("DIVISION")=PSOPHARM
Q Y
;
;
SELSMDET(DFLT) ;
;
; Display (S)ummary or (D)etail Format
;
; Input Variable -> DFLT = 1 Summary
; 2 Detail
;
; Return Value -> "S" = Summary
; "D" = Detail
; ^ = Exit
;
N DIR,DIRUT,DTOUT,DUOUT,X,Y
;
S DFLT=$S($G(DFLT)=1:"Summary",$G(DFLT)=2:"Detail",1:"Detail")
S DIR(0)="S^S:Summary;D:Detail",DIR("A")="Display (S)ummary or (D)etail Format",DIR("B")=DFLT
D ^DIR
I ($G(DUOUT)=1)!($G(DTOUT)=1) S Y="^"
Q Y
;
;
SELDATE(TYPE) ;select begin date
; Enter Date Range
;
; Input Variable -> TYPE = TRANSACTION
;
;
; Return Value -> P1^P2
;
; where P1 = From Date
; = ^ Exit
; P2 = To Date
; = blank for Exit
N PSOSIBDT,DIR,DIRUT,DTOUT,DUOUT,VAL,X,Y
;
SELDATE1 ;
N VAL
S VAL="",DIR(0)="DA^:DT:EX",DIR("A")="START WITH "_TYPE_" DATE: ",DIR("B")="T-1"
W ! D ^DIR
;
;Check for "^", timeout, or blank entry
I ($G(DUOUT)=1)!($G(DTOUT)=1)!($G(X)="") S VAL="^"
;
I VAL="" D
.S $P(VAL,U)=Y
.S DIR(0)="DA^"_VAL_":DT:EX",DIR("A")=" GO TO "_TYPE_" DATE: ",DIR("B")="T"
.D ^DIR
.;
.;Check for "^", timeout, or blank entry
.I ($G(DUOUT)=1)!($G(DTOUT)=1)!($G(X)="") S VAL="^" Q
.;
.;Define Entry
.S $P(VAL,U,2)=Y
;
Q VAL
;
SELATYP(DFLT) ;
;
; Display (T)RICARE or (C)HAMPVA OR (A)LL Format
;
; Input Variable -> DFLT = A ALL
; T TRICARE
; C CHAMPVA
;
; Return Value -> A = ALL
; T = TRICARE
; C = CHAMPVA
; ^ = Exit
;
N DIR,DIRUT,DTOUT,DUOUT,EXIT,X,Y
S EXIT=0
S DFLT=$S($G(DFLT)="T":"TRICARE",$G(DFLT)="C":"CHAMPVA",1:"ALL")
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
D ^DIR
I ($G(DUOUT)=1)!($G(DTOUT)=1) S Y="^"
I Y="A" K PSOSEL("ELIG_TYPE") D
.S PSOSEL("ELIG_TYPE")="A"
.S PSOSEL("ELIG_TYPE","T")="TRICARE"
.S PSOSEL("ELIG_TYPE","C")="CHAMPVA"
.S EXIT=1
I EXIT Q Y
I Y'="" S PSOSEL("ELIG_TYPE")=Y,PSOSEL("ELIG_TYPE",Y)=$S(Y="T":"TRICARE",Y="C":"CHAMPVA",1:"ALL")
Q Y
;
SELTCCD(PSOSEL) ;
;
;Prompt to Include (I)npatient,(N)on-Billable, (R)eject, (P)artial, or A)ll: (no default)
;
N DIC,DIR,DIRUT,DUOUT,EXIT,REJ,X,Y,I
S EXIT=0
F I=1:1:2 D Q:Y="A"!(EXIT)
.S DIR(0)="SO^I:INPATIENT;N:NON-BILLABLE;R:REJECT OVERRIDE;P:PARTIAL FILL;A:ALL"
.S DIR("A")="Select one of the following: **Can select multiples - limit of 2** "
.D ^DIR
.I ($G(DUOUT)=1)!($G(DTOUT)=1) S EXIT=1,Y="^" Q
.I Y="A" K PSOSEL("REJECT CODES") D Q
..S PSOSEL("REJECT CODES")="A"
..S PSOSEL("REJECT CODES","I")="INPATIENT"
..S PSOSEL("REJECT CODES","N")="NON-BILLABLE"
..S PSOSEL("REJECT CODES","R")="REJECT OVERRIDE"
..S PSOSEL("REJECT CODES","P")="PARTIAL FILL"
..S EXIT=1
.I Y="",$D(PSOSEL("REJECT CODES")) S EXIT=1 Q
.I Y="",'$D(PSOSEL("REJECT CODES")) S EXIT=0,I=0 Q
.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")
;
Q Y
;
SELPHMST(PSOSEL) ;
;
; Select to include (S)pecific Pharmacist or (A)ll pharmacists
;
N DIR,DIRUT,DTOUT,DUOUT,VAL,X,Y
K PSOPHARM,DIR
;
;First see if they want to enter individual divisions or ALL
S DIR(0)="S^S:SPECIFIC PHARMACIST(S);A:ALL PHARMACISTS"
S DIR("A")="Select Specific Pharmacist(s) or All Pharmacists"
S DIR("B")="ALL"
S DIR("L",1)="Select one of the following:"
S DIR("L",2)=""
S DIR("L",3)=" S Specific Pharmacist(s)"
S DIR("L",4)=" A All Pharmacists"
D ^DIR K DIR
;
;Check for "^" or timeout, otherwise define PSOPHARM
I ($G(DUOUT)=1)!($G(DTOUT)=1) S Y="^"
E S (PSOSEL("PHARMACIST"),PSOPHARM)=Y
;
;If pharmacist selected, ask prompt
I $G(PSOPHARM)="S" F D Q:Y="^"!(Y="")
.;
.;Prompt for entry
.K X S DIC(0)="QEAM",DIC=200,DIC("A")="Select Pharmacist: "
.S DIC("S")="I $D(^XUSEC(""PSORPH"",Y))"
.W ! D ^DIC
.;
.;Check for "^" or timeout
.I ($G(DUOUT)=1)!($G(DTOUT)=1) K PSOPHARM S Y="^" Q
.;
.;Check for blank entry, quit if no previous selections
.I $G(X)="" S Y=$S($D(PSOPHARM)>9:"",1:"^") K:Y="^" PSOPHARM Q
.;
.;Handle Deletes
.I $D(PSOPHARM(+Y)) D Q:Y="^" I 1
..N P
..S P=Y ;Save Original Value
..S DIR(0)="S^Y:YES;N:NO",DIR("A")="Delete "_$P(P,U,2)_" from your list?"
..S DIR("B")="NO" D ^DIR
..I ($G(DUOUT)=1)!($G(DTOUT)=1) K PSOPHARM S Y="^" Q
..I Y="Y" K PSOPHARM(+P),PSOPHARM("B",$P(P,U,2),+P)
..S Y=P ;Restore Original Value
..K P
.E D
..;Define new entries in PSOPHARM array
..S PSOPHARM(+Y)=Y
..S PSOPHARM("B",$P(Y,U,2),+Y)=""
.;
.;Display a list of selected providers
.I $D(PSOPHARM)>9 D
..N X
..W !,?2,"Selected:"
..S X="" F S X=$O(PSOPHARM("B",X)) Q:X="" W !,?10,X
..K X
.Q
;
K PSOPHARM("B")
M PSOSEL("PHARMACIST")=PSOPHARM
Q Y
;
SELPROV(PSOSEL) ;
;
;select to include (S)pecific Provider or (A)ll Providers
;
N DIR,DIRUT,DTOUT,DUOUT,VAL,X,Y
K PSOPROV
;
;First see if they want to enter individual divisions or ALL
S DIR(0)="S^S:SPECIFIC PROVIDER(S);A:ALL PROVIDERS"
S DIR("A")="Select Specific Provider(s) or include ALL Providers"
S DIR("B")="ALL"
S DIR("L",1)="Select one of the following:"
S DIR("L",2)=""
S DIR("L",3)=" S Specific Provider(s)"
S DIR("L",4)=" A ALL Providers"
D ^DIR K DIR
;
;Check for "^" or timeout, otherwise define PSOPROV
I ($G(DUOUT)=1)!($G(DTOUT)=1) S Y="^"
E S (PSOSEL("PROVIDER"),PSOPROV)=Y
;
;If provider selected, ask prompt
I $G(PSOPROV)="S" F D Q:Y="^"!(Y="")
.;
.;Prompt for entry
.K X S DIC(0)="QEAM",DIC=200,DIC("A")="Select Provider: "
.S DIC("S")="I +$G(^VA(200,Y,""PS""))"
.W ! D ^DIC
.;
.;Check for "^" or timeout
.I ($G(DUOUT)=1)!($G(DTOUT)=1) K PSOPROV S Y="^" Q
.;
.;Check for blank entry, quit if no previous selections
.I $G(X)="" S Y=$S($D(PSOPROV)>9:"",1:"^") K:Y="^" PSOPROV Q
.;
.;Handle Deletes
.I $D(PSOPROV(+Y)) D Q:Y="^" I 1
..N P
..S P=Y ;Save Original Value
..S DIR(0)="S^Y:YES;N:NO",DIR("A")="Delete "_$P(P,U,2)_" from your list?"
..S DIR("B")="NO" D ^DIR
..I ($G(DUOUT)=1)!($G(DTOUT)=1) K PSOPROV S Y="^" Q
..I Y="Y" K PSOPROV(+P),PSOPROV("B",$P(P,U,2),+P)
..S Y=P ;Restore Original Value
..K P
.E D
..;Define new entries in PSOPROV array
..S PSOPROV(+Y)=Y
..S PSOPROV("B",$P(Y,U,2),+Y)=""
.;
.;Display a list of selected providers
.I $D(PSOPROV)>9 D
..N X
..W !,?2,"Selected:"
..S X="" F S X=$O(PSOPROV("B",X)) Q:X="" W !,?10,X
..K X
.Q
;
K PSOPROV("B")
M PSOSEL("PROVIDER")=PSOPROV
Q Y
;
PSOTOTAL(PSOSEL) ;
;
;Prompt to Include Group/Subtotal Report by (R) Pharmacy or (P)rovider/Provider
;ADDED BY BLD
;Returns ()
;
N Y,DUOUT,DTOUT,IBQUIT,DIROUT,DIR
N PSONPI
S DIR(0)="S^R:Pharmacist;P:Provider/Prescriber Name"
S DIR("A")="Group/Subtotal Report by (R)Pharmacist or (P)Provider"
;S DIR("B")="PHARMACIST"
D ^DIR
I ($G(DUOUT)=1)!($G(DTOUT)=1) S Y="^" Q Y
S PSONPI=Y
;
Q Y
;
;
;Print Header 2 Line 1
;
; Input variable: PSORTYPE -> Report Type (1-7)
;
;
SELEXCEL() ; - Returns whether to capture data for Excel report.
; Output: EXCEL = 1 - YES (capture data) / 0 - NO (DO NOT capture data)
;
Q:PSOSEL("SUM_DETAIL")="S"
N EXCEL,DIR,DIRUT,DTOUT,DUOUT,DIROUT
;
S DIR(0)="Y",DIR("B")="NO",DIR("T")=DTIME W !
S DIR("A")="Do you want to capture report data for an Excel document"
S DIR("?")="^D HEXC"
D ^DIR K DIR I $D(DIRUT)!$D(DTOUT)!$D(DUOUT)!$D(DIROUT) Q "^"
K DIROUT,DTOUT,DUOUT,DIRUT
S EXCEL=0 I Y S EXCEL=1
;
;Display Excel display message
I EXCEL=1 D EXMSG
;
Q EXCEL
;
HEXC ; - 'Do you want to capture data...' prompt
W !!," Enter: 'Y' - To capture detail report data to transfer"
W !," to an Excel document"
W !," '<CR>' - To skip this option"
W !," '^' - To quit this option"
Q
;
;Display the message about capturing to an Excel file format
;
EXMSG ;
W !!?5,"Before continuing, please set up your terminal to capture the"
W !?5,"detail report data. On some terminals, this can be done by"
W !?5,"clicking on the 'Tools' menu above, then click on 'Capture"
W !?5,"Incoming Data' to save to Desktop. This report may take a"
W !?5,"while to run."
W !!?5,"Note: To avoid undesired wrapping of the data saved to the"
W !?5," file, please enter '0;256;999' at the 'DEVICE:' prompt.",!
Q
;
;
;Screen Pause
;
PAUSE ;
Q:$G(PSOSCR)'=1 S PSOUT=""
W ! K DIR S DIR(0)="E",DIR("A")="Press Return to continue, '^' to exit" D ^DIR K DIR I 'Y S PSOUT=1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOBORP1 11302 printed Sep 23, 2025@20:01:09 Page 2
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
+2 ;
+3 ;***********copied from routine BPSRPT3 AND BPSRPT4************
+4 ;
+5 QUIT
+6 ;
+7 ;
+8 ;
SELPHARM(PSOSEL) NEW DIC,DIR,DIRUT,DTOUT,DUOUT,X,Y
+1 ;
+2 ; Select the ECME Pharmacy or Pharmacies
+3 ;
+4 ; Input Variable -> none
+5 ; Return Value -> "" = Valid Entry or Entries Selected
+6 ; ^ = Exit
+7 ;
+8 ; Output Variable -> PSOPHARM = "D" One or More Pharmacies Selected
+9 ; = "A" User Entered 'ALL'
+10 ;
+11 ; If PSOPHARM = 1 then the PSOPHARM array will be defined where:
+12 ; PSOPHARM(ptr) = ptr ^ BPS PHARMACY NAME and
+13 ; ptr = Internal Pointer to OUTPATIENT SITE file (#59)
+14 ;
+15 ;Reset PSOPHARM array
+16 KILL PSOPHARM
+17 ;
+18 ;First see if they want to enter individual divisions or ALL
+19 SET DIR(0)="S^D:DIVISION;A:ALL"
+20 SET DIR("A")="Select Certain Pharmacy (D)ivisions or (A)LL"
+21 SET DIR("L",1)="Select one of the following:"
+22 SET DIR("L",2)=""
+23 SET DIR("L",3)=" D DIVISION"
+24 SET DIR("L",4)=" A ALL"
+25 DO ^DIR
KILL DIR
+26 ;
+27 ;Check for "^" or timeout, otherwise define PSOPHARM
+28 IF ($GET(DUOUT)=1)!($GET(DTOUT)=1)
SET Y="^"
+29 IF '$TEST
SET (PSOSEL("DIVISION"),PSOPHARM)=Y
+30 ;If division selected, ask prompt
+31 IF $GET(PSOPHARM)="D"
FOR
Begin DoDot:1
+32 ;
+33 ;Prompt for entry
+34 KILL X
SET DIC(0)="QEAM"
SET DIC=59
SET DIC("A")="Select ECME Pharmacy Division(s): "
+35 WRITE !
DO ^DIC
+36 ;
+37 ;Check for "^" or timeout
+38 IF ($GET(DUOUT)=1)!($GET(DTOUT)=1)
KILL PSOPHARM
SET Y="^"
QUIT
+39 ;
+40 ;Check for blank entry, quit if no previous selections
+41 IF $GET(X)=""
SET Y=$SELECT($DATA(PSOPHARM)>9:"",1:"^")
if Y="^"
KILL PSOPHARM
QUIT
+42 ;
+43 ;Handle Deletes
+44 IF $DATA(PSOPHARM(+Y))
Begin DoDot:2
+45 NEW P
+46 ;Save Original Value
SET P=Y
+47 SET DIR(0)="S^Y:YES;N:NO"
SET DIR("A")="Delete "_$PIECE(P,U,2)_" from your list?"
+48 SET DIR("B")="NO"
DO ^DIR
+49 IF ($GET(DUOUT)=1)!($GET(DTOUT)=1)
KILL PSOPHARM
SET Y="^"
QUIT
+50 IF Y="Y"
KILL PSOPHARM(+P),PSOPHARM("B",$PIECE(P,U,2),+P)
+51 ;Restore Original Value
SET Y=P
+52 KILL P
End DoDot:2
if Y="^"
QUIT
IF 1
+53 IF '$TEST
Begin DoDot:2
+54 ;Define new entries in PSOPHARM array
+55 SET PSOPHARM(+Y)=Y
+56 SET PSOPHARM("B",$PIECE(Y,U,2),+Y)=""
End DoDot:2
+57 ;
+58 ;Display a list of selected divisions
+59 IF $DATA(PSOPHARM)>9
Begin DoDot:2
+60 NEW X
+61 WRITE !,?2,"Selected:"
+62 SET X=""
FOR
SET X=$ORDER(PSOPHARM("B",X))
if X=""
QUIT
WRITE !,?10,X
+63 KILL X
End DoDot:2
+64 QUIT
End DoDot:1
if Y="^"!(Y="")
QUIT
+65 ;
+66 KILL PSOPHARM("B")
+67 MERGE PSOSEL("DIVISION")=PSOPHARM
+68 QUIT Y
+69 ;
+70 ;
SELSMDET(DFLT) ;
+1 ;
+2 ; Display (S)ummary or (D)etail Format
+3 ;
+4 ; Input Variable -> DFLT = 1 Summary
+5 ; 2 Detail
+6 ;
+7 ; Return Value -> "S" = Summary
+8 ; "D" = Detail
+9 ; ^ = Exit
+10 ;
+11 NEW DIR,DIRUT,DTOUT,DUOUT,X,Y
+12 ;
+13 SET DFLT=$SELECT($GET(DFLT)=1:"Summary",$GET(DFLT)=2:"Detail",1:"Detail")
+14 SET DIR(0)="S^S:Summary;D:Detail"
SET DIR("A")="Display (S)ummary or (D)etail Format"
SET DIR("B")=DFLT
+15 DO ^DIR
+16 IF ($GET(DUOUT)=1)!($GET(DTOUT)=1)
SET Y="^"
+17 QUIT Y
+18 ;
+19 ;
SELDATE(TYPE) ;select begin date
+1 ; Enter Date Range
+2 ;
+3 ; Input Variable -> TYPE = TRANSACTION
+4 ;
+5 ;
+6 ; Return Value -> P1^P2
+7 ;
+8 ; where P1 = From Date
+9 ; = ^ Exit
+10 ; P2 = To Date
+11 ; = blank for Exit
+12 NEW PSOSIBDT,DIR,DIRUT,DTOUT,DUOUT,VAL,X,Y
+13 ;
SELDATE1 ;
+1 NEW VAL
+2 SET VAL=""
SET DIR(0)="DA^:DT:EX"
SET DIR("A")="START WITH "_TYPE_" DATE: "
SET DIR("B")="T-1"
+3 WRITE !
DO ^DIR
+4 ;
+5 ;Check for "^", timeout, or blank entry
+6 IF ($GET(DUOUT)=1)!($GET(DTOUT)=1)!($GET(X)="")
SET VAL="^"
+7 ;
+8 IF VAL=""
Begin DoDot:1
+9 SET $PIECE(VAL,U)=Y
+10 SET DIR(0)="DA^"_VAL_":DT:EX"
SET DIR("A")=" GO TO "_TYPE_" DATE: "
SET DIR("B")="T"
+11 DO ^DIR
+12 ;
+13 ;Check for "^", timeout, or blank entry
+14 IF ($GET(DUOUT)=1)!($GET(DTOUT)=1)!($GET(X)="")
SET VAL="^"
QUIT
+15 ;
+16 ;Define Entry
+17 SET $PIECE(VAL,U,2)=Y
End DoDot:1
+18 ;
+19 QUIT VAL
+20 ;
SELATYP(DFLT) ;
+1 ;
+2 ; Display (T)RICARE or (C)HAMPVA OR (A)LL Format
+3 ;
+4 ; Input Variable -> DFLT = A ALL
+5 ; T TRICARE
+6 ; C CHAMPVA
+7 ;
+8 ; Return Value -> A = ALL
+9 ; T = TRICARE
+10 ; C = CHAMPVA
+11 ; ^ = Exit
+12 ;
+13 NEW DIR,DIRUT,DTOUT,DUOUT,EXIT,X,Y
+14 SET EXIT=0
+15 SET DFLT=$SELECT($GET(DFLT)="T":"TRICARE",$GET(DFLT)="C":"CHAMPVA",1:"ALL")
+16 SET DIR(0)="SO^T:TRICARE;C:CHAMPVA;A:ALL"
SET DIR("A")="Display (T)RICARE or (C)HAMPVA or (A)LL Entries"
SET DIR("B")=DFLT
+17 DO ^DIR
+18 IF ($GET(DUOUT)=1)!($GET(DTOUT)=1)
SET Y="^"
+19 IF Y="A"
KILL PSOSEL("ELIG_TYPE")
Begin DoDot:1
+20 SET PSOSEL("ELIG_TYPE")="A"
+21 SET PSOSEL("ELIG_TYPE","T")="TRICARE"
+22 SET PSOSEL("ELIG_TYPE","C")="CHAMPVA"
+23 SET EXIT=1
End DoDot:1
+24 IF EXIT
QUIT Y
+25 IF Y'=""
SET PSOSEL("ELIG_TYPE")=Y
SET PSOSEL("ELIG_TYPE",Y)=$SELECT(Y="T":"TRICARE",Y="C":"CHAMPVA",1:"ALL")
+26 QUIT Y
+27 ;
SELTCCD(PSOSEL) ;
+1 ;
+2 ;Prompt to Include (I)npatient,(N)on-Billable, (R)eject, (P)artial, or A)ll: (no default)
+3 ;
+4 NEW DIC,DIR,DIRUT,DUOUT,EXIT,REJ,X,Y,I
+5 SET EXIT=0
+6 FOR I=1:1:2
Begin DoDot:1
+7 SET DIR(0)="SO^I:INPATIENT;N:NON-BILLABLE;R:REJECT OVERRIDE;P:PARTIAL FILL;A:ALL"
+8 SET DIR("A")="Select one of the following: **Can select multiples - limit of 2** "
+9 DO ^DIR
+10 IF ($GET(DUOUT)=1)!($GET(DTOUT)=1)
SET EXIT=1
SET Y="^"
QUIT
+11 IF Y="A"
KILL PSOSEL("REJECT CODES")
Begin DoDot:2
+12 SET PSOSEL("REJECT CODES")="A"
+13 SET PSOSEL("REJECT CODES","I")="INPATIENT"
+14 SET PSOSEL("REJECT CODES","N")="NON-BILLABLE"
+15 SET PSOSEL("REJECT CODES","R")="REJECT OVERRIDE"
+16 SET PSOSEL("REJECT CODES","P")="PARTIAL FILL"
+17 SET EXIT=1
End DoDot:2
QUIT
+18 IF Y=""
IF $DATA(PSOSEL("REJECT CODES"))
SET EXIT=1
QUIT
+19 IF Y=""
IF '$DATA(PSOSEL("REJECT CODES"))
SET EXIT=0
SET I=0
QUIT
+20 IF Y'=""
SET PSOSEL("REJECT CODES",Y)=$SELECT(Y="I":"INPATIENT",Y="N":"NON-BILLABLE",Y="R":"REJECT OVERRIDE",Y="P":"PARTIAL FILL",1:"ALL")
End DoDot:1
if Y="A"!(EXIT)
QUIT
+21 ;
+22 QUIT Y
+23 ;
SELPHMST(PSOSEL) ;
+1 ;
+2 ; Select to include (S)pecific Pharmacist or (A)ll pharmacists
+3 ;
+4 NEW DIR,DIRUT,DTOUT,DUOUT,VAL,X,Y
+5 KILL PSOPHARM,DIR
+6 ;
+7 ;First see if they want to enter individual divisions or ALL
+8 SET DIR(0)="S^S:SPECIFIC PHARMACIST(S);A:ALL PHARMACISTS"
+9 SET DIR("A")="Select Specific Pharmacist(s) or All Pharmacists"
+10 SET DIR("B")="ALL"
+11 SET DIR("L",1)="Select one of the following:"
+12 SET DIR("L",2)=""
+13 SET DIR("L",3)=" S Specific Pharmacist(s)"
+14 SET DIR("L",4)=" A All Pharmacists"
+15 DO ^DIR
KILL DIR
+16 ;
+17 ;Check for "^" or timeout, otherwise define PSOPHARM
+18 IF ($GET(DUOUT)=1)!($GET(DTOUT)=1)
SET Y="^"
+19 IF '$TEST
SET (PSOSEL("PHARMACIST"),PSOPHARM)=Y
+20 ;
+21 ;If pharmacist selected, ask prompt
+22 IF $GET(PSOPHARM)="S"
FOR
Begin DoDot:1
+23 ;
+24 ;Prompt for entry
+25 KILL X
SET DIC(0)="QEAM"
SET DIC=200
SET DIC("A")="Select Pharmacist: "
+26 SET DIC("S")="I $D(^XUSEC(""PSORPH"",Y))"
+27 WRITE !
DO ^DIC
+28 ;
+29 ;Check for "^" or timeout
+30 IF ($GET(DUOUT)=1)!($GET(DTOUT)=1)
KILL PSOPHARM
SET Y="^"
QUIT
+31 ;
+32 ;Check for blank entry, quit if no previous selections
+33 IF $GET(X)=""
SET Y=$SELECT($DATA(PSOPHARM)>9:"",1:"^")
if Y="^"
KILL PSOPHARM
QUIT
+34 ;
+35 ;Handle Deletes
+36 IF $DATA(PSOPHARM(+Y))
Begin DoDot:2
+37 NEW P
+38 ;Save Original Value
SET P=Y
+39 SET DIR(0)="S^Y:YES;N:NO"
SET DIR("A")="Delete "_$PIECE(P,U,2)_" from your list?"
+40 SET DIR("B")="NO"
DO ^DIR
+41 IF ($GET(DUOUT)=1)!($GET(DTOUT)=1)
KILL PSOPHARM
SET Y="^"
QUIT
+42 IF Y="Y"
KILL PSOPHARM(+P),PSOPHARM("B",$PIECE(P,U,2),+P)
+43 ;Restore Original Value
SET Y=P
+44 KILL P
End DoDot:2
if Y="^"
QUIT
IF 1
+45 IF '$TEST
Begin DoDot:2
+46 ;Define new entries in PSOPHARM array
+47 SET PSOPHARM(+Y)=Y
+48 SET PSOPHARM("B",$PIECE(Y,U,2),+Y)=""
End DoDot:2
+49 ;
+50 ;Display a list of selected providers
+51 IF $DATA(PSOPHARM)>9
Begin DoDot:2
+52 NEW X
+53 WRITE !,?2,"Selected:"
+54 SET X=""
FOR
SET X=$ORDER(PSOPHARM("B",X))
if X=""
QUIT
WRITE !,?10,X
+55 KILL X
End DoDot:2
+56 QUIT
End DoDot:1
if Y="^"!(Y="")
QUIT
+57 ;
+58 KILL PSOPHARM("B")
+59 MERGE PSOSEL("PHARMACIST")=PSOPHARM
+60 QUIT Y
+61 ;
SELPROV(PSOSEL) ;
+1 ;
+2 ;select to include (S)pecific Provider or (A)ll Providers
+3 ;
+4 NEW DIR,DIRUT,DTOUT,DUOUT,VAL,X,Y
+5 KILL PSOPROV
+6 ;
+7 ;First see if they want to enter individual divisions or ALL
+8 SET DIR(0)="S^S:SPECIFIC PROVIDER(S);A:ALL PROVIDERS"
+9 SET DIR("A")="Select Specific Provider(s) or include ALL Providers"
+10 SET DIR("B")="ALL"
+11 SET DIR("L",1)="Select one of the following:"
+12 SET DIR("L",2)=""
+13 SET DIR("L",3)=" S Specific Provider(s)"
+14 SET DIR("L",4)=" A ALL Providers"
+15 DO ^DIR
KILL DIR
+16 ;
+17 ;Check for "^" or timeout, otherwise define PSOPROV
+18 IF ($GET(DUOUT)=1)!($GET(DTOUT)=1)
SET Y="^"
+19 IF '$TEST
SET (PSOSEL("PROVIDER"),PSOPROV)=Y
+20 ;
+21 ;If provider selected, ask prompt
+22 IF $GET(PSOPROV)="S"
FOR
Begin DoDot:1
+23 ;
+24 ;Prompt for entry
+25 KILL X
SET DIC(0)="QEAM"
SET DIC=200
SET DIC("A")="Select Provider: "
+26 SET DIC("S")="I +$G(^VA(200,Y,""PS""))"
+27 WRITE !
DO ^DIC
+28 ;
+29 ;Check for "^" or timeout
+30 IF ($GET(DUOUT)=1)!($GET(DTOUT)=1)
KILL PSOPROV
SET Y="^"
QUIT
+31 ;
+32 ;Check for blank entry, quit if no previous selections
+33 IF $GET(X)=""
SET Y=$SELECT($DATA(PSOPROV)>9:"",1:"^")
if Y="^"
KILL PSOPROV
QUIT
+34 ;
+35 ;Handle Deletes
+36 IF $DATA(PSOPROV(+Y))
Begin DoDot:2
+37 NEW P
+38 ;Save Original Value
SET P=Y
+39 SET DIR(0)="S^Y:YES;N:NO"
SET DIR("A")="Delete "_$PIECE(P,U,2)_" from your list?"
+40 SET DIR("B")="NO"
DO ^DIR
+41 IF ($GET(DUOUT)=1)!($GET(DTOUT)=1)
KILL PSOPROV
SET Y="^"
QUIT
+42 IF Y="Y"
KILL PSOPROV(+P),PSOPROV("B",$PIECE(P,U,2),+P)
+43 ;Restore Original Value
SET Y=P
+44 KILL P
End DoDot:2
if Y="^"
QUIT
IF 1
+45 IF '$TEST
Begin DoDot:2
+46 ;Define new entries in PSOPROV array
+47 SET PSOPROV(+Y)=Y
+48 SET PSOPROV("B",$PIECE(Y,U,2),+Y)=""
End DoDot:2
+49 ;
+50 ;Display a list of selected providers
+51 IF $DATA(PSOPROV)>9
Begin DoDot:2
+52 NEW X
+53 WRITE !,?2,"Selected:"
+54 SET X=""
FOR
SET X=$ORDER(PSOPROV("B",X))
if X=""
QUIT
WRITE !,?10,X
+55 KILL X
End DoDot:2
+56 QUIT
End DoDot:1
if Y="^"!(Y="")
QUIT
+57 ;
+58 KILL PSOPROV("B")
+59 MERGE PSOSEL("PROVIDER")=PSOPROV
+60 QUIT Y
+61 ;
PSOTOTAL(PSOSEL) ;
+1 ;
+2 ;Prompt to Include Group/Subtotal Report by (R) Pharmacy or (P)rovider/Provider
+3 ;ADDED BY BLD
+4 ;Returns ()
+5 ;
+6 NEW Y,DUOUT,DTOUT,IBQUIT,DIROUT,DIR
+7 NEW PSONPI
+8 SET DIR(0)="S^R:Pharmacist;P:Provider/Prescriber Name"
+9 SET DIR("A")="Group/Subtotal Report by (R)Pharmacist or (P)Provider"
+10 ;S DIR("B")="PHARMACIST"
+11 DO ^DIR
+12 IF ($GET(DUOUT)=1)!($GET(DTOUT)=1)
SET Y="^"
QUIT Y
+13 SET PSONPI=Y
+14 ;
+15 QUIT Y
+16 ;
+17 ;
+18 ;Print Header 2 Line 1
+19 ;
+20 ; Input variable: PSORTYPE -> Report Type (1-7)
+21 ;
+22 ;
SELEXCEL() ; - Returns whether to capture data for Excel report.
+1 ; Output: EXCEL = 1 - YES (capture data) / 0 - NO (DO NOT capture data)
+2 ;
+3 if PSOSEL("SUM_DETAIL")="S"
QUIT
+4 NEW EXCEL,DIR,DIRUT,DTOUT,DUOUT,DIROUT
+5 ;
+6 SET DIR(0)="Y"
SET DIR("B")="NO"
SET DIR("T")=DTIME
WRITE !
+7 SET DIR("A")="Do you want to capture report data for an Excel document"
+8 SET DIR("?")="^D HEXC"
+9 DO ^DIR
KILL DIR
IF $DATA(DIRUT)!$DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
QUIT "^"
+10 KILL DIROUT,DTOUT,DUOUT,DIRUT
+11 SET EXCEL=0
IF Y
SET EXCEL=1
+12 ;
+13 ;Display Excel display message
+14 IF EXCEL=1
DO EXMSG
+15 ;
+16 QUIT EXCEL
+17 ;
HEXC ; - 'Do you want to capture data...' prompt
+1 WRITE !!," Enter: 'Y' - To capture detail report data to transfer"
+2 WRITE !," to an Excel document"
+3 WRITE !," '<CR>' - To skip this option"
+4 WRITE !," '^' - To quit this option"
+5 QUIT
+6 ;
+7 ;Display the message about capturing to an Excel file format
+8 ;
EXMSG ;
+1 WRITE !!?5,"Before continuing, please set up your terminal to capture the"
+2 WRITE !?5,"detail report data. On some terminals, this can be done by"
+3 WRITE !?5,"clicking on the 'Tools' menu above, then click on 'Capture"
+4 WRITE !?5,"Incoming Data' to save to Desktop. This report may take a"
+5 WRITE !?5,"while to run."
+6 WRITE !!?5,"Note: To avoid undesired wrapping of the data saved to the"
+7 WRITE !?5," file, please enter '0;256;999' at the 'DEVICE:' prompt.",!
+8 QUIT
+9 ;
+10 ;
+11 ;Screen Pause
+12 ;
PAUSE ;
+1 if $GET(PSOSCR)'=1
QUIT
SET PSOUT=""
+2 WRITE !
KILL DIR
SET DIR(0)="E"
SET DIR("A")="Press Return to continue, '^' to exit"
DO ^DIR
KILL DIR
IF 'Y
SET PSOUT=1
+3 QUIT
