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

XIPSRVR.m

Go to the documentation of this file. 
  1. XIPSRVR ;SFISC/SO- SERVER TO UPDATE THE POSTAL CODE(#5.12) FILE ;3/12/13
  1.  ;;8.0;KERNEL;**449,625**;Jul 10, 1995;Build 4
  1.  ;;Per VHA Directive 2004-038, this routine should not be modified.
  1.  Q
  1.  ;
  1. E1 ;
  1.  N LN,ESC,XIPSEED,ACNT,ECNT,ICNT,LCNT,TREC,NECNT
  1.  S (LN,ESC,ACNT,ECNT,ICNT,TREC,NECNT)=0,LCNT=9
  1.  K ^TMP("XIP DATA",$J)
  1.  S ^TMP("XIP DATA",$J)=""
  1.  S ^TMP("XIP DATA",$J,LCNT)=" ",LCNT=LCNT+1
  1.  S ^TMP("XIP DATA",$J,LCNT)="     **Detail Changes**",LCNT=LCNT+1
  1.  S ^TMP("XIP DATA",$J,LCNT)="IEN^MAIL CODE^CITY^COUNTY^STATE^INACTIVE DATE^CITY KEY^PREFERRED CITY KEY^CITY ABBREVIATION^UNIQUE KEY (VA)^FLAG",LCNT=LCNT+1
  1.  S XIPSEED=1 ; XIPSEED set to prevent "AD" from being set
  1.  ;
  1.  ; XQMSG is passed via the Server option
  1.  ; See Kernel Programmer, Page: 19-1
  1.  ; "Key Variables When a Server Option is Running"
  1.  ;
  1.  F  S LN=$O(^XMB(3.9,XQMSG,2,LN)) Q:'LN  D  Q:ESC
  1.  . I LN<1 Q
  1.  . N DATA,IEN,LKUP
  1.  . S DATA=^XMB(3.9,XQMSG,2,LN,0)
  1.  . I LN=1,DATA'="$$DATA$$" S ESC=1 Q
  1.  . I DATA="$$EOD$$" S TREC=$O(^XMB(3.9,XQMSG,2," "),-1),TREC=TREC-2,ESC=1 Q
  1.  . I DATA="$$DATA$$" Q
  1.  . I DATA="$$EOD$$" Q
  1.  . ;
  1.  . S LKUP=$P(DATA,U,9) ; UNIQUE KEY
  1.  . S IEN=+$O(^XIP(5.12,"E",LKUP,0))
  1. ADD . ;
  1.  . I 'IEN D  Q  ; New ZIP Code
  1.  .. N FIPSPTR,STPTR,Y
  1.  .. S FIPSPTR=0,STPTR=0
  1.  .. S FIPSPTR=+$O(^XIP(5.13,"B",$P(DATA,U,3),0))
  1.  .. I 'FIPSPTR Q  ;Broken FIPS
  1.  .. S STPTR=+$O(^DIC(5,"B",$P(DATA,U,4),0))
  1.  .. I 'STPTR Q  ;Broken STATE
  1.  .. N DO,DIC,X
  1.  .. S DIC="^XIP(5.12,",DIC(0)="Z",X=$P(DATA,U,1) D FILE^DICN
  1.  .. I Y<1 Q
  1.  .. N DA,DIE,DR
  1.  .. S DA=+Y,DIE=DIC
  1.  .. S DR="1///^S X=$P(DATA,U,2);2///^S X=""`""_FIPSPTR;3///^S X=""`""_STPTR;"
  1.  .. S DR=DR_"5///^S X=$P(DATA,U,6);6///^S X=$P(DATA,U,7);7///^S X=$P(DATA,U,8)"
  1.  .. F  L +^XIP(5.12,DA,0):$S($D(DILOCKTM):DILOCKTM,1:3) Q:$T  H $S($D(DILOCKTM):DILOCKTM,1:3)
  1.  .. D ^DIE
  1.  .. L -^XIP(5.12,DA,0)
  1.  .. S ACNT=ACNT+1
  1.  .. S ^TMP("XIP DATA",$J,LCNT)=DA_U_DATA_U_"New",LCNT=LCNT+1
  1.  .. Q
  1. INACT . ;
  1.  . I $P(DATA,U,5)'="" D  Q  ; INACTIVE DATE
  1.  .. I $P(^XIP(5.12,IEN,0),U,5)'="" S NECNT=NECNT+1 Q  ;Already has Inactive Date
  1.  .. N DIE,DA,DR
  1.  .. S DIE="^XIP(5.12,",DA=IEN,DR="4///^S X=$P(DATA,U,5)"
  1.  .. F  L +^XIP(5.12,DA,0):$S($D(DILOCKTM):DILOCKTM,1:3) Q:$T  H $S($D(DILOCKTM):DILOCKTM,1:3)
  1.  .. D ^DIE
  1.  .. L -^XIP(5.12,DA,0)
  1.  .. S ICNT=ICNT+1
  1.  .. S ^TMP("XIP DATA",$J,LCNT)=DA_U_DATA_U_"Inactivated",LCNT=LCNT+1
  1.  .. Q
  1. EDIT . ;
  1.  . D  Q  ; Edited Entry
  1.  .. N FIPSPTR,STPTR,FDATA
  1.  .. S FIPSPTR=0,STPTR=0
  1.  .. S FIPSPTR=+$O(^XIP(5.13,"B",$P(DATA,U,3),0))
  1.  .. I 'FIPSPTR Q  ;Broken FIPS
  1.  .. S STPTR=+$O(^DIC(5,"B",$P(DATA,U,4),0))
  1.  .. I 'STPTR Q  ;Broken STATE
  1.  .. S FDATA=^XIP(5.12,IEN,0)
  1.  .. S $P(FDATA,U,3)=$P(^XIP(5.13,$P(FDATA,U,3),0),U) ;Resolve COUNTY CODE
  1.  .. S $P(FDATA,U,4)=$P(^DIC(5,$P(FDATA,U,4),0),U) ;Resolve STATE
  1.  .. I DATA=FDATA S NECNT=NECNT+1 Q  ;Already been edited
  1.  .. N DA,DIE,DR
  1.  .. S DA=IEN,DIE="^XIP(5.12,"
  1.  .. S DR="1///^S X=$P(DATA,U,2);2///^S X=""`""_FIPSPTR;3///^S X=""`""_STPTR;"
  1.  .. I $P(DATA,U,5)="" S DR=DR_"4///^S X=""@"";" ;Ba added to reactivate a Postal code. P625
  1.  .. S DR=DR_"5///^S X=$P(DATA,U,6);6///^S X=$P(DATA,U,7);7///^S X=$P(DATA,U,8)"
  1.  .. F  L +^XIP(5.12,DA,0):$S($D(DILOCKTM):DILOCKTM,1:3) Q:$T  H $S($D(DILOCKTM):DILOCKTM,1:3)
  1.  .. D ^DIE
  1.  .. L -^XIP(5.12,DA,0)
  1.  .. S ECNT=ECNT+1
  1.  .. S ^TMP("XIP DATA",$J,LCNT)=DA_U_DATA_U_"Edited",LCNT=LCNT+1
  1.  .. Q
  1.  . Q
  1.  ;
  1. END ;
  1.  N TOT S TOT=ACNT+ICNT+ECNT
  1.  I 'TOT K ^TMP("XIP DATA",$J)
  1.  S LCNT=1
  1.  S ^TMP("XIP DATA",$J,LCNT)=" ",LCNT=LCNT+1
  1.  S ^TMP("XIP DATA",$J,LCNT)="*Summary for this Update*",LCNT=LCNT+1
  1.  S ^TMP("XIP DATA",$J,LCNT)="Total Data Records: "_TREC,LCNT=LCNT+1
  1.  S ^TMP("XIP DATA",$J,LCNT)="Unedited Records: "_NECNT,LCNT=LCNT+1
  1.  S ^TMP("XIP DATA",$J,LCNT)="New ZIP Codes: "_ACNT,LCNT=LCNT+1
  1.  S ^TMP("XIP DATA",$J,LCNT)="Inactivated ZIP Codes: "_ICNT,LCNT=LCNT+1
  1.  S ^TMP("XIP DATA",$J,LCNT)="Edited ZIP Codes: "_ECNT,LCNT=LCNT+1
  1.  S ^TMP("XIP DATA",$J,LCNT)="Total Changes: "_TOT,LCNT=LCNT+1
  1.  I 'TOT D
  1.  . S ^TMP("XIP DATA",$J,LCNT)="**Your POSTAL CODE(#5.12) file is current with the Master",LCNT=LCNT+1
  1.  . S ^TMP("XIP DATA",$J,LCNT)="  POSTAL CODE(#5.12) file.",LCNT=LCNT+1
  1.  . Q
  1.  ;
  1. SEND ; Send 'Results' message If & Only If there are MEMBERS
  1.  I $$GOTLOCAL^XMXAPIG("XIP POSTAL CODE UPDATE") D
  1.  . N MSGSBJ,ODUZ,MSG,WHO
  1.  . S MSG=$NA(^TMP("XIP DATA",$J))
  1.  . I DUZ<.5 S ODUZ=DUZ,DUZ=.5 ;** Change user to POSTMASTER **
  1.  . S MSGSBJ="POSTAL CODE(#5.12) File Update Results"
  1.  . S WHO("G.XIP POSTAL CODE UPDATE")=""
  1.  . D SENDMSG^XMXAPI(DUZ,MSGSBJ,.MSG,.WHO)
  1.  . I $G(ODUZ)'="" S DUZ=ODUZ ;** Change POSTMASTER back to current user **
  1.  . Q
  1.  K ^TMP("XIP DATA",$J) ; p461
  1.  Q
  1.  ;
  1. POST ;
  1.  N XU625
  1.  S XU625=$G(^XIP(5.12,52000,0))
  1.  I $P(XU625,"^",1,2)="34607^SPRING HILL" D REACT(52000,"@","34607 SPRING HILL")
  1.  S XU625=$G(^XIP(5.12,52003,0))
  1.  I $P(XU625,"^",1,2)="34610^SPRING HILL" D REACT(52003,"@","34610 SPRING HILL")
  1.  D DEL
  1.  Q
  1.  ;
  1. REACT(IEN,DATA,POSTAL) ;
  1.  N DIE,DA,DR
  1.  S DIE="^XIP(5.12,",DA=IEN,DR="4///^S X=DATA"
  1.  F  L +^XIP(5.12,DA,0):$S($D(DILOCKTM):DILOCKTM,1:3) Q:$T  H $S($D(DILOCKTM):DILOCKTM,1:3)
  1.  D MES^XPDUTL("Reactivate Postal Code "_POSTAL)
  1.  D ^DIE
  1.  L -^XIP(5.12,DA,0)
  1.  Q
  1.  ;
  1. DEL ;
  1.  ;D MES^XPDUTL("Deleting ""AD"" Cross Reference")
  1.  K ^XIP(5.12,"AD")
  1.  ;D MES^XPDUTL("Finished Deleting the ""AD"" Cross Reference")
  1.  Q