source: FOIAVistA/trunk/r/PCE_PATIENT_CARE_ENCOUNTER-AUTN-EFDP-PX-VSIT--PXRM/PXDELFIX.m@ 1535

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

initial load of FOIAVistA 6/30/08 version

File size: 4.0 KB
Line 
1PXDELFIX ;BAY/RJV-CLEAN ENCOUNTERS POINTING TO VISITS THAT DON'T EXIST PART 2. ;14-JUN-2005
2 ;;1.0;PCE;**153**;14-JUL-2004
3 Q
4 ;**********************************************************
5 ;Two entry points. FIXALL and FIXIND. Called from PXDELENC.
6 ;**********************************************************
7FIXALL ; Fix all encounters.
8 N DA,DIK,PXPAT,PXSDATE,PXENC,PXSEC,PXCOUNT,PXPATNM,Y
9 S PXPAT="",PXSDATE="",PXENC=""
10 S PXCOUNT=$G(^XTMP("PXDELENC","PXENC","PXCOUNT"))
11 I PXCOUNT=0 D Q
12 .W !!,"There are no build entries to correct!"
13 .D WAIT^PXDELENC
14 I $G(^XTMP("PXDELENC","END BUILD"))="RUNNING" D Q
15 .W !!,"Build is running, please wait until complete!"
16 .D WAIT^PXDELENC
17 W !!,"There are "_$G(PXCOUNT)_" entries to correct."
18 S DIR("A")="Do you wish to continue? "
19 S DIR(0)="Y",DIR("B")="YES"
20 D ^DIR Q:$D(DIRUT)
21 Q:Y=0
22 K DIR,DA,DIRUT
23 F S PXPAT=$O(^XTMP("PXDELENC","PXENC",PXPAT)) Q:PXPAT="" D
24 .F S PXSDATE=$O(^XTMP("PXDELENC","PXENC",PXPAT,PXSDATE)) Q:PXSDATE="" D
25 ..F S PXENC=$O(^XTMP("PXDELENC","PXENC",PXPAT,PXSDATE,PXENC)) Q:PXENC="" D
26 ...S PXSEC=$G(^XTMP("PXDELENC","PXENC",PXPAT,PXSDATE,PXENC))
27 ...S PXPATNM=$P($G(^DPT(PXPAT,0)),"^",1)
28 ...S $P(^DPT(PXPAT,"S",PXSDATE,0),"^",2)="NT"
29 ...S $P(^DPT(PXPAT,"S",PXSDATE,0),"^",20)=""
30 ...S DIK="^SCE(",DA=PXENC D ^DIK
31 ...I $G(PXSEC)'="" S DIK="^SCE(",DA=PXSEC D ^DIK
32 ...S PXCOUNT=PXCOUNT-1
33 ...K ^XTMP("PXDELENC","PXENC",PXPAT,PXSDATE,PXENC)
34 ...W !!,?3,"Encounter: ",?12,$G(PXENC)_" - "_$G(PXPATNM),?45," Fixed!",!
35 ...S DA=PXPAT D FIXIHS
36 S ^XTMP("PXDELENC","PXENC","PXCOUNT")=PXCOUNT
37 D WAIT^PXDELENC
38 Q
39FIXIND ; Fix individual encounters.
40 N PXPAT,PXSDATE,PXSDTE,PXENC,PXVISIT,PXPRIM,PXEXIST,PXCOUNT,DIC,PXSEC,Y
41 I $G(^XTMP("PXDELENC","END BUILD"))="RUNNING" D Q
42 .W !!,"Build is running, please wait until complete!"
43 .D WAIT^PXDELENC
44 S DIC(0)="AEMQ"
45 D ^DPTLK I Y=-1 Q
46 Q:$D(DIRUT)
47 S PXPAT=$P(Y,"^")
48 S PXSDATE=0,PXENC="",PXPRIM="",PXSEC="",PXEXIST=0
49 S PXCOUNT=$G(^XTMP("PXDELENC","PXENC","PXCOUNT"))
50 W !!,"Processing...."
51 D HEADER
52DISPLAY ;
53 F S PXSDATE=$O(^SCE("ADFN",PXPAT,PXSDATE)) Q:PXSDATE=""!($D(DIRUT)) D Q:$D(DIRUT)
54 .F S PXENC=$O(^SCE("ADFN",PXPAT,PXSDATE,PXENC)) Q:PXENC=""!($D(DIRUT)) D
55 ..S PXVISIT=$P($G(^SCE(PXENC,0)),"^",5)
56 ..S PXPRIM=$P($G(^SCE(PXENC,0)),"^",6)
57 ..I $G(PXVISIT)'="" Q
58 ..I $G(PXPRIM)'="" Q
59 ..I $G(PXVISIT)="",$G(PXPRIM)="",$D(^DPT(PXPAT,"S",PXSDATE,0)) D
60 ...S Y=PXSDATE D DD^%DT S PXSDTE=Y,PXEXIST=1
61 ...S PXPATNM=$P($G(^DPT(PXPAT,0)),"^",1)
62 ...W ?3,PXPAT_" - "_PXPATNM,?35,PXSDTE,?55,PXENC,!
63 ...S ^XTMP("PXDELENC","FIXIND",PXPAT,PXSDATE,PXENC)=""
64 I $G(PXEXIST)=0 G NONE
65 S DIR("A")="This will fix all entries for this Patient. Continue? "
66 S DIR(0)="Y",DIR("B")="YES"
67 D ^DIR
68 G:$D(DIRUT) FIXIND
69 K DIR,DA,DIRUT
70 I Y=0 G FIXIND
71FIX ;
72 N PXPAT,PXSDTE,PXENC
73 S PXPAT="",PXSDTE="",PXENC=""
74 F S PXPAT=$O(^XTMP("PXDELENC","FIXIND",PXPAT)) Q:PXPAT="" D
75 .F S PXSDTE=$O(^XTMP("PXDELENC","FIXIND",PXPAT,PXSDTE)) Q:PXSDTE="" D
76 ..F S PXENC=$O(^XTMP("PXDELENC","FIXIND",PXPAT,PXSDTE,PXENC)) Q:PXENC="" D
77 ...S $P(^DPT(PXPAT,"S",PXSDTE,0),"^",20)=""
78 ...S $P(^DPT(PXPAT,"S",PXSDTE,0),"^",2)="NT"
79 ...I $P($G(^SCE(PXENC+1,0)),"^",6)=PXENC S PXSEC=PXENC+1
80 ...S DIK="^SCE(",DA=PXENC D ^DIK
81 ...I $G(PXSEC)'="" S DIK="^SCE(",DA=PXSEC D ^DIK
82 ...I $D(^XTMP("PXDELENC","PXENC",PXPAT,PXSDTE,PXENC)) S PXCOUNT=PXCOUNT-1
83 ...K ^XTMP("PXDELENC","PXENC",PXPAT,PXSDTE,PXENC)
84 ...K ^XTMP("PXDELENC","FIXIND",PXPAT,PXSDTE,PXENC)
85 ...W !!,?3,"Encounter: ",?12,$G(PXENC)_" - "_$G(PXPATNM),?45," Fixed!",!
86 ...S DA=PXPAT D FIXIHS
87 S ^XTMP("PXDELENC","PXENC","PXCOUNT")=PXCOUNT
88 Q:$D(DIRUT)
89 I PXEXIST=1 D
90 .W !!,"No more missing visits to correct for this patient!"
91 .D WAIT^PXDELENC
92NONE ;
93 I PXEXIST=0 D
94 .W !!,"No missing visits found for this patient!"
95 .D WAIT^PXDELENC
96 K ^XTMP("PXDELENC","FIXIND")
97 G FIXIND
98 Q
99HEADER ;
100 W !,?3,"Patient IEN - Name",?35,"Appt Date",?55,"Encounter"
101 W !,?3,"==================",?35,"=========",?55,"=========",!
102 Q
103FIXIHS ; Will fix the IHS Patient (9000001) file entries.
104 N PX
105 S U="^"
106 D CHECK^PXXDPT Q:'$T
107 S PX=$P($G(^DPT(DA,0)),U,9)
108 D SETSSN^PXXDPT
109 K DR,DIE,DA,PXDA
110 Q
111 ;
Note: See TracBrowser for help on using the repository browser.