PSOBPSSP ;BIRM/LE - ePharmacy Site Parameters Definition ;04/28/08
;;7.0;OUTPATIENT PHARMACY;**289**;DEC 1997;Build 107
;
DIV ; - Prompt for ePharmacy Site Parameters
N DIC,DIE,DA,Y,PSODIV,DLAYGO,DTOUT,DUOUT
W !!,"Regardless of any parameters defined, Refill-Too-Soon, Drug Utilization"
W !,"Review(DUR) and Tricare rejects will always be placed on the Third Party "
W !,"Payer Rejects - Worklist, also known as Pharmacy Reject Worklist. These"
W !,"parameters are uneditable and are the default parameters."
N PSODIV,XX
;
DIV2 ;
K DIC,DIE,DA,Y,PSODIV S PSODIV=""
; - Division/Site selection
I '$G(PSOSITE) D ^PSOLSET I '$D(PSOPAR) W $C(7),!!,"Pharmacy Division Must be Selected!",! Q
W !!
S DIC("A")="Division: ",DIC=52.86,DIC(0)="ABEQL",DLAYGO=52.86 D ^DIC
K DIC G:$D(DUOUT)!($D(DTOUT))!(Y=-1) EXIT I Y<0 W !,"A division must be entered to proceed.",!! G DIV2
S PSODIV=$P(Y,"^")
;
;Prompt for REJECT WORKLIST DAYS and ALLOW ALL REJECTS fields
K DIE,DA,DIC
S DIE="^PS(52.86,",DA=PSODIV,DIC(0)="QEALZ",DR="1;4" D ^DIE
G EXIT:$D(DUOUT)!($D(DTOUT))
;
CODES ;
;Prompt for Reject codes that will be allowed to pass to the Pharmacy Reject Worklist
K DATA
N XX1,XX2,XX3
D GETS^DIQ(52.86,PSODIV_",","52.8651*","EI","DATA")
I $D(DATA) D
. W !!,"Previously defined override reject codes:",!!,"Code",?10,"Description",?70,"Auto Send"
. W !,"-----",?10,"----------------------------------",?70,"---------"
. S (XX1,XX2,XX3)="" F S XX1=$O(DATA(52.8651,XX1)) Q:XX1="" D
.. I $D(DATA(52.8651,XX1,".01","E")) D
... W !,$J(DATA(52.8651,XX1,".01","E"),5)
... W ?10,$E($$GET1^DIQ(9002313.93,DATA(52.8651,XX1,".01","I")_",",.02),1,50)
... I $D(DATA(52.8651,XX1,1,"E")) W ?70,$J(DATA(52.8651,XX1,1,"E"),6)
W !!
;
K DIC,DA,DIE
S DIC="^PS(52.86,"_PSODIV_",1,",DA(1)=PSODIV,DIC(0)="QEALZ",DR=".01;1"
D ^DIC I $D(DUOUT)!($D(DTOUT))!(Y=-1) K DIC,DA G DIV2
S DA=+Y
K DIE S DIE=DIC,DR=".01;1" D ^DIE
K DIE,DR,DA,Y
G CODES
;
EXIT ;
K DIC,DIR,DIE,DA,DLAYGO,DATA
Q
;
HELP ;Help text for CODES field (#.01) of REJECT CODE multiple(#52.8561)
W !!,"*** Enter a valid third party reject code from the previously entered codes"
W !,"*** above, enter a new code, or enter one from the provided listing below."
W !,"*** Valid codes are those defined in BPS NCPDP REJECT CODES file (#900231.93).",!!
Q
PSOBPSSP ;BIRM/LE - ePharmacy Site Parameters Definition ;04/28/08
+1 ;;7.0;OUTPATIENT PHARMACY;**289**;DEC 1997;Build 107
+2 ;
DIV ; - Prompt for ePharmacy Site Parameters
+1 NEW DIC,DIE,DA,Y,PSODIV,DLAYGO,DTOUT,DUOUT
+2 WRITE !!,"Regardless of any parameters defined, Refill-Too-Soon, Drug Utilization"
+3 WRITE !,"Review(DUR) and Tricare rejects will always be placed on the Third Party "
+4 WRITE !,"Payer Rejects - Worklist, also known as Pharmacy Reject Worklist. These"
+5 WRITE !,"parameters are uneditable and are the default parameters."
+6 NEW PSODIV,XX
+7 ;
DIV2 ;
+1 KILL DIC,DIE,DA,Y,PSODIV
SET PSODIV=""
+2 ; - Division/Site selection
+3 IF '$GET(PSOSITE)
DO ^PSOLSET
IF '$DATA(PSOPAR)
WRITE $CHAR(7),!!,"Pharmacy Division Must be Selected!",!
QUIT
+4 WRITE !!
+5 SET DIC("A")="Division: "
SET DIC=52.86
SET DIC(0)="ABEQL"
SET DLAYGO=52.86
DO ^DIC
+6 KILL DIC
IF $DATA(DUOUT)!($DATA(DTOUT))!(Y=-1)
GOTO EXIT
IF Y<0
WRITE !,"A division must be entered to proceed.",!!
GOTO DIV2
+7 SET PSODIV=$PIECE(Y,"^")
+8 ;
+9 ;Prompt for REJECT WORKLIST DAYS and ALLOW ALL REJECTS fields
+10 KILL DIE,DA,DIC
+11 SET DIE="^PS(52.86,"
SET DA=PSODIV
SET DIC(0)="QEALZ"
SET DR="1;4"
DO ^DIE
+12 IF $DATA(DUOUT)!($DATA(DTOUT))
GOTO EXIT
+13 ;
CODES ;
+1 ;Prompt for Reject codes that will be allowed to pass to the Pharmacy Reject Worklist
+2 KILL DATA
+3 NEW XX1,XX2,XX3
+4 DO GETS^DIQ(52.86,PSODIV_",","52.8651*","EI","DATA")
+5 IF $DATA(DATA)
Begin DoDot:1
+6 WRITE !!,"Previously defined override reject codes:",!!,"Code",?10,"Description",?70,"Auto Send"
+7 WRITE !,"-----",?10,"----------------------------------",?70,"---------"
+8 SET (XX1,XX2,XX3)=""
FOR
SET XX1=$ORDER(DATA(52.8651,XX1))
IF XX1=""
QUIT
Begin DoDot:2
+9 IF $DATA(DATA(52.8651,XX1,".01","E"))
Begin DoDot:3
+10 WRITE !,$JUSTIFY(DATA(52.8651,XX1,".01","E"),5)
+11 WRITE ?10,$EXTRACT($$GET1^DIQ(9002313.93,DATA(52.8651,XX1,".01","I")_",",.02),1,50)
+12 IF $DATA(DATA(52.8651,XX1,1,"E"))
WRITE ?70,$JUSTIFY(DATA(52.8651,XX1,1,"E"),6)
End DoDot:3
End DoDot:2
End DoDot:1
+13 WRITE !!
+14 ;
+15 KILL DIC,DA,DIE
+16 SET DIC="^PS(52.86,"_PSODIV_",1,"
SET DA(1)=PSODIV
SET DIC(0)="QEALZ"
SET DR=".01;1"
+17 DO ^DIC
IF $DATA(DUOUT)!($DATA(DTOUT))!(Y=-1)
KILL DIC,DA
GOTO DIV2
+18 SET DA=+Y
+19 KILL DIE
SET DIE=DIC
SET DR=".01;1"
DO ^DIE
+20 KILL DIE,DR,DA,Y
+21 GOTO CODES
+22 ;
EXIT ;
+1 KILL DIC,DIR,DIE,DA,DLAYGO,DATA
+2 QUIT
+3 ;
HELP ;Help text for CODES field (#.01) of REJECT CODE multiple(#52.8561)
+1 WRITE !!,"*** Enter a valid third party reject code from the previously entered codes"
+2 WRITE !,"*** above, enter a new code, or enter one from the provided listing below."
+3 WRITE !,"*** Valid codes are those defined in BPS NCPDP REJECT CODES file (#900231.93).",!!
+4 QUIT
