- 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 Feb 18, 2025@23:51:20 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