source: FOIAVistA/trunk/r/MASTER_PATIENT_INDEX_VISTA-MPIF/MPIFEXT.m@ 1720

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

initial load of FOIAVistA 6/30/08 version
File size: 6.4 KB
Line 
1MPIFEXT ;SFCIO/CMC-EXTENDED PDAT - RPC ;26 JUN 01
2 ;;1.0; MASTER PATIENT INDEX VISTA ;**20**;30 Apr 99
3 ;
4 ;Integration Agreements Utilized:
5 ; ^DGCN(391.91 - #2751
6 ; EN1^XWB2HL7 - #3144
7 ; RTNDATA^XEBDRPC - #3149
8 ;
9PEXT(RETURN,ICN,SSN,LOCAL,ALL,SITE,RPC) ;get patient info array
10 N MPINODE,ARRAY,DFN,TICN,TSSN
11 I RPC="" S RPC=0 ; default is 0 for RPC
12 I $G(ICN)=""&($G(SSN)="") S RETURN="-1^NO ICN OR SSN PASSED" Q
13 I $G(LOCAL)=""&($G(ALL)="")&($G(SITE)="") S ALL=1
14 ; ^ All is the default
15 I LOCAL=1 D PATINFO^MPIFEXT2(.RETURN,ICN,SSN,0) Q
16 I ALL=1 D ALL(.RETURN,ICN,SSN,RPC) Q
17 I SITE'="" D SITE(.RETURN,ICN,SSN,SITE,RPC)
18 Q
19 ;
20SITE(RETS,ICN,SSN,SITE,RPC) ;
21 ; request PDAT from one remote site
22 I $G(SITE)="" S RETS="-1^No Site Passed" Q
23 I $G(ICN)=""&($G(SSN)="") S RETS="-1^No ICN or SSN passed" Q
24 I ICN="" S EXIST=$$ASK(SSN,SITE)
25 I SSN="" S EXIST=$$ASK(ICN,SITE)
26 I EXIST=1 D
27 .I ICN="" S RETS(0)=$G(^XTMP("MPIF EXT PDAT"_SSN,SITE))
28 .I SSN="" S RETS(0)=$G(^XTMP("MPIF EXT PDAT"_ICN,SITE))
29 .I RETS(0)="" S EXIST=0
30 I EXIST=0 D
31 .I ICN="" K ^XTMP("MPIF EXT PDAT"_SSN,SITE)
32 .I SSN="" K ^XTMP("MPIF EXT PDAT"_ICN,SITE)
33 .D EN1^XWB2HL7(.RETS,SITE,"MPIF EXT PDAT REMOTE",1,ICN,SSN,1)
34 .I $G(ICN)'="" S ^XTMP("MPIF EXT PDAT"_ICN,0)=$$FMADD^XLFDT($$NOW^XLFDT,2)_"^"_$$NOW^XLFDT_"^"_"Remote data from site",^XTMP("MPIF EXT PDAT"_ICN,SITE)=RETS(0)
35 .I $G(SSN)'="" S ^XTMP("MPIF EXT PDAT"_SSN,0)=$$FMADD^XLFDT($$NOW^XLFDT,2)_"^"_$$NOW^XLFDT_"^"_"Remote data from site",^XTMP("MPIF EXT PDAT"_SSN,SITE)=RETS(0)
36 ;
37 N CNT,SUB
38 S CNT=0
39AGAIN H 2 K RES D RTNDATA^XWBDRPC(.RES,RETS(0)) S CNT=CNT+1
40 I +RES(0)=-1&(RES(0)["Not DONE") I CNT<10 G AGAIN
41 I +RES(0)=-1&(RES(0)["Not DONE") I CNT>10 S RETS(SITE)="Unable to get data" Q
42 I RES(0)="0^New" I CNT<10 G AGAIN
43 I RES(0)="0^New" I CNT>10 S RETS(SITE)="Unable to get data" Q
44 I +RES(0)=-1 S RETS=RES(0) Q
45 I RES'="" I CNT<10 G AGAIN
46 I RES'="" I CNT>10 S RETS(SITE)="Unable to get data" Q
47 D REFORMAT(.RES)
48 K RETS,EXIST
49 M RETS(SITE)=RES
50 K RES
51 Q
52 ;
53ALL(RETS2,ICN,SSN,RPC) ;
54 ; request PDAT from ALL TFs and the MPI
55 I $G(ICN)=""&($G(SSN)="") S RETS1="-1^No ICN or SSN passed" Q
56 N DFN,ICN2
57 I ICN="" S EXIST=$$ASK(SSN,1)
58 I SSN="" S EXIST=$$ASK(ICN,1)
59 I SSN'="" S ICN=$$GETICNS^MPIF002(SSN)
60 F XX=1:1 S ICN2=$P(ICN,"^",XX) Q:ICN2="" D
61 .S DFN=$$GETDFN^MPIF001(ICN2)
62 .I +DFN<0 S RETS2(ICN2)="-1^No such ICN" Q
63 .D ALL2(DFN,ICN2,SSN,1,.RETS2,EXIST)
64 K EXIST
65 Q
66 ;
67ALL2(DFN,ICN,SSN,RPC,RETS1,EXIST) ;
68 D GETTFS(DFN,.ARR)
69 I +ARR=-1 G MPI
70 S SITE=""
71 F S SITE=$O(ARR(SITE)) Q:SITE="" D
72 .K RETS1
73 .I EXIST=1 D
74 ..I ICN="" S RETS1(0)=$G(^XTMP("MPIF EXT PDAT"_SSN,SITE))
75 ..I SSN="" S RETS1(0)=$G(^XTMP("MPIF EXT PDAT"_ICN,SITE))
76 ..I RETS1(0)="" S EXIST=0
77 .I EXIST=0 D
78 ..I ICN="" K ^XTMP("MPIF EXT PDAT"_SSN,SITE)
79 ..I SSN="" K ^XTMP("MPIF EXT PDAT"_ICN,SITE)
80 ..D EN1^XWB2HL7(.RETS1,SITE,"MPIF EXT PDAT REMOTE",1,ICN,SSN,RPC)
81 ..I $G(ICN)'="" S ^XTMP("MPIF EXT PDAT"_ICN,SITE,0)=$$FMADD^XLFDT($$NOW^XLFDT,2)_"^"_$$NOW^XLFDT_"^"_"Remote data from site",^XTMP("MPIF EXT PDAT"_ICN,SITE)=RETS1(0)
82 ..I $G(SSN)'="" S ^XTMP("MPIF EXT PDAT"_SSN,SITE,0)=$$FMADD^XLFDT($$NOW^XLFDT,2)_"^"_$$NOW^XLFDT_"^"_"Remote data from site",^XTMP("MPIF EXT PDAT"_SSN,SITE)=RETS1(0)
83 ;
84MPI K RETS1
85 I EXIST=1 D
86 .I ICN="" S RETS1(0)=$G(^XTMP("MPIF EXT PDAT"_SSN,"MPI"))
87 .I SSN="" S RETS1(0)=$G(^XTMP("MPIF EXT PDAT"_ICN,"MPI"))
88 .I RETS1(0)="" S EXIST=0
89 I EXIST=0 D
90 .I ICN="" K ^XTMP("MPIF EXT PDAT"_SSN,"MPI")
91 .I SSN="" K ^XTMP("MPIF EXT PDAT"_ICN,"MPI")
92 .D EN1^XWB2HL7(.RETS1,"MPI","MPIF EXT PDAT REMOTE",1,ICN,SSN,RPC)
93 .I $G(ICN)'="" S ^XTMP("MPIF EXT PDAT"_ICN,"MPI",0)=$$FMADD^XLFDT($$NOW^XLFDT,2)_"^"_$$NOW^XLFDT_"^"_"Remote data from site",^XTMP("MPIF EXT PDAT"_ICN,"MPI")=RETS1(0)
94 .I $G(SSN)'="" S ^XTMP("MPIF EXT PDAT"_SSN,"MPI",0)=$$FMADD^XLFDT($$NOW^XLFDT,2)_"^"_$$NOW^XLFDT_"^"_"Remote data from site",^XTMP("MPIF EXT PDAT"_SSN,"MPI")=RETS1(0)
95 ;
96 K RETS1,RES,RESS2
97 N ZNODE,IEN
98 H 2
99 I SSN="" S IEN=ICN
100 I ICN="" S IEN=SSN
101 S SITE=""
102 F S SITE=$O(^XTMP("MPIF EXT PDAT"_IEN,SITE)) Q:SITE="" D
103 .S ZNODE=$G(^XTMP("MPIF EXT PDAT"_IEN,SITE))
104 .K RES
105 .D RET(.RES,SITE,ZNODE)
106 .K RETS1(SITE)
107 .M RETS1(SITE)=RES
108 .K RES
109 ;
110 K RES,RESS2
111 D PATINFO^MPIFEXT2(.RESS2,ICN,SSN,0)
112 S SITE=$P($$SITE^VASITE,"^",3)
113 K RETS1(SITE)
114 M RETS1(SITE)=RESS2
115 K RESS2,ARR
116 Q
117 ;
118RET(REST,SITE,IEN) ;
119 ; RETRIEVING DATA
120 N RES1,CNT S CNT=0
121AGAIN1 H 2 K RES1,REST D RTNDATA^XWBDRPC(.RES1,IEN) S CNT=CNT+1
122 I +RES1(0)=-1&(RES1(0)["Not DONE") I CNT<10 G AGAIN1
123 I +RES1(0)=-1&(RES1(0)["Not DONE") I CNT>10 S REST(SITE)="Unable to get data" Q
124 I RES1(0)="0^New" I CNT<10 G AGAIN1
125 I RES1(0)="0^New" I CNT>10 S REST(SITE)="Unable to get data" Q
126 I +RES1(0)=-1 S REST(SITE)=RES1(0) Q
127 I RES1'="" I CNT<10 G AGAIN1
128 I RES1'="" I CNT>10 S REST(SITE)="Unable to get data" Q
129 D REFORMAT(.RES1)
130 K REST
131 M REST=RES1
132 Q
133 ;
134GETTFS(DFN,ARRAY) ;
135 ; get list of TF station numbers for a patient (dfn)
136 ;
137 N SITE,HERE,HSTN,CNT
138 I $D(^DGCN(391.91,"APAT",DFN))="" S ARRAY="-1^No TFs" Q
139 S HERE=+$$SITE^VASITE(),HSTN=$P($$SITE^VASITE(),"^",3)
140 S SITE="",CNT=0
141 F S SITE=$O(^DGCN(391.91,"APAT",DFN,SITE)) Q:SITE="" D
142 .Q:SITE=HERE
143 .S CNT=CNT+1
144 .S ARRAY($P($$NNT^XUAF4(SITE),"^",2))=""
145 I CNT=0 S ARRAY="-1^No other site TFs" Q
146 S ARRAY=CNT
147 Q
148 ;
149REFORMAT(ARRAY) ; Reformat from RPC=1 format to RPC=0 format
150 N XX,ARR,TARR
151 S XX=0
152 F S XX=$O(ARRAY(XX)) Q:XX="" D
153 .I XX=1 S TARR=$P(ARRAY(XX),"(")
154 .S ARR=$P(ARRAY(XX),"=")
155 .S @ARR=$P(ARRAY(XX),"=",2)
156 K ARRAY
157 M ARRAY=@TARR
158 K @TARR
159 Q
160 ;
161ASK(ICNSSN,SITE) ; Function to check if there has been a previous request
162 ; made for this ICN/SSN. If so, ask the user if they wish to view if or
163 ; create a new request.
164 ;
165 N DIR,X,Y,SITE1
166 I '$D(^XTMP("MPIF EXT PDAT"_ICNSSN)) Q 0
167 I SITE=1 D
168 .S SITE1=0
169 .W !!,"There has been a request made for this patient to site(s): "
170 .F S SITE1=$O(^XTMP("MPIF EXT PDAT"_ICNSSN,SITE1)) Q:SITE1="" D
171 ..I SITE1=$P($$SITE^VASITE(),"^",3) Q
172 ..W !,SITE1,?10,$P($$NNT^XUAF4($$LKUP^XUAF4(SITE1)),"^"),?40,"made at "
173 ..N Y S Y=$P(^XTMP("MPIF EXT PDAT"_ICNSSN,SITE1,0),"^",2) D DD^%DT
174 ..W Y
175 I SITE'=1,'$D(^XTMP("MPIF EXT PDAT"_ICNSSN,SITE)) Q 0
176 I SITE'=1,SITE'=$P($$SITE^VASITE(),"^",3) D
177 .W !!,"There has been a previous request made for this patient from the same "
178 .W !,"site you are requesting. The request was made at "
179 .N Y S Y=$P($G(^XTMP("MPIF EXT PDAT"_ICNSSN,SITE,0)),"^",2) D DD^%DT
180 .W Y
181 S DIR("A")="Would you like to view this data?"
182 S DIR(0)="Y",DIR("B")="No"
183 D ^DIR
184 I Y'=1 Q 0
185 Q 1
Note: See TracBrowser for help on using the repository browser.