PSOBORP1.m

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 ---PSOBORP1   11302     printed  Dec 13, 2024@02:24:53                                                                                                                                                                                                   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