- 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 Mar 13, 2025@21:15:53 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
