- 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 Jan 18, 2025@03:40:05 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