56 lines
2.1 KiB
Mathematica
56 lines
2.1 KiB
Mathematica
XIPUTIL1 ;OIFO/SO- CONTINUATION OF ROUTINE XIPUTIL;2:15 PM 10 Jul 2003
|
|
;;8.0;KERNEL;**292**;Jul 10, 1995
|
|
; Continuation of API POSTALB
|
|
Q
|
|
;
|
|
PBC ; POSTALB's Continuation Entry Point
|
|
;
|
|
; INPUT
|
|
; PCODE - Postal Code for which to return the data
|
|
;
|
|
; OUTPUT
|
|
; XIP(n) - the number of primary subscripts
|
|
; XIP(n,"POSTAL CODE") - the value used to lookup postal data
|
|
; XIP(n,"CITY") - the city that the USPS assigned to this PCODE
|
|
; XIP(n,"COUNTY") - The county associated with this PCODE
|
|
; XIP(n,"COUNTY POINTER") - pointer to the county in file #5.13
|
|
; XIP(n,"STATE") - The state associated with this PCODE
|
|
; XIP(n,"STATE POINTER") - pointer to the state in file #5
|
|
; XIP(n"CITY KEY") - USPS's assigned city key
|
|
; XIP(n,"PREFERRED CITY KEY") - USPS's Preferred (DEFAULT) city key
|
|
; XIP(n,"CITY ABBREVIATION") - USPS's assigned abbreviation
|
|
; XIP(n,"UNIQUE KEY") - a unique look-up value
|
|
; XIP(n,"FIPS CODE") - 5 digit FIPS code associated with the county
|
|
; XIP("ERROR") - returns errors encountered during look-up
|
|
;
|
|
N D512,XIPERR
|
|
S XIP=0
|
|
D
|
|
. N DIERR,FIELDS,S512
|
|
. S FIELDS="@;.01"
|
|
. S S512="I $P(^(0),U,5)=""""" ; Screen out INACTIVE Zip Codes
|
|
. D LIST^DIC(5.12,"",FIELDS,"P","","",LPCODE,"B",S512,"","D512","XIPERR")
|
|
. Q
|
|
I $D(XIPERR) S XIP("ERROR")=XIPERR("DIERR",1,"TEXT",1) Q
|
|
I +D512("DILIST",0)=0 S XIP("ERROR")="Postal Code cannot be found" Q
|
|
N I,I1
|
|
S I=0
|
|
F I1=0:1 S I=$O(D512("DILIST",I)) Q:'I D
|
|
. N X
|
|
. S XIP512=+$P(D512("DILIST",I,0),"^")
|
|
. S X=^XIP(5.12,XIP512,0)
|
|
. S XIP(I,"POSTAL CODE")=LPCODE
|
|
. S XIP(I,"CITY")=$P(X,"^",2)
|
|
. I $P(X,"^",6)=$P(X,"^",7) S XIP(I,"CITY")=XIP(I,"CITY")_"*" ; Indicate this is the DEFAULT city
|
|
. S XIP(I,"COUNTY POINTER")=$P(X,"^",3)
|
|
. S XIP(I,"STATE POINTER")=$P(X,"^",4)
|
|
. S XIP(I,"CITY KEY")=$P(X,"^",6)
|
|
. S XIP(I,"PREFERRED CITY KEY")=$P(X,"^",7)
|
|
. S XIP(I,"CITY ABBREVIATION")=$P(X,"^",8)
|
|
. S XIP(I,"UNIQUE KEY")=$P(X,"^",9)
|
|
. S XIP(I,"STATE")=$P($G(^DIC(5,+XIP(I,"STATE POINTER"),0)),"^")
|
|
. S XIP(I,"COUNTY")=$P($G(^XIP(5.13,+XIP(I,"COUNTY POINTER"),0)),"^",2)
|
|
. S XIP(I,"FIPS CODE")=$P($G(^XIP(5.13,+XIP(I,"COUNTY POINTER"),0)),"^")
|
|
S XIP=I1
|
|
Q
|