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

IVM2174F.m

Go to the documentation of this file. 
  1. IVM2174F ;ALB/JAM - IVM*2.0*174 - FIX BLANK SSN IN PERSON INCOME FILE ;9/26/2018 3:21pm
  1.  ;;2.0;INCOME VERIFICATION MATCH;**174**;21-OCT-94;Build 15
  1.  ;
  1.  Q
  1. EP ; Entry Point
  1.  Q
  1. IVMFSSN(DFN,IVMJOB) ; Process only ZDP segments to store SSNs into 408.13 file if IEN is in ^XTMP("DG53970P")
  1.  ; Called by: ^IVMCM if DFN is defined in ^XTMP("DG53970P") when processing ORU-Z10 message
  1.  ;
  1.  ; Input:   DFN - Patient DFN from the ORU-Z10 PID
  1.  ;          IVMJOB - job number in ^XTMP("DG53970P",JOB)
  1.  ;
  1.  N IVMCTR,IVMSEG,IVMVAL,IEN,IVMIEN,IVMFOUND,IVMIENCNT
  1.  ; spouse segment
  1.  S IVMSEG=$G(^TMP($J,"IVMCM","ZDPS"))
  1.  I IVMSEG'="" D FILESSN(DFN,IVMJOB,IVMSEG)
  1.  ; inactive spouse segments
  1.  S IVMCTR=0
  1.  F  S IVMCTR=$O(^TMP($J,"IVMCM","ZDPIS",IVMCTR)) Q:(IVMCTR="")  D
  1.  . S IVMSEG=$G(^TMP($J,"IVMCM","ZDPIS",IVMCTR)) Q:IVMSEG=""
  1.  . D FILESSN(DFN,IVMJOB,IVMSEG)
  1.  ; dependent segments
  1.  S IVMCTR=0
  1.  F  S IVMCTR=$O(^TMP($J,"IVMCM","ZDPC",IVMCTR)) Q:(IVMCTR="")  D
  1.  . S IVMSEG=$G(^TMP($J,"IVMCM","ZDPC",IVMCTR)) Q:IVMSEG=""
  1.  . D FILESSN(DFN,IVMJOB,IVMSEG)
  1.  ; inactive dependent segments
  1.  S IVMCTR=0
  1.  F  S IVMCTR=$O(^TMP($J,"IVMCM","ZDPIC",IVMCTR)) Q:(IVMCTR="")  D
  1.  . S IVMSEG=$G(^TMP($J,"IVMCM","ZDPIC",IVMCTR)) Q:IVMSEG=""
  1.  . D FILESSN(DFN,IVMJOB,IVMSEG)
  1.  ; All ZDP segments processed
  1.  ; If all IENs related to the DFN are gone from ^XTMP, remove the DFN from ^XTMP
  1.  S IVMFOUND=0
  1.  ; For the DFN, loop over ALL the dependent IENs in the 408.12 file "B" index
  1.  S IEN="" F  S IEN=$O(^DGPR(408.12,"B",DFN,IEN)) Q:'IEN  D  Q:IVMFOUND
  1.  . ; get the related 408.13 IEN
  1.  . S IVMVAL=$P(^DGPR(408.12,IEN,0),"^",3)
  1.  . I $P(IVMVAL,";",2)'="DGPR(408.13," Q
  1.  . S IVMIEN=$P(IVMVAL,";",1)
  1.  . S IVMIENCNT=0
  1.  . ; If IVMIEN is in ^XTMP("DG53970P",IVMJOB,"SSN",count)=IVMIEN set flag
  1.  . F  S IVMIENCNT=$O(^XTMP("DG53970P",IVMJOB,"SSN",IVMIENCNT)) Q:'IVMIENCNT  I ^XTMP("DG53970P",IVMJOB,"SSN",IVMIENCNT)=IVMIEN S IVMFOUND=1 Q
  1.  ; If no IENs found, clear the DFN out of the ^XTMP global
  1.  I 'IVMFOUND K ^XTMP("DG53970P",IVMJOB,"DFN",DFN)
  1.  Q
  1. FILESSN(DFN,IVMJOB,IVMSEG) ; Check segment and store SSN in 408.13 if criteria met
  1.  ; Input:   DFN - DFN from PID segment
  1.  ;          IVMJOB - job number in ^XTMP("DG53970P",JOB) 
  1.  ;          IVMSEG - the ZDPS or ZDPC segment
  1.  N IVMPRI,IVMVAL,IVMIEN,IVMFOUND,IVMIENCNT,IVMSSN,IVMPSSNR,IVMFLG1,IVMERR
  1.  N IVMSEX,IVMSEX13,IVMDOB,IVMDOB13,IVMRELN,IVMRELO
  1.  N FDA,IVMERRORS,DIERR
  1.  S IVMRELN=$P(IVMSEG,"^",6)
  1.  ; skip segment if RELATIONSHIP is SELF
  1.  Q:IVMRELN=1
  1.  S IVMPRI=$P(IVMSEG,"^",7) ; ien of patient relation file 408.12
  1.  ; if IEN not supplied, derive it by looping over dependents in 408.12 file
  1.  I IVMPRI="" D
  1.  . ; get Sex and DOB from segment
  1.  . S IVMSEX=$P(IVMSEG,"^",3),IVMDOB=$$FMDATE^HLFNC($P(IVMSEG,"^",4))
  1.  . S IVMFLG1=0
  1.  . ; loop over dependents for this DFN in the 408.12 file
  1.  . S IVMPRI=0 F  S IVMPRI=$O(^DGPR(408.12,"B",DFN,IVMPRI)) Q:'IVMPRI  D  Q:IVMFLG1
  1.  . . ; Get Relationship, DOB, and Sex from income person file 408.13
  1.  . . D GETIP(IVMPRI,.IVMRELO,.IVMDOB13,.IVMSEX13)
  1.  . . Q:(IVMRELO=1)  ; quit if RELATIONSHIP is SELF
  1.  . . ; match sex, dob and relationship from segment with values from 408.13 file 
  1.  . . I (IVMSEX=IVMSEX13)&(IVMDOB=IVMDOB13)&(IVMRELN=IVMRELO) S IVMFLG1=1   ; Match - found dependent in 408.13.
  1.  ; If dependent IEN from 408.12 file not defined - Quit
  1.  Q:IVMPRI=""
  1.  ; get the related 408.13 IEN
  1.  S IVMVAL=$P(^DGPR(408.12,IVMPRI,0),"^",3)
  1.  I $P(IVMVAL,";",2)'="DGPR(408.13," Q
  1.  S IVMIEN=$P(IVMVAL,";",1) ; ien of income person file 408.13
  1.  S IVMFOUND=0,IVMIENCNT=0
  1.  ; loop over IENs in ^XTMP to see if IVMIEN is there
  1.  F  S IVMIENCNT=$O(^XTMP("DG53970P",IVMJOB,"SSN",IVMIENCNT)) Q:'IVMIENCNT  I ^XTMP("DG53970P",IVMJOB,"SSN",IVMIENCNT)=IVMIEN S IVMFOUND=1 Q
  1.  Q:'IVMFOUND
  1.  ; IVMIEN is the IEN that needs the SSN updated in 408.13 - ^DGPR(408.13,IEN,0) piece 9
  1.  S IVMSSN=$P(IVMSEG,"^",5) ;SSN
  1.  ; Validate the SSN and if not valid, place the error in the ^XTMP global and quit
  1.  S IVMERR=""
  1.  I '$$VALSSN(IVMSSN,.IVMERR) S ^XTMP("DG53970P",IVMJOB,"SSNERR",IVMIEN)=$G(IVMERR) Q
  1.  ; strip dashes
  1.  S IVMSSN=$TR(IVMSSN,"-")
  1.  ; check for Pseudo SSN
  1.  S IVMPSSNR=$P(IVMSEG,"^",10) ;Pseudo SSN Reason
  1.  ; If not valid value, set it to null
  1.  I IVMPSSNR]"",IVMPSSNR'="R",IVMPSSNR'="S",IVMPSSNR'="N" S IVMPSSNR=""
  1.  ; If there is a valid Pseudo SSN Reason, then append a "P" to the end
  1.  ;  of the SSN so that it can be recognized on VistA as a pseudo
  1.  I IVMPSSNR'="" S IVMSSN=$G(IVMSSN)_"P"
  1.  ; Recheck the SSN field in 408.13 file and if corrupted, clean it up
  1.  D CHKSSN(IVMIEN)
  1.  ; Update the SSN - if not successful, place the error in the ^XTMP global and quit
  1.  S FDA(408.13,IVMIEN_",",.09)=IVMSSN
  1.  S FDA(408.13,IVMIEN_",",.1)=IVMPSSNR
  1.  D FILE^DIE("K","FDA","IVMERRORS(1)")
  1.  I +$G(DIERR) D  Q
  1.  . S IVMERR=$G(IVMERRORS(1,"DIERR",1,"TEXT",1))
  1.  . S ^XTMP("DG53970P",IVMJOB,"SSNERR",IVMIEN)=IVMERR
  1.  ; update was successful, clean the IEN out of the ^XTMP global
  1.  K ^XTMP("DG53970P",IVMJOB,"SSN",IVMIENCNT),^XTMP("DG53970P",IVMJOB,"SSNERR",IVMIEN)
  1.  Q
  1. VALSSN(X,ERROR) ; Validate the SSN format
  1.  ; Input:  X - SSN to validate
  1.  ;         ERROR - pass by reference, returns error text if validation fails
  1.  ; Output: 1 if valid, 0 if invalid
  1.  N CNT
  1.  I X'?9N&(X'?3N1"-"2N1"-"4N) S ERROR="SSN must be either nine numbers, or be in the format nnn-nn-nnnn." Q 0
  1.  ; strip dashes
  1.  I X'?.AN F CNT=1:1:$L(X) I $E(X,CNT)?1P S X=$E(X,0,CNT-1)_$E(X,CNT+1,999),CNT=CNT-1
  1.  I X'?9N S ERROR="Invalid format for SSN." Q 0
  1.  I $E(X,1)=9 S ERROR="The SSN must not begin with 9." Q 0
  1.  I $E(X,1,3)="000" S ERROR="First three digits of SSN cannot be zeros." Q 0
  1.  Q 1
  1. GETIP(IVMPRI,IVMRELO,IVMDOB13,IVMSEX13) ; Return 408.13 Sex,DOB,Relationship via 408.12 record
  1.  ; Input: IVMPRI - IEN of 408.12 entry
  1.  ;        IVMRELO - Relationship from 408.12 piece 2 (pass by ref)
  1.  ;        IVMDOB13 - Date of Birth from 408.13 piece 3 (pass by ref)
  1.  ;        IVMSEX13 - Sex from 408.13 piece 2  (pass by ref)
  1.  N IVMPRN
  1.  S IVMPRN=$G(^DGPR(408.12,+IVMPRI,0))
  1.  S IVMRELO=$P(IVMPRN,"^",2)
  1.  I IVMPRN']"" Q
  1.  ; Quit if RELATIONSHIP is SELF
  1.  Q:IVMRELO=1
  1.  N IVMSEG13
  1.  ; ivmseg13 is 0 node of income person file 408.13
  1.  S IVMSEG13=$$DEM^DGMTU1(IVMPRI)
  1.  I IVMSEG13']"" Q   ; Can't find 408.13 record
  1.  ; get Sex and DOB from 408.13 file
  1.  S IVMSEX13=$P(IVMSEG13,"^",2),IVMDOB13=$P(IVMSEG13,"^",3)
  1.  Q
  1. CHKSSN(IEN) ; Check to see if SSN IN 408.13 is corrupted and clean up if it is
  1.  ; Input:  IEN - 408.13 ien
  1.  N IVMSSN
  1.  S IVMSSN=$P(^DGPR(408.13,IEN,0),"^",9)
  1.  I IVMSSN=" "!(IVMSSN=" P") D
  1.  . S $P(^DGPR(408.13,IEN,0),"^",9)=""
  1.  . ; we have to assume the xrefs are bad and need to be cleaned up
  1.  . D XREF(IEN)
  1.  Q
  1. XREF(IEN) ; 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(408.13,XREF,VAL)) Q:VAL=""  D
  1.  . . I $D(^DGPR(408.13,XREF,VAL,IEN)) K ^DGPR(408.13,XREF,VAL,IEN)
  1.  Q