DGV53PTA ;ALB/REW - ALASKA COUNTY UPDATES ;11 JUN 93
;;5.3;Registration;**1015**;Aug 13, 1993;Build 21
;
EN ;
; This will update the ALASKA County codes. The EN tag may be re-run
N DGPRINT
S DGPRINT=$S($D(ZTQUEUED):0,1:1)
W:DGPRINT !!,">>> Updating STATE File (#5) Alaska County data ..."
I '$$UPSTATE(2) W:$G(DGPRINT) !,"Problem with Alaska County Update. Please Review File."
E W:$G(DGPRINT) !!,"...STATE File update completed."
Q
UPSTATE(DGST) ;UPDATE COUNTY MULTIPLE OF STATE FILE
; DGST = TAG FOR STATE (also state code)
; DGOK = 1: COUNTIES UPDATED 0 = NO [RETURNED]
; DGNUMST = NUMBER OF OCCURENCES OF STATE NAME^IFN OF STATE
; DGSTNM = STATE NAME
; DGSTNODE=STATECODE^STATENAME
;
N DGOK,DGSTNODE,DGSTIFN,DGNUMST,DGSTNM
S (DGSTIFN,DGOK)=0
S DGSTNODE=$P($T(@DGST),";;",2)
S DGNUMST=$$NUMSTATE(DGST,DGSTNODE,.DGSTIFN)
I 'DGNUMST!('$D(^DIC(5,DGSTIFN,0))) W:$G(DGPRINT) !,$P(DGSTNODE,U,2)," COUNTY UPDATE ABORTED - NO ENTRY FOR STATE FOUND!" G QTUPC
I +DGNUMST>1 W:$G(DGPRINT) !,$P(DGSTNODE,U,2)," COUNTY UPDATE ABORTED - DUPLICATE STATES FOUND!" G QTUPC
S DGOK=1
D STCOUNTY(DGST,DGSTIFN,.DGOK)
W:('DGOK)&($G(DGPRINT)) !,"PROBLEMS FOUND DURING UPDATE OF COUNTIES FOR ",$P(DGSTNODE,U,2)
QTUPC Q DGOK
STCOUNTY(DGST,DGSTIFN,DGOK) ;UPDATES THE COUNTIES FOR A STATE
;REQUIRED: DGSTIFN,DGPRIN T - ALREADY DEFINED
;REQUIRED: DGST,DGSTIFN,DGOK - PASSED IN
Q:'$D(DGSTIFN)!('$D(DGPRINT))!('$D(DGST))!('$D(DGSTIFN))!('$D(DGOK))
;
N DGCTLINE,DGCTNODE
F DGCTLINE=1:1 S DGCTNODE=$P($T(@DGST+DGCTLINE),";;",2) Q:DGCTNODE']"" D UPCOUNTY(DGCTNODE,DGSTIFN,.DGOK)
Q
UPCOUNTY(DGCTNODE,DGSTIFN,DGOK) ;UPDATES A COUNTY
N B4NAME,B4CODE,NOWNAME,NOWCODE,DGCOUNTY,DGCTIFN
S B4NAME=$P(DGCTNODE,U,1)
S B4CODE=$P(DGCTNODE,U,2)
S NOWNAME=$P(DGCTNODE,U,3)
S NOWCODE=$P(DGCTNODE,U,4)
;Check for existing counties of same before-name
W:$G(DGPRINT) !
S DGCTIFN=0 F S DGCTIFN=$O(^DIC(5,DGSTIFN,1,"B",B4NAME,DGCTIFN)) Q:'DGCTIFN D
.S DGCOUNTY(DGCTIFN)=""
.W:$G(DGPRINT) !,"FOUND MATCH ON NAME. IEN= ",DGCTIFN," FOR ",B4NAME,"-",B4CODE
.D CHGCOUNT(DGCTIFN,.DGOK)
;Check for existing counties of same before-code
S DGCTIFN=0 F S DGCTIFN=$O(^DIC(5,DGSTIFN,1,"C",B4CODE,DGCTIFN)) Q:'DGCTIFN D
.Q:$D(DGCOUNTY(DGCTIFN)) ;don't re-do update done based on name
.S DGCOUNTY(DGCTIFN)=""
.W:$G(DGPRINT) !,"FOUND MATCH ON CODE. IEN= ",DGCTIFN," FOR ",B4NAME,"-",B4CODE
.D CHGCOUNT(DGCTIFN,.DGOK)
;If no existing entires by name or county add a new one
I '$D(DGCOUNTY) D
.W:$G(DGPRINT) !,"FOUND NO ",B4NAME,"-",B4CODE," (OLD COUNTY NAME-CODE)"
.D NEWCOUNT
Q
NEWCOUNT ;ADDS A NEW COUNTY ENTRY
I ('$L($G(NOWCODE)))!('$L($G(NOWNAME))) W:$G(DGPRINT) !,"MISSING INPUT" G QTNC
;Q
N DIC,DIE,DA,DR,X,Y,DGCTIFN
S DA(1)=DGSTIFN
S:'$D(^DIC(5,DGSTIFN,1,0)) ^(0)="^5.01I^^"
S DIC(0)="L",DIC="^DIC(5,"_DA(1)_",1,"
S X=NOWNAME
D ^DIC
S DA=+Y
I DA'>0 D G QTNC
.S DGCTIFN=0
.W:$G(DGPRINT) !,"No county added"
.F S DGCTIFN=$O(^DIC(5,DGSTIFN,1,"B",NOWNAME,DGCTIFN)) Q:'DGCTIFN D
..W:$G(DGPRINT) !,"....IEN= ",DGCTIFN," NAME= ",NOWNAME," CODE= ",NOWCODE," ALREADY EXISTS."
I Y W !,"...NEW COUNTY ",NOWNAME,"-",NOWCODE,$S((+$P(Y,U,3)):" ADDED",1:" ALREADY EXISTS")
S DR="2///^S X=NOWCODE"
S DIE=DIC
D ^DIE
QTNC Q
CHGCOUNT(DGCTIFN,DGOK) ;
N DA,DIC,DIE,DGOLDNM,DGOLDCD,DR,X
;Q
S DA=DGCTIFN,DA(1)=DGSTIFN,DIE="^DIC(5,"_DA(1)_",1,"
S DGOLDNM=$P($G(^DIC(5,+DA(1),1,+DGCTIFN,0)),U,1)
S DGOLDCD=$P($G(^DIC(5,+DA(1),1,+DGCTIFN,0)),U,3)
W !,"...CHANGING COUNTY ",DGOLDNM,"-",DGOLDCD," TO ",NOWNAME,"-",NOWCODE
S DR=".01///^S X=NOWNAME;2///^S X=NOWCODE"
D ^DIE
Q
NUMSTATE(DGST,DGSTNODE,DGSTIFN) ;RETURN DGCNT
; DGCNT = NUMBER OF OCCURENCES OF STATE NAME OR -1 IF ERROR
; DGSTIFN = IFN OF STATE IN FILE 5 - INPUT=0 OUT=STATE IEN
; DGSTNM = NAME OF STATE
N DGCNT,X
S DGCNT=0
S X=""
I '$L($G(DGST)) S DGCNT=-1 G QTNMST
S:'$L($G(DGSTNODE)) DGSTNODE=$P($T(@DGST),";;",2)
S DGSTNM=$P(DGSTNODE,U,2)
I '$L(DGSTNM) S DGCNT=-1 G QTNMST
F S DGSTIFN=$O(^DIC(5,"B",DGSTNM,DGSTIFN)) Q:'DGSTIFN S DGCNT=DGCNT+1,X=DGSTIFN
S DGSTIFN=X
QTNMST Q DGCNT
;Counties Format:B4NAME^B4CODE^NOWNAME^NOWCODE
2 ;;02^ALASKA
;;SKAGWAY-YAKUTAT-ANGOON^231^SKAGWAY-HOONAH-ANGOON^232
;;ALEUTIAN WEST^010^ALEUTIANS WEST^016
;;DENALI BOROUGH^068^DENALI BOROUGH^068
;;YAKUTAT^282^YAKUTAT^282
;;
DGV53PTA ;ALB/REW - ALASKA COUNTY UPDATES ;11 JUN 93
+1 ;;5.3;Registration;**1015**;Aug 13, 1993;Build 21
+2 ;
EN ;
+1 ; This will update the ALASKA County codes. The EN tag may be re-run
+2 NEW DGPRINT
+3 SET DGPRINT=$SELECT($DATA(ZTQUEUED):0,1:1)
+4 IF DGPRINT
WRITE !!,">>> Updating STATE File (#5) Alaska County data ..."
+5 IF '$$UPSTATE(2)
IF $GET(DGPRINT)
WRITE !,"Problem with Alaska County Update. Please Review File."
+6 IF '$TEST
IF $GET(DGPRINT)
WRITE !!,"...STATE File update completed."
+7 QUIT
UPSTATE(DGST) ;UPDATE COUNTY MULTIPLE OF STATE FILE
+1 ; DGST = TAG FOR STATE (also state code)
+2 ; DGOK = 1: COUNTIES UPDATED 0 = NO [RETURNED]
+3 ; DGNUMST = NUMBER OF OCCURENCES OF STATE NAME^IFN OF STATE
+4 ; DGSTNM = STATE NAME
+5 ; DGSTNODE=STATECODE^STATENAME
+6 ;
+7 NEW DGOK,DGSTNODE,DGSTIFN,DGNUMST,DGSTNM
+8 SET (DGSTIFN,DGOK)=0
+9 SET DGSTNODE=$PIECE($TEXT(@DGST),";;",2)
+10 SET DGNUMST=$$NUMSTATE(DGST,DGSTNODE,.DGSTIFN)
+11 IF 'DGNUMST!('$DATA(^DIC(5,DGSTIFN,0)))
IF $GET(DGPRINT)
WRITE !,$PIECE(DGSTNODE,U,2)," COUNTY UPDATE ABORTED - NO ENTRY FOR STATE FOUND!"
GOTO QTUPC
+12 IF +DGNUMST>1
IF $GET(DGPRINT)
WRITE !,$PIECE(DGSTNODE,U,2)," COUNTY UPDATE ABORTED - DUPLICATE STATES FOUND!"
GOTO QTUPC
+13 SET DGOK=1
+14 DO STCOUNTY(DGST,DGSTIFN,.DGOK)
+15 IF ('DGOK)&($GET(DGPRINT))
WRITE !,"PROBLEMS FOUND DURING UPDATE OF COUNTIES FOR ",$PIECE(DGSTNODE,U,2)
QTUPC QUIT DGOK
STCOUNTY(DGST,DGSTIFN,DGOK) ;UPDATES THE COUNTIES FOR A STATE
+1 ;REQUIRED: DGSTIFN,DGPRIN T - ALREADY DEFINED
+2 ;REQUIRED: DGST,DGSTIFN,DGOK - PASSED IN
+3 IF '$DATA(DGSTIFN)!('$DATA(DGPRINT))!('$DATA(DGST))!('$DATA(DGSTIFN))!('$DATA(DGOK))
QUIT
+4 ;
+5 NEW DGCTLINE,DGCTNODE
+6 FOR DGCTLINE=1:1
SET DGCTNODE=$PIECE($TEXT(@DGST+DGCTLINE),";;",2)
IF DGCTNODE']""
QUIT
DO UPCOUNTY(DGCTNODE,DGSTIFN,.DGOK)
+7 QUIT
UPCOUNTY(DGCTNODE,DGSTIFN,DGOK) ;UPDATES A COUNTY
+1 NEW B4NAME,B4CODE,NOWNAME,NOWCODE,DGCOUNTY,DGCTIFN
+2 SET B4NAME=$PIECE(DGCTNODE,U,1)
+3 SET B4CODE=$PIECE(DGCTNODE,U,2)
+4 SET NOWNAME=$PIECE(DGCTNODE,U,3)
+5 SET NOWCODE=$PIECE(DGCTNODE,U,4)
+6 ;Check for existing counties of same before-name
+7 IF $GET(DGPRINT)
WRITE !
+8 SET DGCTIFN=0
FOR
SET DGCTIFN=$ORDER(^DIC(5,DGSTIFN,1,"B",B4NAME,DGCTIFN))
IF 'DGCTIFN
QUIT
Begin DoDot:1
+9 SET DGCOUNTY(DGCTIFN)=""
+10 IF $GET(DGPRINT)
WRITE !,"FOUND MATCH ON NAME. IEN= ",DGCTIFN," FOR ",B4NAME,"-",B4CODE
+11 DO CHGCOUNT(DGCTIFN,.DGOK)
End DoDot:1
+12 ;Check for existing counties of same before-code
+13 SET DGCTIFN=0
FOR
SET DGCTIFN=$ORDER(^DIC(5,DGSTIFN,1,"C",B4CODE,DGCTIFN))
IF 'DGCTIFN
QUIT
Begin DoDot:1
+14 ;don't re-do update done based on name
IF $DATA(DGCOUNTY(DGCTIFN))
QUIT
+15 SET DGCOUNTY(DGCTIFN)=""
+16 IF $GET(DGPRINT)
WRITE !,"FOUND MATCH ON CODE. IEN= ",DGCTIFN," FOR ",B4NAME,"-",B4CODE
+17 DO CHGCOUNT(DGCTIFN,.DGOK)
End DoDot:1
+18 ;If no existing entires by name or county add a new one
+19 IF '$DATA(DGCOUNTY)
Begin DoDot:1
+20 IF $GET(DGPRINT)
WRITE !,"FOUND NO ",B4NAME,"-",B4CODE," (OLD COUNTY NAME-CODE)"
+21 DO NEWCOUNT
End DoDot:1
+22 QUIT
NEWCOUNT ;ADDS A NEW COUNTY ENTRY
+1 IF ('$LENGTH($GET(NOWCODE)))!('$LENGTH($GET(NOWNAME)))
IF $GET(DGPRINT)
WRITE !,"MISSING INPUT"
GOTO QTNC
+2 ;Q
+3 NEW DIC,DIE,DA,DR,X,Y,DGCTIFN
+4 SET DA(1)=DGSTIFN
+5 IF '$DATA(^DIC(5,DGSTIFN,1,0))
SET ^(0)="^5.01I^^"
+6 SET DIC(0)="L"
SET DIC="^DIC(5,"_DA(1)_",1,"
+7 SET X=NOWNAME
+8 DO ^DIC
+9 SET DA=+Y
+10 IF DA'>0
Begin DoDot:1
+11 SET DGCTIFN=0
+12 IF $GET(DGPRINT)
WRITE !,"No county added"
+13 FOR
SET DGCTIFN=$ORDER(^DIC(5,DGSTIFN,1,"B",NOWNAME,DGCTIFN))
IF 'DGCTIFN
QUIT
Begin DoDot:2
+14 IF $GET(DGPRINT)
WRITE !,"....IEN= ",DGCTIFN," NAME= ",NOWNAME," CODE= ",NOWCODE," ALREADY EXISTS."
End DoDot:2
End DoDot:1
GOTO QTNC
+15 IF Y
WRITE !,"...NEW COUNTY ",NOWNAME,"-",NOWCODE,$SELECT((+$PIECE(Y,U,3)):" ADDED",1:" ALREADY EXISTS")
+16 SET DR="2///^S X=NOWCODE"
+17 SET DIE=DIC
+18 DO ^DIE
QTNC QUIT
CHGCOUNT(DGCTIFN,DGOK) ;
+1 NEW DA,DIC,DIE,DGOLDNM,DGOLDCD,DR,X
+2 ;Q
+3 SET DA=DGCTIFN
SET DA(1)=DGSTIFN
SET DIE="^DIC(5,"_DA(1)_",1,"
+4 SET DGOLDNM=$PIECE($GET(^DIC(5,+DA(1),1,+DGCTIFN,0)),U,1)
+5 SET DGOLDCD=$PIECE($GET(^DIC(5,+DA(1),1,+DGCTIFN,0)),U,3)
+6 WRITE !,"...CHANGING COUNTY ",DGOLDNM,"-",DGOLDCD," TO ",NOWNAME,"-",NOWCODE
+7 SET DR=".01///^S X=NOWNAME;2///^S X=NOWCODE"
+8 DO ^DIE
+9 QUIT
NUMSTATE(DGST,DGSTNODE,DGSTIFN) ;RETURN DGCNT
+1 ; DGCNT = NUMBER OF OCCURENCES OF STATE NAME OR -1 IF ERROR
+2 ; DGSTIFN = IFN OF STATE IN FILE 5 - INPUT=0 OUT=STATE IEN
+3 ; DGSTNM = NAME OF STATE
+4 NEW DGCNT,X
+5 SET DGCNT=0
+6 SET X=""
+7 IF '$LENGTH($GET(DGST))
SET DGCNT=-1
GOTO QTNMST
+8 IF '$LENGTH($GET(DGSTNODE))
SET DGSTNODE=$PIECE($TEXT(@DGST),";;",2)
+9 SET DGSTNM=$PIECE(DGSTNODE,U,2)
+10 IF '$LENGTH(DGSTNM)
SET DGCNT=-1
GOTO QTNMST
+11 FOR
SET DGSTIFN=$ORDER(^DIC(5,"B",DGSTNM,DGSTIFN))
IF 'DGSTIFN
QUIT
SET DGCNT=DGCNT+1
SET X=DGSTIFN
+12 SET DGSTIFN=X
QTNMST QUIT DGCNT
+1 ;Counties Format:B4NAME^B4CODE^NOWNAME^NOWCODE
2 ;;02^ALASKA
+1 ;;SKAGWAY-YAKUTAT-ANGOON^231^SKAGWAY-HOONAH-ANGOON^232
+2 ;;ALEUTIAN WEST^010^ALEUTIANS WEST^016
+3 ;;DENALI BOROUGH^068^DENALI BOROUGH^068
+4 ;;YAKUTAT^282^YAKUTAT^282
+5 ;;
