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

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

initial load of FOIAVistA 6/30/08 version

File size: 2.4 KB
Line 
1XU8P328D ;OIFOO/SO- SCAN FOR PATIENT COUNTY BEGIN WITH "ZZ";6:36 AM 8 Jul 2004
2 ;;8.0;KERNEL;**328**;Jul 10, 1995
3 ; Post Install Entry Point
4 N FIX S FIX=0
5 I '$D(XPDNM) D DEVICE Q:POP Q:$D(ZTSK) U IO
6SCAN ;
7 D MES^XPDUTL("Begin Patient File scan for patients with ""ZZ..."" County...")
8 N DFN S DFN=0 N II N CNT S CNT=0
9 F II=0:1 S DFN=$O(^DPT(DFN)) Q:'DFN D
10 . I (II/10000)=(II\10000) D MES^XPDUTL("Scanned: "_II_" patients so far.")
11 . N PDATA,FLDS,DIERR,ZER
12 . S FLDS=".01;.0905;.114;.115;.116;.117"
13 . ; .01=NAME
14 . ; .0905=1U4N
15 . ; .114=CITY
16 . ; .115=STATE FILE POINTER
17 . ; .116=ZIP CODE
18 . ; .117=COUNTY MULTIPLE IEN
19 . ;
20 . D GETS^DIQ(2,DFN_",",FLDS,"I","PDATA","ZER")
21 . N CIEN S CIEN=+$G(PDATA(2,DFN_",",.117,"I")) Q:'CIEN
22 . N SIEN S SIEN=+$G(PDATA(2,DFN_",",.115,"I")) Q:'SIEN
23 . N CO S CO=$$GET1^DIQ(5.01,CIEN_","_SIEN_",",".01")
24 . I CO="" Q
25 . I CO]"",$E(CO,1,2)'="ZZ" Q
26 . S CNT=CNT+1
27 . I 'FIX D NAME
28 . I FIX D
29 .. N ZIP S ZIP=$G(PDATA(2,DFN_",",.116,"I")) Q:ZIP=""
30 .. N CITY S CITY=$G(PDATA(2,DFN_",",.114,"I")) Q:CITY=""
31 .. N ZDATA
32 .. D POSTALB^XIPUTIL(ZIP,.ZDATA)
33 .. I $D(ZDATA("ERROR")) D NAME,MES^XPDUTL(" **Unable to find Patient's ZIP code.") Q
34 .. N III,FLAG S FLAG=0
35 .. F III=1:1:ZDATA D
36 ... I ZDATA(III,"CITY")["*" S ZDATA(III,"CITY")=$TR(ZDATA(III,"CITY"),"*","") ; Remove trailing "*"
37 ... I ZDATA(III,"CITY")=CITY,ZDATA(III,"STATE POINTER")=SIEN,ZDATA(III,"POSTAL CODE")=ZIP D Q
38 .... S FLAG=1
39 .... ; IA #4453
40 .... N DIERR,ZERR,FDA
41 .... S FDA(2,DFN_",",.117)=ZDATA(III,"COUNTY")
42 .... D FILE^DIE("E","FDA","ZERR")
43 .... I $D(DIERR) D NAME,MES^XPDUTL(" **Unable to file Patient's COUNTY.") Q
44 .... Q
45 ... Q
46 .. I 'FLAG D NAME,MES^XPDUTL(" ** City and State do not match ZIP code.")
47 .. Q
48 . Q
49 D MES^XPDUTL("Total Number of Patients who's County begins with ""ZZ"": "_CNT)
50 D MES^XPDUTL("Total Number of Patients examined: "_II)
51 D MES^XPDUTL("Finished Patient File scan.")
52 I '$D(XPDNM) D ^%ZISC
53 Q
54 ;
55FIX ; Repair Entry Point
56 N FIX S FIX=1
57 D DEVICE Q:POP Q:$D(ZTSK) U IO
58DEQUE ; Queued Entry Point
59 D SCAN
60 Q
61 ;
62NAME ; Display Name
63 N X
64 S X="Name: "_PDATA(2,DFN_",",.01,"I")_"; 1U4N: "_PDATA(2,DFN_",",.0905,"I")_"; Current County: "_CO
65 D MES^XPDUTL(X)
66 Q
67 ;
68DEVICE ; Use P-MESSAGE for default device
69 N %ZIS S %ZIS="MQ",%ZIS("B")="P-MESSAGE"
70 D ^%ZIS Q:POP
71 I $D(IO("Q")) D K IO("Q") Q
72 . N ZTSAVE,ZTRTN,ZTDESC
73 . S ZTSAVE("FIX")=""
74 . S ZTRTN="DEQUE^XU8P328D"
75 . S ZTDESC="QUEUED 'ZZ'_COUNTY REPAIR"
76 . D ^%ZTLOAD
77 . D HOME^%ZIS
78 . Q
79 Q
Note: See TracBrowser for help on using the repository browser.