DGREGAZL ;ALB/DW - ZIP LINKING UTILITY ; 5/27/04 10:54am
;;5.3;PIMS;**522,560,581,730,760,1015,1016**;JUN 30, 2012;Build 20
;ihs/cmi/maw 08/08/2012 PATCH 1016 check for XIP routines
;
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=.1112,.114,.115,.117 S RESULT(DGN)=$G(DGR(DGN))
S DGZIP=$$ZIP(DFN)
I DGZIP=-1 S RESULT=-1 Q
S RESULT(.1112)=DGZIP
S DGIND=$$CITY(.DGR,DGZIP,DFN)
I DGIND=$G(DGTOT)+1 S DGIND=""
I $G(DGR)=-1 S RESULT=-1 Q
S RESULT(.114)=$G(DGR)
S DGALW=$$ALWEDT^DGREGDD1($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(.115)=$G(DGR(.115))
. S RESULT(.117)=$G(DGR(.117))
I DGALW=0 D
. I DGZIP'="" D LINK(.DGDFLT,DGZIP,1)
. S RESULT(.115)=$G(DGDFLT(.115))
. S RESULT(.117)=$G(DGDFLT(.117))
Q
ZIP(DFN) ;Let user input zip+4
ZAGN N DIR,DTOUT,DUOUT,DIROUT,DGDATA
S DIR(0)="2,.1112"
S DA=DFN
D ^DIR
I $D(DTOUT) Q -1
I $D(DUOUT)!$D(DIROUT) D UPCT^DGREGAED G ZAGN
S DGZIP=$G(Y)
;allow bogus zip:
I $D(^XUSEC("EAS GMT COUNTY EDIT",+DUZ)) Q DGZIP
I DGZIP="" Q DGZIP
I '$T(POSTAL^XIPUTIL) Q "" ;ihs/cmi/maw 08/02/2012 PATCH 1015 no XIP routines in IHS
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(#.114)
; 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
; DG*760 brought in DGCITI
N DGCITI
S DGIND=""
I '$T(POSTAL^XIPUTIL) Q "" ;ihs/cmi/maw 08/02/2012 PATCH 1015 no XIP routines in IHS
D POSTALB^XIPUTIL(ZIP,.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)
D FIELD^DID(2,.114,"N","LABEL","DGCITY")
S DGN=""
I '$D(DGDATA("ERROR")) D
. S DOLDCITY=$$GET1^DIQ(2,DFN_",",.114)
. 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
.. ; next 4 commented out lines done by DG*760
.. ;I DGABRV="" S DGABRV=$P($G(DGDATA(DGN,"CITY")),"*",1)
.. ;I DOLDCITY'="",DGABRV=DOLDCITY S DGSAME=1
.. ;I $G(DGDATA(DGN,"CITY"))["*" S:DGABRV'="" DGABRV=DGABRV_"*"
.. I $G(DGDATA(DGN,"CITY"))["*" S DGCITI=DGCITI_"*"
.. ;S DGECH=DGN_":"_DGABRV
.. 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)
. ;if zip '= zip on file, default = ""; else default=city on file
. ;I ($G(DFN)'="")&($E(ZIP,1,5)=$$GET1^DIQ(2,DFN_",",.116)) D
. S DIR("B")=$$GET1^DIQ(2,DFN_",",.114)
. S DIR("A")=$G(DGCITY("LABEL"))
CAGN1 . D ^DIR
. I $D(DTOUT) S RESULT=-1 Q
. I $D(DUOUT)!$D(DIROUT) D UPCT^DGREGAED 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,.114"
. S DA=DFN
. D ^DIR
. I $D(DTOUT) S RESULT=-1 Q
. I $D(DUOUT)!$D(DIROUT) D UPCT^DGREGAED G CAGN2
. S RESULT=$G(Y)
I $L($G(RESULT))>15 D
. S DGN=Y
. 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
I '$T(POSTAL^XIPUTIL) Q ;ihs/cmi/maw 08/02/2012 PATCH 1015 no XIP routines in IHS
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(.115)=$G(DGDATA(DGN,"STATE"))_U_$G(DGDATA(DGN,"STATE POINTER"))
S RESULT(.117)=$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 (#.115) and county (#.117)
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=.115,.117 Q:POP D
SCAGN . I DGN=.115 S DIR(0)=2_","_DGN
. I ($G(DGST)="")&(DGN=.117) Q
. I DGN=.117 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=.115 S DGST=$P($G(Y),U)
. I DGN=.117 S RESULT(.117)=$$CNTY(DGST,$P($G(RESULT(.117)),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=.1112,.114,.115,.117 Q:POP D
FAGN . I ($G(DGST)="")&(DGN=.117) Q
. S DIR(0)=2_","_DGN
. I DGN=.117 D
.. S DIR(0)="POA^DIC(5,DGST,1,:AEMQ"
.. S DIR("B")=$$GET1^DIQ(2,DFN_",",.117)
. I DGN'=.117 S DA=DFN
. D ^DIR
. I $D(DTOUT) S POP=1 Q
. I $D(DUOUT)!$D(DIROUT) D UPCT^DGREGAED G FAGN
. I (DGN=.114)!(DGN=.1112) S DGINPUT(DGN)=$G(Y)
. I (DGN=.115) D
.. S DGST=$P($G(Y),U)
.. I DGST=$$GET1^DIQ(2,DFN_",",.115,"I") D
... S DGINPUT(.115)=$$GET1^DIQ(2,DFN_",",.115)_U_DGST
.. I DGST'=$$GET1^DIQ(2,DFN_",",.115,"I") D
... S DGINPUT(.115)=$P($G(Y(0)),U)_U_DGST
. I DGN=.117 S DGINPUT(DGN)=$P($G(Y),U,2)_U_$P($G(Y),U)
I POP=1 S RESULT=-1
Q
DGREGAZL ;ALB/DW - ZIP LINKING UTILITY ; 5/27/04 10:54am
+1 ;;5.3;PIMS;**522,560,581,730,760,1015,1016**;JUN 30, 2012;Build 20
+2 ;ihs/cmi/maw 08/08/2012 PATCH 1016 check for XIP routines
+3 ;
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=.1112,.114,.115,.117
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(.1112)=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(.114)=$GET(DGR)
+18 SET DGALW=$$ALWEDT^DGREGDD1($GET(DUZ),DGZIP)
+19 IF DGALW=1
Begin DoDot:1
+20 KILL DGR
DO STCNTY(.DGR,DGZIP,DFN,DGIND)
+21 IF $GET(DGR)=-1
SET RESULT=-1
QUIT
+22 SET RESULT(.115)=$GET(DGR(.115))
+23 SET RESULT(.117)=$GET(DGR(.117))
End DoDot:1
+24 IF DGALW=0
Begin DoDot:1
+25 IF DGZIP'=""
DO LINK(.DGDFLT,DGZIP,1)
+26 SET RESULT(.115)=$GET(DGDFLT(.115))
+27 SET RESULT(.117)=$GET(DGDFLT(.117))
End DoDot:1
+28 QUIT
ZIP(DFN) ;Let user input zip+4
ZAGN NEW DIR,DTOUT,DUOUT,DIROUT,DGDATA
+1 SET DIR(0)="2,.1112"
+2 SET DA=DFN
+3 DO ^DIR
+4 IF $DATA(DTOUT)
QUIT -1
+5 IF $DATA(DUOUT)!$DATA(DIROUT)
DO UPCT^DGREGAED
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 ;ihs/cmi/maw 08/02/2012 PATCH 1015 no XIP routines in IHS
IF '$TEXT(POSTAL^XIPUTIL)
QUIT ""
+11 DO POSTALB^XIPUTIL(DGZIP,.DGDATA)
+12 ;DG*730 - later commented out by DG*760
+13 ;I $G(DGDATA(1,"CITY ABBREVIATION"))'="",$G(DGDATA(1,"CITY ABBREVIATION"))=$G(DGDATA(2,"CITY")) S DGDATA=1 K DGDATA(2)
+14 IF $DATA(DGDATA("ERROR"))
Begin DoDot:1
+15 WRITE $CHAR(7)," ??"
End DoDot:1
GOTO ZAGN
+16 QUIT DGZIP
CITY(RESULT,ZIP,DFN) ;Base on zip, let user input city(#.114)
+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 ; DG*760 brought in DGCITI
+12 NEW DGCITI
+13 SET DGIND=""
+14 ;ihs/cmi/maw 08/02/2012 PATCH 1015 no XIP routines in IHS
IF '$TEXT(POSTAL^XIPUTIL)
QUIT ""
+15 DO POSTALB^XIPUTIL(ZIP,.DGDATA)
+16 ;DG*730 - later commented out by DG*760
+17 ;I $G(DGDATA(1,"CITY ABBREVIATION"))'="",$G(DGDATA(1,"CITY ABBREVIATION"))=$G(DGDATA(2,"CITY")) S DGDATA=1 K DGDATA(2)
+18 DO FIELD^DID(2,.114,"N","LABEL","DGCITY")
+19 SET DGN=""
+20 IF '$DATA(DGDATA("ERROR"))
Begin DoDot:1
+21 SET DOLDCITY=$$GET1^DIQ(2,DFN_",",.114)
+22 SET DGSAME=0
+23 FOR
SET DGN=$ORDER(DGDATA(DGN))
IF DGN=""
QUIT
Begin DoDot:2
+24 SET DGCITI=$PIECE($GET(DGDATA(DGN,"CITY")),"*",1)
+25 SET DGABRV=$GET(DGDATA(DGN,"CITY ABBREVIATION"))
+26 IF DOLDCITY'=""
IF DGCITI=DOLDCITY!(DGABRV=DOLDCITY)
SET DGSAME=1
+27 ; next 4 commented out lines done by DG*760
+28 ;I DGABRV="" S DGABRV=$P($G(DGDATA(DGN,"CITY")),"*",1)
+29 ;I DOLDCITY'="",DGABRV=DOLDCITY S DGSAME=1
+30 ;I $G(DGDATA(DGN,"CITY"))["*" S:DGABRV'="" DGABRV=DGABRV_"*"
+31 IF $GET(DGDATA(DGN,"CITY"))["*"
SET DGCITI=DGCITI_"*"
+32 ;S DGECH=DGN_":"_DGABRV
+33 SET DGECH=DGN_":"_DGCITI
+34 SET DGSOC=$SELECT($GET(DGSOC)="":DGECH,1:DGSOC_";"_DGECH)
+35 SET DGTOT=DGN
End DoDot:2
+36 IF 'DGSAME
SET DGELEVEN=$GET(^DPT(DFN,.11))
Begin DoDot:2
+37 IF $PIECE(DGELEVEN,U,6)'=$GET(DGDATA(DGTOT,"POSTAL CODE"))
QUIT
+38 IF $PIECE(DGELEVEN,U,14)'="VAMC"
QUIT
+39 IF $PIECE(DGELEVEN,U,15)'=$$GETSITE^DGMTU4($GET(DUZ))
QUIT
+40 IF $PIECE(DGELEVEN,U,17)'>.5
QUIT
+41 SET DGN=DGTOT+1
SET DGECH=DGN_":"_DOLDCITY
SET DGSOC=DGSOC_";"_DGECH
End DoDot:2
+42 ;
+43 IF $DATA(^XUSEC("EAS GMT COUNTY EDIT",+DUZ))
Begin DoDot:2
+44 SET DGSOC=$GET(DGSOC)_";"_99_":"_"FREE TEXT"
End DoDot:2
+45 SET DIR(0)="SO^"_$GET(DGSOC)
+46 ;if zip '= zip on file, default = ""; else default=city on file
+47 ;I ($G(DFN)'="")&($E(ZIP,1,5)=$$GET1^DIQ(2,DFN_",",.116)) D
+48 SET DIR("B")=$$GET1^DIQ(2,DFN_",",.114)
+49 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^DGREGAED
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,.114"
+3 SET DA=DFN
+4 DO ^DIR
+5 IF $DATA(DTOUT)
SET RESULT=-1
QUIT
+6 IF $DATA(DUOUT)!$DATA(DIROUT)
DO UPCT^DGREGAED
GOTO CAGN2
+7 SET RESULT=$GET(Y)
End DoDot:1
+8 IF $LENGTH($GET(RESULT))>15
Begin DoDot:1
+9 SET DGN=Y
+10 SET RESULT=$GET(DGDATA(DGN,"CITY ABBREVIATION"))
End DoDot:1
+11 QUIT DGIND
+12 ;
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 ;ihs/cmi/maw 08/02/2012 PATCH 1015 no XIP routines in IHS
IF '$TEXT(POSTAL^XIPUTIL)
QUIT
+9 DO POSTALB^XIPUTIL(ZIP,.DGDATA)
+10 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")
+11 ;could be duplicate county codes in subfile #5.01
IF 'CNTYIEN
Begin DoDot:1
+12 IF '$DATA(^DIC(5,+$GET(DGDATA(DGN,"STATE POINTER")),1))
QUIT
+13 IF $EXTRACT($GET(DGDATA(DGN,"FIPS CODE")),3,5)=""
QUIT
+14 SET CNTYIEN=$ORDER(^DIC(5,$GET(DGDATA(DGN,"STATE POINTER")),1,"C",$EXTRACT($GET(DGDATA(DGN,"FIPS CODE")),3,5),""))
End DoDot:1
+15 SET RESULT(.115)=$GET(DGDATA(DGN,"STATE"))_U_$GET(DGDATA(DGN,"STATE POINTER"))
+16 SET RESULT(.117)=$GET(DGDATA(DGN,"COUNTY"))_U_$GET(CNTYIEN)_U_$EXTRACT($GET(DGDATA(DGN,"FIPS CODE")),3,5)
+17 QUIT
+18 ;
STCNTY(RESULT,ZIP,DFN,DGNUM) ;Based on zip,input state (#.115) and county (#.117)
+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=.115,.117
IF POP
QUIT
Begin DoDot:1
SCAGN IF DGN=.115
SET DIR(0)=2_","_DGN
+1 IF ($GET(DGST)="")&(DGN=.117)
QUIT
+2 IF DGN=.117
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=.115
SET DGST=$PIECE($GET(Y),U)
+9 IF DGN=.117
SET RESULT(.117)=$$CNTY(DGST,$PIECE($GET(RESULT(.117)),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=.1112,.114,.115,.117
IF POP
QUIT
Begin DoDot:1
FAGN IF ($GET(DGST)="")&(DGN=.117)
QUIT
+1 SET DIR(0)=2_","_DGN
+2 IF DGN=.117
Begin DoDot:2
+3 SET DIR(0)="POA^DIC(5,DGST,1,:AEMQ"
+4 SET DIR("B")=$$GET1^DIQ(2,DFN_",",.117)
End DoDot:2
+5 IF DGN'=.117
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=.114)!(DGN=.1112)
SET DGINPUT(DGN)=$GET(Y)
+10 IF (DGN=.115)
Begin DoDot:2
+11 SET DGST=$PIECE($GET(Y),U)
+12 IF DGST=$$GET1^DIQ(2,DFN_",",.115,"I")
Begin DoDot:3
+13 SET DGINPUT(.115)=$$GET1^DIQ(2,DFN_",",.115)_U_DGST
End DoDot:3
+14 IF DGST'=$$GET1^DIQ(2,DFN_",",.115,"I")
Begin DoDot:3
+15 SET DGINPUT(.115)=$PIECE($GET(Y(0)),U)_U_DGST
End DoDot:3
End DoDot:2
+16 IF DGN=.117
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
