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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXIPUTIL1 2249 printed Dec 13, 2024@02:02:35 Page 2
XIPUTIL1 ;OIFO/SO- CONTINUATION OF ROUTINE XIPUTIL;2:15 PM 10 Jul 2003
+1 ;;8.0;KERNEL;**292**;Jul 10, 1995
+2 ; Continuation of API POSTALB
+3 QUIT
+4 ;
PBC ; POSTALB's Continuation Entry Point
+1 ;
+2 ; INPUT
+3 ; PCODE - Postal Code for which to return the data
+4 ;
+5 ; OUTPUT
+6 ; XIP(n) - the number of primary subscripts
+7 ; XIP(n,"POSTAL CODE") - the value used to lookup postal data
+8 ; XIP(n,"CITY") - the city that the USPS assigned to this PCODE
+9 ; XIP(n,"COUNTY") - The county associated with this PCODE
+10 ; XIP(n,"COUNTY POINTER") - pointer to the county in file #5.13
+11 ; XIP(n,"STATE") - The state associated with this PCODE
+12 ; XIP(n,"STATE POINTER") - pointer to the state in file #5
+13 ; XIP(n"CITY KEY") - USPS's assigned city key
+14 ; XIP(n,"PREFERRED CITY KEY") - USPS's Preferred (DEFAULT) city key
+15 ; XIP(n,"CITY ABBREVIATION") - USPS's assigned abbreviation
+16 ; XIP(n,"UNIQUE KEY") - a unique look-up value
+17 ; XIP(n,"FIPS CODE") - 5 digit FIPS code associated with the county
+18 ; XIP("ERROR") - returns errors encountered during look-up
+19 ;
+20 NEW D512,XIPERR
+21 SET XIP=0
+22 Begin DoDot:1
+23 NEW DIERR,FIELDS,S512
+24 SET FIELDS="@;.01"
+25 ; Screen out INACTIVE Zip Codes
SET S512="I $P(^(0),U,5)="""""
+26 DO LIST^DIC(5.12,"",FIELDS,"P","","",LPCODE,"B",S512,"","D512","XIPERR")
+27 QUIT
End DoDot:1
+28 IF $DATA(XIPERR)
SET XIP("ERROR")=XIPERR("DIERR",1,"TEXT",1)
QUIT
+29 IF +D512("DILIST",0)=0
SET XIP("ERROR")="Postal Code cannot be found"
QUIT
+30 NEW I,I1
+31 SET I=0
+32 FOR I1=0:1
SET I=$ORDER(D512("DILIST",I))
if 'I
QUIT
Begin DoDot:1
+33 NEW X
+34 SET XIP512=+$PIECE(D512("DILIST",I,0),"^")
+35 SET X=^XIP(5.12,XIP512,0)
+36 SET XIP(I,"POSTAL CODE")=LPCODE
+37 SET XIP(I,"CITY")=$PIECE(X,"^",2)
+38 ; Indicate this is the DEFAULT city
IF $PIECE(X,"^",6)=$PIECE(X,"^",7)
SET XIP(I,"CITY")=XIP(I,"CITY")_"*"
+39 SET XIP(I,"COUNTY POINTER")=$PIECE(X,"^",3)
+40 SET XIP(I,"STATE POINTER")=$PIECE(X,"^",4)
+41 SET XIP(I,"CITY KEY")=$PIECE(X,"^",6)
+42 SET XIP(I,"PREFERRED CITY KEY")=$PIECE(X,"^",7)
+43 SET XIP(I,"CITY ABBREVIATION")=$PIECE(X,"^",8)
+44 SET XIP(I,"UNIQUE KEY")=$PIECE(X,"^",9)
+45 SET XIP(I,"STATE")=$PIECE($GET(^DIC(5,+XIP(I,"STATE POINTER"),0)),"^")
+46 SET XIP(I,"COUNTY")=$PIECE($GET(^XIP(5.13,+XIP(I,"COUNTY POINTER"),0)),"^",2)
+47 SET XIP(I,"FIPS CODE")=$PIECE($GET(^XIP(5.13,+XIP(I,"COUNTY POINTER"),0)),"^")
End DoDot:1
+48 SET XIP=I1
+49 QUIT
