DG53500 ;BPFO/JRP - POST INIT FOR PATCH 500 ;3/12/2003
;;5.3;Registration;**500**;Aug 13, 1993
;
POST ;Entry point for patch DG*5.3*500 post init
N DFN,PTR10,GOODPTR,NODE,TMP,DGFDA,DGMSG,COUNT,DGRUGA08,VAFCA08
;Initialize list of good pointers to RACE file (#10)
D BMES^XPDUTL("Initializing list of good pointers to RACE file (#10)")
S PTR10=0
F S PTR10=+$O(^DIC(10,PTR10)) Q:'PTR10 D
.S NODE=$G(^DIC(10,PTR10,0))
.S TMP=$P(NODE,"^",2)
.I TMP?1N S:((TMP>0)&(TMP<8)) GOODPTR(PTR10)=""
;Scan PATIENT file (#2) for bad entries in RACE field (#.06)
K DGMSG
S DGMSG(1)=" "
S DGMSG(2)="Scanning PATIENT file (#2) for entries in RACE field (#.06) that"
S DGMSG(3)="are not valid. Every 1000th DFN checked will be printed."
S DGMSG(4)=" "
D MES^XPDUTL(.DGMSG) K DGMSG
;Don't generate ADT & RAI/MDS HL7 messages
S (VAFCA08,DGRUGA08)=1
I $G(XPDNM)'="" S XPDIDTOT=$O(^DPT("A"),-1) D UPDATE^XPDID(0)
S DFN=0
F COUNT=1:1 S DFN=$O(^DPT(DFN)) Q:'DFN D
.;Display progress
.I '(COUNT#1000) D
..K TMP
..S TMP="Current DFN: "_DFN_" "
..S TMP=$E(TMP,1,30)_"Total checked: "_$FN(COUNT,",")
..D MES^XPDUTL(TMP) K TMP
..D:($G(XPDNM)'="") UPDATE^XPDID(DFN)
.S NODE=$G(^DPT(DFN,0))
.S PTR10=$P(NODE,"^",6)
.Q:(PTR10="")
.;Not a good pointer - delete value
.I '$D(GOODPTR(PTR10)) D
..K DGFDA,DGMSG
..S DGFDA(2,DFN_",",.06)="@"
..D FILE^DIE("","DGFDA","DGMSG")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDG53500 1437 printed Sep 23, 2025@20:13:31 Page 2
DG53500 ;BPFO/JRP - POST INIT FOR PATCH 500 ;3/12/2003
+1 ;;5.3;Registration;**500**;Aug 13, 1993
+2 ;
POST ;Entry point for patch DG*5.3*500 post init
+1 NEW DFN,PTR10,GOODPTR,NODE,TMP,DGFDA,DGMSG,COUNT,DGRUGA08,VAFCA08
+2 ;Initialize list of good pointers to RACE file (#10)
+3 DO BMES^XPDUTL("Initializing list of good pointers to RACE file (#10)")
+4 SET PTR10=0
+5 FOR
SET PTR10=+$ORDER(^DIC(10,PTR10))
if 'PTR10
QUIT
Begin DoDot:1
+6 SET NODE=$GET(^DIC(10,PTR10,0))
+7 SET TMP=$PIECE(NODE,"^",2)
+8 IF TMP?1N
if ((TMP>0)&(TMP<8))
SET GOODPTR(PTR10)=""
End DoDot:1
+9 ;Scan PATIENT file (#2) for bad entries in RACE field (#.06)
+10 KILL DGMSG
+11 SET DGMSG(1)=" "
+12 SET DGMSG(2)="Scanning PATIENT file (#2) for entries in RACE field (#.06) that"
+13 SET DGMSG(3)="are not valid. Every 1000th DFN checked will be printed."
+14 SET DGMSG(4)=" "
+15 DO MES^XPDUTL(.DGMSG)
KILL DGMSG
+16 ;Don't generate ADT & RAI/MDS HL7 messages
+17 SET (VAFCA08,DGRUGA08)=1
+18 IF $GET(XPDNM)'=""
SET XPDIDTOT=$ORDER(^DPT("A"),-1)
DO UPDATE^XPDID(0)
+19 SET DFN=0
+20 FOR COUNT=1:1
SET DFN=$ORDER(^DPT(DFN))
if 'DFN
QUIT
Begin DoDot:1
+21 ;Display progress
+22 IF '(COUNT#1000)
Begin DoDot:2
+23 KILL TMP
+24 SET TMP="Current DFN: "_DFN_" "
+25 SET TMP=$EXTRACT(TMP,1,30)_"Total checked: "_$FNUMBER(COUNT,",")
+26 DO MES^XPDUTL(TMP)
KILL TMP
+27 if ($GET(XPDNM)'="")
DO UPDATE^XPDID(DFN)
End DoDot:2
+28 SET NODE=$GET(^DPT(DFN,0))
+29 SET PTR10=$PIECE(NODE,"^",6)
+30 if (PTR10="")
QUIT
+31 ;Not a good pointer - delete value
+32 IF '$DATA(GOODPTR(PTR10))
Begin DoDot:2
+33 KILL DGFDA,DGMSG
+34 SET DGFDA(2,DFN_",",.06)="@"
+35 DO FILE^DIE("","DGFDA","DGMSG")
End DoDot:2
End DoDot:1
+36 QUIT
