- 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
