DG1157ZN ;MNTVBB/DTA - PATIENT FILE ZERO NODE CLEAN-UP; DEC 10, 2025
;;5.3;Registration;**1157**;Aug 13, 1993;Build 6
;
; ICR#: 10103 $$FMADD^XLFDT
; Reference(s) to BMES^XPDUTL supported by ICR# 10141
Q
EN ;routine entry point
N DGPTIEN,DGPTCNT,DGPMIEN,DGOEIEN,DGNXTREC,DGPTIENS,DGNEWNM,DA,DR,DIE,DGNM,DGNMGD
D BMES^XPDUTL("Search for "_"""B"""_" X-Refs for any Patient record with no zero node or NAME value")
D CHKBXREF
D BMES^XPDUTL("Search for Patient Movement or Outpatient Encounter pointers")
D CHKPNTRS
D BMES^XPDUTL("Updating Patient records without a zero node or null value for the NAME field")
D UPDNM ;update relevant records
D BMES^XPDUTL("Update complete.")
Q
CHKBXREF ;Look for "B" X-Refs for any Patient record with no zero(0) node or NAME value
S (DGPTCNT,DGPTIEN,DGPMIEN,DGNMGD)=0
F S DGPTIEN=+$O(^DPT(DGPTIEN)) Q:DGPTIEN=0 D
. ;Find Patients records without a zero node or a null value for the NAME (.01) field
. I $P($G(^DPT(DGPTIEN,0)),"^",1)'="" Q
. S (DGNM,DGNMGD)="" F S DGNM=$O(^DPT("B",DGNM)) Q:DGNM="" D
.. I $D(^DPT("B",DGNM,DGPTIEN)) S DGPTCNT=DGPTCNT+1 D BMES^XPDUTL(DGPTCNT_" Patient file "_"""B"""_" X-REF has "_DGNM_" for Patient IEN "_DGPTIEN) S DGNMGD=1 Q
.. Q
. Q:DGNMGD=1
Q
CHKPNTRS ;Look for Patient Movement or Outpatient Encounter pointers to a Patient record with no zero(0) node or NAME value
S (DGPTCNT,DGPTIEN,DGPMIEN,DGNMGD)=0
F S DGPTIEN=+$O(^DPT(DGPTIEN)) Q:DGPTIEN=0 D
. ;Find Patients records without a zero node or a null value for the NAME (.01) field
. I $P($G(^DPT(DGPTIEN,0)),"^",1)'="" Q
. I $D(^DGPM("C",DGPTIEN)) S DGPMIEN=$O(^DGPM("C",DGPTIEN,0)) S DGPTCNT=DGPTCNT+1 D BMES^XPDUTL(DGPTCNT_" Patient IEN "_DGPTIEN_" has a pointer to the Patient Movement record :"_DGPMIEN) Q
. I $D(^SCE("C",DGPTIEN)) S DGOEIEN=$O(^SCE("C",DGPTIEN,0)) S DGPTCNT=DGPTCNT+1 D BMES^XPDUTL(DGPTCNT_" Patient IEN "_DGPTIEN_" has a pointer to the Outpatient Encounter record :"_DGOEIEN) Q
. Q
Q
UPDNM ;
S (DGPTCNT,DGPTIEN,DGPMIEN,DGNMGD)=0
S ^XTMP("DGNEWNM",0)=$$FMADD^XLFDT(DT,90)_U_DT_U_"DG UPDATE MISSING PATIENT FILE ZERO(0) NODE WITH DEFAULT NAME"
F S DGPTIEN=+$O(^DPT(DGPTIEN)) Q:DGPTIEN=0 D
. ;Find Patients records without a zero node or a null value for the NAME (.01) field
. I $P($G(^DPT(DGPTIEN,0)),"^",1)'="" Q
. S (DGNM,DGNMGD)="" F S DGNM=$O(^DPT("B",DGNM)) Q:DGNM="" D
.. I $D(^DPT("B",DGNM,DGPTIEN)) S DGNMGD=1 Q
.. Q
. Q:DGNMGD=1
. I $D(^DGPM("C",DGPTIEN)) Q
. I $D(^SCE("C",DGPTIEN)) Q
. S DGPTCNT=DGPTCNT+1
. S ^XTMP("DGNEWNM",DT,DGPTCNT,DGPTIEN)=DGPTIEN
. S DGNEWNM="ZZZPATIENT"_DGPTIEN_",MCLVII"
. S DIE="^DPT(",DA=DGPTIEN,DR=".01////"_DGNEWNM
. D ^DIE
. Q
D BMES^XPDUTL(DGPTCNT_" Records Updated")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDG1157ZN 2780 printed May 25, 2026@12:39 Page 2
DG1157ZN ;MNTVBB/DTA - PATIENT FILE ZERO NODE CLEAN-UP; DEC 10, 2025
+1 ;;5.3;Registration;**1157**;Aug 13, 1993;Build 6
+2 ;
+3 ; ICR#: 10103 $$FMADD^XLFDT
+4 ; Reference(s) to BMES^XPDUTL supported by ICR# 10141
+5 QUIT
EN ;routine entry point
+1 NEW DGPTIEN,DGPTCNT,DGPMIEN,DGOEIEN,DGNXTREC,DGPTIENS,DGNEWNM,DA,DR,DIE,DGNM,DGNMGD
+2 DO BMES^XPDUTL("Search for "_"""B"""_" X-Refs for any Patient record with no zero node or NAME value")
+3 DO CHKBXREF
+4 DO BMES^XPDUTL("Search for Patient Movement or Outpatient Encounter pointers")
+5 DO CHKPNTRS
+6 DO BMES^XPDUTL("Updating Patient records without a zero node or null value for the NAME field")
+7 ;update relevant records
DO UPDNM
+8 DO BMES^XPDUTL("Update complete.")
+9 QUIT
CHKBXREF ;Look for "B" X-Refs for any Patient record with no zero(0) node or NAME value
+1 SET (DGPTCNT,DGPTIEN,DGPMIEN,DGNMGD)=0
+2 FOR
SET DGPTIEN=+$ORDER(^DPT(DGPTIEN))
if DGPTIEN=0
QUIT
Begin DoDot:1
+3 ;Find Patients records without a zero node or a null value for the NAME (.01) field
+4 IF $PIECE($GET(^DPT(DGPTIEN,0)),"^",1)'=""
QUIT
+5 SET (DGNM,DGNMGD)=""
FOR
SET DGNM=$ORDER(^DPT("B",DGNM))
if DGNM=""
QUIT
Begin DoDot:2
+6 IF $DATA(^DPT("B",DGNM,DGPTIEN))
SET DGPTCNT=DGPTCNT+1
DO BMES^XPDUTL(DGPTCNT_" Patient file "_"""B"""_" X-REF has "_DGNM_" for Patient IEN "_DGPTIEN)
SET DGNMGD=1
QUIT
+7 QUIT
End DoDot:2
+8 if DGNMGD=1
QUIT
End DoDot:1
+9 QUIT
CHKPNTRS ;Look for Patient Movement or Outpatient Encounter pointers to a Patient record with no zero(0) node or NAME value
+1 SET (DGPTCNT,DGPTIEN,DGPMIEN,DGNMGD)=0
+2 FOR
SET DGPTIEN=+$ORDER(^DPT(DGPTIEN))
if DGPTIEN=0
QUIT
Begin DoDot:1
+3 ;Find Patients records without a zero node or a null value for the NAME (.01) field
+4 IF $PIECE($GET(^DPT(DGPTIEN,0)),"^",1)'=""
QUIT
+5 IF $DATA(^DGPM("C",DGPTIEN))
SET DGPMIEN=$ORDER(^DGPM("C",DGPTIEN,0))
SET DGPTCNT=DGPTCNT+1
DO BMES^XPDUTL(DGPTCNT_" Patient IEN "_DGPTIEN_" has a pointer to the Patient Movement record :"_DGPMIEN)
QUIT
+6 IF $DATA(^SCE("C",DGPTIEN))
SET DGOEIEN=$ORDER(^SCE("C",DGPTIEN,0))
SET DGPTCNT=DGPTCNT+1
DO BMES^XPDUTL(DGPTCNT_" Patient IEN "_DGPTIEN_" has a pointer to the Outpatient Encounter record :"_DGOEIEN)
QUIT
+7 QUIT
End DoDot:1
+8 QUIT
UPDNM ;
+1 SET (DGPTCNT,DGPTIEN,DGPMIEN,DGNMGD)=0
+2 SET ^XTMP("DGNEWNM",0)=$$FMADD^XLFDT(DT,90)_U_DT_U_"DG UPDATE MISSING PATIENT FILE ZERO(0) NODE WITH DEFAULT NAME"
+3 FOR
SET DGPTIEN=+$ORDER(^DPT(DGPTIEN))
if DGPTIEN=0
QUIT
Begin DoDot:1
+4 ;Find Patients records without a zero node or a null value for the NAME (.01) field
+5 IF $PIECE($GET(^DPT(DGPTIEN,0)),"^",1)'=""
QUIT
+6 SET (DGNM,DGNMGD)=""
FOR
SET DGNM=$ORDER(^DPT("B",DGNM))
if DGNM=""
QUIT
Begin DoDot:2
+7 IF $DATA(^DPT("B",DGNM,DGPTIEN))
SET DGNMGD=1
QUIT
+8 QUIT
End DoDot:2
+9 if DGNMGD=1
QUIT
+10 IF $DATA(^DGPM("C",DGPTIEN))
QUIT
+11 IF $DATA(^SCE("C",DGPTIEN))
QUIT
+12 SET DGPTCNT=DGPTCNT+1
+13 SET ^XTMP("DGNEWNM",DT,DGPTCNT,DGPTIEN)=DGPTIEN
+14 SET DGNEWNM="ZZZPATIENT"_DGPTIEN_",MCLVII"
+15 SET DIE="^DPT("
SET DA=DGPTIEN
SET DR=".01////"_DGNEWNM
+16 DO ^DIE
+17 QUIT
End DoDot:1
+18 DO BMES^XPDUTL(DGPTCNT_" Records Updated")
+19 QUIT
