- 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 Mar 13, 2025@20:55:46 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
