ONCPCDX ;Hines OIFO/GWB - Postal Code INPUT/OUTPUT TRANSFORMS ;06/23/10
;;2.2;ONCOLOGY;**1**;Jul 31, 2013;Build 8
;
PCDX ;POSTAL CODE AT DX (165.5,9) INPUT TRANSFORM
N DIC,ONCXIP,Y
I (X=88888)!(X=99999)!(X=999999) Q
I X?1A1N1A1N1A1N Q
S DIC="^XIP(5.12,",DIC(0)="EMZ"
S DIC("B")=$P(^ONCO(165.5,DA,1),U,2)
D ^DIC
I Y=-1 D EN^DDIOL(" Invalid postal code") K X Q
S X=$P(Y(0),U,1)
D POSTAL^XIPUTIL(X,.ONCXIP)
S ONCCITY=$P(Y(0),U,2)
S ONCSTATE=$P(Y(0),U,4)
S ONCCOUNTY=ONCXIP("FIPS CODE")
Q
;Code for POSTALB^XIPUTIL API if needed
;S SUB=$O(ZIP(""),-1)
;I SUB=1 W " "_ZIP(1,"CITY")_" "_$P($G(^DIC(5,ZIP(1,"STATE POINTER"),0)),U,2)_" "_ZIP(1,"COUNTY") S Y=1 G SET
;W !
;S DIR(0)="SAO^"
;S SUB=0 F S SUB=$O(ZIP(SUB)) Q:SUB'>0 D
;.S CHOICE=ZIP(SUB,"POSTAL CODE")_" "_ZIP(SUB,"CITY")_" "_$P($G(^DIC(5,ZIP(SUB,"STATE POINTER"),0)),U,2)_" "_ZIP(SUB,"COUNTY")
;.S DIR(0)=DIR(0)_SUB_":"_CHOICE_";"
;.W !,?5,SUB," ",CHOICE
;W ! S DIR("A")=" Select Postal Code: "
;D ^DIR
;I $D(DIRUT) K DIRUT K ZIP Q
;I Y<1 K ZIP Q
;
PC1601 ;POSTAL CODE (160.1,.03) INPUT TRANSFORM
N DIC,Y
S DIC="^XIP(5.12,",DIC(0)="EMZ"
S DIC("B")=$P(^ONCO(160.1,DA,0),U,3)
D ^DIC
I Y=-1 D EN^DDIOL(" Invalid postal code") K X Q
S X=$P(Y(0),U,1)
S ONCCITY=$P(Y(0),U,2)
S ONCSTATE=$P(Y(0),U,4)
Q
;
PC165I ;ZIP CODE (165,.119) INPUT TRANSFORM
N DIC,Y
S DIC="^XIP(5.12,",DIC(0)="EMZ"
S DIC("B")=$P($G(^ONCO(165,DA,.11)),U,9)
D ^DIC
I Y=-1 D EN^DDIOL(" Invalid postal code") K X Q
S X=$P(Y(0),U,1)
S ONCCITY=$P(Y(0),U,2)
S ONCSTATE=$P(Y(0),U,4)
Q
;
PC165O ;ZIP CODE (165,.119) OUTPUT TRANSFORM
N CITY,STATE,STATEPNT,ZIP
S CITY=$P($G(^ONCO(165,D0,.11)),U,4)
S STATEPNT=$P($G(^ONCO(165,D0,.11)),U,5)
S STATE="" S:STATEPNT'="" STATE=$$GET1^DIQ(5,STATEPNT,1)
S ZIP=$P($G(^ONCO(165,D0,.11)),U,9)
S:ZIP'="" Y=CITY_", "_STATE_" "_ZIP
Q
;
CLEANUP ;Cleanup
K D0,DA
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HONCPCDX 1932 printed Dec 13, 2024@02:27:02 Page 2
ONCPCDX ;Hines OIFO/GWB - Postal Code INPUT/OUTPUT TRANSFORMS ;06/23/10
+1 ;;2.2;ONCOLOGY;**1**;Jul 31, 2013;Build 8
+2 ;
PCDX ;POSTAL CODE AT DX (165.5,9) INPUT TRANSFORM
+1 NEW DIC,ONCXIP,Y
+2 IF (X=88888)!(X=99999)!(X=999999)
QUIT
+3 IF X?1A1N1A1N1A1N
QUIT
+4 SET DIC="^XIP(5.12,"
SET DIC(0)="EMZ"
+5 SET DIC("B")=$PIECE(^ONCO(165.5,DA,1),U,2)
+6 DO ^DIC
+7 IF Y=-1
DO EN^DDIOL(" Invalid postal code")
KILL X
QUIT
+8 SET X=$PIECE(Y(0),U,1)
+9 DO POSTAL^XIPUTIL(X,.ONCXIP)
+10 SET ONCCITY=$PIECE(Y(0),U,2)
+11 SET ONCSTATE=$PIECE(Y(0),U,4)
+12 SET ONCCOUNTY=ONCXIP("FIPS CODE")
+13 QUIT
+14 ;Code for POSTALB^XIPUTIL API if needed
+15 ;S SUB=$O(ZIP(""),-1)
+16 ;I SUB=1 W " "_ZIP(1,"CITY")_" "_$P($G(^DIC(5,ZIP(1,"STATE POINTER"),0)),U,2)_" "_ZIP(1,"COUNTY") S Y=1 G SET
+17 ;W !
+18 ;S DIR(0)="SAO^"
+19 ;S SUB=0 F S SUB=$O(ZIP(SUB)) Q:SUB'>0 D
+20 ;.S CHOICE=ZIP(SUB,"POSTAL CODE")_" "_ZIP(SUB,"CITY")_" "_$P($G(^DIC(5,ZIP(SUB,"STATE POINTER"),0)),U,2)_" "_ZIP(SUB,"COUNTY")
+21 ;.S DIR(0)=DIR(0)_SUB_":"_CHOICE_";"
+22 ;.W !,?5,SUB," ",CHOICE
+23 ;W ! S DIR("A")=" Select Postal Code: "
+24 ;D ^DIR
+25 ;I $D(DIRUT) K DIRUT K ZIP Q
+26 ;I Y<1 K ZIP Q
+27 ;
PC1601 ;POSTAL CODE (160.1,.03) INPUT TRANSFORM
+1 NEW DIC,Y
+2 SET DIC="^XIP(5.12,"
SET DIC(0)="EMZ"
+3 SET DIC("B")=$PIECE(^ONCO(160.1,DA,0),U,3)
+4 DO ^DIC
+5 IF Y=-1
DO EN^DDIOL(" Invalid postal code")
KILL X
QUIT
+6 SET X=$PIECE(Y(0),U,1)
+7 SET ONCCITY=$PIECE(Y(0),U,2)
+8 SET ONCSTATE=$PIECE(Y(0),U,4)
+9 QUIT
+10 ;
PC165I ;ZIP CODE (165,.119) INPUT TRANSFORM
+1 NEW DIC,Y
+2 SET DIC="^XIP(5.12,"
SET DIC(0)="EMZ"
+3 SET DIC("B")=$PIECE($GET(^ONCO(165,DA,.11)),U,9)
+4 DO ^DIC
+5 IF Y=-1
DO EN^DDIOL(" Invalid postal code")
KILL X
QUIT
+6 SET X=$PIECE(Y(0),U,1)
+7 SET ONCCITY=$PIECE(Y(0),U,2)
+8 SET ONCSTATE=$PIECE(Y(0),U,4)
+9 QUIT
+10 ;
PC165O ;ZIP CODE (165,.119) OUTPUT TRANSFORM
+1 NEW CITY,STATE,STATEPNT,ZIP
+2 SET CITY=$PIECE($GET(^ONCO(165,D0,.11)),U,4)
+3 SET STATEPNT=$PIECE($GET(^ONCO(165,D0,.11)),U,5)
+4 SET STATE=""
if STATEPNT'=""
SET STATE=$$GET1^DIQ(5,STATEPNT,1)
+5 SET ZIP=$PIECE($GET(^ONCO(165,D0,.11)),U,9)
+6 if ZIP'=""
SET Y=CITY_", "_STATE_" "_ZIP
+7 QUIT
+8 ;
CLEANUP ;Cleanup
+1 KILL D0,DA
