BPSJVAL1 ;BHAM ISC/LJF - Pharmacy Application Validation ;3/5/08 11:17
;;1.0;E CLAIMS MGMT ENGINE;**1,5,7,20**;JUN 2004;Build 27
;;Per VA Directive 6402, this routine should not be modified.
;
N BPSJVAL1,VERBOSE
W !!!,"SITE REGISTRATION VALIDATION.",!
D BPSJVAL^BPSJAREG(2)
W !!!!
;
Q
;
VALIDATE ; Validate ZQR Data
;
N SEG,SEGIX,ZQR,RIX,PIX,PIXL,SEGDAT,ZNOTE,ZMAX
N HL7EOIEN,HL7EODNS
N HL7EDOM,HL7PDOM,HL7OPORT,HL7PORT,CMA
;
; Constants
S HL7PORT=5105,ZMAX=8,CMA=","
S HL7PDOM=$S($$PROD^XUPROD:"EPHARMACY.VITRIA-EDI.AAC.DOMAIN.EXT",1:"EPHARMACY.VITRIA-EDI-TEST.AAC.DOMAIN.EXT")
;
S RETCODE=+$G(RETCODE)
S ZQR="",RIX=0
;
S HL7EOIEN=$$FIND1^DIC(870,"",,"EPHARM OUT","B")_CMA ;EPHARM OUT
;
; Vitria Mailman Domain name
S HL7EDOM=$$GET1^DIQ(870,HL7EOIEN,.03) ;EPHARM OUT
I HL7EDOM=HL7PDOM S ZNOTE=" DOMAIN NAME - Required - VALID: "_HL7PDOM
E D
. I HL7EDOM="" S ZNOTE="** DOMAIN NAME - Required - INVALID" S RETCODE=.3 Q
. S ZNOTE=" * WARNING: EXPECTED DOMAIN NAME: "_HL7PDOM_" CURRENT DOMAIN NAME: "_HL7EDOM
S RETCODE(.3)=ZNOTE
I +$G(VERBOSE) W !,RETCODE(.3)
;
; Get DNS address
S HL7EODNS=$$GET1^DIQ(870,HL7EOIEN,.08) ;EPHARM OUT
I HL7EODNS=HL7PDOM S ZNOTE=" DNS ADDRESS - Required - VALID: "_HL7EODNS
E D
. I HL7EODNS="" S ZNOTE="** DNS ADDRESS FOR ""EPHARM OUT"" is missing **",RETCODE=.7 Q
. S ZNOTE=" * WARNING: DNS ADDRESS = "_HL7EODNS_". EXPECTED DNS ADDRESS = "_HL7PDOM_" *"
S RETCODE(.7)=ZNOTE
I +$G(VERBOSE) W !,RETCODE(.7)
;
; Get Outgoing Port
S HL7OPORT=$$GET1^DIQ(870,HL7EOIEN,400.02) ;EPHARM OUT
I HL7OPORT,HL7OPORT=HL7PORT S ZNOTE=" ""EPHARM OUT"" PORT NUMBER - Required - VALID: "_HL7OPORT
E D
. S ZNOTE=" * WARNING: EXPECTED ""EPHARM OUT"" PORT NUMBER: "_HL7PORT
. S ZNOTE=ZNOTE_" CURRENT "
. S ZNOTE=ZNOTE_"""EPHARM OUT"" PORT NUMBER: "_HL7OPORT
. I 'HL7OPORT S ZNOTE="** ""EPHARM OUT"" PORT NUMBER - Required - INVALID",RETCODE=.9 Q
S RETCODE(.9)=ZNOTE
I +$G(VERBOSE) W !,RETCODE(.9)
;
F SEGIX=3:1 S SEG=$G(^TMP("HLS",$J,SEGIX)),PIX=0 Q:SEG="" D
. I $E(SEG,1,3)="ZQR" S ZQR=$E(SEG,4) S $E(SEG,1,4)=""
. I ZQR="" Q
. S PIXL=$L(SEG,ZQR)
. F S RIX=RIX+1,PIX=PIX+1 Q:RIX>ZMAX D
.. S RETCODE(RIX)=$P(SEG,ZQR,PIX) D @RIX
.. ; RIX 4 - EPHARM IN Port - no longer required nor validated
.. I +$G(VERBOSE),$L($G(RETCODE(RIX))),RIX'=4 W !,RETCODE(RIX) Q
;
Q
; NS=Not Supported, R=Required, RE=Required or empty, C=Conditional
; CE=Conditional or empty, O=Optional,
;
1 ; Set ID - NS
Q
2 ; Site Number - R
S ZNOTE=" SITE NUMBER - Required - VALID: "_RETCODE(RIX)
I RETCODE(RIX)="" S ZNOTE="** SITE NUMBER - Required - INVALID",RETCODE=2
S RETCODE(RIX)=ZNOTE
Q
3 ; Interface Version - R
; Must equal 2 or greater for this validation version
S ZNOTE=" INTERFACE VERSION - Required - VALID: "
I RETCODE(RIX)<2 S ZNOTE="** INTERFACE VERSION - Required - INVALID: ",RETCODE=3
S RETCODE(RIX)=ZNOTE_RETCODE(RIX)
Q
4 ; EPHARM IN port - NS
Q
5 ; Contact Name
S RETCODE(RIX)=" CONTACT NAME - VALID: "_$$FMNAME^HLFNC(RETCODE(RIX))
Q
6 ; Contact Means
S RETCODE(RIX)=" CONTACT MEANS - VALID: "_$P($TR(RETCODE(RIX),"^"," "),"~")
Q
7 ; Alternate Contact NAME
S RETCODE(RIX)=" ALTERNATE CONTACT NAME - VALID: "_$$FMNAME^HLFNC(RETCODE(RIX))
Q
8 ; Alternate Contact Means
S RETCODE(RIX)=" ALTERNATE CONTACT MEANS - VALID: "_$P($TR(RETCODE(RIX),"^"," "),"~")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HBPSJVAL1 3534 printed Apr 09, 2024@20:55:30 Page 2
BPSJVAL1 ;BHAM ISC/LJF - Pharmacy Application Validation ;3/5/08 11:17
+1 ;;1.0;E CLAIMS MGMT ENGINE;**1,5,7,20**;JUN 2004;Build 27
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 NEW BPSJVAL1,VERBOSE
+5 WRITE !!!,"SITE REGISTRATION VALIDATION.",!
+6 DO BPSJVAL^BPSJAREG(2)
+7 WRITE !!!!
+8 ;
+9 QUIT
+10 ;
VALIDATE ; Validate ZQR Data
+1 ;
+2 NEW SEG,SEGIX,ZQR,RIX,PIX,PIXL,SEGDAT,ZNOTE,ZMAX
+3 NEW HL7EOIEN,HL7EODNS
+4 NEW HL7EDOM,HL7PDOM,HL7OPORT,HL7PORT,CMA
+5 ;
+6 ; Constants
+7 SET HL7PORT=5105
SET ZMAX=8
SET CMA=","
+8 SET HL7PDOM=$SELECT($$PROD^XUPROD:"EPHARMACY.VITRIA-EDI.AAC.DOMAIN.EXT",1:"EPHARMACY.VITRIA-EDI-TEST.AAC.DOMAIN.EXT")
+9 ;
+10 SET RETCODE=+$GET(RETCODE)
+11 SET ZQR=""
SET RIX=0
+12 ;
+13 ;EPHARM OUT
SET HL7EOIEN=$$FIND1^DIC(870,"",,"EPHARM OUT","B")_CMA
+14 ;
+15 ; Vitria Mailman Domain name
+16 ;EPHARM OUT
SET HL7EDOM=$$GET1^DIQ(870,HL7EOIEN,.03)
+17 IF HL7EDOM=HL7PDOM
SET ZNOTE=" DOMAIN NAME - Required - VALID: "_HL7PDOM
+18 IF '$TEST
Begin DoDot:1
+19 IF HL7EDOM=""
SET ZNOTE="** DOMAIN NAME - Required - INVALID"
SET RETCODE=.3
QUIT
+20 SET ZNOTE=" * WARNING: EXPECTED DOMAIN NAME: "_HL7PDOM_" CURRENT DOMAIN NAME: "_HL7EDOM
End DoDot:1
+21 SET RETCODE(.3)=ZNOTE
+22 IF +$GET(VERBOSE)
WRITE !,RETCODE(.3)
+23 ;
+24 ; Get DNS address
+25 ;EPHARM OUT
SET HL7EODNS=$$GET1^DIQ(870,HL7EOIEN,.08)
+26 IF HL7EODNS=HL7PDOM
SET ZNOTE=" DNS ADDRESS - Required - VALID: "_HL7EODNS
+27 IF '$TEST
Begin DoDot:1
+28 IF HL7EODNS=""
SET ZNOTE="** DNS ADDRESS FOR ""EPHARM OUT"" is missing **"
SET RETCODE=.7
QUIT
+29 SET ZNOTE=" * WARNING: DNS ADDRESS = "_HL7EODNS_". EXPECTED DNS ADDRESS = "_HL7PDOM_" *"
End DoDot:1
+30 SET RETCODE(.7)=ZNOTE
+31 IF +$GET(VERBOSE)
WRITE !,RETCODE(.7)
+32 ;
+33 ; Get Outgoing Port
+34 ;EPHARM OUT
SET HL7OPORT=$$GET1^DIQ(870,HL7EOIEN,400.02)
+35 IF HL7OPORT
IF HL7OPORT=HL7PORT
SET ZNOTE=" ""EPHARM OUT"" PORT NUMBER - Required - VALID: "_HL7OPORT
+36 IF '$TEST
Begin DoDot:1
+37 SET ZNOTE=" * WARNING: EXPECTED ""EPHARM OUT"" PORT NUMBER: "_HL7PORT
+38 SET ZNOTE=ZNOTE_" CURRENT "
+39 SET ZNOTE=ZNOTE_"""EPHARM OUT"" PORT NUMBER: "_HL7OPORT
+40 IF 'HL7OPORT
SET ZNOTE="** ""EPHARM OUT"" PORT NUMBER - Required - INVALID"
SET RETCODE=.9
QUIT
End DoDot:1
+41 SET RETCODE(.9)=ZNOTE
+42 IF +$GET(VERBOSE)
WRITE !,RETCODE(.9)
+43 ;
+44 FOR SEGIX=3:1
SET SEG=$GET(^TMP("HLS",$JOB,SEGIX))
SET PIX=0
if SEG=""
QUIT
Begin DoDot:1
+45 IF $EXTRACT(SEG,1,3)="ZQR"
SET ZQR=$EXTRACT(SEG,4)
SET $EXTRACT(SEG,1,4)=""
+46 IF ZQR=""
QUIT
+47 SET PIXL=$LENGTH(SEG,ZQR)
+48 FOR
SET RIX=RIX+1
SET PIX=PIX+1
if RIX>ZMAX
QUIT
Begin DoDot:2
+49 SET RETCODE(RIX)=$PIECE(SEG,ZQR,PIX)
DO @RIX
+50 ; RIX 4 - EPHARM IN Port - no longer required nor validated
+51 IF +$GET(VERBOSE)
IF $LENGTH($GET(RETCODE(RIX)))
IF RIX'=4
WRITE !,RETCODE(RIX)
QUIT
End DoDot:2
End DoDot:1
+52 ;
+53 QUIT
+54 ; NS=Not Supported, R=Required, RE=Required or empty, C=Conditional
+55 ; CE=Conditional or empty, O=Optional,
+56 ;
1 ; Set ID - NS
+1 QUIT
2 ; Site Number - R
+1 SET ZNOTE=" SITE NUMBER - Required - VALID: "_RETCODE(RIX)
+2 IF RETCODE(RIX)=""
SET ZNOTE="** SITE NUMBER - Required - INVALID"
SET RETCODE=2
+3 SET RETCODE(RIX)=ZNOTE
+4 QUIT
3 ; Interface Version - R
+1 ; Must equal 2 or greater for this validation version
+2 SET ZNOTE=" INTERFACE VERSION - Required - VALID: "
+3 IF RETCODE(RIX)<2
SET ZNOTE="** INTERFACE VERSION - Required - INVALID: "
SET RETCODE=3
+4 SET RETCODE(RIX)=ZNOTE_RETCODE(RIX)
+5 QUIT
4 ; EPHARM IN port - NS
+1 QUIT
5 ; Contact Name
+1 SET RETCODE(RIX)=" CONTACT NAME - VALID: "_$$FMNAME^HLFNC(RETCODE(RIX))
+2 QUIT
6 ; Contact Means
+1 SET RETCODE(RIX)=" CONTACT MEANS - VALID: "_$PIECE($TRANSLATE(RETCODE(RIX),"^"," "),"~")
+2 QUIT
7 ; Alternate Contact NAME
+1 SET RETCODE(RIX)=" ALTERNATE CONTACT NAME - VALID: "_$$FMNAME^HLFNC(RETCODE(RIX))
+2 QUIT
8 ; Alternate Contact Means
+1 SET RETCODE(RIX)=" ALTERNATE CONTACT MEANS - VALID: "_$PIECE($TRANSLATE(RETCODE(RIX),"^"," "),"~")
+2 QUIT
