Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DGV53PTA

DGV53PTA.m

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