source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/VAFCQRY2.m@ 1259

Last change on this file since 1259 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.6 KB
Line 
1VAFCQRY2 ;BIR/DLR-Query for patient demographics ;10/18/2000
2 ;;5.3;Registration;**428**;Aug 13, 1993
3 ;
4 ;Reference to $$GETDFNS^MPIF002 supported by IA #3634.
5 ;
6CHKID(ICN,SSN,DFN) ;
7 N EVN,PID,PD1,EVN,LTD,VAFCMN,VAFCER
8 ;find the patient
9 N LDFN,SITE,RDFN
10 ;if DFN is not passed check ICN
11 I $G(DFN)="" S DFN=$$GETDFN^MPIF001(+ICN) D Q
12 .;If ICN is identified return Patient Information
13 . I DFN>0 Q
14 . I DFN'>0,$G(SSN)="" S VAFCER="-1^Unknown ICN#"_$G(ICN) Q
15 .;If ICN isn't identified and SSN exists use SSN to identify DFN
16 . I DFN'>0,$G(SSN)'="" S RDFN=$$GETDFNS^MPIF002(SSN) S DFN=+RDFN D Q
17 ..;If LIST contains no matches return negative response
18 .. I DFN=0 S VAFCER="-1^Unknown ICN#"_$G(ICN)_" and SSN#"_$G(SSN) Q
19 ..;If LIST contains only one call check ICN
20 .. I +DFN>0 S ICN=$$GETICN^MPIF001(+DFN) D Q
21 ...;If ICN return patient information.
22 ... I +ICN>0 Q
23 ...;If RDFN does not contain a national ICN return negative response with "Unknown ICN#"_ICN_" and known SSN#"_SSN_" was "_
24 ... I +ICN'>0 S VAFCER="-1^Unknown ICN#"_$G(ICN)_", SSN#"_$G(SSN)_", DFN#"_$G(DFN)_" was "_$P(RDFN,"^",2) Q
25 ;if DFN is passed
26 I $G(DFN)'="" S ICN=$$GETICN^MPIF001(DFN) D Q
27 .;If ICN is identified return Patient Information
28 . I +ICN>0 Q
29 . I +ICN'>0,$G(SSN)="" S VAFCER="-1^Unknown ICN#"_$G(ICN) Q
30 .;If ICN isn't identified and SSN exists use SSN to identify DFN
31 . I +ICN'>0,SSN'="" S RDFN=$$GETDFNS^MPIF002(SSN) S DFN=+RDFN D Q
32 ..;If LIST contains no matches return negative response
33 .. I +DFN=0 S VAFCER="-1^Unknown ICN#"_$G(ICN)_" for SSN#"_$G(SSN) Q
34 ..;If LIST contains only one, check ICN
35 .. I +DFN>0 S ICN=$$GETICN^MPIF001(DFN) D Q
36 ...;If ICN return patient information.
37 ... I ICN>0 Q
38 ...;If NOT ICN return negative response with "Unknown ICN#"_$G(ICN)_" and known SSN#"_SSN_" was "_
39 ... S VAFCER="-1^Unknown ICN#"_$G(ICN)_" for known SSN#"_$G(SSN)_" was "_$P(RDFN,"^",2) Q
40 Q
41BLDEVN(DFN,SEQ,EVN,HL,EVR,ERR) ;build EVN for TF last treatment date and event reason
42 N TFIEN,LTD,TFZN,USERID,COMP,SUBCOMP,USERNAME
43 S COMP=$E(HL("ECH"),1),SUBCOMP=$E(HL("ECH"),4)
44 S LTD=""
45 ;reset EVR
46 S EVR=""
47 ;S TFIEN=$O(^DGCN(391.91,"APAT",DFN,+$$SITE^VASITE,0))
48 ;if patient is not already in the associated facility list add
49 D EN1^VAFCTF(DFN,1) S TFIEN=$O(^DGCN(391.91,"APAT",DFN,+$$SITE^VASITE,0)) ;suppress messaging
50 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)
51 ;check to see if this is a pivot file trigger if so reset trigger
52 I +$G(PIVOTPTR)>0 I $D(^VAT(391.71,+$G(PIVOTPTR),0)) D
53 . S USERNAME=$P(^VAT(391.71,+$G(PIVOTPTR),0),"^",9)
54 I $G(USERNAME)="" S USERNAME=DUZ
55 S USERNAME=$$GET1^DIQ(200,+USERNAME_",",.01)
56 S USERNAME=$$HLNAME^HLFNC(USERNAME,HL("ECH"))
57 S USERID=DUZ_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_$P($$SITE^VASITE,"^",3)_SUBCOMP_"L"
58 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")_$P($$SITE^VASITE,"^",3)
59 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
60 Q
61BLDPD1(DFN,SEQ,PD1,HL,ERR) ;
62 N SITE,VAFCMN,COMP,CMOR
63 S SITE=""
64 S COMP=$E(HL("ECH"),1)
65 ;get Patient File MPI node
66 S VAFCMN=$$MPINODE^MPIFAPI(DFN)
67 S CMOR=$P(VAFCMN,"^",3)
68 I CMOR'="" S SITE=$$NS^XUAF4(CMOR)
69 S PD1(1)="PD1"_HL("FS")_HL("FS")_HL("FS")_$P(SITE,"^")_COMP_"D"_COMP_$P(SITE,"^",2)
70 Q
Note: See TracBrowser for help on using the repository browser.