source: FOIAVistA/trunk/r/INCOME_VERIFICATION_MATCH-IVM/IVM289A.m@ 847

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

initial load of FOIAVistA 6/30/08 version

File size: 2.3 KB
Line 
1IVM289A ;ALB/RMM IVM Patient File Xref Cleanup Utility ; 01/27/2004
2 ;;2.0;INCOME VERIFICATION MATCH;**89**;21-OCT-94
3 ;
4 ; Global Counter Storage Details:
5 ; ^XTMP("IVM289",0,"IVM") Count of invalid 301.5 pointers
6 ; ^XTMP("IVM289",0,"DGMT") Count of invalid 408.31 pointers
7 ; ^XTMP("IVM289",0,"DUP") Count of Duplicate xref entries
8 ; ^XTMP("IVM289",0,"TOT") Total count of all xrefs
9 ; ^XTMP("IVM289",0,"DEL") Total count of all xrefs purged
10 ;
11EN ; Begin processing
12 ; Write message to installation device and to INSTALL file (#9.7)
13 D BMES^XPDUTL("IVM Patient File Xref Cleanup Post Install")
14 D MES^XPDUTL("When the the cleanup has completed, a MailMan message")
15 D MES^XPDUTL("messawill bt containing a recap of the deleted")
16 D MES^XPDUTL("cross references.")
17 D BMES^XPDUTL("Beginning clean-up process "_$$FMTE^XLFDT($$NOW^XLFDT))
18 ;
19INIT ; Initialize tracking global (See text above for description)
20 N %,X,X1,X2,I
21 S X1=DT,X2=120 D C^%DTC
22 S ^XTMP("IVM289",0)=X_"^"_$$DT^XLFDT_"^IVM Patient File Xref Cleanup"
23 ;
24 F I="IVM","DGMT","DUP","TOT","DEL" S ^XTMP("IVM289",0,I)=0
25 ;
26START ;
27 N TYPE,FDATE,IVMPAT,MTIEN
28 F TYPE="AC","AD" D
29 .S FDATE=0
30 .F S FDATE=$O(^IVM(301.5,TYPE,FDATE)) Q:('FDATE) D
31 ..S IVMPAT=0
32 ..F S IVMPAT=$O(^IVM(301.5,TYPE,FDATE,IVMPAT)) Q:'IVMPAT D
33 ...S MTIEN=$O(^IVM(301.5,TYPE,FDATE,IVMPAT,""),-1)
34 ...;
35 ...D CKMULT
36 ...I FDATE<DT D DUP,TOT,DEL,DELX(MTIEN) Q
37 ...;
38 ...I '$D(^IVM(301.5,IVMPAT,0)) D IVM,TOT,DEL,DELX(MTIEN) Q
39 ...;
40 ...I '$D(^DGMT(408.31,MTIEN,0)) D DGMT,TOT,DEL,DELX(MTIEN) Q
41 ...;
42 ...D TOT
43 ;
44 ;
45 ; Send a mailman msg to the user with the results
46 D MAIL^IVM289M
47 D MES^XPDUTL(" >>clean-up process completed "_$$FMTE^XLFDT($$NOW^XLFDT))
48 Q
49 ;
50CKMULT ; Remove duplicate entries from cross reference, leaving last entry
51 N MTREC S MTREC=0
52 F S MTREC=$O(^IVM(301.5,TYPE,FDATE,IVMPAT,MTREC)) Q:(MTREC=MTIEN!('MTREC)) D DUP,TOT,DEL,DELX(MTREC)
53 Q
54 ;
55 ; Delete Cross Reference
56DELX(MTIEN) K ^IVM(301.5,TYPE,FDATE,IVMPAT,MTIEN) Q
57 ;
58 ; Increment Global Counters
59IVM S ^XTMP("IVM289",0,"IVM")=^XTMP("IVM289",0,"IVM")+1 Q
60DGMT S ^XTMP("IVM289",0,"DGMT")=^XTMP("IVM289",0,"DGMT")+1 Q
61DUP S ^XTMP("IVM289",0,"DUP")=^XTMP("IVM289",0,"DUP")+1 Q
62TOT S ^XTMP("IVM289",0,"TOT")=^XTMP("IVM289",0,"TOT")+1 Q
63DEL S ^XTMP("IVM289",0,"DEL")=^XTMP("IVM289",0,"DEL")+1 Q
64 Q
Note: See TracBrowser for help on using the repository browser.