BPSWRKLS ;ALB/SS - SEND CLAIMS TO PHARMACY WORKLIST ;12/26/07
;;1.0;E CLAIMS MGMT ENGINE;**7,8,11,15,20,30**;JUN 2004;Build 19
;;Per VA Directive 6402, this routine should not be modified.
;
; -- main entry point for BPS PRTCL USRSCR PHARM WRKLST protocol (ECME User Screen option)
;
EN ;
;entry point for WRK Send to Worklist menu option of the main User Screen
N BPRET,BPSARR59,BPSTATS,BPQ,BP59,BPCNT,BP59SENT,BPCOMZ,BPZ,BPUPD
S BPCNT=0
I '$D(@(VALMAR)) Q
D FULL^VALM1
I '$$CHCKKEY() D Q
. W !,"The user doesn't have enough rights to perform this action"
. D QUIT(1)
;
S BPQ=0
F D Q:BPQ>0
. K BP59SENT,BPSARR59
. S BPZ=$$SELCLMS(.BPSARR59,VALMAR)
. I BPZ=0 S BPQ=1 Q ;nothing selected or up-arrow entered
. ; check selected claims
. S BPCNT=$$CHCKSEL(.BPSARR59,.BP59SENT)
. I BPCNT>0 S BPQ=1 ; if at least one can be processed then do not prompt the user again (BPQ>1)
;
I BPCNT=0 D QUIT() Q
;add comments
S BPCOMZ=$$COMMENT^BPSSCRCL("Comment for Pharmacy ",40)
I BPCOMZ="^" D QUIT() Q
I $L(BPCOMZ)>0 S BPCOMZ="Sent to Pharmacy:"_BPCOMZ
E S BPCOMZ="Sent to Pharmacy Worklist"
W !!,"Eligible claim(s) will be sent to the Pharmacy Worklist...",!
S BPQ=$$YESNO^BPSSCRRS("Are you sure?(Y/N)")
I BPQ<1 D QUIT() Q
;send to Pharmacy
S BP59=0,BPUPD=0
F S BP59=$O(BP59SENT(BP59)) Q:+BP59=0 S BPUPD=$$TOPHARM(BP59,BPCOMZ,.BPSARR59)
D QUIT(1)
D:BPUPD=1 REDRAW^BPSSCRUD("Updating screen...")
Q
;send the claim to Pharmacy Worklist
;BP59 - pointer to the BPS TRANSACTION file
;BPCOMM - comment
;BPSARR59 - array with selected claims as BPS TRANSACTION pointers
;returns:
;1- has been successfully sent
;0- failed to send
TOPHARM(BP59,BPCOMM,BPSARR59) ;
N BPRXIEN,BPRXFIL,BPRET,BPX
S BPX=$$RXREF^BPSSCRU2(BP59)
S BPRXIEN=+BPX
S BPRXFIL=$P(BPX,U,2)
;use Pharmacy API to send the claim and the comment IA #5063
S BPRET=$$WRKLST^PSOREJU4(BPRXIEN,BPRXFIL,BPCOMM,DUZ,DT,1,$$COB59^BPSUTIL2(BP59))
W !,$G(@VALMAR@(+$G(BPSARR59(BP59)),0))
I +BPRET=2 W !,"was ALREADY sent to the Pharmacy Work List." Q 0
I +BPRET=0 W !,"cannot be sent: ",$P(BPRET,U,2) Q 0
;add the comment to BPS TRANSACTION
I $$ADDCOMM^BPSBUTL(BPRXIEN,BPRXFIL,BPCOMM) ;COB
W !,"has been sent to the Pharmacy Work List."
Q 1
;check selected claims
;BPSARR59 - array with the claims selected by the user
;BP59SENT - array with the claims that will be sent to the pharmacy
;output:
;the number of claims that will be sent to the Pharmacy Worklist
CHCKSEL(BPSARR59,BP59SENT) ;
N BP59,BPCNT,BPREJS,BPALLREJ,BPNOTSNT,BPSDIV59
S BP59=0,BPCNT=0
;check each selected claim
S BPNOTSNT=0
W !,"You've chosen to send to Pharmacy Work List the following:"
F S BP59=$O(BPSARR59(BP59)) Q:+BP59=0 D
. W !,$G(@VALMAR@(+$G(BPSARR59(BP59)),0))
. ;
. ; check for non-billable entry - cannot be sent to the Pharmacy work list from here
. I $$NB^BPSSCR03(BP59) W !,"Entry is NON BILLABLE and cannot be sent to the Pharmacy Work List." Q
. ;
. I $$CLOSED02^BPSSCR03($P($G(^BPST(BP59,0)),U,4)) W !,"is closed and cannot be sent to the Pharmacy Work List." Q
. ; check status - only rejected cannot be sent to the Pharmacy worklist
. S BPSTATS=$P($$CLAIMST^BPSSCRU3(BP59),U)
. I BPSTATS'="E REJECTED" W !,"was not rejected and cannot be sent to the Pharmacy Work List." Q
. ;check if the claim has an eligible reject code(s)
. I $$INWRKLST(BP59)=1 W !,"was ALREADY sent to the Pharmacy Work List." Q
. ;check Pharmacy settings - if all rejects can be sent
. ;IA 5063
. S BPSDIV59=$P($G(^BPST(BP59,1)),U,4)
. D AUTOREJ^PSOREJU4(.BPREJS,BPSDIV59)
. I $$CHCKREJ(BP59,BPSDIV59)=0 W !,"doesn't have eligible reject code to be sent to the Pharmacy Work List." Q
. S BPCNT=BPCNT+1 ;count eligible claims
. S BP59SENT(BP59)="" ;put them in the output array
. S BP59SENT=BPCNT
Q BPCNT
;
NOTSNDMS ;
W "cannot be sent - "
Q
;
;BPSARR59 (by reference)- to store BPS TRANSACTION pointers selected by the user
;BPTMP - temporary global (like VALMAR)
SELCLMS(BPSARR59,BPTMP) ;
W !!,"Enter the line numbers for the claim(s) to send to the Pharmacy Worklist."
S BPRET=$$ASKLINES^BPSSCRU4("Select item(s)","C",.BPSARR59,BPTMP)
I BPRET="^" Q 0
Q 1
;
CHCKKEY() ;
;check if the user does have BPS MANAGER key
I $D(^XUSEC("BPS MANAGER",DUZ)) Q 1
Q 0
;BPPAUSE 1- make pause
QUIT(BPPAUSE) ;
I $G(BPPAUSE)>0 D
. I $$PAUSE^BPSSCRRV()
S VALMBCK="R"
Q
;check if the claim can be sent to the pharmacy because its reject code is eligible for this
;BP59 - pointer to the BPS TRANSACTION file
;BPSDIV59 - pointer to file #59 (PHARMACY DIVISION)
;return value:
;1- can be sent
;0- cannot be sent
CHCKREJ(BP59,BPSDIV59) ;
N BPREJS,BPRJCODE,BPRJS,BPFLG
;get reject codes for the claim
D REJCODES^BPSSCRU3(BP59,.BPREJS) ;
;if no reject codes then return 0
I $O(BPREJS(""))="" Q 0
D CONVERT(.BPREJS,.BPRJS)
;call Pharmacy API to read site parameters and check if the claim with these reject codes can be sent to the Pharmacy Worklist
;IA 5063
D AUTOREJ^PSOREJU4(.BPRJS,BPSDIV59)
;check result
S BPRJCODE="",BPFLG=0
F S BPRJCODE=$O(BPRJS(1,BPRJCODE)) Q:BPRJCODE="" I BPRJS(1,BPRJCODE)=1 S BPFLG=1 Q
;return 1 if the claim has at least one reject code that matches site parameter reject codes
;return 0 if not
Q BPFLG
;
;check if the claim is already in the Pharmacy Worklist
;BP59 - pointer to the BPS TRANSACTION file
;return:
;1 - in list
;0 - not in list
INWRKLST(BP59) ;
N BPRXIEN,BPRXFIL,BPX
S BPX=$$RXREF^BPSSCRU2(BP59)
S BPRXIEN=+BPX
S BPRXFIL=$P(BPX,U,2)
;IA #5063
Q $$INLIST^PSOREJU4(BPRXIEN,BPRXFIL,$$COB59^BPSUTIL2(BP59))
;
;Converts external values of the BPS NCPDP REJECT CODES file #9002313.93
;stored in the local array BPSARRJ1 to IENs and save them in the local
;array BPSARRJ2 under "1" subscript - in the form suitable for the AUTOREJ^PSOREJU4
CONVERT(BPSARRJ1,BPSARRJ2) ;
N BPREJ1,BPREJ2
S BPREJ1=""
F S BPREJ1=$O(BPSARRJ1(BPREJ1)) Q:BPREJ1="" D
. S BPREJ2=+$O(^BPSF(9002313.93,"B",BPREJ1,0))
. I BPREJ2>0 S BPSARRJ2(1,BPREJ2)=""
Q
;send the claims rejected with code 79, 88, or 943 to Pharmacy Worklist
;Input:
; BPRXI - RX ien
; BPRXR - refill
; BPIEN59 - ien of BPS TRANSACTION file
; BPPAYSEQ - payer sequence
;Returns:
; 1 sent succesfully
; 2 was ALREADY sent to the Pharmacy Work List
; 0 cannot be sent
SENDREJ(BPRXI,BPRXR,BPIEN59,BPPAYSEQ) ;
N BPZ,BPALLREJ,BPREJ,BPRET
S BPRET=0
D DUR1^BPSNCPD3(BPRXI,BPRXR,.BPREJ,"",BPPAYSEQ)
S BPZ=","_BPREJ(BPPAYSEQ,"REJ CODE LST")_","
I BPZ[",79,"!(BPZ[",88,")!(BPZ[",943,") S BPRET=$$WRKLST^PSOREJU4(BPRXI,BPRXR,"Sent by ECME engine",DUZ,DT,1,BPPAYSEQ)
Q +BPRET
;
;BPSWRKLS
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HBPSWRKLS 6793 printed Sep 23, 2025@19:29:55 Page 2
BPSWRKLS ;ALB/SS - SEND CLAIMS TO PHARMACY WORKLIST ;12/26/07
+1 ;;1.0;E CLAIMS MGMT ENGINE;**7,8,11,15,20,30**;JUN 2004;Build 19
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ; -- main entry point for BPS PRTCL USRSCR PHARM WRKLST protocol (ECME User Screen option)
+5 ;
EN ;
+1 ;entry point for WRK Send to Worklist menu option of the main User Screen
+2 NEW BPRET,BPSARR59,BPSTATS,BPQ,BP59,BPCNT,BP59SENT,BPCOMZ,BPZ,BPUPD
+3 SET BPCNT=0
+4 IF '$DATA(@(VALMAR))
QUIT
+5 DO FULL^VALM1
+6 IF '$$CHCKKEY()
Begin DoDot:1
+7 WRITE !,"The user doesn't have enough rights to perform this action"
+8 DO QUIT(1)
End DoDot:1
QUIT
+9 ;
+10 SET BPQ=0
+11 FOR
Begin DoDot:1
+12 KILL BP59SENT,BPSARR59
+13 SET BPZ=$$SELCLMS(.BPSARR59,VALMAR)
+14 ;nothing selected or up-arrow entered
IF BPZ=0
SET BPQ=1
QUIT
+15 ; check selected claims
+16 SET BPCNT=$$CHCKSEL(.BPSARR59,.BP59SENT)
+17 ; if at least one can be processed then do not prompt the user again (BPQ>1)
IF BPCNT>0
SET BPQ=1
End DoDot:1
if BPQ>0
QUIT
+18 ;
+19 IF BPCNT=0
DO QUIT()
QUIT
+20 ;add comments
+21 SET BPCOMZ=$$COMMENT^BPSSCRCL("Comment for Pharmacy ",40)
+22 IF BPCOMZ="^"
DO QUIT()
QUIT
+23 IF $LENGTH(BPCOMZ)>0
SET BPCOMZ="Sent to Pharmacy:"_BPCOMZ
+24 IF '$TEST
SET BPCOMZ="Sent to Pharmacy Worklist"
+25 WRITE !!,"Eligible claim(s) will be sent to the Pharmacy Worklist...",!
+26 SET BPQ=$$YESNO^BPSSCRRS("Are you sure?(Y/N)")
+27 IF BPQ<1
DO QUIT()
QUIT
+28 ;send to Pharmacy
+29 SET BP59=0
SET BPUPD=0
+30 FOR
SET BP59=$ORDER(BP59SENT(BP59))
if +BP59=0
QUIT
SET BPUPD=$$TOPHARM(BP59,BPCOMZ,.BPSARR59)
+31 DO QUIT(1)
+32 if BPUPD=1
DO REDRAW^BPSSCRUD("Updating screen...")
+33 QUIT
+34 ;send the claim to Pharmacy Worklist
+35 ;BP59 - pointer to the BPS TRANSACTION file
+36 ;BPCOMM - comment
+37 ;BPSARR59 - array with selected claims as BPS TRANSACTION pointers
+38 ;returns:
+39 ;1- has been successfully sent
+40 ;0- failed to send
TOPHARM(BP59,BPCOMM,BPSARR59) ;
+1 NEW BPRXIEN,BPRXFIL,BPRET,BPX
+2 SET BPX=$$RXREF^BPSSCRU2(BP59)
+3 SET BPRXIEN=+BPX
+4 SET BPRXFIL=$PIECE(BPX,U,2)
+5 ;use Pharmacy API to send the claim and the comment IA #5063
+6 SET BPRET=$$WRKLST^PSOREJU4(BPRXIEN,BPRXFIL,BPCOMM,DUZ,DT,1,$$COB59^BPSUTIL2(BP59))
+7 WRITE !,$GET(@VALMAR@(+$GET(BPSARR59(BP59)),0))
+8 IF +BPRET=2
WRITE !,"was ALREADY sent to the Pharmacy Work List."
QUIT 0
+9 IF +BPRET=0
WRITE !,"cannot be sent: ",$PIECE(BPRET,U,2)
QUIT 0
+10 ;add the comment to BPS TRANSACTION
+11 ;COB
IF $$ADDCOMM^BPSBUTL(BPRXIEN,BPRXFIL,BPCOMM)
+12 WRITE !,"has been sent to the Pharmacy Work List."
+13 QUIT 1
+14 ;check selected claims
+15 ;BPSARR59 - array with the claims selected by the user
+16 ;BP59SENT - array with the claims that will be sent to the pharmacy
+17 ;output:
+18 ;the number of claims that will be sent to the Pharmacy Worklist
CHCKSEL(BPSARR59,BP59SENT) ;
+1 NEW BP59,BPCNT,BPREJS,BPALLREJ,BPNOTSNT,BPSDIV59
+2 SET BP59=0
SET BPCNT=0
+3 ;check each selected claim
+4 SET BPNOTSNT=0
+5 WRITE !,"You've chosen to send to Pharmacy Work List the following:"
+6 FOR
SET BP59=$ORDER(BPSARR59(BP59))
if +BP59=0
QUIT
Begin DoDot:1
+7 WRITE !,$GET(@VALMAR@(+$GET(BPSARR59(BP59)),0))
+8 ;
+9 ; check for non-billable entry - cannot be sent to the Pharmacy work list from here
+10 IF $$NB^BPSSCR03(BP59)
WRITE !,"Entry is NON BILLABLE and cannot be sent to the Pharmacy Work List."
QUIT
+11 ;
+12 IF $$CLOSED02^BPSSCR03($PIECE($GET(^BPST(BP59,0)),U,4))
WRITE !,"is closed and cannot be sent to the Pharmacy Work List."
QUIT
+13 ; check status - only rejected cannot be sent to the Pharmacy worklist
+14 SET BPSTATS=$PIECE($$CLAIMST^BPSSCRU3(BP59),U)
+15 IF BPSTATS'="E REJECTED"
WRITE !,"was not rejected and cannot be sent to the Pharmacy Work List."
QUIT
+16 ;check if the claim has an eligible reject code(s)
+17 IF $$INWRKLST(BP59)=1
WRITE !,"was ALREADY sent to the Pharmacy Work List."
QUIT
+18 ;check Pharmacy settings - if all rejects can be sent
+19 ;IA 5063
+20 SET BPSDIV59=$PIECE($GET(^BPST(BP59,1)),U,4)
+21 DO AUTOREJ^PSOREJU4(.BPREJS,BPSDIV59)
+22 IF $$CHCKREJ(BP59,BPSDIV59)=0
WRITE !,"doesn't have eligible reject code to be sent to the Pharmacy Work List."
QUIT
+23 ;count eligible claims
SET BPCNT=BPCNT+1
+24 ;put them in the output array
SET BP59SENT(BP59)=""
+25 SET BP59SENT=BPCNT
End DoDot:1
+26 QUIT BPCNT
+27 ;
NOTSNDMS ;
+1 WRITE "cannot be sent - "
+2 QUIT
+3 ;
+4 ;BPSARR59 (by reference)- to store BPS TRANSACTION pointers selected by the user
+5 ;BPTMP - temporary global (like VALMAR)
SELCLMS(BPSARR59,BPTMP) ;
+1 WRITE !!,"Enter the line numbers for the claim(s) to send to the Pharmacy Worklist."
+2 SET BPRET=$$ASKLINES^BPSSCRU4("Select item(s)","C",.BPSARR59,BPTMP)
+3 IF BPRET="^"
QUIT 0
+4 QUIT 1
+5 ;
CHCKKEY() ;
+1 ;check if the user does have BPS MANAGER key
+2 IF $DATA(^XUSEC("BPS MANAGER",DUZ))
QUIT 1
+3 QUIT 0
+4 ;BPPAUSE 1- make pause
QUIT(BPPAUSE) ;
+1 IF $GET(BPPAUSE)>0
Begin DoDot:1
+2 IF $$PAUSE^BPSSCRRV()
End DoDot:1
+3 SET VALMBCK="R"
+4 QUIT
+5 ;check if the claim can be sent to the pharmacy because its reject code is eligible for this
+6 ;BP59 - pointer to the BPS TRANSACTION file
+7 ;BPSDIV59 - pointer to file #59 (PHARMACY DIVISION)
+8 ;return value:
+9 ;1- can be sent
+10 ;0- cannot be sent
CHCKREJ(BP59,BPSDIV59) ;
+1 NEW BPREJS,BPRJCODE,BPRJS,BPFLG
+2 ;get reject codes for the claim
+3 ;
DO REJCODES^BPSSCRU3(BP59,.BPREJS)
+4 ;if no reject codes then return 0
+5 IF $ORDER(BPREJS(""))=""
QUIT 0
+6 DO CONVERT(.BPREJS,.BPRJS)
+7 ;call Pharmacy API to read site parameters and check if the claim with these reject codes can be sent to the Pharmacy Worklist
+8 ;IA 5063
+9 DO AUTOREJ^PSOREJU4(.BPRJS,BPSDIV59)
+10 ;check result
+11 SET BPRJCODE=""
SET BPFLG=0
+12 FOR
SET BPRJCODE=$ORDER(BPRJS(1,BPRJCODE))
if BPRJCODE=""
QUIT
IF BPRJS(1,BPRJCODE)=1
SET BPFLG=1
QUIT
+13 ;return 1 if the claim has at least one reject code that matches site parameter reject codes
+14 ;return 0 if not
+15 QUIT BPFLG
+16 ;
+17 ;check if the claim is already in the Pharmacy Worklist
+18 ;BP59 - pointer to the BPS TRANSACTION file
+19 ;return:
+20 ;1 - in list
+21 ;0 - not in list
INWRKLST(BP59) ;
+1 NEW BPRXIEN,BPRXFIL,BPX
+2 SET BPX=$$RXREF^BPSSCRU2(BP59)
+3 SET BPRXIEN=+BPX
+4 SET BPRXFIL=$PIECE(BPX,U,2)
+5 ;IA #5063
+6 QUIT $$INLIST^PSOREJU4(BPRXIEN,BPRXFIL,$$COB59^BPSUTIL2(BP59))
+7 ;
+8 ;Converts external values of the BPS NCPDP REJECT CODES file #9002313.93
+9 ;stored in the local array BPSARRJ1 to IENs and save them in the local
+10 ;array BPSARRJ2 under "1" subscript - in the form suitable for the AUTOREJ^PSOREJU4
CONVERT(BPSARRJ1,BPSARRJ2) ;
+1 NEW BPREJ1,BPREJ2
+2 SET BPREJ1=""
+3 FOR
SET BPREJ1=$ORDER(BPSARRJ1(BPREJ1))
if BPREJ1=""
QUIT
Begin DoDot:1
+4 SET BPREJ2=+$ORDER(^BPSF(9002313.93,"B",BPREJ1,0))
+5 IF BPREJ2>0
SET BPSARRJ2(1,BPREJ2)=""
End DoDot:1
+6 QUIT
+7 ;send the claims rejected with code 79, 88, or 943 to Pharmacy Worklist
+8 ;Input:
+9 ; BPRXI - RX ien
+10 ; BPRXR - refill
+11 ; BPIEN59 - ien of BPS TRANSACTION file
+12 ; BPPAYSEQ - payer sequence
+13 ;Returns:
+14 ; 1 sent succesfully
+15 ; 2 was ALREADY sent to the Pharmacy Work List
+16 ; 0 cannot be sent
SENDREJ(BPRXI,BPRXR,BPIEN59,BPPAYSEQ) ;
+1 NEW BPZ,BPALLREJ,BPREJ,BPRET
+2 SET BPRET=0
+3 DO DUR1^BPSNCPD3(BPRXI,BPRXR,.BPREJ,"",BPPAYSEQ)
+4 SET BPZ=","_BPREJ(BPPAYSEQ,"REJ CODE LST")_","
+5 IF BPZ[",79,"!(BPZ[",88,")!(BPZ[",943,")
SET BPRET=$$WRKLST^PSOREJU4(BPRXI,BPRXR,"Sent by ECME engine",DUZ,DT,1,BPPAYSEQ)
+6 QUIT +BPRET
+7 ;
+8 ;BPSWRKLS
