- 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 Apr 23, 2025@18:07:23 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 ;
