RGPVMPI ;BIR/PTD-REMOTE PRIMARY VIEW DISPLAY FROM MPI ;5/17/07
;;1.0;CLINICAL INFO RESOURCE NETWORK;**48,53**;30 Apr 99;Build 2
;
;Reference to EN1^XWB2HL7 supported by IA #3144
;Reference to RPCCHK^XWB2HL7 supported by IA #3144
;
INTRO ;Display purpose of option
W @IOF S SAPV=1 ;from stand alone option, not EH
W !,"This option sends a remote request for data to the Master Patient"
W !,"Index, using a Remote Procedure Call (RPC). When the RPC returns"
W !,"the information, you can review Primary View data as it currently"
W !,"exists on the MPI Patient Data Inquiry (PDAT) report."
;
W !!,"Choose the patient for whom Primary View data is to be requested."
W !,"The selected patient must have an Integration Control Number (ICN)."
W !,"You can select by Patient Name, Social Security Number, or ICN.",!
;
ASK ;Ask For Patient
S DFN="",RGICN="" K DTOUT,DUOUT
S DIC="^DPT(",DIC(0)="QEAM",DIC("A")="Select PATIENT: ",D="SSN^AICN^B^BS^BS5"
D MIX^DIC1 K DIC,D
I Y<0 G EXIT
S DFN=+Y
S RGICN=+$$GETICN^MPIF001(DFN) I RGICN<1 W !,"There is no Integration Control Number for this patient." G ASK
;
SEND ;Send a remote query to the MPI for Primary View PDAT
;Entry point from Exception Handler; DATA should be defined.
S (QFLG,QUIT)=0 N RETURN,RESULT,SNTDT
I SAPV=0 D I QUIT=1 G EXIT
.I DATA="" W !,"No Exception Data available." S QUIT=1 Q
.S RGICN=$P(DATA,"^",6) I RGICN="" W !,"No ICN defined." S QUIT=1 Q
.S VALMBCK=""
.D FULL^VALM1
NOQ ;No previous query exists for this ICN
I '$D(^XTMP("RGPVMPI"_RGICN)) D RPC G DISP
;
OLDQ ;Query previously sent for this ICN
I $D(^XTMP("RGPVMPI"_RGICN)) D
.S SNTDT=$$FMTE^XLFDT($P(^XTMP("RGPVMPI"_RGICN,"DATA"),"^",2))
.W !,"A query was last sent for this ICN on "_SNTDT
.;Has data returned for query?
.S RETURN(0)=$P(^XTMP("RGPVMPI"_RGICN,"DATA"),"^")
.D RPCCHK^XWB2HL7(.RESULT,RETURN(0))
.;Data has NOT returned
.I +RESULT(0)'=1 D FAIL Q ;**53
.I +RESULT(0)=1 D ;Data has returned
..S DIR("A")="Do you wish to view the existing query data now? ",DIR(0)="YA"
..S DIR("?")="Enter YES to review the existing data; enter NO to send a new query"
..S DIR("B")="YES" D ^DIR K DIR I $D(DIRUT) S QUIT=1 Q ;up-arrowed out
..I Y>0 K DIR Q ;yes, use existing query
..I Y=0 D Q ;no, don't use existing, send new query
...K ^XTMP("RGPVMPI"_RGICN)
...D RPC
...K DIR
;
DISP ;Display Primary View Data
I QUIT'=1 D I QFLG G EXIT
.I SAPV=1 D Q:QFLG ;Stand alone PV display
..W !,"(Be sure HISTORY is enabled to capture data!)"
..S DIR(0)="E" W ! D ^DIR K DIR I 'Y S QFLG=1 Q
..W !,@IOF D SAPV^RGEX06(RGICN)
.I SAPV=0 D EN^RGEX06(RGICN) ;Exception Handler PV display
;
EXIT ;Kill variables and quit
K CNT,D,DFN,DIC,DIR,DIRUT,DTOUT,DUOUT,QFLG,QUIT,RGICN,SAPV,X,Y
Q
;
RPC ;Send the Remote Query
W !!,"Sending a Remote Query to the Master Patient Index."
W !,"This will take some time; please be patient."
D EN1^XWB2HL7(.RETURN,"200M","RG PRIMARY VIEW FROM MPI",1,RGICN) I RETURN(0)'="" D Q
.S ^XTMP("RGPVMPI"_RGICN,0)=$$FMADD^XLFDT(DT,2)_"^"_DT_"^"_"PRIMARY VIEW MPI PDAT"
.S ^XTMP("RGPVMPI"_RGICN,"DATA")=RETURN(0)_"^"_$$NOW^XLFDT
.;Has data returned for this query?
.S CNT=0 F S CNT=CNT+1 D RPCCHK^XWB2HL7(.RESULT,RETURN(0)) Q:RESULT(0) H 2 I CNT>15 Q ;result(0)=status of handle
.I +RESULT(0)=1 W !,"Query data has returned from the MPI and is available for review."
.I +RESULT(0)'=1 D FAIL ;**53
W !!,"Problem with Query: ",RETURN(0)_"^"_$G(RETURN(1))
S QUIT=1
I SAPV=0 D PAUSE^VALM1
Q
;
FAIL ;Status of RPC call - unsuccessful after 30 seconds ;**53
W !,"Your query request has NOT returned data from the MPI after trying for"
W !,"30 seconds. This could be due to network issues. Please try again later."
K ^XTMP("RGPVMPI"_RGICN)
S QUIT=1
I SAPV=0 D PAUSE^VALM1
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRGPVMPI 3876 printed Sep 23, 2025@19:18:45 Page 2
RGPVMPI ;BIR/PTD-REMOTE PRIMARY VIEW DISPLAY FROM MPI ;5/17/07
+1 ;;1.0;CLINICAL INFO RESOURCE NETWORK;**48,53**;30 Apr 99;Build 2
+2 ;
+3 ;Reference to EN1^XWB2HL7 supported by IA #3144
+4 ;Reference to RPCCHK^XWB2HL7 supported by IA #3144
+5 ;
INTRO ;Display purpose of option
+1 ;from stand alone option, not EH
WRITE @IOF
SET SAPV=1
+2 WRITE !,"This option sends a remote request for data to the Master Patient"
+3 WRITE !,"Index, using a Remote Procedure Call (RPC). When the RPC returns"
+4 WRITE !,"the information, you can review Primary View data as it currently"
+5 WRITE !,"exists on the MPI Patient Data Inquiry (PDAT) report."
+6 ;
+7 WRITE !!,"Choose the patient for whom Primary View data is to be requested."
+8 WRITE !,"The selected patient must have an Integration Control Number (ICN)."
+9 WRITE !,"You can select by Patient Name, Social Security Number, or ICN.",!
+10 ;
ASK ;Ask For Patient
+1 SET DFN=""
SET RGICN=""
KILL DTOUT,DUOUT
+2 SET DIC="^DPT("
SET DIC(0)="QEAM"
SET DIC("A")="Select PATIENT: "
SET D="SSN^AICN^B^BS^BS5"
+3 DO MIX^DIC1
KILL DIC,D
+4 IF Y<0
GOTO EXIT
+5 SET DFN=+Y
+6 SET RGICN=+$$GETICN^MPIF001(DFN)
IF RGICN<1
WRITE !,"There is no Integration Control Number for this patient."
GOTO ASK
+7 ;
SEND ;Send a remote query to the MPI for Primary View PDAT
+1 ;Entry point from Exception Handler; DATA should be defined.
+2 SET (QFLG,QUIT)=0
NEW RETURN,RESULT,SNTDT
+3 IF SAPV=0
Begin DoDot:1
+4 IF DATA=""
WRITE !,"No Exception Data available."
SET QUIT=1
QUIT
+5 SET RGICN=$PIECE(DATA,"^",6)
IF RGICN=""
WRITE !,"No ICN defined."
SET QUIT=1
QUIT
+6 SET VALMBCK=""
+7 DO FULL^VALM1
End DoDot:1
IF QUIT=1
GOTO EXIT
NOQ ;No previous query exists for this ICN
+1 IF '$DATA(^XTMP("RGPVMPI"_RGICN))
DO RPC
GOTO DISP
+2 ;
OLDQ ;Query previously sent for this ICN
+1 IF $DATA(^XTMP("RGPVMPI"_RGICN))
Begin DoDot:1
+2 SET SNTDT=$$FMTE^XLFDT($PIECE(^XTMP("RGPVMPI"_RGICN,"DATA"),"^",2))
+3 WRITE !,"A query was last sent for this ICN on "_SNTDT
+4 ;Has data returned for query?
+5 SET RETURN(0)=$PIECE(^XTMP("RGPVMPI"_RGICN,"DATA"),"^")
+6 DO RPCCHK^XWB2HL7(.RESULT,RETURN(0))
+7 ;Data has NOT returned
+8 ;**53
IF +RESULT(0)'=1
DO FAIL
QUIT
+9 ;Data has returned
IF +RESULT(0)=1
Begin DoDot:2
+10 SET DIR("A")="Do you wish to view the existing query data now? "
SET DIR(0)="YA"
+11 SET DIR("?")="Enter YES to review the existing data; enter NO to send a new query"
+12 ;up-arrowed out
SET DIR("B")="YES"
DO ^DIR
KILL DIR
IF $DATA(DIRUT)
SET QUIT=1
QUIT
+13 ;yes, use existing query
IF Y>0
KILL DIR
QUIT
+14 ;no, don't use existing, send new query
IF Y=0
Begin DoDot:3
+15 KILL ^XTMP("RGPVMPI"_RGICN)
+16 DO RPC
+17 KILL DIR
End DoDot:3
QUIT
End DoDot:2
End DoDot:1
+18 ;
DISP ;Display Primary View Data
+1 IF QUIT'=1
Begin DoDot:1
+2 ;Stand alone PV display
IF SAPV=1
Begin DoDot:2
+3 WRITE !,"(Be sure HISTORY is enabled to capture data!)"
+4 SET DIR(0)="E"
WRITE !
DO ^DIR
KILL DIR
IF 'Y
SET QFLG=1
QUIT
+5 WRITE !,@IOF
DO SAPV^RGEX06(RGICN)
End DoDot:2
if QFLG
QUIT
+6 ;Exception Handler PV display
IF SAPV=0
DO EN^RGEX06(RGICN)
End DoDot:1
IF QFLG
GOTO EXIT
+7 ;
EXIT ;Kill variables and quit
+1 KILL CNT,D,DFN,DIC,DIR,DIRUT,DTOUT,DUOUT,QFLG,QUIT,RGICN,SAPV,X,Y
+2 QUIT
+3 ;
RPC ;Send the Remote Query
+1 WRITE !!,"Sending a Remote Query to the Master Patient Index."
+2 WRITE !,"This will take some time; please be patient."
+3 DO EN1^XWB2HL7(.RETURN,"200M","RG PRIMARY VIEW FROM MPI",1,RGICN)
IF RETURN(0)'=""
Begin DoDot:1
+4 SET ^XTMP("RGPVMPI"_RGICN,0)=$$FMADD^XLFDT(DT,2)_"^"_DT_"^"_"PRIMARY VIEW MPI PDAT"
+5 SET ^XTMP("RGPVMPI"_RGICN,"DATA")=RETURN(0)_"^"_$$NOW^XLFDT
+6 ;Has data returned for this query?
+7 ;result(0)=status of handle
SET CNT=0
FOR
SET CNT=CNT+1
DO RPCCHK^XWB2HL7(.RESULT,RETURN(0))
if RESULT(0)
QUIT
HANG 2
IF CNT>15
QUIT
+8 IF +RESULT(0)=1
WRITE !,"Query data has returned from the MPI and is available for review."
+9 ;**53
IF +RESULT(0)'=1
DO FAIL
End DoDot:1
QUIT
+10 WRITE !!,"Problem with Query: ",RETURN(0)_"^"_$GET(RETURN(1))
+11 SET QUIT=1
+12 IF SAPV=0
DO PAUSE^VALM1
+13 QUIT
+14 ;
FAIL ;Status of RPC call - unsuccessful after 30 seconds ;**53
+1 WRITE !,"Your query request has NOT returned data from the MPI after trying for"
+2 WRITE !,"30 seconds. This could be due to network issues. Please try again later."
+3 KILL ^XTMP("RGPVMPI"_RGICN)
+4 SET QUIT=1
+5 IF SAPV=0
DO PAUSE^VALM1
+6 QUIT
+7 ;
