BPSJZQR.m

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 ---BPSJZQR   1371     printed  Apr 09, 2024@20:58: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