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

IVMCM2.m

Go to the documentation of this file. 
  1. IVMCM2 ;ALB/SEK,CKN,TDM,JAM - ADD NEW DCD DEPENDENT TO INCOME PERSON FILE ;3/18/10 2:07pm
  1.  ;;2.0;INCOME VERIFICATION MATCH;**17,105,115,139,121,174**;21-OCT-94;Build 15
  1.  ;;Per VHA Directive 10-93-142, this routine should not be modified.
  1.  ;
  1. EN ; this routine will add entries to INCOME PERSON file (408.13) for
  1.  ; new dependents (spouse/children).  if DCD demo data (name, dob, 
  1.  ; ssn, sex) is different than VAMC data, 408.13 will be changed to
  1.  ; contain the DCD data.  the MEANS TEST CHANGES file (408.41) will
  1.  ; contain both values.
  1.  ;
  1. INPIEN ; get INCOME PERSON IEN
  1.  ; if PATIENT RELATION IEN not in ZDP
  1.  ;    add dependent to INCOME PERSON file if dependent not found
  1.  ;    dependent found if dob, sex, & relationship (408.12) match
  1.  ;
  1.  ;     Input    DFN     IEN of file #2
  1.  ;              IVMSEG  dependent's ZDP segment
  1.  ;
  1.  ; ivmflg1=1 have 408.13 ien when exit (found or added)
  1.  ; ivmflg2=1 dep record must be added to 408.12
  1.  ; ivmflg5=1 spouse ZDP incomplete(not dependent) - always spouse records
  1.  N IVMSPFLG,IVMSPMNM
  1.  N IVMZDP13,IVMSADL1,IVMSADL2,IVMSADL3,IVMSCITY,IVMSST,IVMSZIP,IVMSALU,IVMSTELE
  1.  N IVMAL113,IVMAL213,IVMAL313,IVMCTY13,IVMST13,IVMZIP13,IVMTEL13,IVMALU13
  1.  S (IVMFLG1,IVMFLG2,IVMFLG5)=0
  1.  S IVMSPFLG=1 ; VOA
  1.  S DGPRI=$P(IVMSEG,"^",7) ; ien of patient relation file
  1.  ;
  1.  S IVMNM=$$FMNAME^HLFNC($P(IVMSEG,"^",2)),IVMSEX=$P(IVMSEG,"^",3),IVMDOB=$$FMDATE^HLFNC($P(IVMSEG,"^",4)),IVMSSN=$P(IVMSEG,"^",5)
  1.  I IVMSSN=" " S IVMFERR="" Q  ; IVM*2.0*174 ;jam; Set error variable IVMFERR so the ZDP will not be processed if IVMSSN=blank
  1.  S IVMPSSNR=$P(IVMSEG,"^",10) ;Pseudo SSN Reason IVM*2*105
  1.  ;if there is a valid Pseudo SSN Reason, then append a "P" to the end
  1.  ;of the SSN so that it cam be recognized on VistA as a pseudo - IVM*2*115
  1.  S IVMSSN=$G(IVMSSN)_$S($G(IVMPSSNR)="N":"P",$G(IVMPSSNR)="R":"P",$G(IVMPSSNR)="S":"P",1:"")
  1.  S IVMEFFDT=$$FMDATE^HLFNC($P(IVMSEG,"^",9)),IVMRELN=$P(IVMSEG,"^",6)
  1.  S IVMSPMNM=$P(IVMSEG,"^",8) ;Spouse Maiden Name IVM*2*105
  1.  ;If not valid value, set it to null
  1.  I IVMPSSNR]"",IVMPSSNR'="R",IVMPSSNR'="S",IVMPSSNR'="N" S IVMPSSNR=""
  1.  S IVMSSNVS=$P(IVMSEG,"^",12) ;SSN Verification Status IVM*2*115
  1.  ;If not valid value, set it to null
  1.  I IVMSSNVS]"",IVMSSNVS'=2,IVMSSNVS'=4 S IVMSSNVS=""  ;IVM*2*115
  1.  ;
  1.  I IVMSPCHV="S"&((IVMNM']"")!(IVMSEX']"")!(IVMDOB']"")) S IVMFLG5=1 Q
  1.  ;
  1.  ; VOA Spouse additional info
  1.  S IVMZDP13=$P(IVMSEG,"^",13)
  1.  S IVMSADL1=$P(IVMZDP13,$E(HLECH,1),1) ; Addr Line 1 - 13.1
  1.  S IVMSADL2=$P(IVMZDP13,$E(HLECH,1),2) ; Addr Line 2 - 13.2
  1.  S IVMSADL3=$P(IVMZDP13,$E(HLECH,1),8) ; Addr Line 3 - 13.8
  1.  S IVMSCITY=$P(IVMZDP13,$E(HLECH,1),3) ; City - 13.3
  1.  S IVMSST=$P(IVMZDP13,$E(HLECH,1),4) ; State - 13.4
  1.  S IVMSZIP=$P(IVMZDP13,$E(HLECH,1),5) ; Zip - 13.5
  1.  S IVMSALU=$P(IVMZDP13,$E(HLECH,1),12)
  1.  S IVMSALU=$P(IVMSALU,$E(HLECH,2),1) ; Addr Last DT/TM Upt - 13.12.1
  1.  S IVMSALU=$$FMDATE^HLFNC(IVMSALU) ; Convert DT/TM from HL7 to FM
  1.  S IVMSTELE=$P(IVMSEG,"^",14)
  1.  S IVMSTELE=$P(IVMSTELE,$E(HLECH,1),1) ; Telephone - 14.1
  1.  ;
  1.  I 'DGPRI G NOIEN
  1.  ;
  1.  ; if ien of patient relation file (dgpri) transmitted by IVM Center
  1.  ; and found in 408.12, get ien of income person.  if DCD demo data
  1.  ; is different, change in 408.13 & add to 408.41
  1.  ; ivmprn is 0 node of 408.12
  1.  ; dgipi is ien of 408.13
  1.  S IVMPRN=$G(^DGPR(408.12,+DGPRI,0))
  1.  I IVMPRN]"" D GETIPI Q:$D(IVMFERR)  S DGIPI=+$P($P(IVMPRN,"^",3),";"),IVMFLG1=1,IVMRELO=$P(IVMPRN,"^",2) D AUDITP^IVMCM9,AUDIT^IVMCM9 Q
  1.  ;
  1. NOIEN ; ien of patient relation file is not transmitted or transmitted and
  1.  ; not found
  1.  ; check if dependent in income person file
  1.  ; if dependent not found in 408.13, setup ivmstr =  0 node of 408.13
  1.  ; subscript of array IVMAR is ien of 408.12 transmitted by IVM Center or
  1.  ; created or found by upload.
  1.  ;
  1.  S DGPRI=0 F  S DGPRI=$O(^DGPR(408.12,"B",DFN,DGPRI)) Q:'DGPRI  D  Q:IVMFLG1!($D(IVMFERR))
  1.  .D GETIP
  1.  .Q:$D(IVMFERR)!($D(IVMAR(DGPRI)))!(IVMRELO=1)
  1.  .I IVMSEX=IVMSEX13&(IVMDOB=IVMDOB13)&(IVMRELN=IVMRELO) S IVMFLG1=1,IVMAR(DGPRI)=""
  1.  .Q
  1.  ;
  1.  ; found dependent in 408.13. if demo data different, change in 408.13
  1.  ; and add in 408.41
  1.  Q:$D(IVMFERR)
  1.  I IVMFLG1 S DGIPI=+$P($P(IVMPRN,"^",3),";") D AUDITP^IVMCM9,AUDIT1^IVMCM9 Q
  1.  ;
  1.  ; dependent not found. add record to 408.13
  1.  I 'IVMFLG1 D
  1.  .S $P(IVMSTR,"^")=IVMNM,$P(IVMSTR,"^",2)=IVMSEX,$P(IVMSTR,"^",3)=IVMDOB,$P(IVMSTR,"^",9)=IVMSSN,$P(IVMSTR,"^",10)=IVMPSSNR,$P(IVMSTR,"^",11)=IVMSSNVS
  1.  .S $P(IVMSTR1,"^")=IVMSPMNM
  1.  .S $P(IVMSTR1,"^",2)=IVMSADL1,$P(IVMSTR1,"^",3)=IVMSADL2,$P(IVMSTR1,"^",4)=IVMSADL3
  1.  .S $P(IVMSTR1,"^",5)=IVMSCITY,$P(IVMSTR1,"^",6)=IVMSST,$P(IVMSTR1,"^",7)=IVMSZIP,$P(IVMSTR1,"^",8)=IVMSTELE
  1.  .S $P(IVMSTR1,"^",9)=IVMSALU
  1.  .D ADDDEP
  1.  Q
  1.  ;
  1. ADDDEP ; add dependent to 408.13 file
  1.  ; In - DFN=IEN of File #2
  1.  ;      DGRP0ND=0 node of 408.13
  1.  ;      DGRP1ND=1 node of 408.13
  1.  ;Out - DGIPI=408.13 IEN
  1.  ;
  1.  N X,Y
  1.  S DGRP0ND=IVMSTR
  1.  S DGRP1ND=IVMSTR1
  1.  K DINUM
  1.  N CNT,I S CNT=0
  1.  F I=2,3,9 D
  1.  .S CNT=CNT+1,$P(DIC("DR"),";",CNT)=".0"_I_"////"_$P(DGRP0ND,U,I)
  1.  F I=10,11 D
  1.  .S CNT=CNT+1,$P(DIC("DR"),";",CNT)="."_I_"////"_$P(DGRP0ND,U,I)
  1.  F I=1:1:8 S DIC("DR")=DIC("DR")_";1."_I_"////"_$P(DGRP1ND,U,I)
  1.  S (DIK,DIC)="^DGPR(408.13,",DIC(0)="L",DLAYGO=408.13,X=$P(DGRP0ND,"^") K DD,DO D FILE^DICN S (DGIPI,DA)=+Y K DLAYGO
  1.  ;
  1.  ; if can't create stub notify site & IVM Center
  1.  I DGIPI'>0 D  Q
  1.  .S (IVMTEXT(6))="Can't create stub for file 408.13"
  1.  .D PROB^IVMCMC(IVMTEXT(6))
  1.  .D ERRBULL^IVMPREC7,MAIL^IVMUFNC("DGMT MT/CT UPLOAD ALERTS")
  1.  .S IVMFERR=""
  1.  S IVMFLG2=1 ; added dep to 408.13 must add to 408.12
  1.  K DIK,DIC
  1.  Q
  1.  ;
  1.  ;
  1. GETIP ; if can't find 408.12 record notify site & IVM Center
  1.  S IVMPRN=$G(^DGPR(408.12,+DGPRI,0))
  1.  S IVMRELO=$P(IVMPRN,"^",2)
  1.  I IVMPRN']"" D  Q
  1.  .S (IVMTEXT(6))="Can't find 408.12 record "_DGPRI
  1.  .D PROB^IVMCMC(IVMTEXT(6))
  1.  .D ERRBULL^IVMPREC7,MAIL^IVMUFNC("DGMT MT/CT UPLOAD ALERTS")
  1.  .S IVMFERR=""
  1.  Q:IVMRELO=1
  1.  ;
  1. GETIPI ; ivmseg13 is 0 node of income person file
  1.  ; get demo data in 408.13 & 408.12
  1.  S IVMSEG13=$$DEM^DGMTU1(DGPRI)
  1.  S IVMSG131=$$DEM1^DGMTU1(DGPRI) ;Get node 1
  1.  I IVMSEG13']"" D  Q
  1.  .S (IVMTEXT(6))="Can't find 408.13 record"
  1.  .D PROB^IVMCMC(IVMTEXT(6))
  1.  .D ERRBULL^IVMPREC7,MAIL^IVMUFNC("DGMT MT/CT UPLOAD ALERTS")
  1.  .S IVMFERR=""
  1.  S IVMSEX13=$P(IVMSEG13,"^",2),IVMDOB13=$P(IVMSEG13,"^",3),IVMSSN13=$P(IVMSEG13,"^",9),IVMPSR13=$P(IVMSEG13,"^",10),IVMSVS13=$P(IVMSEG13,"^",11)
  1.  S IVMSMN13=$P($G(IVMSG131),"^")
  1.  S IVMNM13=$P(IVMSEG13,"^")
  1.  S IVMAL113=$P($G(IVMSG131),"^",2),IVMAL213=$P($G(IVMSG131),"^",3),IVMAL313=$P($G(IVMSG131),"^",4)
  1.  S IVMCTY13=$P($G(IVMSG131),"^",5),IVMST13=$P($G(IVMSG131),"^",6),IVMZIP13=$P($G(IVMSG131),"^",7)
  1.  S IVMTEL13=$P($G(IVMSG131),"^",8),IVMALU13=$P($G(IVMSG131),"^",9)
  1.  Q