source: WorldVistAEHR/trunk/r/KERNEL-XU-A4A7-USC-XG-XLF-XNOA-XPD-XQ-XVIR-ZI-ZOSF-ZOSV-ZT-ZU-%Z-XIP--XQAB--XUC--XUR--ZIN--ZTED/XIPUTIL1.m@ 660

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

initial load of WorldVistAEHR

File size: 2.1 KB
Line 
1XIPUTIL1 ;OIFO/SO- CONTINUATION OF ROUTINE XIPUTIL;2:15 PM 10 Jul 2003
2 ;;8.0;KERNEL;**292**;Jul 10, 1995
3 ; Continuation of API POSTALB
4 Q
5 ;
6PBC ; POSTALB's Continuation Entry Point
7 ;
8 ; INPUT
9 ; PCODE - Postal Code for which to return the data
10 ;
11 ; OUTPUT
12 ; XIP(n) - the number of primary subscripts
13 ; XIP(n,"POSTAL CODE") - the value used to lookup postal data
14 ; XIP(n,"CITY") - the city that the USPS assigned to this PCODE
15 ; XIP(n,"COUNTY") - The county associated with this PCODE
16 ; XIP(n,"COUNTY POINTER") - pointer to the county in file #5.13
17 ; XIP(n,"STATE") - The state associated with this PCODE
18 ; XIP(n,"STATE POINTER") - pointer to the state in file #5
19 ; XIP(n"CITY KEY") - USPS's assigned city key
20 ; XIP(n,"PREFERRED CITY KEY") - USPS's Preferred (DEFAULT) city key
21 ; XIP(n,"CITY ABBREVIATION") - USPS's assigned abbreviation
22 ; XIP(n,"UNIQUE KEY") - a unique look-up value
23 ; XIP(n,"FIPS CODE") - 5 digit FIPS code associated with the county
24 ; XIP("ERROR") - returns errors encountered during look-up
25 ;
26 N D512,XIPERR
27 S XIP=0
28 D
29 . N DIERR,FIELDS,S512
30 . S FIELDS="@;.01"
31 . S S512="I $P(^(0),U,5)=""""" ; Screen out INACTIVE Zip Codes
32 . D LIST^DIC(5.12,"",FIELDS,"P","","",LPCODE,"B",S512,"","D512","XIPERR")
33 . Q
34 I $D(XIPERR) S XIP("ERROR")=XIPERR("DIERR",1,"TEXT",1) Q
35 I +D512("DILIST",0)=0 S XIP("ERROR")="Postal Code cannot be found" Q
36 N I,I1
37 S I=0
38 F I1=0:1 S I=$O(D512("DILIST",I)) Q:'I D
39 . N X
40 . S XIP512=+$P(D512("DILIST",I,0),"^")
41 . S X=^XIP(5.12,XIP512,0)
42 . S XIP(I,"POSTAL CODE")=LPCODE
43 . S XIP(I,"CITY")=$P(X,"^",2)
44 . I $P(X,"^",6)=$P(X,"^",7) S XIP(I,"CITY")=XIP(I,"CITY")_"*" ; Indicate this is the DEFAULT city
45 . S XIP(I,"COUNTY POINTER")=$P(X,"^",3)
46 . S XIP(I,"STATE POINTER")=$P(X,"^",4)
47 . S XIP(I,"CITY KEY")=$P(X,"^",6)
48 . S XIP(I,"PREFERRED CITY KEY")=$P(X,"^",7)
49 . S XIP(I,"CITY ABBREVIATION")=$P(X,"^",8)
50 . S XIP(I,"UNIQUE KEY")=$P(X,"^",9)
51 . S XIP(I,"STATE")=$P($G(^DIC(5,+XIP(I,"STATE POINTER"),0)),"^")
52 . S XIP(I,"COUNTY")=$P($G(^XIP(5.13,+XIP(I,"COUNTY POINTER"),0)),"^",2)
53 . S XIP(I,"FIPS CODE")=$P($G(^XIP(5.13,+XIP(I,"COUNTY POINTER"),0)),"^")
54 S XIP=I1
55 Q
Note: See TracBrowser for help on using the repository browser.