[613] | 1 | XIPUTIL1 ;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 | ;
|
---|
| 6 | PBC ; 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
|
---|