BPSRSEV ;BHAM ISC/SS - ECME RESEARCH SCREEN EVENT LOG ;05-APR-05
;;1.0;E CLAIMS MGMT ENGINE;**1**;JUN 2004
;; Per VHA Directive 10-93-142, this routine should not be modified.
Q
;
EVNT ;
;entry point for VE View Eligibility menu option of the main User Screen
N BPRET,BPSEL,BPMODE,BPRXIEN,BPPAT
I '$D(@(VALMAR)) Q
D FULL^VALM1
;
W !,"Please select a SINGLE Patient Line item or a SINGLE Rx Line item when accessing the IB Events Report"
S BPSEL=$$ASKLINE^BPSSCRU4("Select item","PC","Please select SINGLE patient summary or SINGLE RX line.")
I BPSEL<1 S VALMBCK="R" Q
S BPPAT=+$P(BPSEL,U,2)
I BPPAT=0 W !,"Invalid Patient Internal Number." D QUIT Q
;
S BPMODE=$S($P(BPSEL,U,7)>0:"R",1:"P")
;
I BPMODE="P" D D QUIT Q
. D USRSCREN^IBNCPDPE("P",BPPAT)
;
S BPRXIEN=+$$RXREF^BPSSCRU2(+$P(BPSEL,U,4))
I BPRXIEN=0 S VALMBCK="R" Q
;
I BPMODE="R" D D QUIT Q
. D USRSCREN^IBNCPDPE("R",BPRXIEN)
;
D QUIT
Q
;
QUIT ;
D PAUSE^VALM1
S VALMBCK="R"
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HBPSRSEV 1007 printed Dec 13, 2024@01:52:54 Page 2
BPSRSEV ;BHAM ISC/SS - ECME RESEARCH SCREEN EVENT LOG ;05-APR-05
+1 ;;1.0;E CLAIMS MGMT ENGINE;**1**;JUN 2004
+2 ;; Per VHA Directive 10-93-142, this routine should not be modified.
+3 QUIT
+4 ;
EVNT ;
+1 ;entry point for VE View Eligibility menu option of the main User Screen
+2 NEW BPRET,BPSEL,BPMODE,BPRXIEN,BPPAT
+3 IF '$DATA(@(VALMAR))
QUIT
+4 DO FULL^VALM1
+5 ;
+6 WRITE !,"Please select a SINGLE Patient Line item or a SINGLE Rx Line item when accessing the IB Events Report"
+7 SET BPSEL=$$ASKLINE^BPSSCRU4("Select item","PC","Please select SINGLE patient summary or SINGLE RX line.")
+8 IF BPSEL<1
SET VALMBCK="R"
QUIT
+9 SET BPPAT=+$PIECE(BPSEL,U,2)
+10 IF BPPAT=0
WRITE !,"Invalid Patient Internal Number."
DO QUIT
QUIT
+11 ;
+12 SET BPMODE=$SELECT($PIECE(BPSEL,U,7)>0:"R",1:"P")
+13 ;
+14 IF BPMODE="P"
Begin DoDot:1
+15 DO USRSCREN^IBNCPDPE("P",BPPAT)
End DoDot:1
DO QUIT
QUIT
+16 ;
+17 SET BPRXIEN=+$$RXREF^BPSSCRU2(+$PIECE(BPSEL,U,4))
+18 IF BPRXIEN=0
SET VALMBCK="R"
QUIT
+19 ;
+20 IF BPMODE="R"
Begin DoDot:1
+21 DO USRSCREN^IBNCPDPE("R",BPRXIEN)
End DoDot:1
DO QUIT
QUIT
+22 ;
+23 DO QUIT
+24 QUIT
+25 ;
QUIT ;
+1 DO PAUSE^VALM1
+2 SET VALMBCK="R"
+3 QUIT
+4 ;
