BPSJZQR ;BHAM ISC/LJF - HL7 Registration ZQR Message ;3/3/08 17:03
;;1.0;E CLAIMS MGMT ENGINE;**1,3,7,15**;JUN 2004;Build 13
;;Per VHA Directive 2004-038, this routine should not be modified.
;
; ZQR is pharmacy site registration info
;
EN(HL) N BPSZQR,BPSFS,BPSCPS,BPSREP,BPSVA1,BPSVA2,BPSCNF,BPSI
;
; Normally: HL("FS")="|" HL("ECH")="^~\&"
S BPSFS=$G(HL("FS")) I BPSFS="" S BPSFS="|"
S BPSCPS=$E($G(HL("ECH"))) I BPSCPS="" S BPSCPS="^"
S BPSREP=$E($G(HL("ECH")),2) I BPSREP="" S BPSREP="~"
;
S BPSZQR=BPSFS_(+$P($G(HL("SITE")),"^",3))
;
; Get Contact Info
S BPSVA1=$G(^BPS(9002313.99,1,"VITRIA")),BPSVA2=$P(BPSVA1,"^",2)
;
; Get Version number
S BPSZQR=BPSZQR_BPSFS_$P(BPSVA1,"^",3)
;
; Port
S BPSZQR=BPSZQR_BPSFS_$$EPPORT^BPSJUTL ;modified to find multi threaded listener - BPS*1*15
;
; Load the Name and Means Fields
; Default the values to null
F BPSI=5:1:8 S $P(BPSZQR,BPSFS,BPSI)=""
; Contact
I BPSVA1 D
. S BPSCNF=$$VA200NM^BPSJUTL(+BPSVA1,"",.HL) I BPSCNF]"" S $P(BPSZQR,BPSFS,5)=BPSCNF
. S BPSCNF=$$VA20013^BPSJUTL(+BPSVA1,.HL) I BPSCNF]"" S $P(BPSZQR,BPSFS,6)=BPSCNF
;
; Alternate Contact
I BPSVA2 D
. S BPSCNF=$$VA200NM^BPSJUTL(BPSVA2,"",.HL) I BPSCNF]"" S $P(BPSZQR,BPSFS,7)=BPSCNF
. S BPSCNF=$$VA20013^BPSJUTL(BPSVA2,.HL) I BPSCNF]"" S $P(BPSZQR,BPSFS,8)=BPSCNF
;
Q "ZQR|"_BPSZQR
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HBPSJZQR 1371 printed Sep 23, 2025@19:27:22 Page 2
BPSJZQR ;BHAM ISC/LJF - HL7 Registration ZQR Message ;3/3/08 17:03
+1 ;;1.0;E CLAIMS MGMT ENGINE;**1,3,7,15**;JUN 2004;Build 13
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
+4 ; ZQR is pharmacy site registration info
+5 ;
EN(HL) NEW BPSZQR,BPSFS,BPSCPS,BPSREP,BPSVA1,BPSVA2,BPSCNF,BPSI
+1 ;
+2 ; Normally: HL("FS")="|" HL("ECH")="^~\&"
+3 SET BPSFS=$GET(HL("FS"))
IF BPSFS=""
SET BPSFS="|"
+4 SET BPSCPS=$EXTRACT($GET(HL("ECH")))
IF BPSCPS=""
SET BPSCPS="^"
+5 SET BPSREP=$EXTRACT($GET(HL("ECH")),2)
IF BPSREP=""
SET BPSREP="~"
+6 ;
+7 SET BPSZQR=BPSFS_(+$PIECE($GET(HL("SITE")),"^",3))
+8 ;
+9 ; Get Contact Info
+10 SET BPSVA1=$GET(^BPS(9002313.99,1,"VITRIA"))
SET BPSVA2=$PIECE(BPSVA1,"^",2)
+11 ;
+12 ; Get Version number
+13 SET BPSZQR=BPSZQR_BPSFS_$PIECE(BPSVA1,"^",3)
+14 ;
+15 ; Port
+16 ;modified to find multi threaded listener - BPS*1*15
SET BPSZQR=BPSZQR_BPSFS_$$EPPORT^BPSJUTL
+17 ;
+18 ; Load the Name and Means Fields
+19 ; Default the values to null
+20 FOR BPSI=5:1:8
SET $PIECE(BPSZQR,BPSFS,BPSI)=""
+21 ; Contact
+22 IF BPSVA1
Begin DoDot:1
+23 SET BPSCNF=$$VA200NM^BPSJUTL(+BPSVA1,"",.HL)
IF BPSCNF]""
SET $PIECE(BPSZQR,BPSFS,5)=BPSCNF
+24 SET BPSCNF=$$VA20013^BPSJUTL(+BPSVA1,.HL)
IF BPSCNF]""
SET $PIECE(BPSZQR,BPSFS,6)=BPSCNF
End DoDot:1
+25 ;
+26 ; Alternate Contact
+27 IF BPSVA2
Begin DoDot:1
+28 SET BPSCNF=$$VA200NM^BPSJUTL(BPSVA2,"",.HL)
IF BPSCNF]""
SET $PIECE(BPSZQR,BPSFS,7)=BPSCNF
+29 SET BPSCNF=$$VA20013^BPSJUTL(BPSVA2,.HL)
IF BPSCNF]""
SET $PIECE(BPSZQR,BPSFS,8)=BPSCNF
End DoDot:1
+30 ;
+31 QUIT "ZQR|"_BPSZQR
