DGREGTZL ;ALB/BDB - Temporary & Confidential Address Edits API ; 11/30/11 10:00am
;;5.3;Registration;**851,892**;Aug 13, 1993;Build 9
EN(RESULT,DFN) ;Let user edit zip+4, city, state, county based on zip-linking
; Output: RESULT(field#) = User Input External ^ Internal
K RESULT
N DGIND,DGTOT
I $G(DFN)="" S RESULT=-1 Q
N DGR,DGDFLT,DGALW,DGZIP,DGN
S DGN=""
I $$FOREIGN() D Q
. D FRGNEDT(.DGR,DFN)
. I $G(DGR)=-1 S RESULT=-1 Q
. F DGN=FZIP,FCITY,FSTATE,FCOUNTY S RESULT(DGN)=$G(DGR(DGN))
S DGZIP=$$ZIP(DFN)
I DGZIP=-1 S RESULT=-1 Q
S RESULT(FZIP)=DGZIP
S DGIND=$$CITY(.DGR,DGZIP,DFN)
I DGIND=$G(DGTOT)+1 S DGIND=""
I $G(DGR)=-1 S RESULT=-1 Q
S RESULT(FCITY)=$G(DGR)
;S DGALW=$$ALWEDT^DGREGDD1($G(DUZ),DGZIP
S DGALW=$$ALWEDTTC($G(DUZ),DGZIP)
I DGALW=1 D
. K DGR D STCNTY(.DGR,DGZIP,DFN,DGIND)
. I $G(DGR)=-1 S RESULT=-1 Q
. S RESULT(FSTATE)=$G(DGR(FSTATE))
. S RESULT(FCOUNTY)=$G(DGR(FCOUNTY))
I DGALW=0 D
. I DGZIP'="" D LINK(.DGDFLT,DGZIP,1)
. S RESULT(FSTATE)=$G(DGDFLT(FSTATE))
. S RESULT(FCOUNTY)=$G(DGDFLT(FCOUNTY))
Q
ZIP(DFN) ;Let user input zip+4
ZAGN N DIR,DTOUT,DUOUT,DIROUT,DGDATA
S DIR(0)="2,"_FZIP
S DA=DFN
D ^DIR
I $D(DTOUT) Q -1
I $D(DUOUT)!$D(DIROUT) D UPCT^DGREGTED G ZAGN
S DGZIP=$G(Y)
;allow bogus zip:
I $D(^XUSEC("EAS GMT COUNTY EDIT",+DUZ)) Q DGZIP
I DGZIP="" Q DGZIP
D POSTALB^XIPUTIL(DGZIP,.DGDATA)
;DG*730 - later commented out by DG*760
;I $G(DGDATA(1,"CITY ABBREVIATION"))'="",$G(DGDATA(1,"CITY ABBREVIATION"))=$G(DGDATA(2,"CITY")) S DGDATA=1 K DGDATA(2)
I $D(DGDATA("ERROR")) D G ZAGN
. W $C(7)," ??"
Q DGZIP
CITY(RESULT,ZIP,DFN) ;Base on zip, let user input city(#FCITY)
; Input:
; ZIP - user input zip for the patient primary address
; DFN - Interal entry number of Patient File (#2)
; Output:RESULT=-1 (input error or timed or ^ out)
; or =user input city
; Array index # of selected city.
K RESULT
N DGDATA,DIR,DA,Y,DTOUT,DUOUT,DIROUT,DGIND
N DGCITY,DGST,DGCNTY,DGABRV,DGN,DGECH,DGSOC
N DOLDCITY,DGSAME,DGELEVEN
N DGCITI
S DGIND=""
D POSTALB^XIPUTIL(ZIP,.DGDATA)
D FIELD^DID(2,FCITY,"N","LABEL","DGCITY")
S DGN=""
I '$D(DGDATA("ERROR")) D
. S DOLDCITY=$$GET1^DIQ(2,DFN_",",FCITY)
. S DGSAME=0
. F S DGN=$O(DGDATA(DGN)) Q:DGN="" D
.. S DGCITI=$P($G(DGDATA(DGN,"CITY")),"*",1)
.. S DGABRV=$G(DGDATA(DGN,"CITY ABBREVIATION"))
.. I DOLDCITY'="",DGCITI=DOLDCITY!(DGABRV=DOLDCITY) S DGSAME=1
.. I $G(DGDATA(DGN,"CITY"))["*" S DGCITI=DGCITI_"*"
.. S DGECH=DGN_":"_DGCITI
.. S DGSOC=$S($G(DGSOC)="":DGECH,1:DGSOC_";"_DGECH)
.. S DGTOT=DGN
.I 'DGSAME S DGELEVEN=$G(^DPT(DFN,.11)) D
..Q:$P(DGELEVEN,U,6)'=$G(DGDATA(DGTOT,"POSTAL CODE"))
..Q:$P(DGELEVEN,U,14)'="VAMC"
..Q:$P(DGELEVEN,U,15)'=$$GETSITE^DGMTU4($G(DUZ))
..Q:$P(DGELEVEN,U,17)'>.5
..S DGN=DGTOT+1,DGECH=DGN_":"_DOLDCITY,DGSOC=DGSOC_";"_DGECH
.;
. I $D(^XUSEC("EAS GMT COUNTY EDIT",+DUZ)) D
.. S DGSOC=$G(DGSOC)_";"_99_":"_"FREE TEXT"
. S DIR(0)="SO^"_$G(DGSOC)
. S DIR("B")=$$GET1^DIQ(2,DFN_",",FCITY)
. S DIR("A")=$G(DGCITY("LABEL"))
CAGN1 . D ^DIR
. I $D(DTOUT) S RESULT=-1 Q
. I $D(DUOUT)!$D(DIROUT) D UPCT^DGREGTED G CAGN1
. S RESULT=$P($G(Y(0)),"*")
. S DGIND=$G(Y)
I ($G(Y)=99)!($D(DGDATA("ERROR"))) D
CAGN2 . I '$D(^XUSEC("EAS GMT COUNTY EDIT",+DUZ)) Q
. N DIR,X,Y
. S DIR(0)="2,"_FCITY
. S DA=DFN
. D ^DIR
. I $D(DTOUT) S RESULT=-1 Q
. I $D(DUOUT)!$D(DIROUT) D UPCT^DGREGTED G CAGN2
. S RESULT=$G(Y)
I $L($G(RESULT))>15 D
. ;S DGN=Y
. S DGN=$G(Y)
. I 'DGN S RESULT=$E(RESULT,1,15)
. E S RESULT=$G(DGDATA(DGN,"CITY ABBREVIATION"))
. ;S RESULT=$G(DGDATA(DGN,"CITY ABBREVIATION"))
Q DGIND
;
LINK(RESULT,ZIP,DGN) ;From zip, get the linked state,county
K RESULT
N DGDATA,CNTYIEN
S CNTYIEN=""
S DGN=$G(DGN)
I (DGN="")&($$MLT^DGREGDD1(ZIP)) S DGN=1
I (DGN=99)&($$MLT^DGREGDD1(ZIP)) S DGN=1
I (DGN="")!(DGN=99) Q
D POSTALB^XIPUTIL(ZIP,.DGDATA)
S:$G(DGDATA(DGN,"STATE POINTER"))'="" CNTYIEN=$$FIND1^DIC(5.01,","_$G(DGDATA(DGN,"STATE POINTER"))_",","MOXQ",$E($G(DGDATA(DGN,"FIPS CODE")),3,5),"C")
D:'CNTYIEN ;could be duplicate county codes in subfile #5.01
.Q:'$D(^DIC(5,+$G(DGDATA(DGN,"STATE POINTER")),1))
.Q:$E($G(DGDATA(DGN,"FIPS CODE")),3,5)=""
.S CNTYIEN=$O(^DIC(5,$G(DGDATA(DGN,"STATE POINTER")),1,"C",$E($G(DGDATA(DGN,"FIPS CODE")),3,5),""))
S RESULT(FSTATE)=$G(DGDATA(DGN,"STATE"))_U_$G(DGDATA(DGN,"STATE POINTER"))
S RESULT(FCOUNTY)=$G(DGDATA(DGN,"COUNTY"))_U_$G(CNTYIEN)_U_$E($G(DGDATA(DGN,"FIPS CODE")),3,5)
Q
;
STCNTY(RESULT,ZIP,DFN,DGNUM) ;Based on zip,input state (#FSTATE) and county (#FCOUNTY)
K RESULT
S DGNUM=$G(DGNUM)
N DGN,DGDFLT,DGST,POP,DIR,X,Y,DTOUT,DUOUT,DIROUT
S POP=0
D LINK(.DGDFLT,ZIP,DGNUM)
F DGN=FSTATE,FCOUNTY Q:POP D
SCAGN . I DGN=FSTATE S DIR(0)=2_","_DGN
. I ($G(DGST)="")&(DGN=FCOUNTY) Q
. I DGN=FCOUNTY S DIR(0)="POA^DIC(5,DGST,1,:AEMQ"
. S DIR("B")=$P($G(DGDFLT(DGN)),U)
. D ^DIR
. I $D(DTOUT) S POP=1 Q
. I $D(DUOUT)!$D(DIROUT) D UPCT^DGREGAED G SCAGN
. S RESULT(DGN)=$P($G(Y),U,2)_U_$P($G(Y),U)
. I DGN=FSTATE S DGST=$P($G(Y),U)
. I DGN=FCOUNTY S RESULT(FCOUNTY)=$$CNTY(DGST,$P($G(RESULT(FCOUNTY)),U,2))
I POP=1 S RESULT=-1
Q
CNTY(DGST,DGCIEN) ;Return county name and code
;Input:state number and county IEN
;Output: CountyName^CountyIEN^CountyCode
I ($G(DGST)="")!($G(DGCIEN)="") S RESULT=-1 Q RESULT
N DGR,RESULT
S DGR=$G(^DIC(5,DGST,1,DGCIEN,0))
S RESULT=$P($G(DGR),U)_U_DGCIEN_U_$P($G(DGR),U,3)
Q RESULT
FOREIGN() ;Manila (Philippines) doesn't need zip linking.
;Output: 1 - area need no zip linking
; 0 - zip-linking area
I $$STA^XUAF4(+$$KSP^XUPARAM("INST"))=358 Q 1
;;;I $$STA^XUAF4(+$$KSP^XUPARAM("INST"))=500 Q 1 ;;HERE TEST
Q 0
FRGNEDT(DGINPUT,DFN) ;Edit zip+4, city, state, county for no zip-linking area
K DGINPUT
N DGN,DIR,DTOUT,DUOUT,DIROUT,X,Y,POP,DGST
S POP=0
F DGN=FZIP,FCITY,FSTATE,FCOUNTY Q:POP D
FAGN . I ($G(DGST)="")&(DGN=FCOUNTY) Q
. S DIR(0)=2_","_DGN
. I DGN=FCOUNTY D
.. S DIR(0)="POA^DIC(5,DGST,1,:AEMQ"
.. S DIR("B")=$$GET1^DIQ(2,DFN_",",FCOUNTY)
. I DGN'=FCOUNTY S DA=DFN
. D ^DIR
. I $D(DTOUT) S POP=1 Q
. I $D(DUOUT)!$D(DIROUT) D UPCT^DGREGAED G FAGN
. I (DGN=FCITY)!(DGN=FZIP) S DGINPUT(DGN)=$G(Y)
. I (DGN=FSTATE) D
.. S DGST=$P($G(Y),U)
.. I DGST=$$GET1^DIQ(2,DFN_",",FSTATE,"I") D
... S DGINPUT(FSTATE)=$$GET1^DIQ(2,DFN_",",FSTATE)_U_DGST
.. I DGST'=$$GET1^DIQ(2,DFN_",",FSTATE,"I") D
... S DGINPUT(FSTATE)=$P($G(Y(0)),U)_U_DGST
. I DGN=FCOUNTY S DGINPUT(DGN)=$P($G(Y),U,2)_U_$P($G(Y),U)
I POP=1 S RESULT=-1
Q
;
ALWEDTTC(DUZ,ZIP) ; determine if a security key is necessary for editing
; Input: zip code
; Output: 1: allow edit state and county
; 0: don't allow edit state and county
N EASDATA
I $G(ZIP)="" Q 0
I '$D(DUZ) Q 0
I '$$MLT^DGREGDD1(ZIP) Q 1 ; > 1 state or county for the zip - allow edit
I $$FOREIGN^DGREGAZL() Q 1 ; Foreign location - allow edit
D POSTAL^XIPUTIL(ZIP,.EASDATA)
Q:$D(EASDATA("ERROR")) 1 ;zip code does not exist - allow editing
Q:'$D(EASDATA("FIPS CODE")) 1 ;cnty code does not exist - allow edit
Q:'$D(EASDATA("STATE")) 1 ;state does not exist - allow editing
Q:$D(^XUSEC("EAS GMT COUNTY EDIT",+DUZ)) 1 ;user holds security key
W !,$S(TYPE="TEMP":"TEMPORARY ",TYPE="CONF":"CONFIDENTIAL ",1:"")_"STATE: ",$G(EASDATA("STATE"))
W !,$S(TYPE="TEMP":"TEMPORARY ",TYPE="CONF":"CONFIDENTIAL ",1:"")_"COUNTY: ",$G(EASDATA("COUNTY"))
Q 0
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGREGTZL 7553 printed Sep 23, 2025@20:30:59 Page 2
DGREGTZL ;ALB/BDB - Temporary & Confidential Address Edits API ; 11/30/11 10:00am
+1 ;;5.3;Registration;**851,892**;Aug 13, 1993;Build 9
EN(RESULT,DFN) ;Let user edit zip+4, city, state, county based on zip-linking
+1 ; Output: RESULT(field#) = User Input External ^ Internal
+2 KILL RESULT
+3 NEW DGIND,DGTOT
+4 IF $GET(DFN)=""
SET RESULT=-1
QUIT
+5 NEW DGR,DGDFLT,DGALW,DGZIP,DGN
+6 SET DGN=""
+7 IF $$FOREIGN()
Begin DoDot:1
+8 DO FRGNEDT(.DGR,DFN)
+9 IF $GET(DGR)=-1
SET RESULT=-1
QUIT
+10 FOR DGN=FZIP,FCITY,FSTATE,FCOUNTY
SET RESULT(DGN)=$GET(DGR(DGN))
End DoDot:1
QUIT
+11 SET DGZIP=$$ZIP(DFN)
+12 IF DGZIP=-1
SET RESULT=-1
QUIT
+13 SET RESULT(FZIP)=DGZIP
+14 SET DGIND=$$CITY(.DGR,DGZIP,DFN)
+15 IF DGIND=$GET(DGTOT)+1
SET DGIND=""
+16 IF $GET(DGR)=-1
SET RESULT=-1
QUIT
+17 SET RESULT(FCITY)=$GET(DGR)
+18 ;S DGALW=$$ALWEDT^DGREGDD1($G(DUZ),DGZIP
+19 SET DGALW=$$ALWEDTTC($GET(DUZ),DGZIP)
+20 IF DGALW=1
Begin DoDot:1
+21 KILL DGR
DO STCNTY(.DGR,DGZIP,DFN,DGIND)
+22 IF $GET(DGR)=-1
SET RESULT=-1
QUIT
+23 SET RESULT(FSTATE)=$GET(DGR(FSTATE))
+24 SET RESULT(FCOUNTY)=$GET(DGR(FCOUNTY))
End DoDot:1
+25 IF DGALW=0
Begin DoDot:1
+26 IF DGZIP'=""
DO LINK(.DGDFLT,DGZIP,1)
+27 SET RESULT(FSTATE)=$GET(DGDFLT(FSTATE))
+28 SET RESULT(FCOUNTY)=$GET(DGDFLT(FCOUNTY))
End DoDot:1
+29 QUIT
ZIP(DFN) ;Let user input zip+4
ZAGN NEW DIR,DTOUT,DUOUT,DIROUT,DGDATA
+1 SET DIR(0)="2,"_FZIP
+2 SET DA=DFN
+3 DO ^DIR
+4 IF $DATA(DTOUT)
QUIT -1
+5 IF $DATA(DUOUT)!$DATA(DIROUT)
DO UPCT^DGREGTED
GOTO ZAGN
+6 SET DGZIP=$GET(Y)
+7 ;allow bogus zip:
+8 IF $DATA(^XUSEC("EAS GMT COUNTY EDIT",+DUZ))
QUIT DGZIP
+9 IF DGZIP=""
QUIT DGZIP
+10 DO POSTALB^XIPUTIL(DGZIP,.DGDATA)
+11 ;DG*730 - later commented out by DG*760
+12 ;I $G(DGDATA(1,"CITY ABBREVIATION"))'="",$G(DGDATA(1,"CITY ABBREVIATION"))=$G(DGDATA(2,"CITY")) S DGDATA=1 K DGDATA(2)
+13 IF $DATA(DGDATA("ERROR"))
Begin DoDot:1
+14 WRITE $CHAR(7)," ??"
End DoDot:1
GOTO ZAGN
+15 QUIT DGZIP
CITY(RESULT,ZIP,DFN) ;Base on zip, let user input city(#FCITY)
+1 ; Input:
+2 ; ZIP - user input zip for the patient primary address
+3 ; DFN - Interal entry number of Patient File (#2)
+4 ; Output:RESULT=-1 (input error or timed or ^ out)
+5 ; or =user input city
+6 ; Array index # of selected city.
+7 KILL RESULT
+8 NEW DGDATA,DIR,DA,Y,DTOUT,DUOUT,DIROUT,DGIND
+9 NEW DGCITY,DGST,DGCNTY,DGABRV,DGN,DGECH,DGSOC
+10 NEW DOLDCITY,DGSAME,DGELEVEN
+11 NEW DGCITI
+12 SET DGIND=""
+13 DO POSTALB^XIPUTIL(ZIP,.DGDATA)
+14 DO FIELD^DID(2,FCITY,"N","LABEL","DGCITY")
+15 SET DGN=""
+16 IF '$DATA(DGDATA("ERROR"))
Begin DoDot:1
+17 SET DOLDCITY=$$GET1^DIQ(2,DFN_",",FCITY)
+18 SET DGSAME=0
+19 FOR
SET DGN=$ORDER(DGDATA(DGN))
if DGN=""
QUIT
Begin DoDot:2
+20 SET DGCITI=$PIECE($GET(DGDATA(DGN,"CITY")),"*",1)
+21 SET DGABRV=$GET(DGDATA(DGN,"CITY ABBREVIATION"))
+22 IF DOLDCITY'=""
IF DGCITI=DOLDCITY!(DGABRV=DOLDCITY)
SET DGSAME=1
+23 IF $GET(DGDATA(DGN,"CITY"))["*"
SET DGCITI=DGCITI_"*"
+24 SET DGECH=DGN_":"_DGCITI
+25 SET DGSOC=$SELECT($GET(DGSOC)="":DGECH,1:DGSOC_";"_DGECH)
+26 SET DGTOT=DGN
End DoDot:2
+27 IF 'DGSAME
SET DGELEVEN=$GET(^DPT(DFN,.11))
Begin DoDot:2
+28 if $PIECE(DGELEVEN,U,6)'=$GET(DGDATA(DGTOT,"POSTAL CODE"))
QUIT
+29 if $PIECE(DGELEVEN,U,14)'="VAMC"
QUIT
+30 if $PIECE(DGELEVEN,U,15)'=$$GETSITE^DGMTU4($GET(DUZ))
QUIT
+31 if $PIECE(DGELEVEN,U,17)'>.5
QUIT
+32 SET DGN=DGTOT+1
SET DGECH=DGN_":"_DOLDCITY
SET DGSOC=DGSOC_";"_DGECH
End DoDot:2
+33 ;
+34 IF $DATA(^XUSEC("EAS GMT COUNTY EDIT",+DUZ))
Begin DoDot:2
+35 SET DGSOC=$GET(DGSOC)_";"_99_":"_"FREE TEXT"
End DoDot:2
+36 SET DIR(0)="SO^"_$GET(DGSOC)
+37 SET DIR("B")=$$GET1^DIQ(2,DFN_",",FCITY)
+38 SET DIR("A")=$GET(DGCITY("LABEL"))
CAGN1 DO ^DIR
+1 IF $DATA(DTOUT)
SET RESULT=-1
QUIT
+2 IF $DATA(DUOUT)!$DATA(DIROUT)
DO UPCT^DGREGTED
GOTO CAGN1
+3 SET RESULT=$PIECE($GET(Y(0)),"*")
+4 SET DGIND=$GET(Y)
End DoDot:1
+5 IF ($GET(Y)=99)!($DATA(DGDATA("ERROR")))
Begin DoDot:1
CAGN2 IF '$DATA(^XUSEC("EAS GMT COUNTY EDIT",+DUZ))
QUIT
+1 NEW DIR,X,Y
+2 SET DIR(0)="2,"_FCITY
+3 SET DA=DFN
+4 DO ^DIR
+5 IF $DATA(DTOUT)
SET RESULT=-1
QUIT
+6 IF $DATA(DUOUT)!$DATA(DIROUT)
DO UPCT^DGREGTED
GOTO CAGN2
+7 SET RESULT=$GET(Y)
End DoDot:1
+8 IF $LENGTH($GET(RESULT))>15
Begin DoDot:1
+9 ;S DGN=Y
+10 SET DGN=$GET(Y)
+11 IF 'DGN
SET RESULT=$EXTRACT(RESULT,1,15)
+12 IF '$TEST
SET RESULT=$GET(DGDATA(DGN,"CITY ABBREVIATION"))
+13 ;S RESULT=$G(DGDATA(DGN,"CITY ABBREVIATION"))
End DoDot:1
+14 QUIT DGIND
+15 ;
LINK(RESULT,ZIP,DGN) ;From zip, get the linked state,county
+1 KILL RESULT
+2 NEW DGDATA,CNTYIEN
+3 SET CNTYIEN=""
+4 SET DGN=$GET(DGN)
+5 IF (DGN="")&($$MLT^DGREGDD1(ZIP))
SET DGN=1
+6 IF (DGN=99)&($$MLT^DGREGDD1(ZIP))
SET DGN=1
+7 IF (DGN="")!(DGN=99)
QUIT
+8 DO POSTALB^XIPUTIL(ZIP,.DGDATA)
+9 if $GET(DGDATA(DGN,"STATE POINTER"))'=""
SET CNTYIEN=$$FIND1^DIC(5.01,","_$GET(DGDATA(DGN,"STATE POINTER"))_",","MOXQ",$EXTRACT($GET(DGDATA(DGN,"FIPS CODE")),3,5),"C")
+10 ;could be duplicate county codes in subfile #5.01
if 'CNTYIEN
Begin DoDot:1
+11 if '$DATA(^DIC(5,+$GET(DGDATA(DGN,"STATE POINTER")),1))
QUIT
+12 if $EXTRACT($GET(DGDATA(DGN,"FIPS CODE")),3,5)=""
QUIT
+13 SET CNTYIEN=$ORDER(^DIC(5,$GET(DGDATA(DGN,"STATE POINTER")),1,"C",$EXTRACT($GET(DGDATA(DGN,"FIPS CODE")),3,5),""))
End DoDot:1
+14 SET RESULT(FSTATE)=$GET(DGDATA(DGN,"STATE"))_U_$GET(DGDATA(DGN,"STATE POINTER"))
+15 SET RESULT(FCOUNTY)=$GET(DGDATA(DGN,"COUNTY"))_U_$GET(CNTYIEN)_U_$EXTRACT($GET(DGDATA(DGN,"FIPS CODE")),3,5)
+16 QUIT
+17 ;
STCNTY(RESULT,ZIP,DFN,DGNUM) ;Based on zip,input state (#FSTATE) and county (#FCOUNTY)
+1 KILL RESULT
+2 SET DGNUM=$GET(DGNUM)
+3 NEW DGN,DGDFLT,DGST,POP,DIR,X,Y,DTOUT,DUOUT,DIROUT
+4 SET POP=0
+5 DO LINK(.DGDFLT,ZIP,DGNUM)
+6 FOR DGN=FSTATE,FCOUNTY
if POP
QUIT
Begin DoDot:1
SCAGN IF DGN=FSTATE
SET DIR(0)=2_","_DGN
+1 IF ($GET(DGST)="")&(DGN=FCOUNTY)
QUIT
+2 IF DGN=FCOUNTY
SET DIR(0)="POA^DIC(5,DGST,1,:AEMQ"
+3 SET DIR("B")=$PIECE($GET(DGDFLT(DGN)),U)
+4 DO ^DIR
+5 IF $DATA(DTOUT)
SET POP=1
QUIT
+6 IF $DATA(DUOUT)!$DATA(DIROUT)
DO UPCT^DGREGAED
GOTO SCAGN
+7 SET RESULT(DGN)=$PIECE($GET(Y),U,2)_U_$PIECE($GET(Y),U)
+8 IF DGN=FSTATE
SET DGST=$PIECE($GET(Y),U)
+9 IF DGN=FCOUNTY
SET RESULT(FCOUNTY)=$$CNTY(DGST,$PIECE($GET(RESULT(FCOUNTY)),U,2))
End DoDot:1
+10 IF POP=1
SET RESULT=-1
+11 QUIT
CNTY(DGST,DGCIEN) ;Return county name and code
+1 ;Input:state number and county IEN
+2 ;Output: CountyName^CountyIEN^CountyCode
+3 IF ($GET(DGST)="")!($GET(DGCIEN)="")
SET RESULT=-1
QUIT RESULT
+4 NEW DGR,RESULT
+5 SET DGR=$GET(^DIC(5,DGST,1,DGCIEN,0))
+6 SET RESULT=$PIECE($GET(DGR),U)_U_DGCIEN_U_$PIECE($GET(DGR),U,3)
+7 QUIT RESULT
FOREIGN() ;Manila (Philippines) doesn't need zip linking.
+1 ;Output: 1 - area need no zip linking
+2 ; 0 - zip-linking area
+3 IF $$STA^XUAF4(+$$KSP^XUPARAM("INST"))=358
QUIT 1
+4 ;;;I $$STA^XUAF4(+$$KSP^XUPARAM("INST"))=500 Q 1 ;;HERE TEST
+5 QUIT 0
FRGNEDT(DGINPUT,DFN) ;Edit zip+4, city, state, county for no zip-linking area
+1 KILL DGINPUT
+2 NEW DGN,DIR,DTOUT,DUOUT,DIROUT,X,Y,POP,DGST
+3 SET POP=0
+4 FOR DGN=FZIP,FCITY,FSTATE,FCOUNTY
if POP
QUIT
Begin DoDot:1
FAGN IF ($GET(DGST)="")&(DGN=FCOUNTY)
QUIT
+1 SET DIR(0)=2_","_DGN
+2 IF DGN=FCOUNTY
Begin DoDot:2
+3 SET DIR(0)="POA^DIC(5,DGST,1,:AEMQ"
+4 SET DIR("B")=$$GET1^DIQ(2,DFN_",",FCOUNTY)
End DoDot:2
+5 IF DGN'=FCOUNTY
SET DA=DFN
+6 DO ^DIR
+7 IF $DATA(DTOUT)
SET POP=1
QUIT
+8 IF $DATA(DUOUT)!$DATA(DIROUT)
DO UPCT^DGREGAED
GOTO FAGN
+9 IF (DGN=FCITY)!(DGN=FZIP)
SET DGINPUT(DGN)=$GET(Y)
+10 IF (DGN=FSTATE)
Begin DoDot:2
+11 SET DGST=$PIECE($GET(Y),U)
+12 IF DGST=$$GET1^DIQ(2,DFN_",",FSTATE,"I")
Begin DoDot:3
+13 SET DGINPUT(FSTATE)=$$GET1^DIQ(2,DFN_",",FSTATE)_U_DGST
End DoDot:3
+14 IF DGST'=$$GET1^DIQ(2,DFN_",",FSTATE,"I")
Begin DoDot:3
+15 SET DGINPUT(FSTATE)=$PIECE($GET(Y(0)),U)_U_DGST
End DoDot:3
End DoDot:2
+16 IF DGN=FCOUNTY
SET DGINPUT(DGN)=$PIECE($GET(Y),U,2)_U_$PIECE($GET(Y),U)
End DoDot:1
+17 IF POP=1
SET RESULT=-1
+18 QUIT
+19 ;
ALWEDTTC(DUZ,ZIP) ; determine if a security key is necessary for editing
+1 ; Input: zip code
+2 ; Output: 1: allow edit state and county
+3 ; 0: don't allow edit state and county
+4 NEW EASDATA
+5 IF $GET(ZIP)=""
QUIT 0
+6 IF '$DATA(DUZ)
QUIT 0
+7 ; > 1 state or county for the zip - allow edit
IF '$$MLT^DGREGDD1(ZIP)
QUIT 1
+8 ; Foreign location - allow edit
IF $$FOREIGN^DGREGAZL()
QUIT 1
+9 DO POSTAL^XIPUTIL(ZIP,.EASDATA)
+10 ;zip code does not exist - allow editing
if $DATA(EASDATA("ERROR"))
QUIT 1
+11 ;cnty code does not exist - allow edit
if '$DATA(EASDATA("FIPS CODE"))
QUIT 1
+12 ;state does not exist - allow editing
if '$DATA(EASDATA("STATE"))
QUIT 1
+13 ;user holds security key
if $DATA(^XUSEC("EAS GMT COUNTY EDIT",+DUZ))
QUIT 1
+14 WRITE !,$SELECT(TYPE="TEMP":"TEMPORARY ",TYPE="CONF":"CONFIDENTIAL ",1:"")_"STATE: ",$GET(EASDATA("STATE"))
+15 WRITE !,$SELECT(TYPE="TEMP":"TEMPORARY ",TYPE="CONF":"CONFIDENTIAL ",1:"")_"COUNTY: ",$GET(EASDATA("COUNTY"))
+16 QUIT 0
