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

VAFCQRY2.m

Go to the documentation of this file.
  1. VAFCQRY2 ;BIR/DLR-Query for patient demographics ; 5/6/20 5:26pm
  1. ;;5.3;Registration;**428,876,1013**;Aug 13, 1993;Build 2
  1. ;
  1. ;Reference to $$GETDFNS^MPIF002 supported by IA #3634.
  1. ;
  1. CHKID(ICN,SSN,DFN) ;
  1. N EVN,PID,PD1,EVN,LTD,VAFCMN,VAFCER
  1. ;**1013 - Story 1260465 (ckn) - HAC specific changes
  1. S SITEINFO=$$SITE^VASITE() S STN=$P(SITEINFO,"^",3),SITEIEN=$P(SITEINFO,"^")
  1. I STN=741 S SITEIEN=$$IEN^XUAF4("741MM"),STN="741MM"
  1. ;find the patient
  1. N LDFN,SITE,RDFN
  1. ;if DFN is not passed check ICN
  1. I $G(DFN)="" S DFN=$$GETDFN^MPIF001(+ICN) D Q
  1. .;If ICN is identified return Patient Information
  1. . I DFN>0 Q
  1. . I DFN'>0,$G(SSN)="" S VAFCER="-1^Unknown ICN#"_$G(ICN) Q
  1. .;If ICN isn't identified and SSN exists use SSN to identify DFN
  1. . I DFN'>0,$G(SSN)'="" S RDFN=$$GETDFNS^MPIF002(SSN) S DFN=+RDFN D Q
  1. ..;If LIST contains no matches return negative response
  1. .. I DFN=0 S VAFCER="-1^Unknown ICN#"_$G(ICN)_" and SSN#"_$G(SSN) Q
  1. ..;If LIST contains only one call check ICN
  1. .. I +DFN>0 S ICN=$$GETICN^MPIF001(+DFN) D Q
  1. ...;If ICN return patient information.
  1. ... I +ICN>0 Q
  1. ...;If RDFN does not contain a national ICN return negative response with "Unknown ICN#"_ICN_" and known SSN#"_SSN_" was "_
  1. ... I +ICN'>0 S VAFCER="-1^Unknown ICN#"_$G(ICN)_", SSN#"_$G(SSN)_", DFN#"_$G(DFN)_" was "_$P(RDFN,"^",2) Q
  1. ;if DFN is passed
  1. I $G(DFN)'="" S ICN=$$GETICN^MPIF001(DFN) D Q
  1. .;If ICN is identified return Patient Information
  1. . I +ICN>0 Q
  1. . I +ICN'>0,$G(SSN)="" S VAFCER="-1^Unknown ICN#"_$G(ICN) Q
  1. .;If ICN isn't identified and SSN exists use SSN to identify DFN
  1. . I +ICN'>0,SSN'="" S RDFN=$$GETDFNS^MPIF002(SSN) S DFN=+RDFN D Q
  1. ..;If LIST contains no matches return negative response
  1. .. I +DFN=0 S VAFCER="-1^Unknown ICN#"_$G(ICN)_" for SSN#"_$G(SSN) Q
  1. ..;If LIST contains only one, check ICN
  1. .. I +DFN>0 S ICN=$$GETICN^MPIF001(DFN) D Q
  1. ...;If ICN return patient information.
  1. ... I ICN>0 Q
  1. ...;If NOT ICN return negative response with "Unknown ICN#"_$G(ICN)_" and known SSN#"_SSN_" was "_
  1. ... S VAFCER="-1^Unknown ICN#"_$G(ICN)_" for known SSN#"_$G(SSN)_" was "_$P(RDFN,"^",2) Q
  1. Q
  1. BLDEVN(DFN,SEQ,EVN,HL,EVR,ERR) ;build EVN for TF last treatment date and event reason
  1. N TFIEN,LTD,TFZN,USERID,COMP,SUBCOMP,USERNAME,USERDUZ,SITEINFO,STN,SITEIEN
  1. S COMP=$E(HL("ECH"),1),SUBCOMP=$E(HL("ECH"),4)
  1. S LTD=""
  1. ;**1013 - Story 1260465 (ckn) - HAC specific changes
  1. S SITEINFO=$$SITE^VASITE(),STN=$P(SITEINFO,"^",3),SITEIEN=$$IEN^XUAF4(STN)
  1. I STN=741 S STN="741MM",SITEIEN=$$IEN^XUAF4(STN)
  1. ;reset EVR
  1. S EVR=""
  1. ;S TFIEN=$O(^DGCN(391.91,"APAT",DFN,+$$SITE^VASITE,0))
  1. ;if patient is not already in the associated facility list add
  1. D EN1^VAFCTF(DFN,1) S TFIEN=$O(^DGCN(391.91,"APAT",DFN,SITEIEN,0)) ;suppress messaging
  1. I $G(TFIEN)'="" S TFZN=^DGCN(391.91,TFIEN,0) S LTD=$P(TFZN,"^",3) I +$P(TFZN,"^",7)'=0 S EVR=$$GET1^DIQ(391.91,TFIEN_",",.07)
  1. ;**876 - MVI_4449 (ckn) - EVN was populating mismatched DUZ and USERNAME.
  1. ;Fix is in place to use appropriate DUZ with USERNAME
  1. ;check to see if this is a pivot file trigger if so reset trigger
  1. I +$G(PIVOTPTR)>0 I $D(^VAT(391.71,+$G(PIVOTPTR),0)) D
  1. . S USERDUZ=$P(^VAT(391.71,+$G(PIVOTPTR),0),"^",9)
  1. I $G(USERDUZ)="" S USERDUZ=DUZ
  1. S USERNAME=$$GET1^DIQ(200,+USERDUZ_",",.01)
  1. S USERNAME=$$HLNAME^HLFNC(USERNAME,HL("ECH"))
  1. S USERID=USERDUZ_COMP_$P(USERNAME,COMP)_COMP_$P(USERNAME,COMP,2)_COMP_COMP_COMP_COMP_COMP_COMP_"USVHA"_SUBCOMP_SUBCOMP_"0363"_COMP_"L"_COMP_COMP_COMP_"NI"_COMP_"VA FACILITY ID"_SUBCOMP_STN_SUBCOMP_"L"
  1. I $G(EVN(1))="" S EVN(1)="EVN"_HL("FS")_HL("FS")_$$HLDATE^HLFNC(LTD)_HL("FS")_HL("FS")_HL("FS")_USERID_HL("FS")_$$HLDATE^HLFNC(LTD)_HL("FS")_STN
  1. I $G(EVN(1))'="" S $P(EVN(1),HL("FS"),2)=$G(EVR),$P(EVN(1),HL("FS"),5)=$G(EVR),$P(EVN(1),HL("FS"),3)=$$HLDATE^HLFNC(LTD),$P(EVN(1),HL("FS"),7)=$$HLDATE^HLFNC(LTD),$P(EVN(1),HL("FS"),8)=$P($$SITE^VASITE,"^",3),$P(EVN(1),HL("FS"),6)=USERID
  1. Q
  1. BLDPD1(DFN,SEQ,PD1,HL,ERR) ;
  1. N SITE,VAFCMN,COMP,CMOR
  1. S SITE=""
  1. S COMP=$E(HL("ECH"),1)
  1. ;get Patient File MPI node
  1. S VAFCMN=$$MPINODE^MPIFAPI(DFN)
  1. S CMOR=$P(VAFCMN,"^",3)
  1. I CMOR'="" S SITE=$$NS^XUAF4(CMOR)
  1. S PD1(1)="PD1"_HL("FS")_HL("FS")_HL("FS")_$P(SITE,"^")_COMP_"D"_COMP_$P(SITE,"^",2)
  1. Q