Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BPSJVAL2

BPSJVAL2.m

Go to the documentation of this file.
  1. 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
  1. ;;Per VHA Directive 2004-038, this routine should not be modified.
  1. ;
  1. N PHARMIX,RET,DIR,X
  1. ;
  1. S PHARMIX=0,X=""
  1. F S PHARMIX=$O(^BPS(9002313.56,PHARMIX)) Q:'PHARMIX D Q:X=U
  1. . W !!,"VERIFY PHARMACY REGISTRATIONS DATA.",!
  1. . D REG^BPSJPREG(PHARMIX,2)
  1. . W !
  1. . S DIR(0)="EO" D ^DIR
  1. ;
  1. Q
  1. ;
  1. ; Array HL and variable VERBOSE newed/set by calling routine
  1. ; RETCODE returned to calling routine
  1. VALIDATE(BPSJDDD) ;
  1. N SEG,SEGIX,ZRP,RAY,RIX,PIX,PIXL,SEGDAT,ZNOTE,ZMAX,CPS,FS,REP
  1. N VALDATA,TMP
  1. S ZMAX=17
  1. ;
  1. S RETCODE=$G(RETCODE)
  1. S ZRP="",RIX=0
  1. ;
  1. ; Set HL7 Delimiters - use standard defaults if none provided
  1. S FS=$G(HL("FS")) I FS="" S FS="|"
  1. S CPS=$E($G(HL("ECH"))) I CPS="" S CPS="^"
  1. S REP=$E($G(HL("ECH")),2) I REP="" S REP="~"
  1. ;
  1. F SEGIX=3:1 S SEG=$G(^TMP("HLS",$J,SEGIX)),PIX=0 Q:SEG="" D I ZRP]"" Q
  1. . I $E(SEG,1,3)="ZRP" S ZRP=$E(SEG,4) S $E(SEG,1,4)=""
  1. I ZRP="" Q
  1. F S RIX=$O(^TMP("HLS",$J,SEGIX,RIX)) Q:'RIX I RIX<(ZMAX+1) D
  1. . S TMP=$P($G(^TMP("HLS",$J,SEGIX,RIX)),ZRP)
  1. . I $G(TMP)="" S RETCODE(RIX)=""
  1. . I RIX=3 S RETCODE(RIX)=TMP ;capture pharmacy name
  1. F S RIX=$O(RETCODE(RIX)) Q:'RIX D
  1. . D @RIX
  1. . I +$G(VERBOSE),$L($G(RETCODE(RIX))) W !,RETCODE(RIX)
  1. ;
  1. Q
  1. ;
  1. ; NS=Not Supported, R=Required, RE=Required or empty, C=Conditional
  1. ; CE=Conditional or empty, O=Optional,
  1. ;
  1. 1 ; Set ID - NS
  1. Q
  1. 2 ; NCPDP Number - C
  1. S ZNOTE=" NCPDP NUMBER - VALID"
  1. I RETCODE(RIX)="" D
  1. . I BPSJDDD=0 D
  1. . . I '$D(RETCODE(17)) Q
  1. . . S ZNOTE="** NCPDP NUMBER - NCPDP OR NPI - Missing/Invalid",RETCODE=2
  1. . . S RETCODE(RIX)=ZNOTE_RETCODE(RIX)
  1. Q
  1. 3 ; PHARMACY NAME - R
  1. S ZNOTE=" PHARMACY NAME"
  1. I RETCODE(RIX)="" D
  1. . S ZNOTE="** PHARMACY NAME - Missing/Invalid",RETCODE=3
  1. I RETCODE(RIX)]"" S RETCODE(RIX)=": "_$$DECODE(RETCODE(RIX))
  1. S RETCODE(RIX)=ZNOTE_RETCODE(RIX)
  1. Q
  1. 4 ; DEA Number - R
  1. S ZNOTE=" DEA NUMBER - Required - VALID"
  1. I RETCODE(RIX)="" D
  1. . S ZNOTE="** DEA NUMBER - Missing/Invalid",RETCODE=4
  1. . S RETCODE(RIX)=ZNOTE_RETCODE(RIX)
  1. Q
  1. 5 ; Hour of Operation
  1. S ZNOTE="" ; not sending anymore
  1. Q
  1. 6 ; Mailing Address - R
  1. S ZNOTE=$$TRIMTAIL(RETCODE(RIX))
  1. S VALDATA=($L($P(ZNOTE,CPS,1))<1) ; Street address
  1. S VALDATA=($L($P(ZNOTE,CPS,3))<1)+VALDATA ; City
  1. S VALDATA=($L($P(ZNOTE,CPS,4))<1)+VALDATA ; State
  1. S VALDATA=($L($P(ZNOTE,CPS,5))<1)+VALDATA ; Zip
  1. S ZNOTE=" MAILING ADDRESS - Required - VALID"
  1. I VALDATA D
  1. . S ZNOTE="** MAILING ADDRESS - Missing/Invalid",RETCODE=6
  1. . S RETCODE(RIX)=ZNOTE_RETCODE(RIX)
  1. Q
  1. 7 ; Remittance Address - R
  1. S ZNOTE=$$TRIMTAIL(RETCODE(RIX))
  1. S VALDATA=($L($P(ZNOTE,CPS,1))<1) ; Street Address
  1. S VALDATA=($L($P(ZNOTE,CPS,3))<1)+VALDATA ; City
  1. S VALDATA=($L($P(ZNOTE,CPS,4))<1)+VALDATA ; State
  1. S VALDATA=($L($P(ZNOTE,CPS,5))<1)+VALDATA ; Zip
  1. S ZNOTE=" REMITTANCE ADDRESS - Required - VALID"
  1. I VALDATA D
  1. . S ZNOTE="** REMITTANCE ADDRESS - Missing/Invalid",RETCODE=7
  1. . S RETCODE(RIX)=ZNOTE_RETCODE(RIX)
  1. Q
  1. 8 ; Contact Name
  1. S ZNOTE=$$TRIMTAIL(RETCODE(RIX))
  1. S VALDATA=($L($P(ZNOTE,CPS,1))<1) ; Surname
  1. S ZNOTE=" CONTACT NAME - Required - VALID"
  1. I VALDATA D
  1. . S ZNOTE="** CONTACT NAME - Missing/Invalid",RETCODE=8
  1. . S RETCODE(RIX)=ZNOTE_RETCODE(RIX)
  1. Q
  1. 9 ; Contact Title
  1. S ZNOTE=" CONTACT TITLE - VALID"
  1. Q
  1. 10 ; Contact means
  1. S ZNOTE=" CONTACT MEANS - VALID"
  1. ;S RETCODE(RIX)=ZNOTE_RETCODE(RIX)
  1. Q
  1. 11 ; Alternate Contact Name
  1. S ZNOTE=$$TRIMTAIL(RETCODE(RIX))
  1. S VALDATA=($L($P(ZNOTE,CPS,1))<1) ; Surname
  1. S ZNOTE=" ALTERNATE CONTACT NAME - Required - VALID"
  1. I VALDATA D
  1. . S ZNOTE="** ALTERNATE CONTACT NAME - Missing/Invalid",RETCODE=11
  1. . S RETCODE(RIX)=ZNOTE_RETCODE(RIX)
  1. Q
  1. 12 ; Alternate Contact Title
  1. S ZNOTE=" ALTERNATE CONTACT TITLE - VALID"
  1. Q
  1. 13 ; Alternate Contact means
  1. S ZNOTE=" ALTERNATE CONTACT MEANS - VALID"
  1. Q
  1. 14 ; Lead Pharmacist Name - R
  1. S ZNOTE=$$TRIMTAIL(RETCODE(RIX))
  1. S VALDATA=($L($P(ZNOTE,CPS,1))<1) ; Surname
  1. S ZNOTE=" LEAD PHARMACIST NAME - Required - VALID"
  1. I VALDATA D
  1. . S ZNOTE="** LEAD PHARMACIST NAME - Missing/Invalid",RETCODE=14
  1. . S RETCODE(RIX)=ZNOTE_RETCODE(RIX)
  1. Q
  1. 15 ; Lead Pharmacist Title
  1. S ZNOTE=" LEAD PHARMACIST TITLE - VALID"
  1. Q
  1. 16 ; Lead Pharmacist License Number
  1. S ZNOTE=" LEAD PHARMACIST LICENSE NUMBER - VALID"
  1. Q
  1. 17 ; NPI Number - C (R - AFTER DDD)
  1. S ZNOTE=" NPI NUMBER - Required - VALID "
  1. I RETCODE(RIX)="" D
  1. . I BPSJDDD=0 D
  1. . . I '$D(RETCODE(2)) S ZNOTE=" NPI NUMBER - Warning NPI NUMBER Missing " Q
  1. . . S ZNOTE="** NPI NUMBER - NPI OR NCPDP - Missing/Invalid" S RETCODE=17
  1. . I BPSJDDD>0 D
  1. . . S ZNOTE="** NPI NUMBER - Missing/Invalid" S RETCODE=17
  1. . S RETCODE(RIX)=ZNOTE_RETCODE(RIX)
  1. Q
  1. ;
  1. TRIMTAIL(INSTR) ;
  1. N OUTSTR,CHR
  1. ;
  1. I $G(INSTR)="" Q "" ; quit if nothing there
  1. ;
  1. S INSTR=$RE(INSTR)
  1. S CHR=$E($TR(INSTR,CPS_REP))
  1. I CHR]"" Q $RE($P(INSTR,CHR,2,200))_CHR
  1. Q ""
  1. ;
  1. ; DECODE - Normalize data for display
  1. ; Input:
  1. ; INSTR - String to normalize
  1. ; Output
  1. ; Normalize data
  1. DECODE(INSTR) ;
  1. N TRCH
  1. S TRCH("\F\")="|",TRCH("\R\")="~",TRCH("\E\")="\"
  1. S TRCH("\T\")="&",TRCH("\S\")="^"
  1. Q $$DECODE^BPSJZPR(INSTR,.TRCH)