source: FOIAVistA/trunk/r/MASTER_PATIENT_INDEX_VISTA-MPIF/MPIFD1.m@ 1397

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

initial load of FOIAVistA 6/30/08 version
File size: 8.0 KB
Line 
1MPIFD1 ;BIRM/CMC-POTENTIAL DUP ON MPI ;DEC 2, 2005
2 ;;1.0; MASTER PATIENT INDEX VISTA ;**43,48**;30 Apr 99;Build 6
3 ;
4INIT ;Entry point for List Manager Template - MPIF POTENTIAL DUP
5 Q
6HDR ;Header code for List Manager Template - MPIF POTENTIAL DUP (CLONED FROM HDR^MPIFQ1)
7 N SSN,DOB,MPIFQ1,NAME1,SEX
8 D GETDATA^MPIFQ0("^DPT(",DFN,"MPIFQ1",".01;.03;.09;.02","EI")
9 S NAME1=$G(MPIFQ1(2,DFN,.01,"E")),SSN=$G(MPIFQ1(2,DFN,.09,"E"))
10 S DOB=$G(MPIFQ1(2,DFN,.03,"I")),SEX=$G(MPIFQ1(2,DFN,.02,"E"))
11 I DOB]"" S DOB=$TR($$FMTE^XLFDT(DOB,"5D"),"/","-")
12 S VALMHDR(1)=" Possible MPI Matches for Patient: "_IOINHI_NAME1_IOINORM
13 S VALMHDR(2)=" SSN: "_IOINHI_SSN_IOINORM
14 S VALMHDR(3)=" DOB: "_IOINHI_DOB_IOINORM
15 S VALMHDR(4)=" SEX: "_IOINHI_SEX_IOINORM,VALMHDR(5)=" "
16 Q
17START(INDEX) ;Starting entry point for envoking the List Manager Template MPIF MPIF POTENTIAL DUP
18 S VALMCNT=INDEX
19 D EN^VALM("MPIF POTENTIAL DUP")
20 Q
21SELECT N VALMY
22 D EN^VALM2(XQORNOD(0),"OS")
23 I '$D(VALMY) Q
24 N DATA,INDEX,ICN,CHKSUM,NODE2
25 S INDEX=$O(VALMY(0)),DATA=^TMP("MPIFVQQ",$J,INDEX,"DATA")
26 S NODE2=$G(^TMP("MPIFVQQ",$J,INDEX,"INDICATOR"))
27 S DATA(.01)=$P(DATA,"^",1) I $E(DATA(.01),$L(DATA(.01)))=" " S DATA(.01)=$E(DATA(.01),1,$L(DATA(.01))-1) ;NAME
28 S DATA(.03)=$P(DATA,"^",4),DATA(.09)=$P(DATA,"^",3),DATA(.02)=$P(DATA,"^",11) ;DOB, SSN, SEX
29 S ICN=$P(DATA,"^",6),CHKSUM=$P(ICN,"V",2),ICN=$P(ICN,"V",1),DATA(991.01)=ICN,DATA(991.02)=CHKSUM,DATA(991.03)=$$LKUP^XUAF4($P(DATA,"^",5))
30 ;If NODE2["*" we have a pt in our list whose ICN is already at this site
31 I NODE2["*",$O(^DPT("AICN",ICN,""))'=DFN D Q
32 .D CLEAR^VALM1,MSG1^MPIFQ3
33 .N DFN2 S DFN2=$O(^DPT("AICN",ICN,""))
34 .D TWODFNS^MPIF002(DFN2,DFN,ICN)
35 .S MPIFRTN="CONTINUE"
36 ;Does your patient have other VISTA systems sharing this ICN? If so, can't match -- message to IMDQ?
37 ;Are there other sites in common (VISTA)? If so matching isn't allowed - message to IMDQ
38 S (MORE,COMMON)=0
39 D COMPARE^MPIF002(DFN,INDEX,.COMMON,.MORE)
40 I COMMON S MSG="Site attempted to resolve MPI duplicate for ICNs "_ICN_" and "_$$GETICN^MPIF001(DFN)_" - they have TFs in common."
41 I MORE S MSG="Site attempted to resolve MPI duplicate for ICNs "_ICN_" and "_$$GETICN^MPIF001(DFN)_" - the site patient is now shared."
42 I COMMON!(MORE) D MIMDQ^MPIF002(ICN,$$GETICN^MPIF001(DFN),DFN,MSG) S PROCESS=1 K COMMON,MORE S MPIFRTN="CONTINUE" Q
43 ;User selected from list, does SSN & Name match? no-ask if sure
44 N SSN,NAME,SEX,BIR K COMMON
45 D GETDATA^MPIFQ0("^DPT(",DFN,"MPIFQ1",".01;.09;.02;.03","EI")
46 S SSN=$G(MPIFQ1(2,DFN,.09,"E")),NAME=$G(MPIFQ1(2,DFN,.01,"E")),SEX=$G(MPIFQ1(2,DFN,.02,"I"))
47 S BIR=$G(MPIFQ1(2,DFN,.03,"I")) I BIR]"" S BIR=$TR($$FMTE^XLFDT(BIR,"5D"),"/","-")
48 ; if sex doesn't match -- not allowed to update ICN
49 I DATA(.02)'=SEX W !!,"Sex for these two patients doesn't match -- Can't select this patient until",!,"Sex matches between the MPI and your site. No action will be taken." D PROMPT^MPIFQ3 S VALMBCK="R" Q
50 I SSN["P" S SSN=""
51 I DATA(.09)'=SSN W !!,"SSN for these two patients doesn't match -- Can't select this patient until",!,"SSN matches between the MPI and your site. No action will be taken." D PROMPT^MPIFQ3 S VALMBCK="R" Q
52 D NAME^VAFCPID2(0,.NAME,0) ;reformat name into DG 149 format
53 N NAME3 S NAME3=DATA(.01) D NAME^VAFCPID2(0,.NAME3,0) S DATA(.01)=NAME3 ;reformat name into DG 149 format
54 N EXACT
55 ; check if Last, First MATCH if so is it a middle name vs middle initial
56 I $P(DATA(.01),",")=$P(NAME,",")&($P($P(NAME,",",2)," ")=$P($P(DATA(.01),",",2)," ")) D
57 .N MPIMID,NMMN S MPIMID=$P($P(DATA(.01),",",2)," ",2)
58 .S NMMN=$P($P(NAME,",",2)," ",2)
59 .I $L(NMMN)>1&($L(MPIMID)=1),($E(NMMN,1)=MPIMID) S EXACT=1
60 .I $L(MPIMID)>1&($L(NMMN)=1),($E(MPIMID,1)=NMMN) S EXACT=1
61 .I $D(EXACT),BIR'=DATA(.03) K EXACT
62 I DATA(.01)=NAME!($D(EXACT)) I BIR=DATA(.03) D Q
63 .N PID2,ERR
64 .K DATA(.09),DATA(.01),DATA(.03)
65 .D INIT^HLFNC2("MPIF ADT-A24 SERVER",.HL)
66 .D BLDPID^VAFCQRY(DFN,2,"ALL",.PID2,.HL,.ERR)
67 .;**48 want to resolve an reject exceptions for "current" ICN
68 .D RESEX^MPIFDUP(DFN)
69 .D EDIT^MPIFQED(DFN,"DATA"),MSG3^MPIFQ3,PROMPT^MPIFQ3
70 .S RESLT=$$A24^MPIFA24B(DFN,.PID2) ;send a24 link icns
71 .S PROCESS=1 Q
72 ; \/ Name doesn't match exactly - ask if sure
73 D CLEAR^VALM1,MSG2^MPIFQ3,MSG^MPIFQ3(SSN,NAME,DATA(.09),DATA(.01),DATA(.03),BIR)
74 N ANS S ANS=$$PROMPT1^MPIFQ3()
75 I ANS K DATA(.09),DATA(.01),DATA(.03) D Q
76 .;build PID segment to be the "from" value
77 .N PID2,ERR
78 .D INIT^HLFNC2("MPIF ADT-A24 SERVER",.HL)
79 .D BLDPID^VAFCQRY(DFN,2,"ALL",.PID2,.HL,.ERR)
80 .;**48 want to resolve an reject exceptions for "current" ICN
81 .D RESEX^MPIFDUP(DFN)
82 .D EDIT^MPIFQED(DFN,"DATA") S MPIFRTN="CONTINUE" ;UPDATE ICN
83 .W !!,"ICN and CMOR Updated" D PROMPT^MPIFQ3
84 .S PROCESS=1 N RESLT
85 .;TRIGGER A24 TO MPI TO LINK ICNs together
86 .S RESLT=$$A24^MPIFA24B(DFN,.PID2) ;SEND A24 LINKING ICNS
87 D MSG5^MPIFQ3,PROMPT^MPIFQ3 S VALMBCK="R"
88 Q
89MPIPD ; MPI PDAT CALL (CLONED FROM MPIPD^MPIFQ1)
90 N VALMY,CNT,Y
91 D EN^VALM2(XQORNOD(0),"OS")
92 I '$D(VALMY) Q
93 N DATA,INDEX,ICN,CHKSUM,CMOR,CASE,CMOR3,TTF,ALIAS,POW,TAL,TMP
94 S INDEX=$O(VALMY(0)),Y="" D CLEAR^VALM1
95 S DATA=^TMP("MPIFVQQ",$J,INDEX,"DATA")
96 S CMOR=$P(DATA,"^",5),CMOR3=CMOR,CMOR=$P($$NS^XUAF4($$LKUP^XUAF4(CMOR)),"^")
97 W !,"MPI Data:",!!!,?3,"ICN: ",+$P(DATA,"^",6) ; **48 REMOVE CMOR FROM DISPLAY ,?30,"CMOR: ",CMOR," (",CMOR3,")"
98 W !,?2,"NAME: ",$P(DATA,"^")
99 W !,?3,"SSN: ",$P(DATA,"^",3),?30,"SEX: ",$P(DATA,"^",11)
100 W !,?3,"DOB: ",$P(DATA,"^",4)
101 W ?30,"DOD: ",$P(DATA,"^",9)
102 I $P(DATA,"^",20)="Y" W !?3,"Multiple Birth Indicator: Yes"
103 I ($P(DATA,"^",12)='"")&($P(DATA,"^",13)'="") W !,?2,"PLACE OF BIRTH: ",$P(DATA,"^",12),", ",$P(DATA,"^",13)
104 I $P(DATA,"^",12)=""!($P(DATA,"^",13)="") W !,?2,"PLACE OF BIRTH: ",$P(DATA,"^",12)," ",$P(DATA,"^",13)
105 W !,?2,"MOTHER'S MAIDEN NAME: ",$P(DATA,"^",16)
106 W !,?2,"CLAIM NUMBER: ",$P(DATA,"^",17)
107 S POW=$P(DATA,"^",19) I POW'="" W !,?2,"POW STATUS: ",POW
108 S CASE=$P(DATA,"^",18)
109 I CASE'="" W !,?2,"Open Data Management Case",!,?5,"CASE#: ",$P(CASE,"/")_" REMEDY/NOIS#: ",$P(CASE,"/",2),!,?5,"CASE WORKER: ",$P(CASE,"/",3)
110 I $D(^TMP("MPIFVQQ",$J,INDEX,"ALIAS")) W !,?2,"Alias(es): " D
111 .N XX S XX=0 F S XX=$O(^TMP("MPIFVQQ",$J,INDEX,"ALIAS",XX)) Q:'XX W !?10,^(XX)
112 I $D(^TMP("MPIFVQQ",$J,INDEX,"TF"))&($O(^TMP("MPIFVQQ",$J,INDEX,"TF",1))'="") D
113 .W !,?2,"TREATING FACILITY LIST:"
114 .N XX S XX=0 F S XX=$O(^TMP("MPIFVQQ",$J,INDEX,"TF",XX)) Q:'XX S TMP=$P($G(^(XX)),MPICOMP) I TMP'=CMOR3 W !?10,"Treating Facility: ",$P($$NS^XUAF4($$LKUP^XUAF4(TMP)),"^")," (",TMP,")"
115 D PROMPT^MPIFQ3
116 S VALMBCK="R"
117 Q
118CMOR ; CMOR PDAT CALL (CLONED FROM CMOR^MPIFQ1)
119 N VALMY,DATA,INDEX,ICN,CHKSUM,CMOR
120 D EN^VALM2(XQORNOD(0),"OS")
121 I '$D(VALMY) Q
122 S INDEX=$O(VALMY(0)),DATA=^TMP("MPIFVQQ",$J,INDEX,"DATA")
123 S ICN=$P(DATA,"^",6),CHKSUM=$P(ICN,"V",2),ICN=$P(ICN,"V",1),CMOR=$P(DATA,"^",5)
124 I CMOR=$P($$SITE^VASITE(),"^",3) W !!,"CMOR is your site" G END
125 W !,"Please be patient while the data is being retrieved from the CMOR."
126 D EN1^XWB2HL7(.RETURN,CMOR,"VAFC REMOTE PDAT",1,ICN,"") ; Request
127 S ^XTMP("MPIFPDAT"_ICN,0)=$$FMADD^XLFDT(DT,2)_"^"_DT_"^"_"REMOTE PDAT QUERY",^XTMP("MPIFPDAT"_ICN,1)=RETURN(0)_"^"_$$NOW^XLFDT
128 S CNT=0
129AGAIN1 H 2 K RES1 D RTNDATA^XWBDRPC(.RES1,RETURN(0)) S CNT=CNT+1
130 I +RES1(0)=-1&(RES1(0)["Not DONE") I CNT<11 G AGAIN1
131 I +RES1(0)=-1&(RES1(0)["Not DONE") I CNT>10 W !,"Unable to get data" G END
132 I RES1(0)="0^New" I CNT<11 G AGAIN1
133 I RES1(0)="0^New" I CNT>10 W !,"Unable to get data" G END
134 I +RES1(0)=-1 W !!,$P(RES1(0),"^",2) G END
135 I RES1'="" I CNT<11 G AGAIN1
136 I RES1'="" I CNT>10 W !,"Unable to get data" Q
137 D CLEAR^VALM1
138 N NUM S NUM="",CNT=0
139 F S NUM=$O(RES1(NUM)) Q:NUM="" D
140 .I CNT>20 D PROMPT^MPIFQ3,CLEAR^VALM1 S CNT=0
141 .I RES1(NUM)["Additional" W !! S CNT=CNT+2
142 .I CNT<21 W !,RES1(NUM) S CNT=CNT+1
143END D PROMPT^MPIFQ3 S VALMBCK="R" K CNT,RETURN,RES1
144 Q
145HELP ; Help List Manager Action (MPIF POTENTIAL DUP (HELP))
146 D CLEAR^VALM1
147 K MPIFDUP S MPIFDUP=1 D MSG4^MPIFQ3,PROMPT^MPIFQ3 S VALMBCK="R" K MPIFDUP
148 Q
149EXIT ;Exit for List Manager Template MPIF MPIF POTENTIAL DUP
150 K VALMBCK,VALMCNT,VALMHDR
151 Q
Note: See TracBrowser for help on using the repository browser.