- 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 Mar 13, 2025@21:05:05 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
