source: WorldVistAEHR/trunk/r/E_CLAIMS_MGMT_ENGINE-BPS/BPSJVAL1.m@ 1150

Last change on this file since 1150 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.5 KB
Line 
1BPSJVAL1 ;BHAM ISC/LJF - Pharmacy Application Validation ;2004-03-01
2 ;;1.0;E CLAIMS MGMT ENGINE;**1,5**;JUN 2004;Build 45
3 ;;Per VHA Directive 2004-038, this routine should not be modified.
4 ;
5 N BPSJVAL1,VERBOSE
6 W !!!,"SITE REGISTRATION VALIDATION.",!
7 D BPSJVAL^BPSJAREG(2)
8 W !!!!
9 ;
10 Q
11 ;
12VALIDATE ; Validate ZQR Data
13 ;
14 N SEG,SEGIX,ZQR,RIX,PIX,PIXL,SEGDAT,ZNOTE,ZMAX
15 N HL7EOIEN,HL7EOIP
16 N HL7VOIEN,HL7VOIP
17 N HL7EDOM,HL7PDOM,HL7OPORT,HL7PORT,CMA
18 ;
19 ; Constants
20 S HL7PORT=5105,ZMAX=8,CMA=","
21 S HL7PDOM="EPHARMACY.VITRIA-EDI.AAC.VA.GOV"
22 ;
23 S RETCODE=+$G(RETCODE)
24 S ZQR="",RIX=0
25 ;
26 S HL7EOIEN=$$FIND1^DIC(870,"",,"EPHARM OUT","B")_CMA ;EPHARM OUT
27 S HL7VOIEN=$$FIND1^DIC(870,"",,"IIV EC","B")_CMA ;IIV EC
28 ;
29 ; Vitria Domain name
30 S HL7EDOM=$$GET1^DIQ(870,HL7EOIEN,.03) ;EPHARM OUT
31 I HL7EDOM=HL7PDOM S ZNOTE=" DOMAIN NAME - Required - VALID: "_HL7PDOM
32 E D
33 . I HL7EDOM="" S ZNOTE="** DOMAIN NAME - Required - INVALID" S RETCODE=.3 Q
34 . S ZNOTE=" * WARNING: EXPECTED DOMAIN NAME: "_HL7PDOM_" CURRENT DOMAIN NAME: "_HL7EDOM
35 S RETCODE(.3)=ZNOTE
36 I +$G(VERBOSE) W !,RETCODE(.3)
37 ;
38 ; Get IP addresses
39 S HL7EOIP=$$GET1^DIQ(870,HL7EOIEN,400.01) ;EPHARM OUT
40 S HL7VOIP=$$GET1^DIQ(870,HL7VOIEN,400.01) ;IIV EC
41 ;
42 I HL7EOIP,HL7EOIP=HL7VOIP S ZNOTE=" TCP/IP ADDRESS FOR ""EPHARM OUT"" - Required - VALID: "_HL7EOIP
43 E D
44 . I 'HL7EOIP S ZNOTE="** TCP/IP ADDRESS FOR ""EPHARM OUT"" - Required - INVALID",RETCODE=.7 Q
45 . I HL7VOIP,HL7EOIP'=HL7VOIP S ZNOTE=" * WARNING: ""EPHARM OUT"" TCP/IP ADDRESS DIFFERENT THAN ""IIV EC"" TCP/IP ADDRESS. EPHARM OUT: "_HL7EOIP_" IIV EC: "_HL7VOIP
46 S RETCODE(.7)=ZNOTE
47 I +$G(VERBOSE) W !,RETCODE(.7)
48 ;
49 ; Get Outgoing Port and IP Address
50 S HL7OPORT=$$GET1^DIQ(870,HL7EOIEN,400.02) ;EPHARM OUT
51 I HL7OPORT,HL7OPORT=HL7PORT S ZNOTE=" ""EPHARM OUT"" PORT NUMBER - Required - VALID: "_HL7OPORT
52 E D
53 . S ZNOTE=" * WARNING: EXPECTED ""EPHARM OUT"" PORT NUMBER: "_HL7PORT
54 . S ZNOTE=ZNOTE_" CURRENT "
55 . S ZNOTE=ZNOTE_"""EPHARM OUT"" PORT NUMBER: "_HL7OPORT
56 . I 'HL7OPORT S ZNOTE="** ""EPHARM OUT"" PORT NUMBER - Required - INVALID",RETCODE=.9 Q
57 S RETCODE(.9)=ZNOTE
58 I +$G(VERBOSE) W !,RETCODE(.9)
59 ;
60 F SEGIX=3:1 S SEG=$G(^TMP("HLS",$J,SEGIX)),PIX=0 Q:SEG="" D
61 . I $E(SEG,1,3)="ZQR" S ZQR=$E(SEG,4) S $E(SEG,1,4)=""
62 . I ZQR="" Q
63 . S PIXL=$L(SEG,ZQR)
64 . F S RIX=RIX+1,PIX=PIX+1 Q:RIX>ZMAX D
65 .. S RETCODE(RIX)=$P(SEG,ZQR,PIX) D @RIX
66 .. ; RIX 4 - EPHARM IN Port - no longer required nor validated
67 .. I +$G(VERBOSE),$L($G(RETCODE(RIX))),RIX'=4 W !,RETCODE(RIX) Q
68 ;
69 Q
70 ; NS=Not Supported, R=Required, RE=Required or empty, C=Conditional
71 ; CE=Conditional or empty, O=Optional,
72 ;
731 ; Set ID - NS
74 Q
752 ; Site Number - R
76 S ZNOTE=" SITE NUMBER - Required - VALID: "_RETCODE(RIX)
77 I RETCODE(RIX)="" S ZNOTE="** SITE NUMBER - Required - INVALID",RETCODE=2
78 S RETCODE(RIX)=ZNOTE
79 Q
803 ; Interface Version - R
81 ; Must equal 2 or greater for this validation version
82 S ZNOTE=" INTERFACE VERSION - Required - VALID: "
83 I RETCODE(RIX)<2 S ZNOTE="** INTERFACE VERSION - Required - INVALID: ",RETCODE=3
84 S RETCODE(RIX)=ZNOTE_RETCODE(RIX)
85 Q
864 ; EPHARM IN port - NS
87 Q
885 ; Contact Name
89 S RETCODE(RIX)=" CONTACT NAME - VALID: "_RETCODE(RIX)
90 Q
916 ; Contact Means
92 S RETCODE(RIX)=" CONTACT MEANS - VALID: "_RETCODE(RIX)
93 Q
947 ; Alternate Contact NAME
95 S RETCODE(RIX)=" ALTERNATE CONTACT NAME - VALID: "_RETCODE(RIX)
96 Q
978 ; Alternate Contact Means
98 S RETCODE(RIX)=" ALTERNATE CONTACT MEANS - VALID: "_RETCODE(RIX)
99 Q
Note: See TracBrowser for help on using the repository browser.