- MPIFD1 ;BIRM/CMC-POTENTIAL DUP ON MPI ;DEC 2, 2005
- ;;1.0; MASTER PATIENT INDEX VISTA ;**43,48**;30 Apr 99;Build 6
- ;
- INIT ;Entry point for List Manager Template - MPIF POTENTIAL DUP
- Q
- HDR ;Header code for List Manager Template - MPIF POTENTIAL DUP (CLONED FROM HDR^MPIFQ1)
- 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 MPIF POTENTIAL DUP
- S VALMCNT=INDEX
- D EN^VALM("MPIF POTENTIAL DUP")
- 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)
- .S MPIFRTN="CONTINUE"
- ;Does your patient have other VISTA systems sharing this ICN? If so, can't match -- message to IMDQ?
- ;Are there other sites in common (VISTA)? If so matching isn't allowed - message to IMDQ
- S (MORE,COMMON)=0
- D COMPARE^MPIF002(DFN,INDEX,.COMMON,.MORE)
- I COMMON S MSG="Site attempted to resolve MPI duplicate for ICNs "_ICN_" and "_$$GETICN^MPIF001(DFN)_" - they have TFs in common."
- I MORE S MSG="Site attempted to resolve MPI duplicate for ICNs "_ICN_" and "_$$GETICN^MPIF001(DFN)_" - the site patient is now shared."
- I COMMON!(MORE) D MIMDQ^MPIF002(ICN,$$GETICN^MPIF001(DFN),DFN,MSG) S PROCESS=1 K COMMON,MORE S MPIFRTN="CONTINUE" Q
- ;User selected from list, does SSN & Name match? no-ask if sure
- N SSN,NAME,SEX,BIR K COMMON
- D GETDATA^MPIFQ0("^DPT(",DFN,"MPIFQ1",".01;.09;.02;.03","EI")
- S SSN=$G(MPIFQ1(2,DFN,.09,"E")),NAME=$G(MPIFQ1(2,DFN,.01,"E")),SEX=$G(MPIFQ1(2,DFN,.02,"I"))
- S BIR=$G(MPIFQ1(2,DFN,.03,"I")) I BIR]"" S BIR=$TR($$FMTE^XLFDT(BIR,"5D"),"/","-")
- ; 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 $D(EXACT),BIR'=DATA(.03) K EXACT
- I DATA(.01)=NAME!($D(EXACT)) I BIR=DATA(.03) D Q
- .N PID2,ERR
- .K DATA(.09),DATA(.01),DATA(.03)
- .D INIT^HLFNC2("MPIF ADT-A24 SERVER",.HL)
- .D BLDPID^VAFCQRY(DFN,2,"ALL",.PID2,.HL,.ERR)
- .;**48 want to resolve an reject exceptions for "current" ICN
- .D RESEX^MPIFDUP(DFN)
- .D EDIT^MPIFQED(DFN,"DATA"),MSG3^MPIFQ3,PROMPT^MPIFQ3
- .S RESLT=$$A24^MPIFA24B(DFN,.PID2) ;send a24 link icns
- .S PROCESS=1 Q
- ; \/ Name doesn't match exactly - ask if sure
- D CLEAR^VALM1,MSG2^MPIFQ3,MSG^MPIFQ3(SSN,NAME,DATA(.09),DATA(.01),DATA(.03),BIR)
- N ANS S ANS=$$PROMPT1^MPIFQ3()
- I ANS K DATA(.09),DATA(.01),DATA(.03) D Q
- .;build PID segment to be the "from" value
- .N PID2,ERR
- .D INIT^HLFNC2("MPIF ADT-A24 SERVER",.HL)
- .D BLDPID^VAFCQRY(DFN,2,"ALL",.PID2,.HL,.ERR)
- .;**48 want to resolve an reject exceptions for "current" ICN
- .D RESEX^MPIFDUP(DFN)
- .D EDIT^MPIFQED(DFN,"DATA") S MPIFRTN="CONTINUE" ;UPDATE ICN
- .W !!,"ICN and CMOR Updated" D PROMPT^MPIFQ3
- .S PROCESS=1 N RESLT
- .;TRIGGER A24 TO MPI TO LINK ICNs together
- .S RESLT=$$A24^MPIFA24B(DFN,.PID2) ;SEND A24 LINKING ICNS
- D MSG5^MPIFQ3,PROMPT^MPIFQ3 S VALMBCK="R"
- Q
- MPIPD ; MPI PDAT CALL (CLONED FROM MPIPD^MPIFQ1)
- 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) ; **48 REMOVE CMOR FROM DISPLAY ,?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,"/")_" REMEDY/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 (CLONED FROM CMOR^MPIFQ1)
- 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 POTENTIAL DUP (HELP))
- D CLEAR^VALM1
- K MPIFDUP S MPIFDUP=1 D MSG4^MPIFQ3,PROMPT^MPIFQ3 S VALMBCK="R" K MPIFDUP
- Q
- EXIT ;Exit for List Manager Template MPIF MPIF POTENTIAL DUP
- K VALMBCK,VALMCNT,VALMHDR
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMPIFD1 8314 printed Feb 18, 2025@23:37:17 Page 2
- MPIFD1 ;BIRM/CMC-POTENTIAL DUP ON MPI ;DEC 2, 2005
- +1 ;;1.0; MASTER PATIENT INDEX VISTA ;**43,48**;30 Apr 99;Build 6
- +2 ;
- INIT ;Entry point for List Manager Template - MPIF POTENTIAL DUP
- +1 QUIT
- HDR ;Header code for List Manager Template - MPIF POTENTIAL DUP (CLONED FROM HDR^MPIFQ1)
- +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 MPIF POTENTIAL DUP
- +1 SET VALMCNT=INDEX
- +2 DO EN^VALM("MPIF POTENTIAL DUP")
- +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 SET MPIFRTN="CONTINUE"
- End DoDot:1
- QUIT
- +15 ;Does your patient have other VISTA systems sharing this ICN? If so, can't match -- message to IMDQ?
- +16 ;Are there other sites in common (VISTA)? If so matching isn't allowed - message to IMDQ
- +17 SET (MORE,COMMON)=0
- +18 DO COMPARE^MPIF002(DFN,INDEX,.COMMON,.MORE)
- +19 IF COMMON
- SET MSG="Site attempted to resolve MPI duplicate for ICNs "_ICN_" and "_$$GETICN^MPIF001(DFN)_" - they have TFs in common."
- +20 IF MORE
- SET MSG="Site attempted to resolve MPI duplicate for ICNs "_ICN_" and "_$$GETICN^MPIF001(DFN)_" - the site patient is now shared."
- +21 IF COMMON!(MORE)
- DO MIMDQ^MPIF002(ICN,$$GETICN^MPIF001(DFN),DFN,MSG)
- SET PROCESS=1
- KILL COMMON,MORE
- SET MPIFRTN="CONTINUE"
- QUIT
- +22 ;User selected from list, does SSN & Name match? no-ask if sure
- +23 NEW SSN,NAME,SEX,BIR
- KILL COMMON
- +24 DO GETDATA^MPIFQ0("^DPT(",DFN,"MPIFQ1",".01;.09;.02;.03","EI")
- +25 SET SSN=$GET(MPIFQ1(2,DFN,.09,"E"))
- SET NAME=$GET(MPIFQ1(2,DFN,.01,"E"))
- SET SEX=$GET(MPIFQ1(2,DFN,.02,"I"))
- +26 SET BIR=$GET(MPIFQ1(2,DFN,.03,"I"))
- IF BIR]""
- SET BIR=$TRANSLATE($$FMTE^XLFDT(BIR,"5D"),"/","-")
- +27 ; if sex doesn't match -- not allowed to update ICN
- +28 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
- +29 IF SSN["P"
- SET SSN=""
- +30 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
- +31 ;reformat name into DG 149 format
- DO NAME^VAFCPID2(0,.NAME,0)
- +32 ;reformat name into DG 149 format
- NEW NAME3
- SET NAME3=DATA(.01)
- DO NAME^VAFCPID2(0,.NAME3,0)
- SET DATA(.01)=NAME3
- +33 NEW EXACT
- +34 ; check if Last, First MATCH if so is it a middle name vs middle initial
- +35 IF $PIECE(DATA(.01),",")=$PIECE(NAME,",")&($PIECE($PIECE(NAME,",",2)," ")=$PIECE($PIECE(DATA(.01),",",2)," "))
- Begin DoDot:1
- +36 NEW MPIMID,NMMN
- SET MPIMID=$PIECE($PIECE(DATA(.01),",",2)," ",2)
- +37 SET NMMN=$PIECE($PIECE(NAME,",",2)," ",2)
- +38 IF $LENGTH(NMMN)>1&($LENGTH(MPIMID)=1)
- IF ($EXTRACT(NMMN,1)=MPIMID)
- SET EXACT=1
- +39 IF $LENGTH(MPIMID)>1&($LENGTH(NMMN)=1)
- IF ($EXTRACT(MPIMID,1)=NMMN)
- SET EXACT=1
- +40 IF $DATA(EXACT)
- IF BIR'=DATA(.03)
- KILL EXACT
- End DoDot:1
- +41 IF DATA(.01)=NAME!($DATA(EXACT))
- IF BIR=DATA(.03)
- Begin DoDot:1
- +42 NEW PID2,ERR
- +43 KILL DATA(.09),DATA(.01),DATA(.03)
- +44 DO INIT^HLFNC2("MPIF ADT-A24 SERVER",.HL)
- +45 DO BLDPID^VAFCQRY(DFN,2,"ALL",.PID2,.HL,.ERR)
- +46 ;**48 want to resolve an reject exceptions for "current" ICN
- +47 DO RESEX^MPIFDUP(DFN)
- +48 DO EDIT^MPIFQED(DFN,"DATA")
- DO MSG3^MPIFQ3
- DO PROMPT^MPIFQ3
- +49 ;send a24 link icns
- SET RESLT=$$A24^MPIFA24B(DFN,.PID2)
- +50 SET PROCESS=1
- QUIT
- End DoDot:1
- QUIT
- +51 ; \/ Name doesn't match exactly - ask if sure
- +52 DO CLEAR^VALM1
- DO MSG2^MPIFQ3
- DO MSG^MPIFQ3(SSN,NAME,DATA(.09),DATA(.01),DATA(.03),BIR)
- +53 NEW ANS
- SET ANS=$$PROMPT1^MPIFQ3()
- +54 IF ANS
- KILL DATA(.09),DATA(.01),DATA(.03)
- Begin DoDot:1
- +55 ;build PID segment to be the "from" value
- +56 NEW PID2,ERR
- +57 DO INIT^HLFNC2("MPIF ADT-A24 SERVER",.HL)
- +58 DO BLDPID^VAFCQRY(DFN,2,"ALL",.PID2,.HL,.ERR)
- +59 ;**48 want to resolve an reject exceptions for "current" ICN
- +60 DO RESEX^MPIFDUP(DFN)
- +61 ;UPDATE ICN
- DO EDIT^MPIFQED(DFN,"DATA")
- SET MPIFRTN="CONTINUE"
- +62 WRITE !!,"ICN and CMOR Updated"
- DO PROMPT^MPIFQ3
- +63 SET PROCESS=1
- NEW RESLT
- +64 ;TRIGGER A24 TO MPI TO LINK ICNs together
- +65 ;SEND A24 LINKING ICNS
- SET RESLT=$$A24^MPIFA24B(DFN,.PID2)
- End DoDot:1
- QUIT
- +66 DO MSG5^MPIFQ3
- DO PROMPT^MPIFQ3
- SET VALMBCK="R"
- +67 QUIT
- MPIPD ; MPI PDAT CALL (CLONED FROM MPIPD^MPIFQ1)
- +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 ; **48 REMOVE CMOR FROM DISPLAY ,?30,"CMOR: ",CMOR," (",CMOR3,")"
- WRITE !,"MPI Data:",!!!,?3,"ICN: ",+$PIECE(DATA,"^",6)
- +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,"/")_" REMEDY/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 (CLONED FROM CMOR^MPIFQ1)
- +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 POTENTIAL DUP (HELP))
- +1 DO CLEAR^VALM1
- +2 KILL MPIFDUP
- SET MPIFDUP=1
- DO MSG4^MPIFQ3
- DO PROMPT^MPIFQ3
- SET VALMBCK="R"
- KILL MPIFDUP
- +3 QUIT
- EXIT ;Exit for List Manager Template MPIF MPIF POTENTIAL DUP
- +1 KILL VALMBCK,VALMCNT,VALMHDR
- +2 QUIT