- 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 Feb 18, 2025@23:17:33 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