BPSRSPRS ;BHAM ISC/SS - ECME RESEARCH SCREEN PRESCRIPTION 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
;
VP ;
;entry point for VP View Prescription menu option of the main User Screen
N BPRET,BPSEL,BPRXIEN,DA,PSOVDA,PS
I '$D(@(VALMAR)) Q
D FULL^VALM1
W !,"Please select a SINGLE Rx Line item for viewing a Prescription"
S BPSEL=$$ASKLINE^BPSSCRU4("Select item","C","Please select SINGLE RX line.")
I BPSEL<1 S VALMBCK="R" Q
S BPRXIEN=+$$RXREF^BPSSCRU2(+$P(BPSEL,U,4))
I BPRXIEN=0 S VALMBCK="R" Q
S PS=""
S (DA,PSOVDA)=BPRXIEN D DP^PSORXVW
S VALMBCK="R"
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HBPSRSPRS 679 printed Nov 22, 2024@17:03:09 Page 2
BPSRSPRS ;BHAM ISC/SS - ECME RESEARCH SCREEN PRESCRIPTION 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 ;
VP ;
+1 ;entry point for VP View Prescription menu option of the main User Screen
+2 NEW BPRET,BPSEL,BPRXIEN,DA,PSOVDA,PS
+3 IF '$DATA(@(VALMAR))
QUIT
+4 DO FULL^VALM1
+5 WRITE !,"Please select a SINGLE Rx Line item for viewing a Prescription"
+6 SET BPSEL=$$ASKLINE^BPSSCRU4("Select item","C","Please select SINGLE RX line.")
+7 IF BPSEL<1
SET VALMBCK="R"
QUIT
+8 SET BPRXIEN=+$$RXREF^BPSSCRU2(+$PIECE(BPSEL,U,4))
+9 IF BPRXIEN=0
SET VALMBCK="R"
QUIT
+10 SET PS=""
+11 SET (DA,PSOVDA)=BPRXIEN
DO DP^PSORXVW
+12 SET VALMBCK="R"
+13 QUIT
+14 ;