IVM289A ;ALB/RMM IVM Patient File Xref Cleanup Utility ; 01/27/2004
;;2.0;INCOME VERIFICATION MATCH;**89**;21-OCT-94
;
; Global Counter Storage Details:
; ^XTMP("IVM289",0,"IVM") Count of invalid 301.5 pointers
; ^XTMP("IVM289",0,"DGMT") Count of invalid 408.31 pointers
; ^XTMP("IVM289",0,"DUP") Count of Duplicate xref entries
; ^XTMP("IVM289",0,"TOT") Total count of all xrefs
; ^XTMP("IVM289",0,"DEL") Total count of all xrefs purged
;
EN ; Begin processing
; Write message to installation device and to INSTALL file (#9.7)
D BMES^XPDUTL("IVM Patient File Xref Cleanup Post Install")
D MES^XPDUTL("When the the cleanup has completed, a MailMan message")
D MES^XPDUTL("messawill bt containing a recap of the deleted")
D MES^XPDUTL("cross references.")
D BMES^XPDUTL("Beginning clean-up process "_$$FMTE^XLFDT($$NOW^XLFDT))
;
INIT ; Initialize tracking global (See text above for description)
N %,X,X1,X2,I
S X1=DT,X2=120 D C^%DTC
S ^XTMP("IVM289",0)=X_"^"_$$DT^XLFDT_"^IVM Patient File Xref Cleanup"
;
F I="IVM","DGMT","DUP","TOT","DEL" S ^XTMP("IVM289",0,I)=0
;
START ;
N TYPE,FDATE,IVMPAT,MTIEN
F TYPE="AC","AD" D
.S FDATE=0
.F S FDATE=$O(^IVM(301.5,TYPE,FDATE)) Q:('FDATE) D
..S IVMPAT=0
..F S IVMPAT=$O(^IVM(301.5,TYPE,FDATE,IVMPAT)) Q:'IVMPAT D
...S MTIEN=$O(^IVM(301.5,TYPE,FDATE,IVMPAT,""),-1)
...;
...D CKMULT
...I FDATE<DT D DUP,TOT,DEL,DELX(MTIEN) Q
...;
...I '$D(^IVM(301.5,IVMPAT,0)) D IVM,TOT,DEL,DELX(MTIEN) Q
...;
...I '$D(^DGMT(408.31,MTIEN,0)) D DGMT,TOT,DEL,DELX(MTIEN) Q
...;
...D TOT
;
;
; Send a mailman msg to the user with the results
D MAIL^IVM289M
D MES^XPDUTL(" >>clean-up process completed "_$$FMTE^XLFDT($$NOW^XLFDT))
Q
;
CKMULT ; Remove duplicate entries from cross reference, leaving last entry
N MTREC S MTREC=0
F S MTREC=$O(^IVM(301.5,TYPE,FDATE,IVMPAT,MTREC)) Q:(MTREC=MTIEN!('MTREC)) D DUP,TOT,DEL,DELX(MTREC)
Q
;
; Delete Cross Reference
DELX(MTIEN) K ^IVM(301.5,TYPE,FDATE,IVMPAT,MTIEN) Q
;
; Increment Global Counters
IVM S ^XTMP("IVM289",0,"IVM")=^XTMP("IVM289",0,"IVM")+1 Q
DGMT S ^XTMP("IVM289",0,"DGMT")=^XTMP("IVM289",0,"DGMT")+1 Q
DUP S ^XTMP("IVM289",0,"DUP")=^XTMP("IVM289",0,"DUP")+1 Q
TOT S ^XTMP("IVM289",0,"TOT")=^XTMP("IVM289",0,"TOT")+1 Q
DEL S ^XTMP("IVM289",0,"DEL")=^XTMP("IVM289",0,"DEL")+1 Q
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIVM289A 2385 printed Sep 23, 2025@19:36:23 Page 2
IVM289A ;ALB/RMM IVM Patient File Xref Cleanup Utility ; 01/27/2004
+1 ;;2.0;INCOME VERIFICATION MATCH;**89**;21-OCT-94
+2 ;
+3 ; Global Counter Storage Details:
+4 ; ^XTMP("IVM289",0,"IVM") Count of invalid 301.5 pointers
+5 ; ^XTMP("IVM289",0,"DGMT") Count of invalid 408.31 pointers
+6 ; ^XTMP("IVM289",0,"DUP") Count of Duplicate xref entries
+7 ; ^XTMP("IVM289",0,"TOT") Total count of all xrefs
+8 ; ^XTMP("IVM289",0,"DEL") Total count of all xrefs purged
+9 ;
EN ; Begin processing
+1 ; Write message to installation device and to INSTALL file (#9.7)
+2 DO BMES^XPDUTL("IVM Patient File Xref Cleanup Post Install")
+3 DO MES^XPDUTL("When the the cleanup has completed, a MailMan message")
+4 DO MES^XPDUTL("messawill bt containing a recap of the deleted")
+5 DO MES^XPDUTL("cross references.")
+6 DO BMES^XPDUTL("Beginning clean-up process "_$$FMTE^XLFDT($$NOW^XLFDT))
+7 ;
INIT ; Initialize tracking global (See text above for description)
+1 NEW %,X,X1,X2,I
+2 SET X1=DT
SET X2=120
DO C^%DTC
+3 SET ^XTMP("IVM289",0)=X_"^"_$$DT^XLFDT_"^IVM Patient File Xref Cleanup"
+4 ;
+5 FOR I="IVM","DGMT","DUP","TOT","DEL"
SET ^XTMP("IVM289",0,I)=0
+6 ;
START ;
+1 NEW TYPE,FDATE,IVMPAT,MTIEN
+2 FOR TYPE="AC","AD"
Begin DoDot:1
+3 SET FDATE=0
+4 FOR
SET FDATE=$ORDER(^IVM(301.5,TYPE,FDATE))
if ('FDATE)
QUIT
Begin DoDot:2
+5 SET IVMPAT=0
+6 FOR
SET IVMPAT=$ORDER(^IVM(301.5,TYPE,FDATE,IVMPAT))
if 'IVMPAT
QUIT
Begin DoDot:3
+7 SET MTIEN=$ORDER(^IVM(301.5,TYPE,FDATE,IVMPAT,""),-1)
+8 ;
+9 DO CKMULT
+10 IF FDATE<DT
DO DUP
DO TOT
DO DEL
DO DELX(MTIEN)
QUIT
+11 ;
+12 IF '$DATA(^IVM(301.5,IVMPAT,0))
DO IVM
DO TOT
DO DEL
DO DELX(MTIEN)
QUIT
+13 ;
+14 IF '$DATA(^DGMT(408.31,MTIEN,0))
DO DGMT
DO TOT
DO DEL
DO DELX(MTIEN)
QUIT
+15 ;
+16 DO TOT
End DoDot:3
End DoDot:2
End DoDot:1
+17 ;
+18 ;
+19 ; Send a mailman msg to the user with the results
+20 DO MAIL^IVM289M
+21 DO MES^XPDUTL(" >>clean-up process completed "_$$FMTE^XLFDT($$NOW^XLFDT))
+22 QUIT
+23 ;
CKMULT ; Remove duplicate entries from cross reference, leaving last entry
+1 NEW MTREC
SET MTREC=0
+2 FOR
SET MTREC=$ORDER(^IVM(301.5,TYPE,FDATE,IVMPAT,MTREC))
if (MTREC=MTIEN!('MTREC))
QUIT
DO DUP
DO TOT
DO DEL
DO DELX(MTREC)
+3 QUIT
+4 ;
+5 ; Delete Cross Reference
DELX(MTIEN) KILL ^IVM(301.5,TYPE,FDATE,IVMPAT,MTIEN)
QUIT
+1 ;
+2 ; Increment Global Counters
IVM SET ^XTMP("IVM289",0,"IVM")=^XTMP("IVM289",0,"IVM")+1
QUIT
DGMT SET ^XTMP("IVM289",0,"DGMT")=^XTMP("IVM289",0,"DGMT")+1
QUIT
DUP SET ^XTMP("IVM289",0,"DUP")=^XTMP("IVM289",0,"DUP")+1
QUIT
TOT SET ^XTMP("IVM289",0,"TOT")=^XTMP("IVM289",0,"TOT")+1
QUIT
DEL SET ^XTMP("IVM289",0,"DEL")=^XTMP("IVM289",0,"DEL")+1
QUIT
+1 QUIT
