BPSPHAR ;BHAM ISC/BEE - ECME MGR PHAR OPTION ;14-FEB-05
;;1.0;E CLAIMS MGMT ENGINE;**1,3,2,5,22,33**;JUN 2004;Build 5
;;Per VA Directive 6402, this routine should not be modified.
;
; This routine is called by the BPS SETUP PHARMACY menu option. It updates
; several fields in the BPS PHARMACIES file.
;
Q
;
EN ; Main Entry Point
N BPS56,BPS5601,BPS561,BPSCNT,BPSCS,BPSCSAR,BPSFN,BPSCSID,BPSCSNM,BPSREC
N D0,DA,DI,DIC,DIR,DLAYGO,DIE,DIRUT,DQ,DR,DTOUT,DUOUT,X,Y
;
; First select the pharmacy or enter a new one
W !! S DIC(0)="QEALM",(DLAYGO,DIC)=9002313.56,DIC("A")="Select BPS PHARMACIES NAME: "
D ^DIC
;
;Check for "^", timeout, or blank entry
I ($G(DUOUT)=1)!($G(DTOUT)=1)!($G(Y)=-1) Q
;
;Pull internal entry
S DA=$P($G(Y),U) Q:'$G(Y)
;
; If new BPS Pharmacy, default the CMOP Switch and Auto-Reversal Parameter
I $P(Y,U,3)=1 D
. N DIE,DR,DTOUT
. S DIE=9002313.56,DR="1////0;.09////5"
. D ^DIE
;
; Display the BPS Pharmacy name, NCPDP #, and NPI
W !!,"NAME: ",$P($G(^BPS(9002313.56,DA,0)),U,1)
W !,"STATUS: ",$$GET1^DIQ(9002313.56,DA,.1,"E")
W !,"NCPDP #: ",$P($G(^BPS(9002313.56,DA,0)),U,2)
W !,"NPI: ",$P($G(^BPS(9002313.56,DA,"NPI")),U,1)
;
; Now edit OUTPATIENT SITE, CMOP SWITCH, AUTO-REVERSE PARAMETER,
; and the DEFAULT DEA #
S DIE=9002313.56
S DR="13800;1;.09;.03"
S DR(2,9002313.5601)=".01"
D ^DIE
I $D(Y) Q
;
; If the current BPS Pharmacy being edited is not Active, do
; not display the prompt for BPS Pharmacy for Controlled Substances.
I $$GET1^DIQ(9002313.56,DA,.1,"I")'=1 Q
;
K BPSCSAR
S BPS56=0
S BPSCNT=0
F S BPS56=$O(^BPS(9002313.56,BPS56)) Q:'BPS56 D
. I BPS56=DA Q
. ; Exclude from list if not active
. S BPS561=$$GET1^DIQ(9002313.56,BPS56,.1,"I")
. I BPS561'=1 Q
. ; Exclude from list if pointing to another pharmacy
. I $$GET1^DIQ(9002313.56,BPS56,2)'="" Q
. S BPS5601=$$GET1^DIQ(9002313.56,BPS56,.01)
. S BPSCNT=BPSCNT+1
. S BPSCSAR(BPSCNT)=BPS56_"^"_BPS5601
;
I '$D(BPSCSAR) Q
S BPSCSNM=""
S BPSCSID=$$GET1^DIQ(9002313.56,DA,2,"I")
I BPSCSID'="" S BPSCSNM=$$GET1^DIQ(9002313.56,BPSCSID,.01)
;
W !!,"*** BPS Pharmacy for CS is an optional field."
W !,"This field should only be used when a dispensing pharmacy does not"
W !,"have a valid DEA Controlled Substance Registration Certificate"
W !,"and therefore those products are dispensed by a different pharmacy."
W !,"Press Enter to bypass the prompt. ***"
;
K DIR
S DIR(0)="SO^"
S BPSCNT=""
F S BPSCNT=$O(BPSCSAR(BPSCNT)) Q:'BPSCNT D
. S DIR(0)=DIR(0)_BPSCNT_":"_$P(BPSCSAR(BPSCNT),"^",2)_";"
S DIR(0)=$E(DIR(0),1,$L(DIR(0))-1)
S DIR("A")="Select BPS Pharmacy for CS or Enter to bypass"
S DIR("B")=BPSCSNM
S DIR("?",1)="*** BPS Pharmacy for CS is an optional field."
S DIR("?",2)="This field should only be used when a dispensing pharmacy does not"
S DIR("?",3)="have a valid DEA Controlled Substance Registration Certificate"
S DIR("?",4)="and therefore those products are dispensed by a different pharmacy."
S DIR("?")="Press Enter to bypass the prompt. ***"
D ^DIR
;
I '$G(Y),$G(X)'="@" Q
;
S BPS56=""
I Y S BPS56=$P(BPSCSAR(Y),"^")
;
S BPSFN=9002313.56
S BPSREC=DA_","
S BPSCS(BPSFN,BPSREC,2)=BPS56
D FILE^DIE("","BPSCS","")
;
I BPS56="" Q
W !!?5,"NCPDP #: "_$$GET1^DIQ(9002313.56,BPS56,.02)
W !?5,"NPI: "_$$GET1^DIQ(9002313.56,BPS56,41.01),!
;
N DIR
S DIR(0)="E"
S DIR("A")="Press enter to continue"
D ^DIR
;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HBPSPHAR 3511 printed Nov 22, 2024@17:02:30 Page 2
BPSPHAR ;BHAM ISC/BEE - ECME MGR PHAR OPTION ;14-FEB-05
+1 ;;1.0;E CLAIMS MGMT ENGINE;**1,3,2,5,22,33**;JUN 2004;Build 5
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ; This routine is called by the BPS SETUP PHARMACY menu option. It updates
+5 ; several fields in the BPS PHARMACIES file.
+6 ;
+7 QUIT
+8 ;
EN ; Main Entry Point
+1 NEW BPS56,BPS5601,BPS561,BPSCNT,BPSCS,BPSCSAR,BPSFN,BPSCSID,BPSCSNM,BPSREC
+2 NEW D0,DA,DI,DIC,DIR,DLAYGO,DIE,DIRUT,DQ,DR,DTOUT,DUOUT,X,Y
+3 ;
+4 ; First select the pharmacy or enter a new one
+5 WRITE !!
SET DIC(0)="QEALM"
SET (DLAYGO,DIC)=9002313.56
SET DIC("A")="Select BPS PHARMACIES NAME: "
+6 DO ^DIC
+7 ;
+8 ;Check for "^", timeout, or blank entry
+9 IF ($GET(DUOUT)=1)!($GET(DTOUT)=1)!($GET(Y)=-1)
QUIT
+10 ;
+11 ;Pull internal entry
+12 SET DA=$PIECE($GET(Y),U)
if '$GET(Y)
QUIT
+13 ;
+14 ; If new BPS Pharmacy, default the CMOP Switch and Auto-Reversal Parameter
+15 IF $PIECE(Y,U,3)=1
Begin DoDot:1
+16 NEW DIE,DR,DTOUT
+17 SET DIE=9002313.56
SET DR="1////0;.09////5"
+18 DO ^DIE
End DoDot:1
+19 ;
+20 ; Display the BPS Pharmacy name, NCPDP #, and NPI
+21 WRITE !!,"NAME: ",$PIECE($GET(^BPS(9002313.56,DA,0)),U,1)
+22 WRITE !,"STATUS: ",$$GET1^DIQ(9002313.56,DA,.1,"E")
+23 WRITE !,"NCPDP #: ",$PIECE($GET(^BPS(9002313.56,DA,0)),U,2)
+24 WRITE !,"NPI: ",$PIECE($GET(^BPS(9002313.56,DA,"NPI")),U,1)
+25 ;
+26 ; Now edit OUTPATIENT SITE, CMOP SWITCH, AUTO-REVERSE PARAMETER,
+27 ; and the DEFAULT DEA #
+28 SET DIE=9002313.56
+29 SET DR="13800;1;.09;.03"
+30 SET DR(2,9002313.5601)=".01"
+31 DO ^DIE
+32 IF $DATA(Y)
QUIT
+33 ;
+34 ; If the current BPS Pharmacy being edited is not Active, do
+35 ; not display the prompt for BPS Pharmacy for Controlled Substances.
+36 IF $$GET1^DIQ(9002313.56,DA,.1,"I")'=1
QUIT
+37 ;
+38 KILL BPSCSAR
+39 SET BPS56=0
+40 SET BPSCNT=0
+41 FOR
SET BPS56=$ORDER(^BPS(9002313.56,BPS56))
if 'BPS56
QUIT
Begin DoDot:1
+42 IF BPS56=DA
QUIT
+43 ; Exclude from list if not active
+44 SET BPS561=$$GET1^DIQ(9002313.56,BPS56,.1,"I")
+45 IF BPS561'=1
QUIT
+46 ; Exclude from list if pointing to another pharmacy
+47 IF $$GET1^DIQ(9002313.56,BPS56,2)'=""
QUIT
+48 SET BPS5601=$$GET1^DIQ(9002313.56,BPS56,.01)
+49 SET BPSCNT=BPSCNT+1
+50 SET BPSCSAR(BPSCNT)=BPS56_"^"_BPS5601
End DoDot:1
+51 ;
+52 IF '$DATA(BPSCSAR)
QUIT
+53 SET BPSCSNM=""
+54 SET BPSCSID=$$GET1^DIQ(9002313.56,DA,2,"I")
+55 IF BPSCSID'=""
SET BPSCSNM=$$GET1^DIQ(9002313.56,BPSCSID,.01)
+56 ;
+57 WRITE !!,"*** BPS Pharmacy for CS is an optional field."
+58 WRITE !,"This field should only be used when a dispensing pharmacy does not"
+59 WRITE !,"have a valid DEA Controlled Substance Registration Certificate"
+60 WRITE !,"and therefore those products are dispensed by a different pharmacy."
+61 WRITE !,"Press Enter to bypass the prompt. ***"
+62 ;
+63 KILL DIR
+64 SET DIR(0)="SO^"
+65 SET BPSCNT=""
+66 FOR
SET BPSCNT=$ORDER(BPSCSAR(BPSCNT))
if 'BPSCNT
QUIT
Begin DoDot:1
+67 SET DIR(0)=DIR(0)_BPSCNT_":"_$PIECE(BPSCSAR(BPSCNT),"^",2)_";"
End DoDot:1
+68 SET DIR(0)=$EXTRACT(DIR(0),1,$LENGTH(DIR(0))-1)
+69 SET DIR("A")="Select BPS Pharmacy for CS or Enter to bypass"
+70 SET DIR("B")=BPSCSNM
+71 SET DIR("?",1)="*** BPS Pharmacy for CS is an optional field."
+72 SET DIR("?",2)="This field should only be used when a dispensing pharmacy does not"
+73 SET DIR("?",3)="have a valid DEA Controlled Substance Registration Certificate"
+74 SET DIR("?",4)="and therefore those products are dispensed by a different pharmacy."
+75 SET DIR("?")="Press Enter to bypass the prompt. ***"
+76 DO ^DIR
+77 ;
+78 IF '$GET(Y)
IF $GET(X)'="@"
QUIT
+79 ;
+80 SET BPS56=""
+81 IF Y
SET BPS56=$PIECE(BPSCSAR(Y),"^")
+82 ;
+83 SET BPSFN=9002313.56
+84 SET BPSREC=DA_","
+85 SET BPSCS(BPSFN,BPSREC,2)=BPS56
+86 DO FILE^DIE("","BPSCS","")
+87 ;
+88 IF BPS56=""
QUIT
+89 WRITE !!?5,"NCPDP #: "_$$GET1^DIQ(9002313.56,BPS56,.02)
+90 WRITE !?5,"NPI: "_$$GET1^DIQ(9002313.56,BPS56,41.01),!
+91 ;
+92 NEW DIR
+93 SET DIR(0)="E"
+94 SET DIR("A")="Press enter to continue"
+95 DO ^DIR
+96 ;
+97 QUIT
