- PX91P ;ALB/DW - Post install routine ; 5/2/2000
- ;;1.0;PCE PATIENT CARE ENCOUNTER;**91**;Aug 12, 1996
- ;Post installation routine of patch PX*1.0*91.
- ;Clean up PATIENT/IHS entries that point to non-existing patients.
- ;Problematic entries pointed to by other files are not
- ;deleted and are reported by the routine.
- Q
- ;
- EN ;Entry point.
- N PXIEN,PXPOINT,DA,DIK
- S (PXIEN,PXPOINT)=0
- K ^TMP("PX91P",$J)
- F S PXIEN=$O(^AUPNPAT("B",PXIEN)) Q:PXIEN="" D
- . I PXIEN?.N,'$D(^DPT(PXIEN)) S PXPOINT=0 D
- .. ;Check if file #839.01 points to the entry:
- .. I $D(^PX(839.01,"C",PXIEN)) S PXPOINT=1 D LIST(PXIEN,"#839.01")
- .. ;Check if file #8925 points to the entry:
- .. I $D(^TIU(8925,"C",PXIEN)) S PXPOINT=1 D LIST(PXIEN,"#8925")
- .. ;Check if file #9000010 points to the entry:
- .. I $D(^AUPNVSIT("C",PXIEN)) S PXPOINT=1 D LIST(PXIEN,"#9000010")
- .. ;;;Check if file #9000010.01 points to the entry:
- .. ;;;I $D(^AUPNVMSR("C",PXIEN)) S PXPOINT=1 D LIST(PXIEN,"#9000010.01")
- .. ;Check if file #9000010.06 points to the entry:
- .. I $D(^AUPNVPRV("C",PXIEN)) S PXPOINT=1 D LIST(PXIEN,"#9000010.06")
- .. ;Check if file #9000010.07 points to the entry:
- .. I $D(^AUPNVPOV("C",PXIEN)) S PXPOINT=1 D LIST(PXIEN,"#9000010.07")
- .. ;Check if file #9000010.11 points to the entry:
- .. I $D(^AUPNVIMM("C",PXIEN)) S PXPOINT=1 D LIST(PXIEN,"#9000010.11")
- .. ;Check if file #9000010.12 points to the entry:
- .. I $D(^AUPNVSK("C",PXIEN)) S PXPOINT=1 D LIST(PXIEN,"#9000010.12")
- .. ;Check if file #9000010.13 points to the entry:
- .. I $D(^AUPNVXAM("C",PXIEN)) S PXPOINT=1 D LIST(PXIEN,"#90000010.13")
- .. ;Check if file #9000010.15 points to the entry:
- .. I $D(^AUPNVTRT("C",PXIEN)) S PXPOINT=1 D LIST(PXIEN,"#9000010.15")
- .. ;Check if file #9000010.16 points to the entry:
- .. I $D(^AUPNVPED("C",PXIEN)) S PXPOINT=1 D LIST(PXIEN,"#900010.16")
- .. ;Check if file #9000010.18 points to the entry:
- .. I $D(^AUPNVCPT("C",PXIEN)) S PXPOINT=1 D LIST(PXIEN,"#9000010.18")
- .. ;Check if file #9000010.23 points to the entry:
- .. I $D(^AUPNVHF("C",PXIEN)) S PXPOINT=1 D LIST(PXIEN,"#9000010.23")
- .. ;Check if file #9000011 points to the entry:
- .. I $D(^AUPNPROB("AC",PXIEN)) S PXPOINT=1 D LIST(PXIEN,"#9000011")
- .. ;Delete the problematic entry if no other files points to it:
- .. I PXPOINT=0 S DA=PXIEN,DIK="^AUPNPAT(" D ^DIK D LISTD(PXIEN)
- D REPORT
- K ^TMP("PX91P",$J)
- Q
- ;
- LIST(PXIEN,FILE) ;List problematic entries not deleted.
- S ^TMP("PX91P",$J,"NOK",PXIEN,FILE)=""
- Q
- ;
- LISTD(PXIEN) ;List problematic entries deleted.
- S ^TMP("PX91P",$J,"KIL",PXIEN)=""
- Q
- ;
- REPORT ;Report problematic entries and their status.
- D BMES^XPDUTL("PATIENT/IHS entries that point to non-existing patient but not deleted:")
- N NM,FL
- S NM="" F S NM=$O(^TMP("PX91P",$J,"NOK",NM)) Q:NM="" D
- . D MES^XPDUTL(" Entry#"_NM)
- . S FL="" F S FL=$O(^TMP("PX91P",$J,"NOK",NM,FL)) Q:FL="" D
- .. D MES^XPDUTL(" Pointed to by file "_FL)
- ;
- D BMES^XPDUTL("Entries deleted from the PATIENT/IHS file:")
- S NM="" F S NM=$O(^TMP("PX91P",$J,"KIL",NM)) Q:NM="" D
- . D MES^XPDUTL(" Entry#"_NM_" is deleted.")
- Q
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPX91P 3148 printed Feb 18, 2025@23:51:58 Page 2
- PX91P ;ALB/DW - Post install routine ; 5/2/2000
- +1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**91**;Aug 12, 1996
- +2 ;Post installation routine of patch PX*1.0*91.
- +3 ;Clean up PATIENT/IHS entries that point to non-existing patients.
- +4 ;Problematic entries pointed to by other files are not
- +5 ;deleted and are reported by the routine.
- +6 QUIT
- +7 ;
- EN ;Entry point.
- +1 NEW PXIEN,PXPOINT,DA,DIK
- +2 SET (PXIEN,PXPOINT)=0
- +3 KILL ^TMP("PX91P",$JOB)
- +4 FOR
- SET PXIEN=$ORDER(^AUPNPAT("B",PXIEN))
- if PXIEN=""
- QUIT
- Begin DoDot:1
- +5 IF PXIEN?.N
- IF '$DATA(^DPT(PXIEN))
- SET PXPOINT=0
- Begin DoDot:2
- +6 ;Check if file #839.01 points to the entry:
- +7 IF $DATA(^PX(839.01,"C",PXIEN))
- SET PXPOINT=1
- DO LIST(PXIEN,"#839.01")
- +8 ;Check if file #8925 points to the entry:
- +9 IF $DATA(^TIU(8925,"C",PXIEN))
- SET PXPOINT=1
- DO LIST(PXIEN,"#8925")
- +10 ;Check if file #9000010 points to the entry:
- +11 IF $DATA(^AUPNVSIT("C",PXIEN))
- SET PXPOINT=1
- DO LIST(PXIEN,"#9000010")
- +12 ;;;Check if file #9000010.01 points to the entry:
- +13 ;;;I $D(^AUPNVMSR("C",PXIEN)) S PXPOINT=1 D LIST(PXIEN,"#9000010.01")
- +14 ;Check if file #9000010.06 points to the entry:
- +15 IF $DATA(^AUPNVPRV("C",PXIEN))
- SET PXPOINT=1
- DO LIST(PXIEN,"#9000010.06")
- +16 ;Check if file #9000010.07 points to the entry:
- +17 IF $DATA(^AUPNVPOV("C",PXIEN))
- SET PXPOINT=1
- DO LIST(PXIEN,"#9000010.07")
- +18 ;Check if file #9000010.11 points to the entry:
- +19 IF $DATA(^AUPNVIMM("C",PXIEN))
- SET PXPOINT=1
- DO LIST(PXIEN,"#9000010.11")
- +20 ;Check if file #9000010.12 points to the entry:
- +21 IF $DATA(^AUPNVSK("C",PXIEN))
- SET PXPOINT=1
- DO LIST(PXIEN,"#9000010.12")
- +22 ;Check if file #9000010.13 points to the entry:
- +23 IF $DATA(^AUPNVXAM("C",PXIEN))
- SET PXPOINT=1
- DO LIST(PXIEN,"#90000010.13")
- +24 ;Check if file #9000010.15 points to the entry:
- +25 IF $DATA(^AUPNVTRT("C",PXIEN))
- SET PXPOINT=1
- DO LIST(PXIEN,"#9000010.15")
- +26 ;Check if file #9000010.16 points to the entry:
- +27 IF $DATA(^AUPNVPED("C",PXIEN))
- SET PXPOINT=1
- DO LIST(PXIEN,"#900010.16")
- +28 ;Check if file #9000010.18 points to the entry:
- +29 IF $DATA(^AUPNVCPT("C",PXIEN))
- SET PXPOINT=1
- DO LIST(PXIEN,"#9000010.18")
- +30 ;Check if file #9000010.23 points to the entry:
- +31 IF $DATA(^AUPNVHF("C",PXIEN))
- SET PXPOINT=1
- DO LIST(PXIEN,"#9000010.23")
- +32 ;Check if file #9000011 points to the entry:
- +33 IF $DATA(^AUPNPROB("AC",PXIEN))
- SET PXPOINT=1
- DO LIST(PXIEN,"#9000011")
- +34 ;Delete the problematic entry if no other files points to it:
- +35 IF PXPOINT=0
- SET DA=PXIEN
- SET DIK="^AUPNPAT("
- DO ^DIK
- DO LISTD(PXIEN)
- End DoDot:2
- End DoDot:1
- +36 DO REPORT
- +37 KILL ^TMP("PX91P",$JOB)
- +38 QUIT
- +39 ;
- LIST(PXIEN,FILE) ;List problematic entries not deleted.
- +1 SET ^TMP("PX91P",$JOB,"NOK",PXIEN,FILE)=""
- +2 QUIT
- +3 ;
- LISTD(PXIEN) ;List problematic entries deleted.
- +1 SET ^TMP("PX91P",$JOB,"KIL",PXIEN)=""
- +2 QUIT
- +3 ;
- REPORT ;Report problematic entries and their status.
- +1 DO BMES^XPDUTL("PATIENT/IHS entries that point to non-existing patient but not deleted:")
- +2 NEW NM,FL
- +3 SET NM=""
- FOR
- SET NM=$ORDER(^TMP("PX91P",$JOB,"NOK",NM))
- if NM=""
- QUIT
- Begin DoDot:1
- +4 DO MES^XPDUTL(" Entry#"_NM)
- +5 SET FL=""
- FOR
- SET FL=$ORDER(^TMP("PX91P",$JOB,"NOK",NM,FL))
- if FL=""
- QUIT
- Begin DoDot:2
- +6 DO MES^XPDUTL(" Pointed to by file "_FL)
- End DoDot:2
- End DoDot:1
- +7 ;
- +8 DO BMES^XPDUTL("Entries deleted from the PATIENT/IHS file:")
- +9 SET NM=""
- FOR
- SET NM=$ORDER(^TMP("PX91P",$JOB,"KIL",NM))
- if NM=""
- QUIT
- Begin DoDot:1
- +10 DO MES^XPDUTL(" Entry#"_NM_" is deleted.")
- End DoDot:1
- +11 QUIT
- +12 ;