BPSJVAL2 ;BHAM ISC/LJF - Validate Pharmacy data ;3/5/08 11:14
;;1.0;E CLAIMS MGMT ENGINE;**1,2,5,7**;JUN 2004;Build 46
;;Per VHA Directive 2004-038, this routine should not be modified.
;
N PHARMIX,RET,DIR,X
;
S PHARMIX=0,X=""
F S PHARMIX=$O(^BPS(9002313.56,PHARMIX)) Q:'PHARMIX D Q:X=U
. W !!,"VERIFY PHARMACY REGISTRATIONS DATA.",!
. D REG^BPSJPREG(PHARMIX,2)
. W !
. S DIR(0)="EO" D ^DIR
;
Q
;
; Array HL and variable VERBOSE newed/set by calling routine
; RETCODE returned to calling routine
VALIDATE(BPSJDDD) ;
N SEG,SEGIX,ZRP,RAY,RIX,PIX,PIXL,SEGDAT,ZNOTE,ZMAX,CPS,FS,REP
N VALDATA,TMP
S ZMAX=17
;
S RETCODE=$G(RETCODE)
S ZRP="",RIX=0
;
; Set HL7 Delimiters - use standard defaults if none provided
S FS=$G(HL("FS")) I FS="" S FS="|"
S CPS=$E($G(HL("ECH"))) I CPS="" S CPS="^"
S REP=$E($G(HL("ECH")),2) I REP="" S REP="~"
;
F SEGIX=3:1 S SEG=$G(^TMP("HLS",$J,SEGIX)),PIX=0 Q:SEG="" D I ZRP]"" Q
. I $E(SEG,1,3)="ZRP" S ZRP=$E(SEG,4) S $E(SEG,1,4)=""
I ZRP="" Q
F S RIX=$O(^TMP("HLS",$J,SEGIX,RIX)) Q:'RIX I RIX<(ZMAX+1) D
. S TMP=$P($G(^TMP("HLS",$J,SEGIX,RIX)),ZRP)
. I $G(TMP)="" S RETCODE(RIX)=""
. I RIX=3 S RETCODE(RIX)=TMP ;capture pharmacy name
F S RIX=$O(RETCODE(RIX)) Q:'RIX D
. D @RIX
. I +$G(VERBOSE),$L($G(RETCODE(RIX))) W !,RETCODE(RIX)
;
Q
;
; NS=Not Supported, R=Required, RE=Required or empty, C=Conditional
; CE=Conditional or empty, O=Optional,
;
1 ; Set ID - NS
Q
2 ; NCPDP Number - C
S ZNOTE=" NCPDP NUMBER - VALID"
I RETCODE(RIX)="" D
. I BPSJDDD=0 D
. . I '$D(RETCODE(17)) Q
. . S ZNOTE="** NCPDP NUMBER - NCPDP OR NPI - Missing/Invalid",RETCODE=2
. . S RETCODE(RIX)=ZNOTE_RETCODE(RIX)
Q
3 ; PHARMACY NAME - R
S ZNOTE=" PHARMACY NAME"
I RETCODE(RIX)="" D
. S ZNOTE="** PHARMACY NAME - Missing/Invalid",RETCODE=3
I RETCODE(RIX)]"" S RETCODE(RIX)=": "_$$DECODE(RETCODE(RIX))
S RETCODE(RIX)=ZNOTE_RETCODE(RIX)
Q
4 ; DEA Number - R
S ZNOTE=" DEA NUMBER - Required - VALID"
I RETCODE(RIX)="" D
. S ZNOTE="** DEA NUMBER - Missing/Invalid",RETCODE=4
. S RETCODE(RIX)=ZNOTE_RETCODE(RIX)
Q
5 ; Hour of Operation
S ZNOTE="" ; not sending anymore
Q
6 ; Mailing Address - R
S ZNOTE=$$TRIMTAIL(RETCODE(RIX))
S VALDATA=($L($P(ZNOTE,CPS,1))<1) ; Street address
S VALDATA=($L($P(ZNOTE,CPS,3))<1)+VALDATA ; City
S VALDATA=($L($P(ZNOTE,CPS,4))<1)+VALDATA ; State
S VALDATA=($L($P(ZNOTE,CPS,5))<1)+VALDATA ; Zip
S ZNOTE=" MAILING ADDRESS - Required - VALID"
I VALDATA D
. S ZNOTE="** MAILING ADDRESS - Missing/Invalid",RETCODE=6
. S RETCODE(RIX)=ZNOTE_RETCODE(RIX)
Q
7 ; Remittance Address - R
S ZNOTE=$$TRIMTAIL(RETCODE(RIX))
S VALDATA=($L($P(ZNOTE,CPS,1))<1) ; Street Address
S VALDATA=($L($P(ZNOTE,CPS,3))<1)+VALDATA ; City
S VALDATA=($L($P(ZNOTE,CPS,4))<1)+VALDATA ; State
S VALDATA=($L($P(ZNOTE,CPS,5))<1)+VALDATA ; Zip
S ZNOTE=" REMITTANCE ADDRESS - Required - VALID"
I VALDATA D
. S ZNOTE="** REMITTANCE ADDRESS - Missing/Invalid",RETCODE=7
. S RETCODE(RIX)=ZNOTE_RETCODE(RIX)
Q
8 ; Contact Name
S ZNOTE=$$TRIMTAIL(RETCODE(RIX))
S VALDATA=($L($P(ZNOTE,CPS,1))<1) ; Surname
S ZNOTE=" CONTACT NAME - Required - VALID"
I VALDATA D
. S ZNOTE="** CONTACT NAME - Missing/Invalid",RETCODE=8
. S RETCODE(RIX)=ZNOTE_RETCODE(RIX)
Q
9 ; Contact Title
S ZNOTE=" CONTACT TITLE - VALID"
Q
10 ; Contact means
S ZNOTE=" CONTACT MEANS - VALID"
;S RETCODE(RIX)=ZNOTE_RETCODE(RIX)
Q
11 ; Alternate Contact Name
S ZNOTE=$$TRIMTAIL(RETCODE(RIX))
S VALDATA=($L($P(ZNOTE,CPS,1))<1) ; Surname
S ZNOTE=" ALTERNATE CONTACT NAME - Required - VALID"
I VALDATA D
. S ZNOTE="** ALTERNATE CONTACT NAME - Missing/Invalid",RETCODE=11
. S RETCODE(RIX)=ZNOTE_RETCODE(RIX)
Q
12 ; Alternate Contact Title
S ZNOTE=" ALTERNATE CONTACT TITLE - VALID"
Q
13 ; Alternate Contact means
S ZNOTE=" ALTERNATE CONTACT MEANS - VALID"
Q
14 ; Lead Pharmacist Name - R
S ZNOTE=$$TRIMTAIL(RETCODE(RIX))
S VALDATA=($L($P(ZNOTE,CPS,1))<1) ; Surname
S ZNOTE=" LEAD PHARMACIST NAME - Required - VALID"
I VALDATA D
. S ZNOTE="** LEAD PHARMACIST NAME - Missing/Invalid",RETCODE=14
. S RETCODE(RIX)=ZNOTE_RETCODE(RIX)
Q
15 ; Lead Pharmacist Title
S ZNOTE=" LEAD PHARMACIST TITLE - VALID"
Q
16 ; Lead Pharmacist License Number
S ZNOTE=" LEAD PHARMACIST LICENSE NUMBER - VALID"
Q
17 ; NPI Number - C (R - AFTER DDD)
S ZNOTE=" NPI NUMBER - Required - VALID "
I RETCODE(RIX)="" D
. I BPSJDDD=0 D
. . I '$D(RETCODE(2)) S ZNOTE=" NPI NUMBER - Warning NPI NUMBER Missing " Q
. . S ZNOTE="** NPI NUMBER - NPI OR NCPDP - Missing/Invalid" S RETCODE=17
. I BPSJDDD>0 D
. . S ZNOTE="** NPI NUMBER - Missing/Invalid" S RETCODE=17
. S RETCODE(RIX)=ZNOTE_RETCODE(RIX)
Q
;
TRIMTAIL(INSTR) ;
N OUTSTR,CHR
;
I $G(INSTR)="" Q "" ; quit if nothing there
;
S INSTR=$RE(INSTR)
S CHR=$E($TR(INSTR,CPS_REP))
I CHR]"" Q $RE($P(INSTR,CHR,2,200))_CHR
Q ""
;
; DECODE - Normalize data for display
; Input:
; INSTR - String to normalize
; Output
; Normalize data
DECODE(INSTR) ;
N TRCH
S TRCH("\F\")="|",TRCH("\R\")="~",TRCH("\E\")="\"
S TRCH("\T\")="&",TRCH("\S\")="^"
Q $$DECODE^BPSJZPR(INSTR,.TRCH)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HBPSJVAL2 5319 printed Sep 23, 2025@19:27:20 Page 2
BPSJVAL2 ;BHAM ISC/LJF - Validate Pharmacy data ;3/5/08 11:14
+1 ;;1.0;E CLAIMS MGMT ENGINE;**1,2,5,7**;JUN 2004;Build 46
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
+4 NEW PHARMIX,RET,DIR,X
+5 ;
+6 SET PHARMIX=0
SET X=""
+7 FOR
SET PHARMIX=$ORDER(^BPS(9002313.56,PHARMIX))
if 'PHARMIX
QUIT
Begin DoDot:1
+8 WRITE !!,"VERIFY PHARMACY REGISTRATIONS DATA.",!
+9 DO REG^BPSJPREG(PHARMIX,2)
+10 WRITE !
+11 SET DIR(0)="EO"
DO ^DIR
End DoDot:1
if X=U
QUIT
+12 ;
+13 QUIT
+14 ;
+15 ; Array HL and variable VERBOSE newed/set by calling routine
+16 ; RETCODE returned to calling routine
VALIDATE(BPSJDDD) ;
+1 NEW SEG,SEGIX,ZRP,RAY,RIX,PIX,PIXL,SEGDAT,ZNOTE,ZMAX,CPS,FS,REP
+2 NEW VALDATA,TMP
+3 SET ZMAX=17
+4 ;
+5 SET RETCODE=$GET(RETCODE)
+6 SET ZRP=""
SET RIX=0
+7 ;
+8 ; Set HL7 Delimiters - use standard defaults if none provided
+9 SET FS=$GET(HL("FS"))
IF FS=""
SET FS="|"
+10 SET CPS=$EXTRACT($GET(HL("ECH")))
IF CPS=""
SET CPS="^"
+11 SET REP=$EXTRACT($GET(HL("ECH")),2)
IF REP=""
SET REP="~"
+12 ;
+13 FOR SEGIX=3:1
SET SEG=$GET(^TMP("HLS",$JOB,SEGIX))
SET PIX=0
if SEG=""
QUIT
Begin DoDot:1
+14 IF $EXTRACT(SEG,1,3)="ZRP"
SET ZRP=$EXTRACT(SEG,4)
SET $EXTRACT(SEG,1,4)=""
End DoDot:1
IF ZRP]""
QUIT
+15 IF ZRP=""
QUIT
+16 FOR
SET RIX=$ORDER(^TMP("HLS",$JOB,SEGIX,RIX))
if 'RIX
QUIT
IF RIX<(ZMAX+1)
Begin DoDot:1
+17 SET TMP=$PIECE($GET(^TMP("HLS",$JOB,SEGIX,RIX)),ZRP)
+18 IF $GET(TMP)=""
SET RETCODE(RIX)=""
+19 ;capture pharmacy name
IF RIX=3
SET RETCODE(RIX)=TMP
End DoDot:1
+20 FOR
SET RIX=$ORDER(RETCODE(RIX))
if 'RIX
QUIT
Begin DoDot:1
+21 DO @RIX
+22 IF +$GET(VERBOSE)
IF $LENGTH($GET(RETCODE(RIX)))
WRITE !,RETCODE(RIX)
End DoDot:1
+23 ;
+24 QUIT
+25 ;
+26 ; NS=Not Supported, R=Required, RE=Required or empty, C=Conditional
+27 ; CE=Conditional or empty, O=Optional,
+28 ;
1 ; Set ID - NS
+1 QUIT
2 ; NCPDP Number - C
+1 SET ZNOTE=" NCPDP NUMBER - VALID"
+2 IF RETCODE(RIX)=""
Begin DoDot:1
+3 IF BPSJDDD=0
Begin DoDot:2
+4 IF '$DATA(RETCODE(17))
QUIT
+5 SET ZNOTE="** NCPDP NUMBER - NCPDP OR NPI - Missing/Invalid"
SET RETCODE=2
+6 SET RETCODE(RIX)=ZNOTE_RETCODE(RIX)
End DoDot:2
End DoDot:1
+7 QUIT
3 ; PHARMACY NAME - R
+1 SET ZNOTE=" PHARMACY NAME"
+2 IF RETCODE(RIX)=""
Begin DoDot:1
+3 SET ZNOTE="** PHARMACY NAME - Missing/Invalid"
SET RETCODE=3
End DoDot:1
+4 IF RETCODE(RIX)]""
SET RETCODE(RIX)=": "_$$DECODE(RETCODE(RIX))
+5 SET RETCODE(RIX)=ZNOTE_RETCODE(RIX)
+6 QUIT
4 ; DEA Number - R
+1 SET ZNOTE=" DEA NUMBER - Required - VALID"
+2 IF RETCODE(RIX)=""
Begin DoDot:1
+3 SET ZNOTE="** DEA NUMBER - Missing/Invalid"
SET RETCODE=4
+4 SET RETCODE(RIX)=ZNOTE_RETCODE(RIX)
End DoDot:1
+5 QUIT
5 ; Hour of Operation
+1 ; not sending anymore
SET ZNOTE=""
+2 QUIT
6 ; Mailing Address - R
+1 SET ZNOTE=$$TRIMTAIL(RETCODE(RIX))
+2 ; Street address
SET VALDATA=($LENGTH($PIECE(ZNOTE,CPS,1))<1)
+3 ; City
SET VALDATA=($LENGTH($PIECE(ZNOTE,CPS,3))<1)+VALDATA
+4 ; State
SET VALDATA=($LENGTH($PIECE(ZNOTE,CPS,4))<1)+VALDATA
+5 ; Zip
SET VALDATA=($LENGTH($PIECE(ZNOTE,CPS,5))<1)+VALDATA
+6 SET ZNOTE=" MAILING ADDRESS - Required - VALID"
+7 IF VALDATA
Begin DoDot:1
+8 SET ZNOTE="** MAILING ADDRESS - Missing/Invalid"
SET RETCODE=6
+9 SET RETCODE(RIX)=ZNOTE_RETCODE(RIX)
End DoDot:1
+10 QUIT
7 ; Remittance Address - R
+1 SET ZNOTE=$$TRIMTAIL(RETCODE(RIX))
+2 ; Street Address
SET VALDATA=($LENGTH($PIECE(ZNOTE,CPS,1))<1)
+3 ; City
SET VALDATA=($LENGTH($PIECE(ZNOTE,CPS,3))<1)+VALDATA
+4 ; State
SET VALDATA=($LENGTH($PIECE(ZNOTE,CPS,4))<1)+VALDATA
+5 ; Zip
SET VALDATA=($LENGTH($PIECE(ZNOTE,CPS,5))<1)+VALDATA
+6 SET ZNOTE=" REMITTANCE ADDRESS - Required - VALID"
+7 IF VALDATA
Begin DoDot:1
+8 SET ZNOTE="** REMITTANCE ADDRESS - Missing/Invalid"
SET RETCODE=7
+9 SET RETCODE(RIX)=ZNOTE_RETCODE(RIX)
End DoDot:1
+10 QUIT
8 ; Contact Name
+1 SET ZNOTE=$$TRIMTAIL(RETCODE(RIX))
+2 ; Surname
SET VALDATA=($LENGTH($PIECE(ZNOTE,CPS,1))<1)
+3 SET ZNOTE=" CONTACT NAME - Required - VALID"
+4 IF VALDATA
Begin DoDot:1
+5 SET ZNOTE="** CONTACT NAME - Missing/Invalid"
SET RETCODE=8
+6 SET RETCODE(RIX)=ZNOTE_RETCODE(RIX)
End DoDot:1
+7 QUIT
9 ; Contact Title
+1 SET ZNOTE=" CONTACT TITLE - VALID"
+2 QUIT
10 ; Contact means
+1 SET ZNOTE=" CONTACT MEANS - VALID"
+2 ;S RETCODE(RIX)=ZNOTE_RETCODE(RIX)
+3 QUIT
11 ; Alternate Contact Name
+1 SET ZNOTE=$$TRIMTAIL(RETCODE(RIX))
+2 ; Surname
SET VALDATA=($LENGTH($PIECE(ZNOTE,CPS,1))<1)
+3 SET ZNOTE=" ALTERNATE CONTACT NAME - Required - VALID"
+4 IF VALDATA
Begin DoDot:1
+5 SET ZNOTE="** ALTERNATE CONTACT NAME - Missing/Invalid"
SET RETCODE=11
+6 SET RETCODE(RIX)=ZNOTE_RETCODE(RIX)
End DoDot:1
+7 QUIT
12 ; Alternate Contact Title
+1 SET ZNOTE=" ALTERNATE CONTACT TITLE - VALID"
+2 QUIT
13 ; Alternate Contact means
+1 SET ZNOTE=" ALTERNATE CONTACT MEANS - VALID"
+2 QUIT
14 ; Lead Pharmacist Name - R
+1 SET ZNOTE=$$TRIMTAIL(RETCODE(RIX))
+2 ; Surname
SET VALDATA=($LENGTH($PIECE(ZNOTE,CPS,1))<1)
+3 SET ZNOTE=" LEAD PHARMACIST NAME - Required - VALID"
+4 IF VALDATA
Begin DoDot:1
+5 SET ZNOTE="** LEAD PHARMACIST NAME - Missing/Invalid"
SET RETCODE=14
+6 SET RETCODE(RIX)=ZNOTE_RETCODE(RIX)
End DoDot:1
+7 QUIT
15 ; Lead Pharmacist Title
+1 SET ZNOTE=" LEAD PHARMACIST TITLE - VALID"
+2 QUIT
16 ; Lead Pharmacist License Number
+1 SET ZNOTE=" LEAD PHARMACIST LICENSE NUMBER - VALID"
+2 QUIT
17 ; NPI Number - C (R - AFTER DDD)
+1 SET ZNOTE=" NPI NUMBER - Required - VALID "
+2 IF RETCODE(RIX)=""
Begin DoDot:1
+3 IF BPSJDDD=0
Begin DoDot:2
+4 IF '$DATA(RETCODE(2))
SET ZNOTE=" NPI NUMBER - Warning NPI NUMBER Missing "
QUIT
+5 SET ZNOTE="** NPI NUMBER - NPI OR NCPDP - Missing/Invalid"
SET RETCODE=17
End DoDot:2
+6 IF BPSJDDD>0
Begin DoDot:2
+7 SET ZNOTE="** NPI NUMBER - Missing/Invalid"
SET RETCODE=17
End DoDot:2
+8 SET RETCODE(RIX)=ZNOTE_RETCODE(RIX)
End DoDot:1
+9 QUIT
+10 ;
TRIMTAIL(INSTR) ;
+1 NEW OUTSTR,CHR
+2 ;
+3 ; quit if nothing there
IF $GET(INSTR)=""
QUIT ""
+4 ;
+5 SET INSTR=$REVERSE(INSTR)
+6 SET CHR=$EXTRACT($TRANSLATE(INSTR,CPS_REP))
+7 IF CHR]""
QUIT $REVERSE($PIECE(INSTR,CHR,2,200))_CHR
+8 QUIT ""
+9 ;
+10 ; DECODE - Normalize data for display
+11 ; Input:
+12 ; INSTR - String to normalize
+13 ; Output
+14 ; Normalize data
DECODE(INSTR) ;
+1 NEW TRCH
+2 SET TRCH("\F\")="|"
SET TRCH("\R\")="~"
SET TRCH("\E\")="\"
+3 SET TRCH("\T\")="&"
SET TRCH("\S\")="^"
+4 QUIT $$DECODE^BPSJZPR(INSTR,.TRCH)
