DG53970P ;ALB/JAM - REGISTRATION EMERGENCY PATCH POST-INSTALL TO FIX BLANK SSN IN PERSON INCOME FILE ;9/4/2018 3:21pm
;;5.3;Registration;**970**;Aug 13,1993;Build 14
;
Q
EP ; Entry Point
D BMES^XPDUTL(">>> Cleanup of SSNs in INCOME PERSON file (#408.13)...")
; Quit if already installed and ^XTMP exists
I $$PATCH^XPDUTL("DG*5.3*970"),$D(^XTMP("DG53970P")) D MES^XPDUTL(" Job does not need to be run since patch has been installed previously.") Q
;queue off SSN cleanup
N ZTRTN,ZTDESC,ZTDTH,DGTEXT,ZTIO,ZTSK
S ZTRTN="CLEANUP^DG53970P"
S ZTDESC="DG*5.3*970 Emergency patch to clean up SSNs in INCOME PERSON file (#408.13)."
S ZTDTH=$$NOW^XLFDT
S ZTIO=""
D ^%ZTLOAD
S DGTEXT(1)=" Cleanup of SSN fields queued."
S DGTEXT(2)=" The task number is "_$G(ZTSK)_"."
D MES^XPDUTL(.DGTEXT)
Q
CLEANUP ; Entry point
; sweep through 408.13 file looking at SSN field (Piece 9) for values " " OR " P"
; - modify the SSN field to NULL
; - clean up the xrefs
; - get the associated DFN and store it
;
; Information from the cleanup will be placed in ^XTMP (120 day expiration) and sent in a Mailman message
K ^XTMP("DG53970P")
S ^XTMP("DG53970P",0)=$$FMADD^XLFDT(DT,120)_U_DT_U_"EMERGENCY PATCH DG*5.3*970-SSN CLEANUP"
; Collect stats: start/end time and the number of records scanned and number of SSNs cleaned
N %,ZTDTS,ZTDTE,PCNT,SSN,SSNCNT,DFN,IEN,DGFIL,Y
D NOW^%DTC S Y=% D DD^%DT
S ZTDTS=Y
S (PCNT,SSNCNT)=0
S IEN=0,DGFIL=408.13
F S IEN=$O(^DGPR(DGFIL,IEN)) Q:'IEN D
. S PCNT=PCNT+1
. S SSN=$P(^DGPR(DGFIL,IEN,0),"^",9)
. I SSN=" "!(SSN=" P") D
. . S $P(^DGPR(DGFIL,IEN,0),"^",9)=""
. . ; we have to assume the xrefs are bad and need to be cleaned up
. . D XREF(IEN,DGFIL)
. . ; track number of records with SSN data cleaned
. . S SSNCNT=SSNCNT+1
. . ; Place IEN affected in ^XTMP global
. . S ^XTMP("DG53970P",$J,"SSN",SSNCNT)=IEN
. . ; retrieve the associated patient (DFN) for this record from the PATIENT RELATION file (#408.12)
. . S DFN=$$GETDFN(IEN)
. . ; we should always get a DFN but just in case we don't, log this and quit
. . I 'DFN S ^XTMP("DG53970P",$J,"ERR",IEN)="" Q
. . ; log the DFN in ^XTMP
. . S ^XTMP("DG53970P",$J,"DFN",DFN)=""
; job completed, capture stats and send mailman message
D NOW^%DTC S Y=% D DD^%DT
S ZTDTE=Y
D SENDMSG
; Place job data into ^XTMP Global
S ^XTMP("DG53970P",$J,"DGSTART")=$G(ZTDTS) ;job start date/time
S ^XTMP("DG53970P",$J,"DGEND")=$G(ZTDTE) ;job end date/time
S ^XTMP("DG53970P",$J,"TOTAL")=SSNCNT ; total records affected
Q
XREF(IEN,DGFIL) ; clean "SSN", "BS" and "BS5" xrefs for this INCOME PERSON file (#408.13) record
N VAL,XREF
F XREF="SSN","BS","BS5" D
. S VAL=""
. F S VAL=$O(^DGPR(DGFIL,XREF,VAL)) Q:VAL="" D
. . I $D(^DGPR(DGFIL,XREF,VAL,IEN)) K ^DGPR(DGFIL,XREF,VAL,IEN)
Q
GETDFN(IEN) ; retrieve DFN for this IEN from 408.12
N DFN,VAL,GLOC,XIEN,RELIEN
S VAL="",DFN=""
; step through "C" xref
F S VAL=$O(^DGPR(408.12,"C",VAL)) Q:VAL="" D Q:DFN
. ; the format of VAL we are looking for is IEN;GLOBAL REFERENCE
. ; where the IEN matches the IEN passed in and the GLOBAL REF is "DGRP(408.13,"
. S GLOC=$P(VAL,";",2),XIEN=+VAL
. ; if we have what we are looking for, the next node in the xref will be the 408.12 IEN we want
. I XIEN=IEN,GLOC="DGPR(408.13," D
. . S RELIEN=$O(^DGPR(408.12,"C",VAL,""))
. . Q:RELIEN=""
. . ; the DFN will be piece 1 of this IEN record
. . S DFN=$P(^DGPR(408.12,RELIEN,0),"^",1)
Q DFN
SENDMSG ;Send MailMan message when process completes
N XMSUB,XMDUZ,XMY,XMTEXT,MSG,LN
S XMY(DUZ)="",XMTEXT="MSG("
S XMDUZ=.5,XMSUB="DG*5.3*970 JOB TO CORRECT SSNs IN INCOME PERSON FILE (#408.13)"
S MSG($$LN)="The DG*5.3*970 process has completed."
S MSG($$LN)=""
S MSG($$LN)="This process ran through the INCOME PERSON file #408.13 and checked each"
S MSG($$LN)="record for the Social Security Number (#.09) field having a 'space' or"
S MSG($$LN)="a 'space' followed by a 'P' and deleted the field."
S MSG($$LN)=""
S MSG($$LN)="The process statistics:"
S MSG($$LN)=""
S MSG($$LN)="Job Start Date/Time: "_$G(ZTDTS)
S MSG($$LN)=" Job End Date/Time: "_$G(ZTDTE)
S MSG($$LN)=""
S MSG($$LN)="Total INCOME PERSON file (#408.13) records searched: "_+$G(PCNT)
S MSG($$LN)="Total records with SSN data updated: "_+$G(SSNCNT)
S MSG($$LN)=""
S MSG($$LN)=" View global ^XTMP(""DG53970P"","_$J_",""SSN"" for the list of records in the"
S MSG($$LN)=" INCOME PERSON file that had SSN data updated."
S MSG($$LN)=" View global ^XTMP(""DG53970P"","_$J_",""DFN"" for the list of Patients (DFNs)"
S MSG($$LN)=" associated with the updated INCOME PERSON file records."
S MSG($$LN)=" View global ^XTMP(""DG53970P"","_$J_",""ERR"" for the list of records in the"
S MSG($$LN)=" INCOME PERSON file for which a DFN was not found."
D ^XMD
Q
LN() ;Increment line counter
S LN=$G(LN)+1
Q LN
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDG53970P 4951 printed Sep 23, 2025@20:15:15 Page 2
DG53970P ;ALB/JAM - REGISTRATION EMERGENCY PATCH POST-INSTALL TO FIX BLANK SSN IN PERSON INCOME FILE ;9/4/2018 3:21pm
+1 ;;5.3;Registration;**970**;Aug 13,1993;Build 14
+2 ;
+3 QUIT
EP ; Entry Point
+1 DO BMES^XPDUTL(">>> Cleanup of SSNs in INCOME PERSON file (#408.13)...")
+2 ; Quit if already installed and ^XTMP exists
+3 IF $$PATCH^XPDUTL("DG*5.3*970")
IF $DATA(^XTMP("DG53970P"))
DO MES^XPDUTL(" Job does not need to be run since patch has been installed previously.")
QUIT
+4 ;queue off SSN cleanup
+5 NEW ZTRTN,ZTDESC,ZTDTH,DGTEXT,ZTIO,ZTSK
+6 SET ZTRTN="CLEANUP^DG53970P"
+7 SET ZTDESC="DG*5.3*970 Emergency patch to clean up SSNs in INCOME PERSON file (#408.13)."
+8 SET ZTDTH=$$NOW^XLFDT
+9 SET ZTIO=""
+10 DO ^%ZTLOAD
+11 SET DGTEXT(1)=" Cleanup of SSN fields queued."
+12 SET DGTEXT(2)=" The task number is "_$GET(ZTSK)_"."
+13 DO MES^XPDUTL(.DGTEXT)
+14 QUIT
CLEANUP ; Entry point
+1 ; sweep through 408.13 file looking at SSN field (Piece 9) for values " " OR " P"
+2 ; - modify the SSN field to NULL
+3 ; - clean up the xrefs
+4 ; - get the associated DFN and store it
+5 ;
+6 ; Information from the cleanup will be placed in ^XTMP (120 day expiration) and sent in a Mailman message
+7 KILL ^XTMP("DG53970P")
+8 SET ^XTMP("DG53970P",0)=$$FMADD^XLFDT(DT,120)_U_DT_U_"EMERGENCY PATCH DG*5.3*970-SSN CLEANUP"
+9 ; Collect stats: start/end time and the number of records scanned and number of SSNs cleaned
+10 NEW %,ZTDTS,ZTDTE,PCNT,SSN,SSNCNT,DFN,IEN,DGFIL,Y
+11 DO NOW^%DTC
SET Y=%
DO DD^%DT
+12 SET ZTDTS=Y
+13 SET (PCNT,SSNCNT)=0
+14 SET IEN=0
SET DGFIL=408.13
+15 FOR
SET IEN=$ORDER(^DGPR(DGFIL,IEN))
if 'IEN
QUIT
Begin DoDot:1
+16 SET PCNT=PCNT+1
+17 SET SSN=$PIECE(^DGPR(DGFIL,IEN,0),"^",9)
+18 IF SSN=" "!(SSN=" P")
Begin DoDot:2
+19 SET $PIECE(^DGPR(DGFIL,IEN,0),"^",9)=""
+20 ; we have to assume the xrefs are bad and need to be cleaned up
+21 DO XREF(IEN,DGFIL)
+22 ; track number of records with SSN data cleaned
+23 SET SSNCNT=SSNCNT+1
+24 ; Place IEN affected in ^XTMP global
+25 SET ^XTMP("DG53970P",$JOB,"SSN",SSNCNT)=IEN
+26 ; retrieve the associated patient (DFN) for this record from the PATIENT RELATION file (#408.12)
+27 SET DFN=$$GETDFN(IEN)
+28 ; we should always get a DFN but just in case we don't, log this and quit
+29 IF 'DFN
SET ^XTMP("DG53970P",$JOB,"ERR",IEN)=""
QUIT
+30 ; log the DFN in ^XTMP
+31 SET ^XTMP("DG53970P",$JOB,"DFN",DFN)=""
End DoDot:2
End DoDot:1
+32 ; job completed, capture stats and send mailman message
+33 DO NOW^%DTC
SET Y=%
DO DD^%DT
+34 SET ZTDTE=Y
+35 DO SENDMSG
+36 ; Place job data into ^XTMP Global
+37 ;job start date/time
SET ^XTMP("DG53970P",$JOB,"DGSTART")=$GET(ZTDTS)
+38 ;job end date/time
SET ^XTMP("DG53970P",$JOB,"DGEND")=$GET(ZTDTE)
+39 ; total records affected
SET ^XTMP("DG53970P",$JOB,"TOTAL")=SSNCNT
+40 QUIT
XREF(IEN,DGFIL) ; clean "SSN", "BS" and "BS5" xrefs for this INCOME PERSON file (#408.13) record
+1 NEW VAL,XREF
+2 FOR XREF="SSN","BS","BS5"
Begin DoDot:1
+3 SET VAL=""
+4 FOR
SET VAL=$ORDER(^DGPR(DGFIL,XREF,VAL))
if VAL=""
QUIT
Begin DoDot:2
+5 IF $DATA(^DGPR(DGFIL,XREF,VAL,IEN))
KILL ^DGPR(DGFIL,XREF,VAL,IEN)
End DoDot:2
End DoDot:1
+6 QUIT
GETDFN(IEN) ; retrieve DFN for this IEN from 408.12
+1 NEW DFN,VAL,GLOC,XIEN,RELIEN
+2 SET VAL=""
SET DFN=""
+3 ; step through "C" xref
+4 FOR
SET VAL=$ORDER(^DGPR(408.12,"C",VAL))
if VAL=""
QUIT
Begin DoDot:1
+5 ; the format of VAL we are looking for is IEN;GLOBAL REFERENCE
+6 ; where the IEN matches the IEN passed in and the GLOBAL REF is "DGRP(408.13,"
+7 SET GLOC=$PIECE(VAL,";",2)
SET XIEN=+VAL
+8 ; if we have what we are looking for, the next node in the xref will be the 408.12 IEN we want
+9 IF XIEN=IEN
IF GLOC="DGPR(408.13,"
Begin DoDot:2
+10 SET RELIEN=$ORDER(^DGPR(408.12,"C",VAL,""))
+11 if RELIEN=""
QUIT
+12 ; the DFN will be piece 1 of this IEN record
+13 SET DFN=$PIECE(^DGPR(408.12,RELIEN,0),"^",1)
End DoDot:2
End DoDot:1
if DFN
QUIT
+14 QUIT DFN
SENDMSG ;Send MailMan message when process completes
+1 NEW XMSUB,XMDUZ,XMY,XMTEXT,MSG,LN
+2 SET XMY(DUZ)=""
SET XMTEXT="MSG("
+3 SET XMDUZ=.5
SET XMSUB="DG*5.3*970 JOB TO CORRECT SSNs IN INCOME PERSON FILE (#408.13)"
+4 SET MSG($$LN)="The DG*5.3*970 process has completed."
+5 SET MSG($$LN)=""
+6 SET MSG($$LN)="This process ran through the INCOME PERSON file #408.13 and checked each"
+7 SET MSG($$LN)="record for the Social Security Number (#.09) field having a 'space' or"
+8 SET MSG($$LN)="a 'space' followed by a 'P' and deleted the field."
+9 SET MSG($$LN)=""
+10 SET MSG($$LN)="The process statistics:"
+11 SET MSG($$LN)=""
+12 SET MSG($$LN)="Job Start Date/Time: "_$G(ZTDTS)
+13 SET MSG($$LN)=" Job End Date/Time: "_$G(ZTDTE)
+14 SET MSG($$LN)=""
+15 SET MSG($$LN)="Total INCOME PERSON file (#408.13) records searched: "_+$G(PCNT)
+16 SET MSG($$LN)="Total records with SSN data updated: "_+$G(SSNCNT)
+17 SET MSG($$LN)=""
+18 SET MSG($$LN)=" View global ^XTMP(""DG53970P"","_$J_",""SSN"" for the list of records in the"
+19 SET MSG($$LN)=" INCOME PERSON file that had SSN data updated."
+20 SET MSG($$LN)=" View global ^XTMP(""DG53970P"","_$J_",""DFN"" for the list of Patients (DFNs)"
+21 SET MSG($$LN)=" associated with the updated INCOME PERSON file records."
+22 SET MSG($$LN)=" View global ^XTMP(""DG53970P"","_$J_",""ERR"" for the list of records in the"
+23 SET MSG($$LN)=" INCOME PERSON file for which a DFN was not found."
+24 DO ^XMD
+25 QUIT
LN() ;Increment line counter
+1 SET LN=$GET(LN)+1
+2 QUIT LN
