Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PX91P

PX91P.m

Go to the documentation of this file.
  1. PX91P ;ALB/DW - Post install routine ; 5/2/2000
  1. ;;1.0;PCE PATIENT CARE ENCOUNTER;**91**;Aug 12, 1996
  1. ;Post installation routine of patch PX*1.0*91.
  1. ;Clean up PATIENT/IHS entries that point to non-existing patients.
  1. ;Problematic entries pointed to by other files are not
  1. ;deleted and are reported by the routine.
  1. Q
  1. ;
  1. EN ;Entry point.
  1. N PXIEN,PXPOINT,DA,DIK
  1. S (PXIEN,PXPOINT)=0
  1. K ^TMP("PX91P",$J)
  1. F S PXIEN=$O(^AUPNPAT("B",PXIEN)) Q:PXIEN="" D
  1. . I PXIEN?.N,'$D(^DPT(PXIEN)) S PXPOINT=0 D
  1. .. ;Check if file #839.01 points to the entry:
  1. .. I $D(^PX(839.01,"C",PXIEN)) S PXPOINT=1 D LIST(PXIEN,"#839.01")
  1. .. ;Check if file #8925 points to the entry:
  1. .. I $D(^TIU(8925,"C",PXIEN)) S PXPOINT=1 D LIST(PXIEN,"#8925")
  1. .. ;Check if file #9000010 points to the entry:
  1. .. I $D(^AUPNVSIT("C",PXIEN)) S PXPOINT=1 D LIST(PXIEN,"#9000010")
  1. .. ;;;Check if file #9000010.01 points to the entry:
  1. .. ;;;I $D(^AUPNVMSR("C",PXIEN)) S PXPOINT=1 D LIST(PXIEN,"#9000010.01")
  1. .. ;Check if file #9000010.06 points to the entry:
  1. .. I $D(^AUPNVPRV("C",PXIEN)) S PXPOINT=1 D LIST(PXIEN,"#9000010.06")
  1. .. ;Check if file #9000010.07 points to the entry:
  1. .. I $D(^AUPNVPOV("C",PXIEN)) S PXPOINT=1 D LIST(PXIEN,"#9000010.07")
  1. .. ;Check if file #9000010.11 points to the entry:
  1. .. I $D(^AUPNVIMM("C",PXIEN)) S PXPOINT=1 D LIST(PXIEN,"#9000010.11")
  1. .. ;Check if file #9000010.12 points to the entry:
  1. .. I $D(^AUPNVSK("C",PXIEN)) S PXPOINT=1 D LIST(PXIEN,"#9000010.12")
  1. .. ;Check if file #9000010.13 points to the entry:
  1. .. I $D(^AUPNVXAM("C",PXIEN)) S PXPOINT=1 D LIST(PXIEN,"#90000010.13")
  1. .. ;Check if file #9000010.15 points to the entry:
  1. .. I $D(^AUPNVTRT("C",PXIEN)) S PXPOINT=1 D LIST(PXIEN,"#9000010.15")
  1. .. ;Check if file #9000010.16 points to the entry:
  1. .. I $D(^AUPNVPED("C",PXIEN)) S PXPOINT=1 D LIST(PXIEN,"#900010.16")
  1. .. ;Check if file #9000010.18 points to the entry:
  1. .. I $D(^AUPNVCPT("C",PXIEN)) S PXPOINT=1 D LIST(PXIEN,"#9000010.18")
  1. .. ;Check if file #9000010.23 points to the entry:
  1. .. I $D(^AUPNVHF("C",PXIEN)) S PXPOINT=1 D LIST(PXIEN,"#9000010.23")
  1. .. ;Check if file #9000011 points to the entry:
  1. .. I $D(^AUPNPROB("AC",PXIEN)) S PXPOINT=1 D LIST(PXIEN,"#9000011")
  1. .. ;Delete the problematic entry if no other files points to it:
  1. .. I PXPOINT=0 S DA=PXIEN,DIK="^AUPNPAT(" D ^DIK D LISTD(PXIEN)
  1. D REPORT
  1. K ^TMP("PX91P",$J)
  1. Q
  1. ;
  1. LIST(PXIEN,FILE) ;List problematic entries not deleted.
  1. S ^TMP("PX91P",$J,"NOK",PXIEN,FILE)=""
  1. Q
  1. ;
  1. LISTD(PXIEN) ;List problematic entries deleted.
  1. S ^TMP("PX91P",$J,"KIL",PXIEN)=""
  1. Q
  1. ;
  1. REPORT ;Report problematic entries and their status.
  1. D BMES^XPDUTL("PATIENT/IHS entries that point to non-existing patient but not deleted:")
  1. N NM,FL
  1. S NM="" F S NM=$O(^TMP("PX91P",$J,"NOK",NM)) Q:NM="" D
  1. . D MES^XPDUTL(" Entry#"_NM)
  1. . S FL="" F S FL=$O(^TMP("PX91P",$J,"NOK",NM,FL)) Q:FL="" D
  1. .. D MES^XPDUTL(" Pointed to by file "_FL)
  1. ;
  1. D BMES^XPDUTL("Entries deleted from the PATIENT/IHS file:")
  1. S NM="" F S NM=$O(^TMP("PX91P",$J,"KIL",NM)) Q:NM="" D
  1. . D MES^XPDUTL(" Entry#"_NM_" is deleted.")
  1. Q
  1. ;