BPSJVAL ;BHAM ISC/LJF - Pharmacy data entry ;2004-03-01
;;1.0;E CLAIMS MGMT ENGINE;**1,2**;JUN 2004;Build 12
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
D ^BPSJVAL1
K DIR,X S DIR(0)="EO" D ^DIR
I X=U Q
D ^BPSJVAL2
Q
;
VAL1(VALCK) ; Application
N RETCODE,VERBOSE,IX2
;
; VALCK=0 = validation, HL7 trigger, no display
I '$G(VALCK) N RETCODE D Q RETCODE ; 0 means ok, '0 means invalid
. ;-validate and quit if ok
. S RETCODE=0 D VALIDATE^BPSJVAL1 I $G(BPSJVALR)=-1 S BPSJVALR=RETCODE
. I 'RETCODE Q
. ;-invalid data, send an email
. S MCT=1+$G(MCT),MSG(MCT)="ECME Application Registration HL7 Message not created."
. F IX2=1:1:RETCODE I $G(RETCODE(IX2))]"" D
.. S MCT=1+MCT,MSG(MCT)=$G(RETCODE(IX2))
. D MSG^BPSJUTL(.MSG,"ECME Application Registration")
;
; VALCK=1 = validation, HL7 trigger, display
I $G(VALCK)=1 N RETCODE D Q RETCODE ; 0 means ok, '0 means invalid
. S RETCODE=0,VERBOSE=1 D VALIDATE^BPSJVAL1
. I $G(BPSJVALR)=-1 S BPSJVALR=RETCODE
;
; VALCK=2 = validation, no HL7 trigger, display
I $G(VALCK)=2 N RETCODE D Q 1
. S RETCODE=0,VERBOSE=1 D VALIDATE^BPSJVAL1
. I $G(BPSJVALR)=-1 S BPSJVALR=RETCODE
;
; VALCK=3 = validation, no HL7 trigger, no display
I $G(VALCK)=3 N RETCODE D Q 1
. S RETCODE=0 D VALIDATE^BPSJVAL1
. I $G(BPSJVALR)=-1 S BPSJVALR=RETCODE
;
Q
;
VAL2(VALCK,BPSJD) ; Pharmacies
N RETCODE,VERBOSE,IX2
;
; VALCK=0 = validation, HL7 trigger, no display
I '$G(VALCK) N RETCODE D Q RETCODE ; 0 means ok, '0 means invalid
. ;-validate and quit if ok
. S RETCODE=0 D VALIDATE^BPSJVAL2(BPSJD) I $G(BPSJVALR)=-1 S BPSJVALR=RETCODE
. I 'RETCODE Q
. ;-invalid data, send an email
. S MCT=1+$G(MCT),MSG(MCT)="ECME Pharmacy Registration HL7 Message not created."
. F IX2=1:1:RETCODE I $G(RETCODE(IX2))]"" D
.. S MCT=1+MCT,MSG(MCT)=$G(RETCODE(IX2))
. D MSG^BPSJUTL(.MSG,"ECME Pharmacy Registration")
;
; VALCK=1 = validation, HL7 trigger, display
I $G(VALCK)=1 N RETCODE D Q RETCODE ; 0 means ok, '0 means invalid
. S RETCODE=0,VERBOSE=1 D VALIDATE^BPSJVAL2(BPSJD)
. I $G(BPSJVALR)=-1 S BPSJVALR=RETCODE
;
; VALCK=2 = validation, no HL7 trigger, display
I $G(VALCK)=2 N RETCODE D Q 1
. S RETCODE=0,VERBOSE=1 D VALIDATE^BPSJVAL2(BPSJD)
. I $G(BPSJVALR)=-1 S BPSJVALR=RETCODE
;
; VALCK=3 = validation, no display, no HL7 trigger
I $G(VALCK)=3 N RETCODE D Q 1
. S RETCODE=0 D VALIDATE^BPSJVAL2(BPSJD)
. I $G(BPSJVALR)=-1 S BPSJVALR=RETCODE
;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HBPSJVAL 2533 printed Sep 23, 2025@19:27:18 Page 2
BPSJVAL ;BHAM ISC/LJF - Pharmacy data entry ;2004-03-01
+1 ;;1.0;E CLAIMS MGMT ENGINE;**1,2**;JUN 2004;Build 12
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
+4 DO ^BPSJVAL1
+5 KILL DIR,X
SET DIR(0)="EO"
DO ^DIR
+6 IF X=U
QUIT
+7 DO ^BPSJVAL2
+8 QUIT
+9 ;
VAL1(VALCK) ; Application
+1 NEW RETCODE,VERBOSE,IX2
+2 ;
+3 ; VALCK=0 = validation, HL7 trigger, no display
+4 ; 0 means ok, '0 means invalid
IF '$GET(VALCK)
NEW RETCODE
Begin DoDot:1
+5 ;-validate and quit if ok
+6 SET RETCODE=0
DO VALIDATE^BPSJVAL1
IF $GET(BPSJVALR)=-1
SET BPSJVALR=RETCODE
+7 IF 'RETCODE
QUIT
+8 ;-invalid data, send an email
+9 SET MCT=1+$GET(MCT)
SET MSG(MCT)="ECME Application Registration HL7 Message not created."
+10 FOR IX2=1:1:RETCODE
IF $GET(RETCODE(IX2))]""
Begin DoDot:2
+11 SET MCT=1+MCT
SET MSG(MCT)=$GET(RETCODE(IX2))
End DoDot:2
+12 DO MSG^BPSJUTL(.MSG,"ECME Application Registration")
End DoDot:1
QUIT RETCODE
+13 ;
+14 ; VALCK=1 = validation, HL7 trigger, display
+15 ; 0 means ok, '0 means invalid
IF $GET(VALCK)=1
NEW RETCODE
Begin DoDot:1
+16 SET RETCODE=0
SET VERBOSE=1
DO VALIDATE^BPSJVAL1
+17 IF $GET(BPSJVALR)=-1
SET BPSJVALR=RETCODE
End DoDot:1
QUIT RETCODE
+18 ;
+19 ; VALCK=2 = validation, no HL7 trigger, display
+20 IF $GET(VALCK)=2
NEW RETCODE
Begin DoDot:1
+21 SET RETCODE=0
SET VERBOSE=1
DO VALIDATE^BPSJVAL1
+22 IF $GET(BPSJVALR)=-1
SET BPSJVALR=RETCODE
End DoDot:1
QUIT 1
+23 ;
+24 ; VALCK=3 = validation, no HL7 trigger, no display
+25 IF $GET(VALCK)=3
NEW RETCODE
Begin DoDot:1
+26 SET RETCODE=0
DO VALIDATE^BPSJVAL1
+27 IF $GET(BPSJVALR)=-1
SET BPSJVALR=RETCODE
End DoDot:1
QUIT 1
+28 ;
+29 QUIT
+30 ;
VAL2(VALCK,BPSJD) ; Pharmacies
+1 NEW RETCODE,VERBOSE,IX2
+2 ;
+3 ; VALCK=0 = validation, HL7 trigger, no display
+4 ; 0 means ok, '0 means invalid
IF '$GET(VALCK)
NEW RETCODE
Begin DoDot:1
+5 ;-validate and quit if ok
+6 SET RETCODE=0
DO VALIDATE^BPSJVAL2(BPSJD)
IF $GET(BPSJVALR)=-1
SET BPSJVALR=RETCODE
+7 IF 'RETCODE
QUIT
+8 ;-invalid data, send an email
+9 SET MCT=1+$GET(MCT)
SET MSG(MCT)="ECME Pharmacy Registration HL7 Message not created."
+10 FOR IX2=1:1:RETCODE
IF $GET(RETCODE(IX2))]""
Begin DoDot:2
+11 SET MCT=1+MCT
SET MSG(MCT)=$GET(RETCODE(IX2))
End DoDot:2
+12 DO MSG^BPSJUTL(.MSG,"ECME Pharmacy Registration")
End DoDot:1
QUIT RETCODE
+13 ;
+14 ; VALCK=1 = validation, HL7 trigger, display
+15 ; 0 means ok, '0 means invalid
IF $GET(VALCK)=1
NEW RETCODE
Begin DoDot:1
+16 SET RETCODE=0
SET VERBOSE=1
DO VALIDATE^BPSJVAL2(BPSJD)
+17 IF $GET(BPSJVALR)=-1
SET BPSJVALR=RETCODE
End DoDot:1
QUIT RETCODE
+18 ;
+19 ; VALCK=2 = validation, no HL7 trigger, display
+20 IF $GET(VALCK)=2
NEW RETCODE
Begin DoDot:1
+21 SET RETCODE=0
SET VERBOSE=1
DO VALIDATE^BPSJVAL2(BPSJD)
+22 IF $GET(BPSJVALR)=-1
SET BPSJVALR=RETCODE
End DoDot:1
QUIT 1
+23 ;
+24 ; VALCK=3 = validation, no display, no HL7 trigger
+25 IF $GET(VALCK)=3
NEW RETCODE
Begin DoDot:1
+26 SET RETCODE=0
DO VALIDATE^BPSJVAL2(BPSJD)
+27 IF $GET(BPSJVALR)=-1
SET BPSJVALR=RETCODE
End DoDot:1
QUIT 1
+28 ;
+29 QUIT
