VAFCQRY2 ;BIR/DLR-Query for patient demographics ; 5/6/20 5:26pm
;;5.3;Registration;**428,876,1013**;Aug 13, 1993;Build 2
;
;Reference to $$GETDFNS^MPIF002 supported by IA #3634.
;
CHKID(ICN,SSN,DFN) ;
N EVN,PID,PD1,EVN,LTD,VAFCMN,VAFCER
;**1013 - Story 1260465 (ckn) - HAC specific changes
S SITEINFO=$$SITE^VASITE() S STN=$P(SITEINFO,"^",3),SITEIEN=$P(SITEINFO,"^")
I STN=741 S SITEIEN=$$IEN^XUAF4("741MM"),STN="741MM"
;find the patient
N LDFN,SITE,RDFN
;if DFN is not passed check ICN
I $G(DFN)="" S DFN=$$GETDFN^MPIF001(+ICN) D Q
.;If ICN is identified return Patient Information
. I DFN>0 Q
. I DFN'>0,$G(SSN)="" S VAFCER="-1^Unknown ICN#"_$G(ICN) Q
.;If ICN isn't identified and SSN exists use SSN to identify DFN
. I DFN'>0,$G(SSN)'="" S RDFN=$$GETDFNS^MPIF002(SSN) S DFN=+RDFN D Q
..;If LIST contains no matches return negative response
.. I DFN=0 S VAFCER="-1^Unknown ICN#"_$G(ICN)_" and SSN#"_$G(SSN) Q
..;If LIST contains only one call check ICN
.. I +DFN>0 S ICN=$$GETICN^MPIF001(+DFN) D Q
...;If ICN return patient information.
... I +ICN>0 Q
...;If RDFN does not contain a national ICN return negative response with "Unknown ICN#"_ICN_" and known SSN#"_SSN_" was "_
... I +ICN'>0 S VAFCER="-1^Unknown ICN#"_$G(ICN)_", SSN#"_$G(SSN)_", DFN#"_$G(DFN)_" was "_$P(RDFN,"^",2) Q
;if DFN is passed
I $G(DFN)'="" S ICN=$$GETICN^MPIF001(DFN) D Q
.;If ICN is identified return Patient Information
. I +ICN>0 Q
. I +ICN'>0,$G(SSN)="" S VAFCER="-1^Unknown ICN#"_$G(ICN) Q
.;If ICN isn't identified and SSN exists use SSN to identify DFN
. I +ICN'>0,SSN'="" S RDFN=$$GETDFNS^MPIF002(SSN) S DFN=+RDFN D Q
..;If LIST contains no matches return negative response
.. I +DFN=0 S VAFCER="-1^Unknown ICN#"_$G(ICN)_" for SSN#"_$G(SSN) Q
..;If LIST contains only one, check ICN
.. I +DFN>0 S ICN=$$GETICN^MPIF001(DFN) D Q
...;If ICN return patient information.
... I ICN>0 Q
...;If NOT ICN return negative response with "Unknown ICN#"_$G(ICN)_" and known SSN#"_SSN_" was "_
... S VAFCER="-1^Unknown ICN#"_$G(ICN)_" for known SSN#"_$G(SSN)_" was "_$P(RDFN,"^",2) Q
Q
BLDEVN(DFN,SEQ,EVN,HL,EVR,ERR) ;build EVN for TF last treatment date and event reason
N TFIEN,LTD,TFZN,USERID,COMP,SUBCOMP,USERNAME,USERDUZ,SITEINFO,STN,SITEIEN
S COMP=$E(HL("ECH"),1),SUBCOMP=$E(HL("ECH"),4)
S LTD=""
;**1013 - Story 1260465 (ckn) - HAC specific changes
S SITEINFO=$$SITE^VASITE(),STN=$P(SITEINFO,"^",3),SITEIEN=$$IEN^XUAF4(STN)
I STN=741 S STN="741MM",SITEIEN=$$IEN^XUAF4(STN)
;reset EVR
S EVR=""
;S TFIEN=$O(^DGCN(391.91,"APAT",DFN,+$$SITE^VASITE,0))
;if patient is not already in the associated facility list add
D EN1^VAFCTF(DFN,1) S TFIEN=$O(^DGCN(391.91,"APAT",DFN,SITEIEN,0)) ;suppress messaging
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)
;**876 - MVI_4449 (ckn) - EVN was populating mismatched DUZ and USERNAME.
;Fix is in place to use appropriate DUZ with USERNAME
;check to see if this is a pivot file trigger if so reset trigger
I +$G(PIVOTPTR)>0 I $D(^VAT(391.71,+$G(PIVOTPTR),0)) D
. S USERDUZ=$P(^VAT(391.71,+$G(PIVOTPTR),0),"^",9)
I $G(USERDUZ)="" S USERDUZ=DUZ
S USERNAME=$$GET1^DIQ(200,+USERDUZ_",",.01)
S USERNAME=$$HLNAME^HLFNC(USERNAME,HL("ECH"))
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"
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
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
Q
BLDPD1(DFN,SEQ,PD1,HL,ERR) ;
N SITE,VAFCMN,COMP,CMOR
S SITE=""
S COMP=$E(HL("ECH"),1)
;get Patient File MPI node
S VAFCMN=$$MPINODE^MPIFAPI(DFN)
S CMOR=$P(VAFCMN,"^",3)
I CMOR'="" S SITE=$$NS^XUAF4(CMOR)
S PD1(1)="PD1"_HL("FS")_HL("FS")_HL("FS")_$P(SITE,"^")_COMP_"D"_COMP_$P(SITE,"^",2)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVAFCQRY2 4261 printed Apr 09, 2024@21:38:27 Page 2
VAFCQRY2 ;BIR/DLR-Query for patient demographics ; 5/6/20 5:26pm
+1 ;;5.3;Registration;**428,876,1013**;Aug 13, 1993;Build 2
+2 ;
+3 ;Reference to $$GETDFNS^MPIF002 supported by IA #3634.
+4 ;
CHKID(ICN,SSN,DFN) ;
+1 NEW EVN,PID,PD1,EVN,LTD,VAFCMN,VAFCER
+2 ;**1013 - Story 1260465 (ckn) - HAC specific changes
+3 SET SITEINFO=$$SITE^VASITE()
SET STN=$PIECE(SITEINFO,"^",3)
SET SITEIEN=$PIECE(SITEINFO,"^")
+4 IF STN=741
SET SITEIEN=$$IEN^XUAF4("741MM")
SET STN="741MM"
+5 ;find the patient
+6 NEW LDFN,SITE,RDFN
+7 ;if DFN is not passed check ICN
+8 IF $GET(DFN)=""
SET DFN=$$GETDFN^MPIF001(+ICN)
Begin DoDot:1
+9 ;If ICN is identified return Patient Information
+10 IF DFN>0
QUIT
+11 IF DFN'>0
IF $GET(SSN)=""
SET VAFCER="-1^Unknown ICN#"_$GET(ICN)
QUIT
+12 ;If ICN isn't identified and SSN exists use SSN to identify DFN
+13 IF DFN'>0
IF $GET(SSN)'=""
SET RDFN=$$GETDFNS^MPIF002(SSN)
SET DFN=+RDFN
Begin DoDot:2
+14 ;If LIST contains no matches return negative response
+15 IF DFN=0
SET VAFCER="-1^Unknown ICN#"_$GET(ICN)_" and SSN#"_$GET(SSN)
QUIT
+16 ;If LIST contains only one call check ICN
+17 IF +DFN>0
SET ICN=$$GETICN^MPIF001(+DFN)
Begin DoDot:3
+18 ;If ICN return patient information.
+19 IF +ICN>0
QUIT
+20 ;If RDFN does not contain a national ICN return negative response with "Unknown ICN#"_ICN_" and known SSN#"_SSN_" was "_
+21 IF +ICN'>0
SET VAFCER="-1^Unknown ICN#"_$GET(ICN)_", SSN#"_$GET(SSN)_", DFN#"_$GET(DFN)_" was "_$PIECE(RDFN,"^",2)
QUIT
End DoDot:3
QUIT
End DoDot:2
QUIT
End DoDot:1
QUIT
+22 ;if DFN is passed
+23 IF $GET(DFN)'=""
SET ICN=$$GETICN^MPIF001(DFN)
Begin DoDot:1
+24 ;If ICN is identified return Patient Information
+25 IF +ICN>0
QUIT
+26 IF +ICN'>0
IF $GET(SSN)=""
SET VAFCER="-1^Unknown ICN#"_$GET(ICN)
QUIT
+27 ;If ICN isn't identified and SSN exists use SSN to identify DFN
+28 IF +ICN'>0
IF SSN'=""
SET RDFN=$$GETDFNS^MPIF002(SSN)
SET DFN=+RDFN
Begin DoDot:2
+29 ;If LIST contains no matches return negative response
+30 IF +DFN=0
SET VAFCER="-1^Unknown ICN#"_$GET(ICN)_" for SSN#"_$GET(SSN)
QUIT
+31 ;If LIST contains only one, check ICN
+32 IF +DFN>0
SET ICN=$$GETICN^MPIF001(DFN)
Begin DoDot:3
+33 ;If ICN return patient information.
+34 IF ICN>0
QUIT
+35 ;If NOT ICN return negative response with "Unknown ICN#"_$G(ICN)_" and known SSN#"_SSN_" was "_
+36 SET VAFCER="-1^Unknown ICN#"_$GET(ICN)_" for known SSN#"_$GET(SSN)_" was "_$PIECE(RDFN,"^",2)
QUIT
End DoDot:3
QUIT
End DoDot:2
QUIT
End DoDot:1
QUIT
+37 QUIT
BLDEVN(DFN,SEQ,EVN,HL,EVR,ERR) ;build EVN for TF last treatment date and event reason
+1 NEW TFIEN,LTD,TFZN,USERID,COMP,SUBCOMP,USERNAME,USERDUZ,SITEINFO,STN,SITEIEN
+2 SET COMP=$EXTRACT(HL("ECH"),1)
SET SUBCOMP=$EXTRACT(HL("ECH"),4)
+3 SET LTD=""
+4 ;**1013 - Story 1260465 (ckn) - HAC specific changes
+5 SET SITEINFO=$$SITE^VASITE()
SET STN=$PIECE(SITEINFO,"^",3)
SET SITEIEN=$$IEN^XUAF4(STN)
+6 IF STN=741
SET STN="741MM"
SET SITEIEN=$$IEN^XUAF4(STN)
+7 ;reset EVR
+8 SET EVR=""
+9 ;S TFIEN=$O(^DGCN(391.91,"APAT",DFN,+$$SITE^VASITE,0))
+10 ;if patient is not already in the associated facility list add
+11 ;suppress messaging
DO EN1^VAFCTF(DFN,1)
SET TFIEN=$ORDER(^DGCN(391.91,"APAT",DFN,SITEIEN,0))
+12 IF $GET(TFIEN)'=""
SET TFZN=^DGCN(391.91,TFIEN,0)
SET LTD=$PIECE(TFZN,"^",3)
IF +$PIECE(TFZN,"^",7)'=0
SET EVR=$$GET1^DIQ(391.91,TFIEN_",",.07)
+13 ;**876 - MVI_4449 (ckn) - EVN was populating mismatched DUZ and USERNAME.
+14 ;Fix is in place to use appropriate DUZ with USERNAME
+15 ;check to see if this is a pivot file trigger if so reset trigger
+16 IF +$GET(PIVOTPTR)>0
IF $DATA(^VAT(391.71,+$GET(PIVOTPTR),0))
Begin DoDot:1
+17 SET USERDUZ=$PIECE(^VAT(391.71,+$GET(PIVOTPTR),0),"^",9)
End DoDot:1
+18 IF $GET(USERDUZ)=""
SET USERDUZ=DUZ
+19 SET USERNAME=$$GET1^DIQ(200,+USERDUZ_",",.01)
+20 SET USERNAME=$$HLNAME^HLFNC(USERNAME,HL("ECH"))
+21 SET USERID=USERDUZ_COMP_$PIECE(USERNAME,COMP)_COMP_$PIECE(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"
+22 IF $GET(EVN(1))=""
SET 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
+23 IF $GET(EVN(1))'=""
SET $PIECE(EVN(1),HL("FS"),2)=$GET(EVR)
SET $PIECE(EVN(1),HL("FS"),5)=$GET(EVR)
SET $PIECE(EVN(1),HL("FS"),3)=$$HLDATE^HLFNC(LTD)
SET $PIECE(EVN(1),HL("FS"),7)=$$HLDATE^HLFNC(LTD)
SET $PIECE(EVN(1),HL("FS"),8)=$PIECE($$SITE^VASITE,"^",3)
SET $PIECE(EVN(1),HL("FS"),6)=USERID
+24 QUIT
BLDPD1(DFN,SEQ,PD1,HL,ERR) ;
+1 NEW SITE,VAFCMN,COMP,CMOR
+2 SET SITE=""
+3 SET COMP=$EXTRACT(HL("ECH"),1)
+4 ;get Patient File MPI node
+5 SET VAFCMN=$$MPINODE^MPIFAPI(DFN)
+6 SET CMOR=$PIECE(VAFCMN,"^",3)
+7 IF CMOR'=""
SET SITE=$$NS^XUAF4(CMOR)
+8 SET PD1(1)="PD1"_HL("FS")_HL("FS")_HL("FS")_$PIECE(SITE,"^")_COMP_"D"_COMP_$PIECE(SITE,"^",2)
+9 QUIT
