Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DG53970P

DG53970P.m

Go to the documentation of this file.
  1. 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
  1. ;
  1. Q
  1. EP ; Entry Point
  1. D BMES^XPDUTL(">>> Cleanup of SSNs in INCOME PERSON file (#408.13)...")
  1. ; Quit if already installed and ^XTMP exists
  1. 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
  1. ;queue off SSN cleanup
  1. N ZTRTN,ZTDESC,ZTDTH,DGTEXT,ZTIO,ZTSK
  1. S ZTRTN="CLEANUP^DG53970P"
  1. S ZTDESC="DG*5.3*970 Emergency patch to clean up SSNs in INCOME PERSON file (#408.13)."
  1. S ZTDTH=$$NOW^XLFDT
  1. S ZTIO=""
  1. D ^%ZTLOAD
  1. S DGTEXT(1)=" Cleanup of SSN fields queued."
  1. S DGTEXT(2)=" The task number is "_$G(ZTSK)_"."
  1. D MES^XPDUTL(.DGTEXT)
  1. Q
  1. CLEANUP ; Entry point
  1. ; sweep through 408.13 file looking at SSN field (Piece 9) for values " " OR " P"
  1. ; - modify the SSN field to NULL
  1. ; - clean up the xrefs
  1. ; - get the associated DFN and store it
  1. ;
  1. ; Information from the cleanup will be placed in ^XTMP (120 day expiration) and sent in a Mailman message
  1. K ^XTMP("DG53970P")
  1. S ^XTMP("DG53970P",0)=$$FMADD^XLFDT(DT,120)_U_DT_U_"EMERGENCY PATCH DG*5.3*970-SSN CLEANUP"
  1. ; Collect stats: start/end time and the number of records scanned and number of SSNs cleaned
  1. N %,ZTDTS,ZTDTE,PCNT,SSN,SSNCNT,DFN,IEN,DGFIL,Y
  1. D NOW^%DTC S Y=% D DD^%DT
  1. S ZTDTS=Y
  1. S (PCNT,SSNCNT)=0
  1. S IEN=0,DGFIL=408.13
  1. F S IEN=$O(^DGPR(DGFIL,IEN)) Q:'IEN D
  1. . S PCNT=PCNT+1
  1. . S SSN=$P(^DGPR(DGFIL,IEN,0),"^",9)
  1. . I SSN=" "!(SSN=" P") D
  1. . . S $P(^DGPR(DGFIL,IEN,0),"^",9)=""
  1. . . ; we have to assume the xrefs are bad and need to be cleaned up
  1. . . D XREF(IEN,DGFIL)
  1. . . ; track number of records with SSN data cleaned
  1. . . S SSNCNT=SSNCNT+1
  1. . . ; Place IEN affected in ^XTMP global
  1. . . S ^XTMP("DG53970P",$J,"SSN",SSNCNT)=IEN
  1. . . ; retrieve the associated patient (DFN) for this record from the PATIENT RELATION file (#408.12)
  1. . . S DFN=$$GETDFN(IEN)
  1. . . ; we should always get a DFN but just in case we don't, log this and quit
  1. . . I 'DFN S ^XTMP("DG53970P",$J,"ERR",IEN)="" Q
  1. . . ; log the DFN in ^XTMP
  1. . . S ^XTMP("DG53970P",$J,"DFN",DFN)=""
  1. ; job completed, capture stats and send mailman message
  1. D NOW^%DTC S Y=% D DD^%DT
  1. S ZTDTE=Y
  1. D SENDMSG
  1. ; Place job data into ^XTMP Global
  1. S ^XTMP("DG53970P",$J,"DGSTART")=$G(ZTDTS) ;job start date/time
  1. S ^XTMP("DG53970P",$J,"DGEND")=$G(ZTDTE) ;job end date/time
  1. S ^XTMP("DG53970P",$J,"TOTAL")=SSNCNT ; total records affected
  1. Q
  1. XREF(IEN,DGFIL) ; clean "SSN", "BS" and "BS5" xrefs for this INCOME PERSON file (#408.13) record
  1. N VAL,XREF
  1. F XREF="SSN","BS","BS5" D
  1. . S VAL=""
  1. . F S VAL=$O(^DGPR(DGFIL,XREF,VAL)) Q:VAL="" D
  1. . . I $D(^DGPR(DGFIL,XREF,VAL,IEN)) K ^DGPR(DGFIL,XREF,VAL,IEN)
  1. Q
  1. GETDFN(IEN) ; retrieve DFN for this IEN from 408.12
  1. N DFN,VAL,GLOC,XIEN,RELIEN
  1. S VAL="",DFN=""
  1. ; step through "C" xref
  1. F S VAL=$O(^DGPR(408.12,"C",VAL)) Q:VAL="" D Q:DFN
  1. . ; the format of VAL we are looking for is IEN;GLOBAL REFERENCE
  1. . ; where the IEN matches the IEN passed in and the GLOBAL REF is "DGRP(408.13,"
  1. . S GLOC=$P(VAL,";",2),XIEN=+VAL
  1. . ; if we have what we are looking for, the next node in the xref will be the 408.12 IEN we want
  1. . I XIEN=IEN,GLOC="DGPR(408.13," D
  1. . . S RELIEN=$O(^DGPR(408.12,"C",VAL,""))
  1. . . Q:RELIEN=""
  1. . . ; the DFN will be piece 1 of this IEN record
  1. . . S DFN=$P(^DGPR(408.12,RELIEN,0),"^",1)
  1. Q DFN
  1. SENDMSG ;Send MailMan message when process completes
  1. N XMSUB,XMDUZ,XMY,XMTEXT,MSG,LN
  1. S XMY(DUZ)="",XMTEXT="MSG("
  1. S XMDUZ=.5,XMSUB="DG*5.3*970 JOB TO CORRECT SSNs IN INCOME PERSON FILE (#408.13)"
  1. S MSG($$LN)="The DG*5.3*970 process has completed."
  1. S MSG($$LN)=""
  1. S MSG($$LN)="This process ran through the INCOME PERSON file #408.13 and checked each"
  1. S MSG($$LN)="record for the Social Security Number (#.09) field having a 'space' or"
  1. S MSG($$LN)="a 'space' followed by a 'P' and deleted the field."
  1. S MSG($$LN)=""
  1. S MSG($$LN)="The process statistics:"
  1. S MSG($$LN)=""
  1. S MSG($$LN)="Job Start Date/Time: "_$G(ZTDTS)
  1. S MSG($$LN)=" Job End Date/Time: "_$G(ZTDTE)
  1. S MSG($$LN)=""
  1. S MSG($$LN)="Total INCOME PERSON file (#408.13) records searched: "_+$G(PCNT)
  1. S MSG($$LN)="Total records with SSN data updated: "_+$G(SSNCNT)
  1. S MSG($$LN)=""
  1. S MSG($$LN)=" View global ^XTMP(""DG53970P"","_$J_",""SSN"" for the list of records in the"
  1. S MSG($$LN)=" INCOME PERSON file that had SSN data updated."
  1. S MSG($$LN)=" View global ^XTMP(""DG53970P"","_$J_",""DFN"" for the list of Patients (DFNs)"
  1. S MSG($$LN)=" associated with the updated INCOME PERSON file records."
  1. S MSG($$LN)=" View global ^XTMP(""DG53970P"","_$J_",""ERR"" for the list of records in the"
  1. S MSG($$LN)=" INCOME PERSON file for which a DFN was not found."
  1. D ^XMD
  1. Q
  1. LN() ;Increment line counter
  1. S LN=$G(LN)+1
  1. Q LN