- 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 ;;