BPSRSELG ;BHAM ISC/SS - ECME RESEARCH SCREEN ELIGIBILITY VIEW ;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
;
VE ;
; -- main entry point for BPS LSTMN RSCH ELIGIBILITY
;entry point for VE View Eligibility menu option of the main User Screen
N BPRET,BPSEL,BPDFN
I '$D(@(VALMAR)) Q
D FULL^VALM1
W !,"Please select a SINGLE Patient Line item for viewing Eligibility"
S BPSEL=$$ASKLINE^BPSSCRU4("Select item","P","Please select SINGLE patient summary line.")
I BPSEL<1 S VALMBCK="R" Q
S BPDFN=+$P(BPSEL,U,2)
D EN1^IBNCPDPL(BPDFN)
S VALMBCK="R"
Q
;
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HBPSRSELG 662 printed Nov 22, 2024@17:03:05 Page 2
BPSRSELG ;BHAM ISC/SS - ECME RESEARCH SCREEN ELIGIBILITY VIEW ;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 ;
VE ;
+1 ; -- main entry point for BPS LSTMN RSCH ELIGIBILITY
+2 ;entry point for VE View Eligibility menu option of the main User Screen
+3 NEW BPRET,BPSEL,BPDFN
+4 IF '$DATA(@(VALMAR))
QUIT
+5 DO FULL^VALM1
+6 WRITE !,"Please select a SINGLE Patient Line item for viewing Eligibility"
+7 SET BPSEL=$$ASKLINE^BPSSCRU4("Select item","P","Please select SINGLE patient summary line.")
+8 IF BPSEL<1
SET VALMBCK="R"
QUIT
+9 SET BPDFN=+$PIECE(BPSEL,U,2)
+10 DO EN1^IBNCPDPL(BPDFN)
+11 SET VALMBCK="R"
+12 QUIT
+13 ;
+14 ;