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 Apr 09, 2024@21:29:19 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 ;
