source: WorldVistAEHR/trunk/r/KERNEL-XU-A4A7-USC-XG-XLF-XNOA-XPD-XQ-XVIR-ZI-ZOSF-ZOSV-ZT-ZU-%Z-XIP--XQAB--XUC--XUR--ZIN--ZTED/XIPSRVR.m@ 623

Last change on this file since 623 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 4.3 KB
Line 
1XIPSRVR ;SFISC/SO- SERVER TO UPDATE THE POSTAL CODE(#5.12) FILE ;7:03 AM 12 Apr 2007
2 ;;8.0;KERNEL;**449**;Jul 10, 1995;Build 24
3 Q
4 ;
5E1 ;
6 N LN,ESC,XIPSEED,ACNT,ECNT,ICNT,LCNT,TREC,NECNT
7 S (LN,ESC,ACNT,ECNT,ICNT,TREC,NECNT)=0,LCNT=9
8 K ^TMP("XIP DATA",$J)
9 S ^TMP("XIP DATA",$J)=""
10 S ^TMP("XIP DATA",$J,LCNT)=" ",LCNT=LCNT+1
11 S ^TMP("XIP DATA",$J,LCNT)=" **Detail Changes**",LCNT=LCNT+1
12 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
13 S XIPSEED=1 ; XIPSEED set to prevent "AD" from being set
14 ;
15 ; XQMSG is passed via the Server option
16 ; See Kernel Programmer, Page: 19-1
17 ; "Key Variables When a Server Option is Running"
18 ;
19 F S LN=$O(^XMB(3.9,XQMSG,2,LN)) Q:'LN D Q:ESC
20 . I LN<1 Q
21 . N DATA,IEN,LKUP
22 . S DATA=^XMB(3.9,XQMSG,2,LN,0)
23 . I LN=1,DATA'="$$DATA$$" S ESC=1 Q
24 . I DATA="$$EOD$$" S TREC=$O(^XMB(3.9,XQMSG,2," "),-1),TREC=TREC-2,ESC=1 Q
25 . I DATA="$$DATA$$" Q
26 . I DATA="$$EOD$$" Q
27 . ;
28 . S LKUP=$P(DATA,U,9) ; UNIQUE KEY
29 . S IEN=+$O(^XIP(5.12,"E",LKUP,0))
30ADD . ;
31 . I 'IEN D Q ; New ZIP Code
32 .. N FIPSPTR,STPTR,Y
33 .. S FIPSPTR=0,STPTR=0
34 .. S FIPSPTR=+$O(^XIP(5.13,"B",$P(DATA,U,3),0))
35 .. I 'FIPSPTR Q ;Broken FIPS
36 .. S STPTR=+$O(^DIC(5,"B",$P(DATA,U,4),0))
37 .. I 'STPTR Q ;Broken STATE
38 .. N DO,DIC,X
39 .. S DIC="^XIP(5.12,",DIC(0)="Z",X=$P(DATA,U,1) D FILE^DICN
40 .. I Y<1 Q
41 .. N DA,DIE,DR
42 .. S DA=+Y,DIE=DIC
43 .. S DR="1///^S X=$P(DATA,U,2);2///^S X=""`""_FIPSPTR;3///^S X=""`""_STPTR;"
44 .. S DR=DR_"5///^S X=$P(DATA,U,6);6///^S X=$P(DATA,U,7);7///^S X=$P(DATA,U,8)"
45 .. F L +^XIP(5.12,DA,0):$S($D(DILOCKTM):DILOCKTM,1:3) Q:$T H $S($D(DILOCKTM):DILOCKTM,1:3)
46 .. D ^DIE
47 .. L -^XIP(5.12,DA,0)
48 .. S ACNT=ACNT+1
49 .. S ^TMP("XIP DATA",$J,LCNT)=DA_U_DATA_U_"New",LCNT=LCNT+1
50 .. Q
51INACT . ;
52 . I $P(DATA,U,5)'="" D Q ; INACTIVE DATE
53 .. I $P(^XIP(5.12,IEN,0),U,5)'="" S NECNT=NECNT+1 Q ;Already has Inactive Date
54 .. N DIE,DA,DR
55 .. S DIE="^XIP(5.12,",DA=IEN,DR="4///^S X=$P(DATA,U,5)"
56 .. F L +^XIP(5.12,DA,0):$S($D(DILOCKTM):DILOCKTM,1:3) Q:$T H $S($D(DILOCKTM):DILOCKTM,1:3)
57 .. D ^DIE
58 .. L -^XIP(5.12,DA,0)
59 .. S ICNT=ICNT+1
60 .. S ^TMP("XIP DATA",$J,LCNT)=DA_U_DATA_U_"Inactivated",LCNT=LCNT+1
61 .. Q
62EDIT . ;
63 . D Q ; Edited Entry
64 .. N FIPSPTR,STPTR,FDATA
65 .. S FIPSPTR=0,STPTR=0
66 .. S FIPSPTR=+$O(^XIP(5.13,"B",$P(DATA,U,3),0))
67 .. I 'FIPSPTR Q ;Broken FIPS
68 .. S STPTR=+$O(^DIC(5,"B",$P(DATA,U,4),0))
69 .. I 'STPTR Q ;Broken STATE
70 .. S FDATA=^XIP(5.12,IEN,0)
71 .. S $P(FDATA,U,3)=$P(^XIP(5.13,$P(FDATA,U,3),0),U) ;Resolve COUNTY CODE
72 .. S $P(FDATA,U,4)=$P(^DIC(5,$P(FDATA,U,4),0),U) ;Resolve STATE
73 .. I DATA=FDATA S NECNT=NECNT+1 Q ;Already been edited
74 .. N DA,DIE,DR
75 .. S DA=IEN,DIE="^XIP(5.12,"
76 .. S DR="1///^S X=$P(DATA,U,2);2///^S X=""`""_FIPSPTR;3///^S X=""`""_STPTR;"
77 .. S DR=DR_"5///^S X=$P(DATA,U,6);6///^S X=$P(DATA,U,7);7///^S X=$P(DATA,U,8)"
78 .. F L +^XIP(5.12,DA,0):$S($D(DILOCKTM):DILOCKTM,1:3) Q:$T H $S($D(DILOCKTM):DILOCKTM,1:3)
79 .. D ^DIE
80 .. L -^XIP(5.12,DA,0)
81 .. S ECNT=ECNT+1
82 .. S ^TMP("XIP DATA",$J,LCNT)=DA_U_DATA_U_"Edited",LCNT=LCNT+1
83 .. Q
84 . Q
85 ;
86END ;
87 N TOT S TOT=ACNT+ICNT+ECNT
88 I 'TOT K ^TMP("XIP DATA",$J)
89 S LCNT=1
90 S ^TMP("XIP DATA",$J,LCNT)=" ",LCNT=LCNT+1
91 S ^TMP("XIP DATA",$J,LCNT)="*Summary for this Update*",LCNT=LCNT+1
92 S ^TMP("XIP DATA",$J,LCNT)="Total Data Records: "_TREC,LCNT=LCNT+1
93 S ^TMP("XIP DATA",$J,LCNT)="Unedited Records: "_NECNT,LCNT=LCNT+1
94 S ^TMP("XIP DATA",$J,LCNT)="New ZIP Codes: "_ACNT,LCNT=LCNT+1
95 S ^TMP("XIP DATA",$J,LCNT)="Inactivated ZIP Codes: "_ICNT,LCNT=LCNT+1
96 S ^TMP("XIP DATA",$J,LCNT)="Edited ZIP Codes: "_ECNT,LCNT=LCNT+1
97 S ^TMP("XIP DATA",$J,LCNT)="Total Changes: "_TOT,LCNT=LCNT+1
98 I 'TOT D
99 . S ^TMP("XIP DATA",$J,LCNT)="**Your POSTAL CODE(#5.12) file is current with the Master",LCNT=LCNT+1
100 . S ^TMP("XIP DATA",$J,LCNT)=" POSTAL CODE(#5.12) file.",LCNT=LCNT+1
101 . Q
102 ;
103SEND ; Send 'Results' message If & Only If there are MEMBERS
104 I $$GOTLOCAL^XMXAPIG("XIP POSTAL CODE UPDATE") D
105 . N MSGSBJ,ODUZ,MSG,WHO
106 . S MSG=$NA(^TMP("XIP DATA",$J))
107 . I DUZ<.5 S ODUZ=DUZ,DUZ=.5 ;** Change user to POSTMASTER **
108 . S MSGSBJ="POSTAL CODE(#5.12) File Update Results"
109 . S WHO("G.XIP POSTAL CODE UPDATE")=""
110 . D SENDMSG^XMXAPI(DUZ,MSGSBJ,.MSG,.WHO)
111 . I $G(ODUZ)'="" S DUZ=ODUZ ;** Change POSTMASTER back to current user **
112 . K ^TMP("XIPDATA",$J)
113 . Q
114 Q
Note: See TracBrowser for help on using the repository browser.