source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DG53P593.m@ 1800

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

initial load of WorldVistAEHR

File size: 5.1 KB
RevLine 
[613]1DG53P593 ;BAY/JAT - Patient File Cleanup; 2/22/1999 ; 6/24/04 3:43pm
2 ;;5.3;Registration;**593**;Aug 13,1993
3 Q
4 ;
5CLEANUP ;This entry point will do the cleanup.
6 ;
7 N DGENSKIP
8 S DGENSKIP=0
9 W !,"This is a one-time cleanup of the Patient File."
10 W !,"Certain records which were created in error will be deleted."
11 N X1,X2
12 K ^XTMP("DG53P593",$J)
13 S X1=DT,X2=90 D C^%DTC
14 S ^XTMP("DG53P593",$J,0)=X_"^"_DT_"^Patient File cleanup"
15 I $$DEVICE() D ENTER
16 Q
17 ;
18REPORT ;This entry point was provided for testing, so that before
19 ;patient records are deleted the site can have a list of
20 ;the DFN's that would be deleted.
21 ;
22 ;Use this entry point to report on what the cleanup would do.
23 ;No changes will be made to the database.
24 ;
25 N DGENSKIP
26 S DGENSKIP=1
27 W !,"This is a preliminary report by DFN of the Patient file"
28 W !,"records which would be deleted by the cleanup."
29 N X1,X2
30 K ^XTMP("DG53P593",$J)
31 S X1=DT,X2=90 D C^%DTC
32 S ^XTMP("DG53P593",$J,0)=X_"^"_DT_"^Patient File cleanup"
33 I $$DEVICE() D ENTER
34 Q
35 ;
36ENTER ;
37 ;
38 D DELETE(DGENSKIP)
39 D:(DGENSKIP) ^%ZISC
40 I $D(ZTQUEUED) S ZTREQ="@"
41 Q
42DEVICE() ;
43 ;Description: allows the user to select a device.
44 ;
45 ;Output:
46 ; Function Value - Returns 0 if the user decides not to print or to
47 ; queue the report, 1 otherwise.
48 ;
49 N OK,IOP,POP,%ZIS
50 S OK=1
51 S %ZIS="MQ"
52 D ^%ZIS
53 S:POP OK=0
54 D:OK&$D(IO("Q"))
55 .N ZTRTN,ZTDESC,ZTSKM,ZTREQ,ZTSTOP
56 .S ZTRTN="ENTER^DG53P593",ZTDESC=$S(DGENSKIP:"Report",1:"Cleanup")_" of Incomplete Patient Records"
57 .S ZTSAVE("DGENSKIP")=""
58 .D ^%ZTLOAD
59 .W !,$S($D(ZTSK):"REQUEST QUEUED TASK="_ZTSK,1:"REQUEST CANCELLED")
60 .D HOME^%ZIS
61 .S OK=0
62 Q OK
63 ;
64DELETE(DGENSKIP) ;
65 ;This will delete bogus patient records --
66 ;
67 ;Input: If DGENSKIP=1, the records will not be deleted,
68 ;just reported.
69 ;
70 N DFN,SUB,GOOD,COUNT,DGNAME,DGDEL,DGSORT,DGVAL,DGFDA,DGERR
71 S (COUNT,DFN)=0
72 F S DFN=$O(^DPT(DFN)) Q:'DFN D
73 .; merged record
74 .I $D(^DPT(DFN,-9)) Q
75 .; in process of being merged
76 .I $P($G(^DPT(DFN,0)),U)["MERGING INTO" Q
77 .; usual good patient record
78 .I $D(^DPT(DFN,0)) S DGNAME=$P($G(^DPT(DFN,0)),U) I DGNAME'="",$D(^DPT("B",DGNAME,DFN)) Q
79 .; evaluate if record related to DG*5.3*578
80 .D EVAL578
81 .; evaluate if record related to DG*5.3*222
82 .S GOOD=0
83 .S SUB=""
84 .F S SUB=$O(^DPT(DFN,SUB)) Q:SUB="" D
85 ..I (SUB'=.3),(SUB'=.38),(SUB'=.52) S GOOD=1 Q
86 .I 'GOOD D DIKDEL Q
87 .I DGDEL D DIKDEL
88 ;
89 D PRINT
90 Q
91 ;
92EVAL578 ;
93 S DGDEL=0
94 N DGCNT,DGNODE,DGSSN,DGNEWIEN,DGMPI
95 I '$D(^DPT(DFN,0)) Q
96 S DGNODE=""
97 S DGCNT=0
98 F S DGNODE=$O(^DPT(DFN,DGNODE)) Q:DGNODE="" S DGCNT=DGCNT+1
99 ; there must be minimal data, so skip if too many nodes
100 Q:DGCNT>7
101 I DGNAME="" S DGDEL=DGDEL+1
102 I DGNAME'="",'$D(^DPT("B",DGNAME,DFN)) S DGDEL=DGDEL+1
103 S DGSSN=$P($G(^DPT(DFN,0)),U,9)
104 I DGSSN="" S DGDEL=DGDEL+1
105 I DGSSN'="",'$D(^DPT("SSN",DGSSN,DFN)) S DGDEL=DGDEL+1 D
106 .S DGNEWIEN=0
107 .F S DGNEWIEN=$O(^DPT("SSN",DGSSN,DGNEWIEN)) Q:'DGNEWIEN I DGNEWIEN S DGDEL=DGDEL+1
108 S DGMPI=$E($P($G(^DPT(DFN,"MPI")),U),1,3)
109 I DGMPI="" S DGDEL=DGDEL+1
110 ; checking if only local ICN
111 I DGMPI=+$$SITE^VASITE() S DGDEL=DGDEL+1
112 I DGDEL>1 Q
113 S DGDEL=0
114 Q
115 ;
116DIKDEL ;
117 S COUNT=COUNT+1
118 S DGSORT=$S('GOOD:2,1:1)
119 S ^XTMP("DG53P593",$J,DGSORT,DFN)=$S(DGSORT=1:"Related to DG*5.3*578",1:"Related to DG*5.3*222")
120 I 'DGENSKIP D
121 .D DELEXE
122 .I '$D(^DPT(DFN,0)) D Q
123 ..S DA=DFN,DIK="^DPT(" D ^DIK K DA,DIK
124 .I $P($G(^DPT(DFN,0)),U)="" K ^DPT(DFN) Q
125 .S DGVAL="@"
126 .S DGFDA(2,DFN_",",.01)=DGVAL
127 .D FILE^DIE("","DGFDA","DGERR")
128 Q
129 ;
130DELEXE ; Delete exceptions on file for patient record being removed.
131 S EXCT=""
132 F S EXCT=$O(^RGHL7(991.1,"ADFN",EXCT)) Q:EXCT="" D
133 . I $D(^RGHL7(991.1,"ADFN",EXCT,DFN)) D
134 .. S IEN=0
135 .. F S IEN=$O(^RGHL7(991.1,"ADFN",EXCT,DFN,IEN)) Q:'IEN D
136 ... S IEN2=0
137 ... F S IEN2=$O(^RGHL7(991.1,"ADFN",EXCT,DFN,IEN,IEN2)) Q:'IEN2 D
138 .... S NUM="" S NUM=$P(^RGHL7(991.1,IEN,1,0),"^",4)
139 .... I NUM=1 D
140 ..... L +^RGHL7(991.1,IEN):10
141 ..... S DIK="^RGHL7(991.1,",DA=IEN
142 ..... D ^DIK K DIK,DA
143 ..... L -^RGHL7(991.1,IEN)
144 .... E I NUM>1 D DELE
145 K EXCT,IEN,IEN2,NUM
146 Q
147DELE ; delete exception
148 L +^RGHL7(991.1,IEN):10
149 S DA(1)=IEN,DA=IEN2
150 S DIK="^RGHL7(991.1,"_DA(1)_",1,"
151 D ^DIK K DIK,DA
152 L -^RGHL7(991.1,IEN)
153 Q
154PRINT ;
155 U IO
156 N DGDDT,DGQUIT,DGPG
157 S DGDDT=$$FMTE^XLFDT($$NOW^XLFDT,"D")
158 S (DGQUIT,DGPG)=0
159 D HEAD
160 I '$G(COUNT) D Q
161 .W !!!,?20,"*** No records to report ***"
162 W !!,"*** COUNT OF BAD PATIENT RECORDS"_$S(DGENSKIP:"",1:" DELETED")_": ",COUNT," ***",!!
163 S DGSORT=0
164 F S DGSORT=$O(^XTMP("DG53P593",$J,DGSORT)) Q:'DGSORT D Q:DGQUIT
165 .S DFN=0
166 .F S DFN=$O(^XTMP("DG53P593",$J,DGSORT,DFN)) Q:'DFN D Q:DGQUIT
167 ..I $Y>(IOSL-4) D HEAD
168 ..W ?2,DFN,?15,$G(^XTMP("DG53P593",$J,DGSORT,DFN)),!
169 ;
170 I DGQUIT W:$D(ZTQUEUED) !!,"Report stopped at user's request" Q
171 I $G(DGPG)>0,$E(IOST)="C" K DIR S DIR(0)="E" D ^DIR K DIR S:+Y=0 DGQUIT=1
172 I $D(ZTQUEUED) S ZTREQ="@"
173 Q
174 ;
175HEAD ;
176 I $D(ZTQUEUED),$$S^%ZTLOAD S (ZTSTOP,DGQUIT)=1 Q
177 I $G(DGPG)>0,$E(IOST)="C" K DIR S DIR(0)="E" D ^DIR K DIR S:+Y=0 DGQUIT=1
178 Q:DGQUIT
179 S DGPG=$G(DGPG)+1
180 W @IOF,!,DGDDT,?15,"DG*5.3*593 Patient File Cleanup Utility",?70,"Page:",$J(DGPG,5),! K X S $P(X,"-",81)="" W X,!
181 W !,?2,"DFN",?15,"Reason for Deletion",!
182 S $P(X,"-",81)="" W X,!
183 Q
Note: See TracBrowser for help on using the repository browser.