MPIFQ1 ;ALB/RJS-CIRN QUERY HANDLER ;JUN 30, 1997
;;1.0; MASTER PATIENT INDEX VISTA ;**1,8,12,16,17,21,23,24,28,31,33,35**;30 Apr 99
;
; Integration Agreements Utilized:
; EXC, START, STOP^RGHLLOG - #2796
; FILE^VAFCTFU - #2988
; ^DPT("AICN" - #2070
; NAME^VAFCPID2 - #3492
; EN1^XWB2HL7 - #3144
; RTNDATA^XWBDRPC - #3149
; VAFC REMOTE PDAT (RPC) - #3496
;
INIT ;Entry point for List Manager Template - MPIF REAL-TIME QUERY
Q
HDR ;Header code for List Manager Template - MPIF REAL-TIME QUERY
N SSN,DOB,MPIFQ1,NAME1,SEX
D GETDATA^MPIFQ0("^DPT(",DFN,"MPIFQ1",".01;.03;.09;.02","EI")
S NAME1=$G(MPIFQ1(2,DFN,.01,"E")),SSN=$G(MPIFQ1(2,DFN,.09,"E"))
S DOB=$G(MPIFQ1(2,DFN,.03,"I")),SEX=$G(MPIFQ1(2,DFN,.02,"E"))
I DOB]"" S DOB=$TR($$FMTE^XLFDT(DOB,"5D"),"/","-")
S VALMHDR(1)=" Possible MPI Matches for Patient: "_IOINHI_NAME1_IOINORM
S VALMHDR(2)=" SSN: "_IOINHI_SSN_IOINORM
S VALMHDR(3)=" DOB: "_IOINHI_DOB_IOINORM
S VALMHDR(4)=" SEX: "_IOINHI_SEX_IOINORM,VALMHDR(5)=" "
Q
START(INDEX) ;Starting entry point for envoking the List Manager Template MPIF Real-time query
S VALMCNT=INDEX
D EN^VALM("MPIF REAL-TIME QUERY")
Q
SELECT N VALMY
D EN^VALM2(XQORNOD(0),"OS")
I '$D(VALMY) Q
N DATA,INDEX,ICN,CHKSUM,NODE2
S INDEX=$O(VALMY(0)),DATA=^TMP("MPIFVQQ",$J,INDEX,"DATA")
S NODE2=$G(^TMP("MPIFVQQ",$J,INDEX,"INDICATOR"))
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
S DATA(.03)=$P(DATA,"^",4),DATA(.09)=$P(DATA,"^",3),DATA(.02)=$P(DATA,"^",11) ;DOB, SSN, SEX
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))
;If NODE2["*" we have a pt in our list whose ICN is already at this site
I NODE2["*",$O(^DPT("AICN",ICN,""))'=DFN D Q
.D CLEAR^VALM1,MSG1^MPIFQ3
.N DFN2 S DFN2=$O(^DPT("AICN",ICN,""))
.D TWODFNS^MPIF002(DFN2,DFN,ICN)
.W !!,"Assigning Local ICN" D LOCAL^MPIFQ3(DFN),PROMPT^MPIFQ3 S MPIFRTN="CONTINUE"
;User selected from list, does SSN & Name match? no-ask if sure
N SSN,NAME,SEX
D GETDATA^MPIFQ0("^DPT(",DFN,"MPIFQ1",".01;.09;.02","EI")
S SSN=$G(MPIFQ1(2,DFN,.09,"E")),NAME=$G(MPIFQ1(2,DFN,.01,"E")),SEX=$G(MPIFQ1(2,DFN,.02,"I"))
; if sex doesn't match -- not allowed to update ICN
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
I SSN["P" S SSN=""
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
D NAME^VAFCPID2(0,.NAME,0) ;reformat name into DG 149 format
N NAME3 S NAME3=DATA(.01) D NAME^VAFCPID2(0,.NAME3,0) S DATA(.01)=NAME3 ;reformat name into DG 149 format
N EXACT
; check if Last, First MATCH if so is it a middle name vs middle initial
I $P(DATA(.01),",")=$P(NAME,",")&($P($P(NAME,",",2)," ")=$P($P(DATA(.01),",",2)," ")) D
.N MPIMID,NMMN S MPIMID=$P($P(DATA(.01),",",2)," ",2)
.S NMMN=$P($P(NAME,",",2)," ",2)
.I $L(NMMN)>1&($L(MPIMID)=1),($E(NMMN,1)=MPIMID) S EXACT=1
.I $L(MPIMID)>1&($L(NMMN)=1),($E(MPIMID,1)=NMMN) S EXACT=1
I DATA(.01)=NAME!($D(EXACT)) K DATA(.09),DATA(.01),DATA(.03) D EDIT^MPIFQED(DFN,"DATA") D MSG3^MPIFQ3,PROMPT^MPIFQ3,TF^MPIFQ3(DFN,.DATA) Q
; \/ Name doesn't match exactly - ask if sure
D CLEAR^VALM1,MSG2^MPIFQ3,MSG^MPIFQ3(SSN,NAME,DATA(.09),DATA(.01))
N ANS S ANS=$$PROMPT1^MPIFQ3()
I ANS K DATA(.09),DATA(.01),DATA(.03) D EDIT^MPIFQED(DFN,"DATA") S MPIFRTN="CONTINUE" W !!,"ICN and CMOR Updated" D PROMPT^MPIFQ3,TF^MPIFQ3(DFN,.DATA) Q
D MSG5^MPIFQ3,PROMPT^MPIFQ3 S VALMBCK="R"
Q
ADD ;Add (MPIF REAL-TIME QUERY (ADD PATIENT)) add pt to MPI Austin.
D A28^MPIFQ3(DFN),PROMPT^MPIFQ3 S MPIFRTN="CONTINUE"
Q
MPIPD ; MPI PDAT CALL
N VALMY,CNT,Y
D EN^VALM2(XQORNOD(0),"OS")
I '$D(VALMY) Q
N DATA,INDEX,ICN,CHKSUM,CMOR,CASE,CMOR3,TTF,ALIAS,POW,TAL,TMP
S INDEX=$O(VALMY(0)),Y="" D CLEAR^VALM1
S DATA=^TMP("MPIFVQQ",$J,INDEX,"DATA")
S CMOR=$P(DATA,"^",5),CMOR3=CMOR,CMOR=$P($$NS^XUAF4($$LKUP^XUAF4(CMOR)),"^")
W !,"MPI Data:",!!!,?3,"ICN: ",+$P(DATA,"^",6),?30,"CMOR: ",CMOR," (",CMOR3,")"
W !,?2,"NAME: ",$P(DATA,"^")
W !,?3,"SSN: ",$P(DATA,"^",3),?30,"SEX: ",$P(DATA,"^",11)
W !,?3,"DOB: ",$P(DATA,"^",4)
W ?30,"DOD: ",$P(DATA,"^",9)
I $P(DATA,"^",20)="Y" W !?3,"Multiple Birth Indicator: Yes"
I ($P(DATA,"^",12)='"")&($P(DATA,"^",13)'="") W !,?2,"PLACE OF BIRTH: ",$P(DATA,"^",12),", ",$P(DATA,"^",13)
I $P(DATA,"^",12)=""!($P(DATA,"^",13)="") W !,?2,"PLACE OF BIRTH: ",$P(DATA,"^",12)," ",$P(DATA,"^",13)
W !,?2,"MOTHER'S MAIDEN NAME: ",$P(DATA,"^",16)
W !,?2,"CLAIM NUMBER: ",$P(DATA,"^",17)
S POW=$P(DATA,"^",19) I POW'="" W !,?2,"POW STATUS: ",POW
S CASE=$P(DATA,"^",18)
I CASE'="" W !,?2,"Open Data Management Case",!,?5,"CASE#: ",$P(CASE,"/")_" NOIS#: ",$P(CASE,"/",2),!,?5,"CASE WORKER: ",$P(CASE,"/",3)
I $D(^TMP("MPIFVQQ",$J,INDEX,"ALIAS")) W !,?2,"Alias(es): " D
.N XX S XX=0 F S XX=$O(^TMP("MPIFVQQ",$J,INDEX,"ALIAS",XX)) Q:'XX W !?10,^(XX)
I $D(^TMP("MPIFVQQ",$J,INDEX,"TF"))&($O(^TMP("MPIFVQQ",$J,INDEX,"TF",1))'="") D
.W !,?2,"TREATING FACILITY LIST:"
.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,")"
D PROMPT^MPIFQ3
S VALMBCK="R"
Q
CMOR ; CMOR PDAT CALL
N VALMY,DATA,INDEX,ICN,CHKSUM,CMOR
D EN^VALM2(XQORNOD(0),"OS")
I '$D(VALMY) Q
S INDEX=$O(VALMY(0)),DATA=^TMP("MPIFVQQ",$J,INDEX,"DATA")
S ICN=$P(DATA,"^",6),CHKSUM=$P(ICN,"V",2),ICN=$P(ICN,"V",1),CMOR=$P(DATA,"^",5)
I CMOR=$P($$SITE^VASITE(),"^",3) W !!,"CMOR is your site" G END
W !,"Please be patient while the data is being retrieved from the CMOR."
D EN1^XWB2HL7(.RETURN,CMOR,"VAFC REMOTE PDAT",1,ICN,"") ; Request
S ^XTMP("MPIFPDAT"_ICN,0)=$$FMADD^XLFDT(DT,2)_"^"_DT_"^"_"REMOTE PDAT QUERY",^XTMP("MPIFPDAT"_ICN,1)=RETURN(0)_"^"_$$NOW^XLFDT
S CNT=0
AGAIN1 H 2 K RES1 D RTNDATA^XWBDRPC(.RES1,RETURN(0)) S CNT=CNT+1
I +RES1(0)=-1&(RES1(0)["Not DONE") I CNT<11 G AGAIN1
I +RES1(0)=-1&(RES1(0)["Not DONE") I CNT>10 W !,"Unable to get data" G END
I RES1(0)="0^New" I CNT<11 G AGAIN1
I RES1(0)="0^New" I CNT>10 W !,"Unable to get data" G END
I +RES1(0)=-1 W !!,$P(RES1(0),"^",2) G END
I RES1'="" I CNT<11 G AGAIN1
I RES1'="" I CNT>10 W !,"Unable to get data" Q
D CLEAR^VALM1
N NUM S NUM="",CNT=0
F S NUM=$O(RES1(NUM)) Q:NUM="" D
.I CNT>20 D PROMPT^MPIFQ3,CLEAR^VALM1 S CNT=0
.I RES1(NUM)["Additional" W !! S CNT=CNT+2
.I CNT<21 W !,RES1(NUM) S CNT=CNT+1
END D PROMPT^MPIFQ3 S VALMBCK="R" K CNT,RETURN,RES1
Q
HELP ; Help List Manager Action (MPIF REAL-TIME QUERY (HELP))
D CLEAR^VALM1,MSG4^MPIFQ3,PROMPT^MPIFQ3 S VALMBCK="R"
Q
EXIT ;Exit for List Manager Template MPIF REAL-TIME QUERY
K VALMBCK,VALMCNT,VALMHDR
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMPIFQ1 7182 printed Dec 13, 2024@02:11:27 Page 2
MPIFQ1 ;ALB/RJS-CIRN QUERY HANDLER ;JUN 30, 1997
+1 ;;1.0; MASTER PATIENT INDEX VISTA ;**1,8,12,16,17,21,23,24,28,31,33,35**;30 Apr 99
+2 ;
+3 ; Integration Agreements Utilized:
+4 ; EXC, START, STOP^RGHLLOG - #2796
+5 ; FILE^VAFCTFU - #2988
+6 ; ^DPT("AICN" - #2070
+7 ; NAME^VAFCPID2 - #3492
+8 ; EN1^XWB2HL7 - #3144
+9 ; RTNDATA^XWBDRPC - #3149
+10 ; VAFC REMOTE PDAT (RPC) - #3496
+11 ;
INIT ;Entry point for List Manager Template - MPIF REAL-TIME QUERY
+1 QUIT
HDR ;Header code for List Manager Template - MPIF REAL-TIME QUERY
+1 NEW SSN,DOB,MPIFQ1,NAME1,SEX
+2 DO GETDATA^MPIFQ0("^DPT(",DFN,"MPIFQ1",".01;.03;.09;.02","EI")
+3 SET NAME1=$GET(MPIFQ1(2,DFN,.01,"E"))
SET SSN=$GET(MPIFQ1(2,DFN,.09,"E"))
+4 SET DOB=$GET(MPIFQ1(2,DFN,.03,"I"))
SET SEX=$GET(MPIFQ1(2,DFN,.02,"E"))
+5 IF DOB]""
SET DOB=$TRANSLATE($$FMTE^XLFDT(DOB,"5D"),"/","-")
+6 SET VALMHDR(1)=" Possible MPI Matches for Patient: "_IOINHI_NAME1_IOINORM
+7 SET VALMHDR(2)=" SSN: "_IOINHI_SSN_IOINORM
+8 SET VALMHDR(3)=" DOB: "_IOINHI_DOB_IOINORM
+9 SET VALMHDR(4)=" SEX: "_IOINHI_SEX_IOINORM
SET VALMHDR(5)=" "
+10 QUIT
START(INDEX) ;Starting entry point for envoking the List Manager Template MPIF Real-time query
+1 SET VALMCNT=INDEX
+2 DO EN^VALM("MPIF REAL-TIME QUERY")
+3 QUIT
SELECT NEW VALMY
+1 DO EN^VALM2(XQORNOD(0),"OS")
+2 IF '$DATA(VALMY)
QUIT
+3 NEW DATA,INDEX,ICN,CHKSUM,NODE2
+4 SET INDEX=$ORDER(VALMY(0))
SET DATA=^TMP("MPIFVQQ",$JOB,INDEX,"DATA")
+5 SET NODE2=$GET(^TMP("MPIFVQQ",$JOB,INDEX,"INDICATOR"))
+6 ;NAME
SET DATA(.01)=$PIECE(DATA,"^",1)
IF $EXTRACT(DATA(.01),$LENGTH(DATA(.01)))=" "
SET DATA(.01)=$EXTRACT(DATA(.01),1,$LENGTH(DATA(.01))-1)
+7 ;DOB, SSN, SEX
SET DATA(.03)=$PIECE(DATA,"^",4)
SET DATA(.09)=$PIECE(DATA,"^",3)
SET DATA(.02)=$PIECE(DATA,"^",11)
+8 SET ICN=$PIECE(DATA,"^",6)
SET CHKSUM=$PIECE(ICN,"V",2)
SET ICN=$PIECE(ICN,"V",1)
SET DATA(991.01)=ICN
SET DATA(991.02)=CHKSUM
SET DATA(991.03)=$$LKUP^XUAF4($PIECE(DATA,"^",5))
+9 ;If NODE2["*" we have a pt in our list whose ICN is already at this site
+10 IF NODE2["*"
IF $ORDER(^DPT("AICN",ICN,""))'=DFN
Begin DoDot:1
+11 DO CLEAR^VALM1
DO MSG1^MPIFQ3
+12 NEW DFN2
SET DFN2=$ORDER(^DPT("AICN",ICN,""))
+13 DO TWODFNS^MPIF002(DFN2,DFN,ICN)
+14 WRITE !!,"Assigning Local ICN"
DO LOCAL^MPIFQ3(DFN)
DO PROMPT^MPIFQ3
SET MPIFRTN="CONTINUE"
End DoDot:1
QUIT
+15 ;User selected from list, does SSN & Name match? no-ask if sure
+16 NEW SSN,NAME,SEX
+17 DO GETDATA^MPIFQ0("^DPT(",DFN,"MPIFQ1",".01;.09;.02","EI")
+18 SET SSN=$GET(MPIFQ1(2,DFN,.09,"E"))
SET NAME=$GET(MPIFQ1(2,DFN,.01,"E"))
SET SEX=$GET(MPIFQ1(2,DFN,.02,"I"))
+19 ; if sex doesn't match -- not allowed to update ICN
+20 IF DATA(.02)'=SEX
WRITE !!,"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."
DO PROMPT^MPIFQ3
SET VALMBCK="R"
QUIT
+21 IF SSN["P"
SET SSN=""
+22 IF DATA(.09)'=SSN
WRITE !!,"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."
DO PROMPT^MPIFQ3
SET VALMBCK="R"
QUIT
+23 ;reformat name into DG 149 format
DO NAME^VAFCPID2(0,.NAME,0)
+24 ;reformat name into DG 149 format
NEW NAME3
SET NAME3=DATA(.01)
DO NAME^VAFCPID2(0,.NAME3,0)
SET DATA(.01)=NAME3
+25 NEW EXACT
+26 ; check if Last, First MATCH if so is it a middle name vs middle initial
+27 IF $PIECE(DATA(.01),",")=$PIECE(NAME,",")&($PIECE($PIECE(NAME,",",2)," ")=$PIECE($PIECE(DATA(.01),",",2)," "))
Begin DoDot:1
+28 NEW MPIMID,NMMN
SET MPIMID=$PIECE($PIECE(DATA(.01),",",2)," ",2)
+29 SET NMMN=$PIECE($PIECE(NAME,",",2)," ",2)
+30 IF $LENGTH(NMMN)>1&($LENGTH(MPIMID)=1)
IF ($EXTRACT(NMMN,1)=MPIMID)
SET EXACT=1
+31 IF $LENGTH(MPIMID)>1&($LENGTH(NMMN)=1)
IF ($EXTRACT(MPIMID,1)=NMMN)
SET EXACT=1
End DoDot:1
+32 IF DATA(.01)=NAME!($DATA(EXACT))
KILL DATA(.09),DATA(.01),DATA(.03)
DO EDIT^MPIFQED(DFN,"DATA")
DO MSG3^MPIFQ3
DO PROMPT^MPIFQ3
DO TF^MPIFQ3(DFN,.DATA)
QUIT
+33 ; \/ Name doesn't match exactly - ask if sure
+34 DO CLEAR^VALM1
DO MSG2^MPIFQ3
DO MSG^MPIFQ3(SSN,NAME,DATA(.09),DATA(.01))
+35 NEW ANS
SET ANS=$$PROMPT1^MPIFQ3()
+36 IF ANS
KILL DATA(.09),DATA(.01),DATA(.03)
DO EDIT^MPIFQED(DFN,"DATA")
SET MPIFRTN="CONTINUE"
WRITE !!,"ICN and CMOR Updated"
DO PROMPT^MPIFQ3
DO TF^MPIFQ3(DFN,.DATA)
QUIT
+37 DO MSG5^MPIFQ3
DO PROMPT^MPIFQ3
SET VALMBCK="R"
+38 QUIT
ADD ;Add (MPIF REAL-TIME QUERY (ADD PATIENT)) add pt to MPI Austin.
+1 DO A28^MPIFQ3(DFN)
DO PROMPT^MPIFQ3
SET MPIFRTN="CONTINUE"
+2 QUIT
MPIPD ; MPI PDAT CALL
+1 NEW VALMY,CNT,Y
+2 DO EN^VALM2(XQORNOD(0),"OS")
+3 IF '$DATA(VALMY)
QUIT
+4 NEW DATA,INDEX,ICN,CHKSUM,CMOR,CASE,CMOR3,TTF,ALIAS,POW,TAL,TMP
+5 SET INDEX=$ORDER(VALMY(0))
SET Y=""
DO CLEAR^VALM1
+6 SET DATA=^TMP("MPIFVQQ",$JOB,INDEX,"DATA")
+7 SET CMOR=$PIECE(DATA,"^",5)
SET CMOR3=CMOR
SET CMOR=$PIECE($$NS^XUAF4($$LKUP^XUAF4(CMOR)),"^")
+8 WRITE !,"MPI Data:",!!!,?3,"ICN: ",+$PIECE(DATA,"^",6),?30,"CMOR: ",CMOR," (",CMOR3,")"
+9 WRITE !,?2,"NAME: ",$PIECE(DATA,"^")
+10 WRITE !,?3,"SSN: ",$PIECE(DATA,"^",3),?30,"SEX: ",$PIECE(DATA,"^",11)
+11 WRITE !,?3,"DOB: ",$PIECE(DATA,"^",4)
+12 WRITE ?30,"DOD: ",$PIECE(DATA,"^",9)
+13 IF $PIECE(DATA,"^",20)="Y"
WRITE !?3,"Multiple Birth Indicator: Yes"
+14 IF ($PIECE(DATA,"^",12)='"")&($PIECE(DATA,"^",13)'="")
WRITE !,?2,"PLACE OF BIRTH: ",$PIECE(DATA,"^",12),", ",$PIECE(DATA,"^",13)
+15 IF $PIECE(DATA,"^",12)=""!($PIECE(DATA,"^",13)="")
WRITE !,?2,"PLACE OF BIRTH: ",$PIECE(DATA,"^",12)," ",$PIECE(DATA,"^",13)
+16 WRITE !,?2,"MOTHER'S MAIDEN NAME: ",$PIECE(DATA,"^",16)
+17 WRITE !,?2,"CLAIM NUMBER: ",$PIECE(DATA,"^",17)
+18 SET POW=$PIECE(DATA,"^",19)
IF POW'=""
WRITE !,?2,"POW STATUS: ",POW
+19 SET CASE=$PIECE(DATA,"^",18)
+20 IF CASE'=""
WRITE !,?2,"Open Data Management Case",!,?5,"CASE#: ",$PIECE(CASE,"/")_" NOIS#: ",$PIECE(CASE,"/",2),!,?5,"CASE WORKER: ",$PIECE(CASE,"/",3)
+21 IF $DATA(^TMP("MPIFVQQ",$JOB,INDEX,"ALIAS"))
WRITE !,?2,"Alias(es): "
Begin DoDot:1
+22 NEW XX
SET XX=0
FOR
SET XX=$ORDER(^TMP("MPIFVQQ",$JOB,INDEX,"ALIAS",XX))
if 'XX
QUIT
WRITE !?10,^(XX)
End DoDot:1
+23 IF $DATA(^TMP("MPIFVQQ",$JOB,INDEX,"TF"))&($ORDER(^TMP("MPIFVQQ",$JOB,INDEX,"TF",1))'="")
Begin DoDot:1
+24 WRITE !,?2,"TREATING FACILITY LIST:"
+25 NEW XX
SET XX=0
FOR
SET XX=$ORDER(^TMP("MPIFVQQ",$JOB,INDEX,"TF",XX))
if 'XX
QUIT
SET TMP=$PIECE($GET(^(XX)),MPICOMP)
IF TMP'=CMOR3
WRITE !?10,"Treating Facility: ",$PIECE($$NS^XUAF4($$LKUP^XUAF4(TMP)),"^")," (",TMP,")"
End DoDot:1
+26 DO PROMPT^MPIFQ3
+27 SET VALMBCK="R"
+28 QUIT
CMOR ; CMOR PDAT CALL
+1 NEW VALMY,DATA,INDEX,ICN,CHKSUM,CMOR
+2 DO EN^VALM2(XQORNOD(0),"OS")
+3 IF '$DATA(VALMY)
QUIT
+4 SET INDEX=$ORDER(VALMY(0))
SET DATA=^TMP("MPIFVQQ",$JOB,INDEX,"DATA")
+5 SET ICN=$PIECE(DATA,"^",6)
SET CHKSUM=$PIECE(ICN,"V",2)
SET ICN=$PIECE(ICN,"V",1)
SET CMOR=$PIECE(DATA,"^",5)
+6 IF CMOR=$PIECE($$SITE^VASITE(),"^",3)
WRITE !!,"CMOR is your site"
GOTO END
+7 WRITE !,"Please be patient while the data is being retrieved from the CMOR."
+8 ; Request
DO EN1^XWB2HL7(.RETURN,CMOR,"VAFC REMOTE PDAT",1,ICN,"")
+9 SET ^XTMP("MPIFPDAT"_ICN,0)=$$FMADD^XLFDT(DT,2)_"^"_DT_"^"_"REMOTE PDAT QUERY"
SET ^XTMP("MPIFPDAT"_ICN,1)=RETURN(0)_"^"_$$NOW^XLFDT
+10 SET CNT=0
AGAIN1 HANG 2
KILL RES1
DO RTNDATA^XWBDRPC(.RES1,RETURN(0))
SET CNT=CNT+1
+1 IF +RES1(0)=-1&(RES1(0)["Not DONE")
IF CNT<11
GOTO AGAIN1
+2 IF +RES1(0)=-1&(RES1(0)["Not DONE")
IF CNT>10
WRITE !,"Unable to get data"
GOTO END
+3 IF RES1(0)="0^New"
IF CNT<11
GOTO AGAIN1
+4 IF RES1(0)="0^New"
IF CNT>10
WRITE !,"Unable to get data"
GOTO END
+5 IF +RES1(0)=-1
WRITE !!,$PIECE(RES1(0),"^",2)
GOTO END
+6 IF RES1'=""
IF CNT<11
GOTO AGAIN1
+7 IF RES1'=""
IF CNT>10
WRITE !,"Unable to get data"
QUIT
+8 DO CLEAR^VALM1
+9 NEW NUM
SET NUM=""
SET CNT=0
+10 FOR
SET NUM=$ORDER(RES1(NUM))
if NUM=""
QUIT
Begin DoDot:1
+11 IF CNT>20
DO PROMPT^MPIFQ3
DO CLEAR^VALM1
SET CNT=0
+12 IF RES1(NUM)["Additional"
WRITE !!
SET CNT=CNT+2
+13 IF CNT<21
WRITE !,RES1(NUM)
SET CNT=CNT+1
End DoDot:1
END DO PROMPT^MPIFQ3
SET VALMBCK="R"
KILL CNT,RETURN,RES1
+1 QUIT
HELP ; Help List Manager Action (MPIF REAL-TIME QUERY (HELP))
+1 DO CLEAR^VALM1
DO MSG4^MPIFQ3
DO PROMPT^MPIFQ3
SET VALMBCK="R"
+2 QUIT
EXIT ;Exit for List Manager Template MPIF REAL-TIME QUERY
+1 KILL VALMBCK,VALMCNT,VALMHDR
+2 QUIT
