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

BPSJZRP.m

Go to the documentation of this file. 
  1. BPSJZRP ;BHAM ISC/LJF - HL7 Registration ZRP Message ;3/5/08  10:41
  1.  ;;1.0;E CLAIMS MGMT ENGINE;**1,2,7**;JUN 2004;Build 46
  1.  ;;Per VHA Directive 2004-038, this routine should not be modified.
  1.  ;
  1. EN(HL,PHIX,ZRP,NPI,NCP) ;
  1.  ; ZRP array contains pharmacy registration info
  1.  N ZRPS,FS,CPS,REP,NDZRO,NDHRS,NDREM,NDREP,NDREP1,NDADD,STATE
  1.  N VAIX1,VAIX2,VAIXLP,VATLE,CNF,MSGCNT,TCH
  1.  ;
  1.  ; Quit if no Pharmacy index provided
  1.  I '$G(PHIX) Q
  1.  ;
  1.  K ZRP S ZRPS=""
  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.  S NDZRO=$G(^BPS(9002313.56,PHIX,0))
  1.  S NDREM=$G(^BPS(9002313.56,PHIX,"REMIT"))
  1.  S NDREP=$G(^BPS(9002313.56,PHIX,"REP"))
  1.  S NDREP1=$G(^BPS(9002313.56,PHIX,"REP1"))
  1.  S NDADD=$G(^BPS(9002313.56,PHIX,"ADDR"))
  1.  ;
  1.  F ZRP=1:1:17 S ZRP(ZRP)="" ;Initialize
  1.  S (ZRP(2),NCP)=$P(NDZRO,U,2)     ;NCPDP #
  1.  S ZRP(3)=$P(NDZRO,U)       ;NAME
  1.  S ZRP(4)=$P(NDZRO,U,3)     ;DEFAULT DEA #
  1.  ;
  1.  I $L($P(NDADD,U,8)) S $P(ZRPS,CPS,1)=$P(NDADD,U,8)  ;SITE ADDRESS NAME
  1.  I $L($P(NDADD,U,1)) S $P(ZRPS,CPS,1)=$P(ZRPS,CPS,1)_" "_$P(NDADD,U,1)  ;SITE ADDRESS 1
  1.  I $L($P(NDADD,U,2)) S $P(ZRPS,CPS,2)=$P(NDADD,U,2)  ;SITE ADDRESS 2
  1.  I $L($P(NDADD,U,3)) S $P(ZRPS,CPS,3)=$P(NDADD,U,3)  ;CITY
  1.  I $L($P(NDADD,U,4)) S STATE=$P(NDADD,U,4) I STATE D  ; State
  1.  . S STATE=$P($G(^DIC(5,STATE,0)),U,2)
  1.  . I STATE]"" S $P(ZRPS,CPS,4)=STATE
  1.  I $L($P(NDADD,U,5)) S $P(ZRPS,CPS,5)=$P(NDADD,U,5)  ;ZIP
  1.  I ZRPS]"" S ZRP(6)=ZRPS,ZRPS=""
  1.  ;
  1.  I $L($P(NDREM,U,1)) S $P(ZRPS,CPS,1)=$P(NDREM,U,1)   ;REMITTANCE ADDRESS NAME
  1.  I $L($P(NDREM,U,2)) S $P(ZRPS,CPS,1)=$P(ZRPS,CPS,1)_" "_$P(NDREM,U,2)  ;REMIT ADDRESS LINE 1
  1.  I $L($P(NDREM,U,3)) S $P(ZRPS,CPS,2)=$P(NDREM,U,3)   ;REMIT ADDRESS LINE 2
  1.  I $L($P(NDREM,U,6)) S $P(ZRPS,CPS,3)=$P(NDREM,U,6)   ;CITY
  1.  I $L($P(NDREM,U,7)) S STATE=$P(NDREM,U,7) I STATE D  ;State
  1.  . S STATE=$P($G(^DIC(5,STATE,0)),U,2)
  1.  . I STATE]"" S $P(ZRPS,CPS,4)=STATE
  1.  I $L($P(NDREM,U,8)) S $P(ZRPS,CPS,5)=$P(NDREM,U,8)  ;ZIP
  1.  I ZRPS]"" S ZRP(7)=ZRPS,ZRPS=""
  1.  ;
  1.  ; Load the Name and Means Fields
  1.  S VAIX1=$P(NDREP,U,3)
  1.  S VAIX2=$P(NDREP,U,4)
  1.  S VAIXLP=$P(NDREP,U,5)
  1.  ;
  1.  ; Contact
  1.  I $G(VAIX1) S VATLE="" D
  1.  . S CNF=$$VA200NM^BPSJUTL(VAIX1,.VATLE,.HL) I CNF]"" S ZRP(8)=CNF
  1.  . I VATLE]"" S ZRP(9)=VATLE
  1.  . S CNF=$$VA20013^BPSJUTL(VAIX1,.HL) I CNF]"" S ZRP(10)=CNF
  1.  ;
  1.  ; Alternate Contact
  1.  I $G(VAIX2) S VATLE="" D
  1.  . S CNF=$$VA200NM^BPSJUTL(VAIX2,.VATLE,.HL) I CNF]"" S ZRP(11)=CNF
  1.  . I VATLE]"" S ZRP(12)=VATLE
  1.  . S CNF=$$VA20013^BPSJUTL(VAIX2,.HL) I CNF]"" S ZRP(13)=CNF
  1.  ;
  1.  ; Lead Pharmacist
  1.  I $G(VAIXLP) S VATLE="" D
  1.  . S CNF=$$VA200NM^BPSJUTL(VAIXLP,.VATLE,.HL) I CNF]"" S ZRP(14)=CNF
  1.  . I VATLE]"" S ZRP(15)=VATLE
  1.  ;
  1.  ; Pharmacist's License
  1.  I $L($P(NDREP1,U)) S ZRP(16)=$P(NDREP1,U)
  1.  ;
  1.  ; NPI
  1.  S ZRP(17)=$G(NPI)
  1.  ;
  1.  ; Encode special chars. Add Field separators.
  1.  S TCH("\")="\E\",TCH("&")="\T\",TCH("|")="\F\"
  1.  S (ZRPS(5),ZRPS(10),ZRPS(13))=1  ;Fields with HL7 repetion chars
  1.  F ZRP=17:-1:1 D  S ZRP(ZRP)=$$ENCODE^BPSJUTL(ZRP(ZRP),.TCH)_FS
  1.  . I $G(ZRPS(ZRP)) K TCH("~")  ; don't convert repetion chars
  1.  . E  S TCH("~")="\R\"         ; ok to convert repetion chars
  1.  S ZRP="ZRP|"
  1.  ;
  1.  Q
  1.  ;