XU8P328D ;OIFOO/SO- SCAN FOR PATIENT COUNTY BEGIN WITH "ZZ";6:36 AM 8 Jul 2004
;;8.0;KERNEL;**328**;Jul 10, 1995
; Post Install Entry Point
N FIX S FIX=0
I '$D(XPDNM) D DEVICE Q:POP Q:$D(ZTSK) U IO
SCAN ;
D MES^XPDUTL("Begin Patient File scan for patients with ""ZZ..."" County...")
N DFN S DFN=0 N II N CNT S CNT=0
F II=0:1 S DFN=$O(^DPT(DFN)) Q:'DFN D
. I (II/10000)=(II\10000) D MES^XPDUTL("Scanned: "_II_" patients so far.")
. N PDATA,FLDS,DIERR,ZER
. S FLDS=".01;.0905;.114;.115;.116;.117"
. ; .01=NAME
. ; .0905=1U4N
. ; .114=CITY
. ; .115=STATE FILE POINTER
. ; .116=ZIP CODE
. ; .117=COUNTY MULTIPLE IEN
. ;
. D GETS^DIQ(2,DFN_",",FLDS,"I","PDATA","ZER")
. N CIEN S CIEN=+$G(PDATA(2,DFN_",",.117,"I")) Q:'CIEN
. N SIEN S SIEN=+$G(PDATA(2,DFN_",",.115,"I")) Q:'SIEN
. N CO S CO=$$GET1^DIQ(5.01,CIEN_","_SIEN_",",".01")
. I CO="" Q
. I CO]"",$E(CO,1,2)'="ZZ" Q
. S CNT=CNT+1
. I 'FIX D NAME
. I FIX D
.. N ZIP S ZIP=$G(PDATA(2,DFN_",",.116,"I")) Q:ZIP=""
.. N CITY S CITY=$G(PDATA(2,DFN_",",.114,"I")) Q:CITY=""
.. N ZDATA
.. D POSTALB^XIPUTIL(ZIP,.ZDATA)
.. I $D(ZDATA("ERROR")) D NAME,MES^XPDUTL(" **Unable to find Patient's ZIP code.") Q
.. N III,FLAG S FLAG=0
.. F III=1:1:ZDATA D
... I ZDATA(III,"CITY")["*" S ZDATA(III,"CITY")=$TR(ZDATA(III,"CITY"),"*","") ; Remove trailing "*"
... I ZDATA(III,"CITY")=CITY,ZDATA(III,"STATE POINTER")=SIEN,ZDATA(III,"POSTAL CODE")=ZIP D Q
.... S FLAG=1
.... ; IA #4453
.... N DIERR,ZERR,FDA
.... S FDA(2,DFN_",",.117)=ZDATA(III,"COUNTY")
.... D FILE^DIE("E","FDA","ZERR")
.... I $D(DIERR) D NAME,MES^XPDUTL(" **Unable to file Patient's COUNTY.") Q
.... Q
... Q
.. I 'FLAG D NAME,MES^XPDUTL(" ** City and State do not match ZIP code.")
.. Q
. Q
D MES^XPDUTL("Total Number of Patients who's County begins with ""ZZ"": "_CNT)
D MES^XPDUTL("Total Number of Patients examined: "_II)
D MES^XPDUTL("Finished Patient File scan.")
I '$D(XPDNM) D ^%ZISC
Q
;
FIX ; Repair Entry Point
N FIX S FIX=1
D DEVICE Q:POP Q:$D(ZTSK) U IO
DEQUE ; Queued Entry Point
D SCAN
Q
;
NAME ; Display Name
N X
S X="Name: "_PDATA(2,DFN_",",.01,"I")_"; 1U4N: "_PDATA(2,DFN_",",.0905,"I")_"; Current County: "_CO
D MES^XPDUTL(X)
Q
;
DEVICE ; Use P-MESSAGE for default device
N %ZIS S %ZIS="MQ",%ZIS("B")="P-MESSAGE"
D ^%ZIS Q:POP
I $D(IO("Q")) D K IO("Q") Q
. N ZTSAVE,ZTRTN,ZTDESC
. S ZTSAVE("FIX")=""
. S ZTRTN="DEQUE^XU8P328D"
. S ZTDESC="QUEUED 'ZZ'_COUNTY REPAIR"
. D ^%ZTLOAD
. D HOME^%ZIS
. Q
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXU8P328D 2578 printed Nov 22, 2024@17:17:25 Page 2
XU8P328D ;OIFOO/SO- SCAN FOR PATIENT COUNTY BEGIN WITH "ZZ";6:36 AM 8 Jul 2004
+1 ;;8.0;KERNEL;**328**;Jul 10, 1995
+2 ; Post Install Entry Point
+3 NEW FIX
SET FIX=0
+4 IF '$DATA(XPDNM)
DO DEVICE
if POP
QUIT
if $DATA(ZTSK)
QUIT
USE IO
SCAN ;
+1 DO MES^XPDUTL("Begin Patient File scan for patients with ""ZZ..."" County...")
+2 NEW DFN
SET DFN=0
NEW II
NEW CNT
SET CNT=0
+3 FOR II=0:1
SET DFN=$ORDER(^DPT(DFN))
if 'DFN
QUIT
Begin DoDot:1
+4 IF (II/10000)=(II\10000)
DO MES^XPDUTL("Scanned: "_II_" patients so far.")
+5 NEW PDATA,FLDS,DIERR,ZER
+6 SET FLDS=".01;.0905;.114;.115;.116;.117"
+7 ; .01=NAME
+8 ; .0905=1U4N
+9 ; .114=CITY
+10 ; .115=STATE FILE POINTER
+11 ; .116=ZIP CODE
+12 ; .117=COUNTY MULTIPLE IEN
+13 ;
+14 DO GETS^DIQ(2,DFN_",",FLDS,"I","PDATA","ZER")
+15 NEW CIEN
SET CIEN=+$GET(PDATA(2,DFN_",",.117,"I"))
if 'CIEN
QUIT
+16 NEW SIEN
SET SIEN=+$GET(PDATA(2,DFN_",",.115,"I"))
if 'SIEN
QUIT
+17 NEW CO
SET CO=$$GET1^DIQ(5.01,CIEN_","_SIEN_",",".01")
+18 IF CO=""
QUIT
+19 IF CO]""
IF $EXTRACT(CO,1,2)'="ZZ"
QUIT
+20 SET CNT=CNT+1
+21 IF 'FIX
DO NAME
+22 IF FIX
Begin DoDot:2
+23 NEW ZIP
SET ZIP=$GET(PDATA(2,DFN_",",.116,"I"))
if ZIP=""
QUIT
+24 NEW CITY
SET CITY=$GET(PDATA(2,DFN_",",.114,"I"))
if CITY=""
QUIT
+25 NEW ZDATA
+26 DO POSTALB^XIPUTIL(ZIP,.ZDATA)
+27 IF $DATA(ZDATA("ERROR"))
DO NAME
DO MES^XPDUTL(" **Unable to find Patient's ZIP code.")
QUIT
+28 NEW III,FLAG
SET FLAG=0
+29 FOR III=1:1:ZDATA
Begin DoDot:3
+30 ; Remove trailing "*"
IF ZDATA(III,"CITY")["*"
SET ZDATA(III,"CITY")=$TRANSLATE(ZDATA(III,"CITY"),"*","")
+31 IF ZDATA(III,"CITY")=CITY
IF ZDATA(III,"STATE POINTER")=SIEN
IF ZDATA(III,"POSTAL CODE")=ZIP
Begin DoDot:4
+32 SET FLAG=1
+33 ; IA #4453
+34 NEW DIERR,ZERR,FDA
+35 SET FDA(2,DFN_",",.117)=ZDATA(III,"COUNTY")
+36 DO FILE^DIE("E","FDA","ZERR")
+37 IF $DATA(DIERR)
DO NAME
DO MES^XPDUTL(" **Unable to file Patient's COUNTY.")
QUIT
+38 QUIT
End DoDot:4
QUIT
+39 QUIT
End DoDot:3
+40 IF 'FLAG
DO NAME
DO MES^XPDUTL(" ** City and State do not match ZIP code.")
+41 QUIT
End DoDot:2
+42 QUIT
End DoDot:1
+43 DO MES^XPDUTL("Total Number of Patients who's County begins with ""ZZ"": "_CNT)
+44 DO MES^XPDUTL("Total Number of Patients examined: "_II)
+45 DO MES^XPDUTL("Finished Patient File scan.")
+46 IF '$DATA(XPDNM)
DO ^%ZISC
+47 QUIT
+48 ;
FIX ; Repair Entry Point
+1 NEW FIX
SET FIX=1
+2 DO DEVICE
if POP
QUIT
if $DATA(ZTSK)
QUIT
USE IO
DEQUE ; Queued Entry Point
+1 DO SCAN
+2 QUIT
+3 ;
NAME ; Display Name
+1 NEW X
+2 SET X="Name: "_PDATA(2,DFN_",",.01,"I")_"; 1U4N: "_PDATA(2,DFN_",",.0905,"I")_"; Current County: "_CO
+3 DO MES^XPDUTL(X)
+4 QUIT
+5 ;
DEVICE ; Use P-MESSAGE for default device
+1 NEW %ZIS
SET %ZIS="MQ"
SET %ZIS("B")="P-MESSAGE"
+2 DO ^%ZIS
if POP
QUIT
+3 IF $DATA(IO("Q"))
Begin DoDot:1
+4 NEW ZTSAVE,ZTRTN,ZTDESC
+5 SET ZTSAVE("FIX")=""
+6 SET ZTRTN="DEQUE^XU8P328D"
+7 SET ZTDESC="QUEUED 'ZZ'_COUNTY REPAIR"
+8 DO ^%ZTLOAD
+9 DO HOME^%ZIS
+10 QUIT
End DoDot:1
KILL IO("Q")
QUIT
+11 QUIT
