MPIFEXT ;SFCIO/CMC-EXTENDED PDAT - RPC ;9 Apr 2013 4:42 PM
;;1.0;MASTER PATIENT INDEX VISTA;**20,57**;30 Apr 99;Build 2
;
;Integration Agreements Utilized:
; ^DGCN(391.91 - #2751
; EN1^XWB2HL7 - #3144
; RPCCHK^XWB2HL7 - #3144
; RTNDATA^XEBDRPC - #3149
;
PEXT(RETURN,ICN,SSN,LOCAL,ALL,SITE,RPC) ;get patient info array
N MPINODE,ARRAY,DFN,TICN,TSSN
I RPC="" S RPC=0 ; default is 0 for RPC
I $G(ICN)=""&($G(SSN)="") S RETURN="-1^NO ICN OR SSN PASSED" Q
I $G(LOCAL)=""&($G(ALL)="")&($G(SITE)="") S ALL=1
; ^ All is the default
I LOCAL=1 D PATINFO^MPIFEXT2(.RETURN,ICN,SSN,0) Q
I ALL=1 D ALL(.RETURN,ICN,SSN,RPC) Q
I SITE'="" D SITE(.RETURN,ICN,SSN,SITE,RPC)
Q
;
SITE(RETS,ICN,SSN,SITE,RPC) ;
; request PDAT from one remote site
I $G(SITE)="" S RETS="-1^No Site Passed" Q
I $G(ICN)=""&($G(SSN)="") S RETS="-1^No ICN or SSN passed" Q
I ICN="" S EXIST=$$ASK(SSN,SITE)
I SSN="" S EXIST=$$ASK(ICN,SITE)
I EXIST=1 D
.I ICN="" S RETS(0)=$G(^XTMP("MPIF EXT PDAT"_SSN,SITE))
.I SSN="" S RETS(0)=$G(^XTMP("MPIF EXT PDAT"_ICN,SITE))
.I RETS(0)="" S EXIST=0
I EXIST=0 D
.I ICN="" K ^XTMP("MPIF EXT PDAT"_SSN,SITE)
.I SSN="" K ^XTMP("MPIF EXT PDAT"_ICN,SITE)
.D EN1^XWB2HL7(.RETS,SITE,"MPIF EXT PDAT REMOTE",1,ICN,SSN,1)
.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)
.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)
;
;**57,MVI_1414 (mko): Call RPCCHK^XWB2HL7 to check for results
N CNT
F CNT=1:1:10 K RES D RPCCHK^XWB2HL7(.RES,RETS(0)) Q:+RES(0)=1 Q:+RES(0)=-1 H 2
I +RES(0)=-1 S RETS=RES(0) Q
I +RES(0)'=1 S RETS(SITE)="Unable to get data" Q
K RES D RTNDATA^XWBDRPC(.RES,RETS(0))
;S CNT=0
;AGAIN H 2 K RES D RTNDATA^XWBDRPC(.RES,RETS(0)) S CNT=CNT+1
;I +RES(0)=-1&(RES(0)["Not DONE") I CNT<10 G AGAIN
;I +RES(0)=-1&(RES(0)["Not DONE") I CNT>10 S RETS(SITE)="Unable to get data" Q
;I RES(0)="0^New" I CNT<10 G AGAIN
;I RES(0)="0^New" I CNT>10 S RETS(SITE)="Unable to get data" Q
;I +RES(0)=-1 S RETS=RES(0) Q
;I RES'="" I CNT<10 G AGAIN
;I RES'="" I CNT>10 S RETS(SITE)="Unable to get data" Q
D REFORMAT(.RES)
K RETS,EXIST
M RETS(SITE)=RES
K RES
Q
;
ALL(RETS2,ICN,SSN,RPC) ;
; request PDAT from ALL TFs and the MPI
I $G(ICN)=""&($G(SSN)="") S RETS1="-1^No ICN or SSN passed" Q
N DFN,ICN2
I ICN="" S EXIST=$$ASK(SSN,1)
I SSN="" S EXIST=$$ASK(ICN,1)
I SSN'="" S ICN=$$GETICNS^MPIF002(SSN)
F XX=1:1 S ICN2=$P(ICN,"^",XX) Q:ICN2="" D
.S DFN=$$GETDFN^MPIF001(ICN2)
.I +DFN<0 S RETS2(ICN2)="-1^No such ICN" Q
.D ALL2(DFN,ICN2,SSN,1,.RETS2,EXIST)
K EXIST
Q
;
ALL2(DFN,ICN,SSN,RPC,RETS1,EXIST) ;
D GETTFS(DFN,.ARR)
I +ARR=-1 G MPI
S SITE=""
F S SITE=$O(ARR(SITE)) Q:SITE="" D
.K RETS1
.I EXIST=1 D
..I ICN="" S RETS1(0)=$G(^XTMP("MPIF EXT PDAT"_SSN,SITE))
..I SSN="" S RETS1(0)=$G(^XTMP("MPIF EXT PDAT"_ICN,SITE))
..I RETS1(0)="" S EXIST=0
.I EXIST=0 D
..I ICN="" K ^XTMP("MPIF EXT PDAT"_SSN,SITE)
..I SSN="" K ^XTMP("MPIF EXT PDAT"_ICN,SITE)
..D EN1^XWB2HL7(.RETS1,SITE,"MPIF EXT PDAT REMOTE",1,ICN,SSN,RPC)
..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)
..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)
;
MPI K RETS1
I EXIST=1 D
.I ICN="" S RETS1(0)=$G(^XTMP("MPIF EXT PDAT"_SSN,"MPI"))
.I SSN="" S RETS1(0)=$G(^XTMP("MPIF EXT PDAT"_ICN,"MPI"))
.I RETS1(0)="" S EXIST=0
I EXIST=0 D
.I ICN="" K ^XTMP("MPIF EXT PDAT"_SSN,"MPI")
.I SSN="" K ^XTMP("MPIF EXT PDAT"_ICN,"MPI")
.D EN1^XWB2HL7(.RETS1,"MPI","MPIF EXT PDAT REMOTE",1,ICN,SSN,RPC)
.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)
.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)
;
K RETS1,RES,RESS2
N ZNODE,IEN
H 2
I SSN="" S IEN=ICN
I ICN="" S IEN=SSN
S SITE=""
F S SITE=$O(^XTMP("MPIF EXT PDAT"_IEN,SITE)) Q:SITE="" D
.S ZNODE=$G(^XTMP("MPIF EXT PDAT"_IEN,SITE))
.K RES
.D RET(.RES,SITE,ZNODE)
.K RETS1(SITE)
.M RETS1(SITE)=RES
.K RES
;
K RES,RESS2
D PATINFO^MPIFEXT2(.RESS2,ICN,SSN,0)
S SITE=$P($$SITE^VASITE,"^",3)
K RETS1(SITE)
M RETS1(SITE)=RESS2
K RESS2,ARR
Q
;
RET(REST,SITE,IEN) ;
; RETRIEVING DATA
;**57,MVI_1414 (mko): Call RPCCHK^XWB2HL7 to check for results
N RES1,CNT
F CNT=1:1:10 K RES1 D RPCCHK^XWB2HL7(.RES1,IEN) Q:+RES1(0)=1 Q:+RES1(0)=-1 H 2
I +RES1(0)=-1 S REST=RES1(0) Q
I +RES1(0)'=1 S REST(SITE)="Unable to get data" Q
K RES1 D RTNDATA^XWBDRPC(.RES1,IEN)
;N RES1,CNT S CNT=0
;AGAIN1 H 2 K RES1,REST D RTNDATA^XWBDRPC(.RES1,IEN) S CNT=CNT+1
;I +RES1(0)=-1&(RES1(0)["Not DONE") I CNT<10 G AGAIN1
;I +RES1(0)=-1&(RES1(0)["Not DONE") I CNT>10 S REST(SITE)="Unable to get data" Q
;I RES1(0)="0^New" I CNT<10 G AGAIN1
;I RES1(0)="0^New" I CNT>10 S REST(SITE)="Unable to get data" Q
;I +RES1(0)=-1 S REST(SITE)=RES1(0) Q
;I RES1'="" I CNT<10 G AGAIN1
;I RES1'="" I CNT>10 S REST(SITE)="Unable to get data" Q
D REFORMAT(.RES1)
K REST
M REST=RES1
Q
;
GETTFS(DFN,ARRAY) ;
; get list of TF station numbers for a patient (dfn)
;
N SITE,HERE,HSTN,CNT
I $D(^DGCN(391.91,"APAT",DFN))="" S ARRAY="-1^No TFs" Q
S HERE=+$$SITE^VASITE(),HSTN=$P($$SITE^VASITE(),"^",3)
S SITE="",CNT=0
F S SITE=$O(^DGCN(391.91,"APAT",DFN,SITE)) Q:SITE="" D
.Q:SITE=HERE
.S CNT=CNT+1
.S ARRAY($P($$NNT^XUAF4(SITE),"^",2))=""
I CNT=0 S ARRAY="-1^No other site TFs" Q
S ARRAY=CNT
Q
;
REFORMAT(ARRAY) ; Reformat from RPC=1 format to RPC=0 format
N XX,ARR,TARR
S XX=0
F S XX=$O(ARRAY(XX)) Q:XX="" D
.I XX=1 S TARR=$P(ARRAY(XX),"(")
.S ARR=$P(ARRAY(XX),"=")
.S @ARR=$P(ARRAY(XX),"=",2)
K ARRAY
M ARRAY=@TARR
K @TARR
Q
;
ASK(ICNSSN,SITE) ; Function to check if there has been a previous request
; made for this ICN/SSN. If so, ask the user if they wish to view if or
; create a new request.
;
N DIR,X,Y,SITE1
I '$D(^XTMP("MPIF EXT PDAT"_ICNSSN)) Q 0
I SITE=1 D
.S SITE1=0
.W !!,"There has been a request made for this patient to site(s): "
.F S SITE1=$O(^XTMP("MPIF EXT PDAT"_ICNSSN,SITE1)) Q:SITE1="" D
..I SITE1=$P($$SITE^VASITE(),"^",3) Q
..W !,SITE1,?10,$P($$NNT^XUAF4($$LKUP^XUAF4(SITE1)),"^"),?40,"made at "
..N Y S Y=$P(^XTMP("MPIF EXT PDAT"_ICNSSN,SITE1,0),"^",2) D DD^%DT
..W Y
I SITE'=1,'$D(^XTMP("MPIF EXT PDAT"_ICNSSN,SITE)) Q 0
I SITE'=1,SITE'=$P($$SITE^VASITE(),"^",3) D
.W !!,"There has been a previous request made for this patient from the same "
.W !,"site you are requesting. The request was made at "
.N Y S Y=$P($G(^XTMP("MPIF EXT PDAT"_ICNSSN,SITE,0)),"^",2) D DD^%DT
.W Y
S DIR("A")="Would you like to view this data?"
S DIR(0)="Y",DIR("B")="No"
D ^DIR
I Y'=1 Q 0
Q 1
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMPIFEXT 7306 printed Nov 22, 2024@17:21:11 Page 2
MPIFEXT ;SFCIO/CMC-EXTENDED PDAT - RPC ;9 Apr 2013 4:42 PM
+1 ;;1.0;MASTER PATIENT INDEX VISTA;**20,57**;30 Apr 99;Build 2
+2 ;
+3 ;Integration Agreements Utilized:
+4 ; ^DGCN(391.91 - #2751
+5 ; EN1^XWB2HL7 - #3144
+6 ; RPCCHK^XWB2HL7 - #3144
+7 ; RTNDATA^XEBDRPC - #3149
+8 ;
PEXT(RETURN,ICN,SSN,LOCAL,ALL,SITE,RPC) ;get patient info array
+1 NEW MPINODE,ARRAY,DFN,TICN,TSSN
+2 ; default is 0 for RPC
IF RPC=""
SET RPC=0
+3 IF $GET(ICN)=""&($GET(SSN)="")
SET RETURN="-1^NO ICN OR SSN PASSED"
QUIT
+4 IF $GET(LOCAL)=""&($GET(ALL)="")&($GET(SITE)="")
SET ALL=1
+5 ; ^ All is the default
+6 IF LOCAL=1
DO PATINFO^MPIFEXT2(.RETURN,ICN,SSN,0)
QUIT
+7 IF ALL=1
DO ALL(.RETURN,ICN,SSN,RPC)
QUIT
+8 IF SITE'=""
DO SITE(.RETURN,ICN,SSN,SITE,RPC)
+9 QUIT
+10 ;
SITE(RETS,ICN,SSN,SITE,RPC) ;
+1 ; request PDAT from one remote site
+2 IF $GET(SITE)=""
SET RETS="-1^No Site Passed"
QUIT
+3 IF $GET(ICN)=""&($GET(SSN)="")
SET RETS="-1^No ICN or SSN passed"
QUIT
+4 IF ICN=""
SET EXIST=$$ASK(SSN,SITE)
+5 IF SSN=""
SET EXIST=$$ASK(ICN,SITE)
+6 IF EXIST=1
Begin DoDot:1
+7 IF ICN=""
SET RETS(0)=$GET(^XTMP("MPIF EXT PDAT"_SSN,SITE))
+8 IF SSN=""
SET RETS(0)=$GET(^XTMP("MPIF EXT PDAT"_ICN,SITE))
+9 IF RETS(0)=""
SET EXIST=0
End DoDot:1
+10 IF EXIST=0
Begin DoDot:1
+11 IF ICN=""
KILL ^XTMP("MPIF EXT PDAT"_SSN,SITE)
+12 IF SSN=""
KILL ^XTMP("MPIF EXT PDAT"_ICN,SITE)
+13 DO EN1^XWB2HL7(.RETS,SITE,"MPIF EXT PDAT REMOTE",1,ICN,SSN,1)
+14 IF $GET(ICN)'=""
SET ^XTMP("MPIF EXT PDAT"_ICN,0)=$$FMADD^XLFDT($$NOW^XLFDT,2)_"^"_$$NOW^XLFDT_"^"_"Remote data from site"
SET ^XTMP("MPIF EXT PDAT"_ICN,SITE)=RETS(0)
+15 IF $GET(SSN)'=""
SET ^XTMP("MPIF EXT PDAT"_SSN,0)=$$FMADD^XLFDT($$NOW^XLFDT,2)_"^"_$$NOW^XLFDT_"^"_"Remote data from site"
SET ^XTMP("MPIF EXT PDAT"_SSN,SITE)=RETS(0)
End DoDot:1
+16 ;
+17 ;**57,MVI_1414 (mko): Call RPCCHK^XWB2HL7 to check for results
+18 NEW CNT
+19 FOR CNT=1:1:10
KILL RES
DO RPCCHK^XWB2HL7(.RES,RETS(0))
if +RES(0)=1
QUIT
if +RES(0)=-1
QUIT
HANG 2
+20 IF +RES(0)=-1
SET RETS=RES(0)
QUIT
+21 IF +RES(0)'=1
SET RETS(SITE)="Unable to get data"
QUIT
+22 KILL RES
DO RTNDATA^XWBDRPC(.RES,RETS(0))
+23 ;S CNT=0
+24 ;AGAIN H 2 K RES D RTNDATA^XWBDRPC(.RES,RETS(0)) S CNT=CNT+1
+25 ;I +RES(0)=-1&(RES(0)["Not DONE") I CNT<10 G AGAIN
+26 ;I +RES(0)=-1&(RES(0)["Not DONE") I CNT>10 S RETS(SITE)="Unable to get data" Q
+27 ;I RES(0)="0^New" I CNT<10 G AGAIN
+28 ;I RES(0)="0^New" I CNT>10 S RETS(SITE)="Unable to get data" Q
+29 ;I +RES(0)=-1 S RETS=RES(0) Q
+30 ;I RES'="" I CNT<10 G AGAIN
+31 ;I RES'="" I CNT>10 S RETS(SITE)="Unable to get data" Q
+32 DO REFORMAT(.RES)
+33 KILL RETS,EXIST
+34 MERGE RETS(SITE)=RES
+35 KILL RES
+36 QUIT
+37 ;
ALL(RETS2,ICN,SSN,RPC) ;
+1 ; request PDAT from ALL TFs and the MPI
+2 IF $GET(ICN)=""&($GET(SSN)="")
SET RETS1="-1^No ICN or SSN passed"
QUIT
+3 NEW DFN,ICN2
+4 IF ICN=""
SET EXIST=$$ASK(SSN,1)
+5 IF SSN=""
SET EXIST=$$ASK(ICN,1)
+6 IF SSN'=""
SET ICN=$$GETICNS^MPIF002(SSN)
+7 FOR XX=1:1
SET ICN2=$PIECE(ICN,"^",XX)
if ICN2=""
QUIT
Begin DoDot:1
+8 SET DFN=$$GETDFN^MPIF001(ICN2)
+9 IF +DFN<0
SET RETS2(ICN2)="-1^No such ICN"
QUIT
+10 DO ALL2(DFN,ICN2,SSN,1,.RETS2,EXIST)
End DoDot:1
+11 KILL EXIST
+12 QUIT
+13 ;
ALL2(DFN,ICN,SSN,RPC,RETS1,EXIST) ;
+1 DO GETTFS(DFN,.ARR)
+2 IF +ARR=-1
GOTO MPI
+3 SET SITE=""
+4 FOR
SET SITE=$ORDER(ARR(SITE))
if SITE=""
QUIT
Begin DoDot:1
+5 KILL RETS1
+6 IF EXIST=1
Begin DoDot:2
+7 IF ICN=""
SET RETS1(0)=$GET(^XTMP("MPIF EXT PDAT"_SSN,SITE))
+8 IF SSN=""
SET RETS1(0)=$GET(^XTMP("MPIF EXT PDAT"_ICN,SITE))
+9 IF RETS1(0)=""
SET EXIST=0
End DoDot:2
+10 IF EXIST=0
Begin DoDot:2
+11 IF ICN=""
KILL ^XTMP("MPIF EXT PDAT"_SSN,SITE)
+12 IF SSN=""
KILL ^XTMP("MPIF EXT PDAT"_ICN,SITE)
+13 DO EN1^XWB2HL7(.RETS1,SITE,"MPIF EXT PDAT REMOTE",1,ICN,SSN,RPC)
+14 IF $GET(ICN)'=""
SET ^XTMP("MPIF EXT PDAT"_ICN,SITE,0)=$$FMADD^XLFDT($$NOW^XLFDT,2)_"^"_$$NOW^XLFDT_"^"_"Remote data from site"
SET ^XTMP("MPIF EXT PDAT"_ICN,SITE)=RETS1(0)
+15 IF $GET(SSN)'=""
SET ^XTMP("MPIF EXT PDAT"_SSN,SITE,0)=$$FMADD^XLFDT($$NOW^XLFDT,2)_"^"_$$NOW^XLFDT_"^"_"Remote data from site"
SET ^XTMP("MPIF EXT PDAT"_SSN,SITE)=RETS1(0)
End DoDot:2
End DoDot:1
+16 ;
MPI KILL RETS1
+1 IF EXIST=1
Begin DoDot:1
+2 IF ICN=""
SET RETS1(0)=$GET(^XTMP("MPIF EXT PDAT"_SSN,"MPI"))
+3 IF SSN=""
SET RETS1(0)=$GET(^XTMP("MPIF EXT PDAT"_ICN,"MPI"))
+4 IF RETS1(0)=""
SET EXIST=0
End DoDot:1
+5 IF EXIST=0
Begin DoDot:1
+6 IF ICN=""
KILL ^XTMP("MPIF EXT PDAT"_SSN,"MPI")
+7 IF SSN=""
KILL ^XTMP("MPIF EXT PDAT"_ICN,"MPI")
+8 DO EN1^XWB2HL7(.RETS1,"MPI","MPIF EXT PDAT REMOTE",1,ICN,SSN,RPC)
+9 IF $GET(ICN)'=""
SET ^XTMP("MPIF EXT PDAT"_ICN,"MPI",0)=$$FMADD^XLFDT($$NOW^XLFDT,2)_"^"_$$NOW^XLFDT_"^"_"Remote data from site"
SET ^XTMP("MPIF EXT PDAT"_ICN,"MPI")=RETS1(0)
+10 IF $GET(SSN)'=""
SET ^XTMP("MPIF EXT PDAT"_SSN,"MPI",0)=$$FMADD^XLFDT($$NOW^XLFDT,2)_"^"_$$NOW^XLFDT_"^"_"Remote data from site"
SET ^XTMP("MPIF EXT PDAT"_SSN,"MPI")=RETS1(0)
End DoDot:1
+11 ;
+12 KILL RETS1,RES,RESS2
+13 NEW ZNODE,IEN
+14 HANG 2
+15 IF SSN=""
SET IEN=ICN
+16 IF ICN=""
SET IEN=SSN
+17 SET SITE=""
+18 FOR
SET SITE=$ORDER(^XTMP("MPIF EXT PDAT"_IEN,SITE))
if SITE=""
QUIT
Begin DoDot:1
+19 SET ZNODE=$GET(^XTMP("MPIF EXT PDAT"_IEN,SITE))
+20 KILL RES
+21 DO RET(.RES,SITE,ZNODE)
+22 KILL RETS1(SITE)
+23 MERGE RETS1(SITE)=RES
+24 KILL RES
End DoDot:1
+25 ;
+26 KILL RES,RESS2
+27 DO PATINFO^MPIFEXT2(.RESS2,ICN,SSN,0)
+28 SET SITE=$PIECE($$SITE^VASITE,"^",3)
+29 KILL RETS1(SITE)
+30 MERGE RETS1(SITE)=RESS2
+31 KILL RESS2,ARR
+32 QUIT
+33 ;
RET(REST,SITE,IEN) ;
+1 ; RETRIEVING DATA
+2 ;**57,MVI_1414 (mko): Call RPCCHK^XWB2HL7 to check for results
+3 NEW RES1,CNT
+4 FOR CNT=1:1:10
KILL RES1
DO RPCCHK^XWB2HL7(.RES1,IEN)
if +RES1(0)=1
QUIT
if +RES1(0)=-1
QUIT
HANG 2
+5 IF +RES1(0)=-1
SET REST=RES1(0)
QUIT
+6 IF +RES1(0)'=1
SET REST(SITE)="Unable to get data"
QUIT
+7 KILL RES1
DO RTNDATA^XWBDRPC(.RES1,IEN)
+8 ;N RES1,CNT S CNT=0
+9 ;AGAIN1 H 2 K RES1,REST D RTNDATA^XWBDRPC(.RES1,IEN) S CNT=CNT+1
+10 ;I +RES1(0)=-1&(RES1(0)["Not DONE") I CNT<10 G AGAIN1
+11 ;I +RES1(0)=-1&(RES1(0)["Not DONE") I CNT>10 S REST(SITE)="Unable to get data" Q
+12 ;I RES1(0)="0^New" I CNT<10 G AGAIN1
+13 ;I RES1(0)="0^New" I CNT>10 S REST(SITE)="Unable to get data" Q
+14 ;I +RES1(0)=-1 S REST(SITE)=RES1(0) Q
+15 ;I RES1'="" I CNT<10 G AGAIN1
+16 ;I RES1'="" I CNT>10 S REST(SITE)="Unable to get data" Q
+17 DO REFORMAT(.RES1)
+18 KILL REST
+19 MERGE REST=RES1
+20 QUIT
+21 ;
GETTFS(DFN,ARRAY) ;
+1 ; get list of TF station numbers for a patient (dfn)
+2 ;
+3 NEW SITE,HERE,HSTN,CNT
+4 IF $DATA(^DGCN(391.91,"APAT",DFN))=""
SET ARRAY="-1^No TFs"
QUIT
+5 SET HERE=+$$SITE^VASITE()
SET HSTN=$PIECE($$SITE^VASITE(),"^",3)
+6 SET SITE=""
SET CNT=0
+7 FOR
SET SITE=$ORDER(^DGCN(391.91,"APAT",DFN,SITE))
if SITE=""
QUIT
Begin DoDot:1
+8 if SITE=HERE
QUIT
+9 SET CNT=CNT+1
+10 SET ARRAY($PIECE($$NNT^XUAF4(SITE),"^",2))=""
End DoDot:1
+11 IF CNT=0
SET ARRAY="-1^No other site TFs"
QUIT
+12 SET ARRAY=CNT
+13 QUIT
+14 ;
REFORMAT(ARRAY) ; Reformat from RPC=1 format to RPC=0 format
+1 NEW XX,ARR,TARR
+2 SET XX=0
+3 FOR
SET XX=$ORDER(ARRAY(XX))
if XX=""
QUIT
Begin DoDot:1
+4 IF XX=1
SET TARR=$PIECE(ARRAY(XX),"(")
+5 SET ARR=$PIECE(ARRAY(XX),"=")
+6 SET @ARR=$PIECE(ARRAY(XX),"=",2)
End DoDot:1
+7 KILL ARRAY
+8 MERGE ARRAY=@TARR
+9 KILL @TARR
+10 QUIT
+11 ;
ASK(ICNSSN,SITE) ; Function to check if there has been a previous request
+1 ; made for this ICN/SSN. If so, ask the user if they wish to view if or
+2 ; create a new request.
+3 ;
+4 NEW DIR,X,Y,SITE1
+5 IF '$DATA(^XTMP("MPIF EXT PDAT"_ICNSSN))
QUIT 0
+6 IF SITE=1
Begin DoDot:1
+7 SET SITE1=0
+8 WRITE !!,"There has been a request made for this patient to site(s): "
+9 FOR
SET SITE1=$ORDER(^XTMP("MPIF EXT PDAT"_ICNSSN,SITE1))
if SITE1=""
QUIT
Begin DoDot:2
+10 IF SITE1=$PIECE($$SITE^VASITE(),"^",3)
QUIT
+11 WRITE !,SITE1,?10,$PIECE($$NNT^XUAF4($$LKUP^XUAF4(SITE1)),"^"),?40,"made at "
+12 NEW Y
SET Y=$PIECE(^XTMP("MPIF EXT PDAT"_ICNSSN,SITE1,0),"^",2)
DO DD^%DT
+13 WRITE Y
End DoDot:2
End DoDot:1
+14 IF SITE'=1
IF '$DATA(^XTMP("MPIF EXT PDAT"_ICNSSN,SITE))
QUIT 0
+15 IF SITE'=1
IF SITE'=$PIECE($$SITE^VASITE(),"^",3)
Begin DoDot:1
+16 WRITE !!,"There has been a previous request made for this patient from the same "
+17 WRITE !,"site you are requesting. The request was made at "
+18 NEW Y
SET Y=$PIECE($GET(^XTMP("MPIF EXT PDAT"_ICNSSN,SITE,0)),"^",2)
DO DD^%DT
+19 WRITE Y
End DoDot:1
+20 SET DIR("A")="Would you like to view this data?"
+21 SET DIR(0)="Y"
SET DIR("B")="No"
+22 DO ^DIR
+23 IF Y'=1
QUIT 0
+24 QUIT 1
