MPIFVER ;ALB/CKN,VISTA ENTERPRISE REGISTRATION ; 7/26/17 2:18pm
;;1.0;MASTER PATIENT INDEX VISTA;**61,62,65,66,67,79**;30 Apr 99;Build 2
Q
ENP(RESULTS,ALTRSHLD,TKTRSHLD) ;
N XCNT,XCNTR,DFN,TMPRESLT
S XCNT="",XCNTR="",DFN=""
D DISPLAY
I XCNTR'="" D
. M TMPRESLT(1)=RESULTS(XCNTR)
. K RESULTS M RESULTS=TMPRESLT
S DFN=$$BR(XCNTR)
Q DFN
BR(XCNTR) ;Business rules
N ICN,SSN,MPIIDS
;If no record is selected by user, return empty RESULTS and no DFN
I XCNTR="" K RESULTS Q ""
;
S ICN=$G(RESULTS(1,"ICN")),SSN=$G(RESULTS(1,"SSN"))
;If user select record with NO ICN value, return no DFN and single
;record in RESULTS
I ICN="" Q DFN
;If user select record with ICN value, check PATIENT file for
;ICN. If it exist, return DFN. If it does not exist, check for
;SSN. If SSN exist, Notify user and return empty DFN and RESULTS to
;go back to select patient prompt.
I $D(^DPT("AICN",+ICN)) D Q DFN
. S DFN=$O(^DPT("AICN",+ICN,""))
. K RESULTS
I SSN'="",($D(^DPT("SSN",SSN))) D Q DFN
. N IEN,NAME
. S IEN=$O(^DPT("SSN",SSN,"")),NAME=$P($G(^DPT(IEN,0)),"^"),DFN=-1
. W !,"SSN in selected record already exist in PATIENT file..."
. K RESULTS
;If existing patient not found in VistA,
;Call Enterprise Get Corresponding IDs, confirm MVI doesn't know
;this site already (active record) - if the site is already known
;need use that DFN.
D GETIDS^MPIFXMLG(.MPIIDS,RESULTS(1,"ICN"))
N ID,CN,STNUM,QFLG
S STNUM=$P($$SITE^VASITE(),"^",3),QFLG=0
S CN=0 F S CN=$O(MPIIDS(CN)) Q:+CN=0!(QFLG) D
. I $G(MPIIDS(CN,"IDType"))="PI",($G(MPIIDS(CN,"Source"))=STNUM) D Q
.. S DFN=$G(MPIIDS(CN,"ID")),QFLG=1
.. K RESULTS
.;If 200ESR is one of the site, set a flag to trigger Z11 query.
. I $G(MPIIDS(CN,"Source"))="200ESR" S RESULTS(1,"Z11")=1
Q DFN
DISPLAY ;
N CNT1,NAME,FNAME,MNAME,SCORE,SSN,DOB,ICN,SEX,LNAME,M,XMPIVER,EFLG,ECNT,DOD,DODFLG
S CNT1=0,EFLG=0,DODFLG=0
F S CNT1=$O(RESULTS(CNT1)) Q:+CNT1=0 D
. N DOD
. S FNAME=$G(RESULTS(CNT1,"FirstName")),SSN=$G(RESULTS(CNT1,"SSN"))
. S DOB=$G(RESULTS(CNT1,"DOB")),ICN=$G(RESULTS(CNT1,"ICN"))
. ; Story 722746 (elz) need dod if there is one and set flag
. I $D(RESULTS(CNT1,"DOD")) S DOD=RESULTS(CNT1,"DOD"),DODFLG=1
. S SEX=$G(RESULTS(CNT1,"Gender")),LNAME=$G(RESULTS(CNT1,"Surname"))
. S MNAME=$G(RESULTS(CNT1,"MiddleName"))
. S SCORE=+$G(RESULTS(CNT1,"Score")),NAME=LNAME_","_FNAME_" "_MNAME
. I ICN="",($D(RESULTS(CNT1,"IDS"))) D
.. S EFLG=1,ECNT=0 F S ECNT=$O(RESULTS(CNT1,"IDS",ECNT)) Q:+ECNT=0 D
... I $G(RESULTS(CNT1,"IDS",ECNT,"SOURCE"))="200DOD" S ICN=$G(RESULTS(CNT1,"IDS",ECNT,"ID")) ;Get EDIPI instead of ICN if from DoD
. S M=$S(SCORE>=ALTRSHLD:"E",1:"P")
. ;Rearranging array for sectional view display
. ;Story 722746 (elz) add "*" to ICN for display if deceased
. S XMPIVER("MPIVER",M,SCORE,CNT1)=NAME_"^"_SSN_"^"_DOB_"^"_SEX_"^"_$S($D(DOD):"*",1:"")_ICN
DISP2 ;
N DIR,DA,DR,Y,X,DATA,ENOUGH,COUNT,I,SCORE,CNTR
S COUNT=0
W @IOF
F I="E","P" D
. I $D(XMPIVER("MPIVER",I)) D HDR($S(I="E":"",I="P":" POTENTIAL",1:""))
. S SCORE=9999999 F S SCORE=$O(XMPIVER("MPIVER",I,SCORE),-1) Q:SCORE="" D
.. S CNTR=0 F S CNTR=$O(XMPIVER("MPIVER",I,SCORE,CNTR)) Q:CNTR="" D
... S COUNT=COUNT+1
... S XMPIVER("MPIVER",I,SCORE,CNTR,COUNT)=""
... S DATA=$G(XMPIVER("MPIVER",I,SCORE,CNTR))
... D HDR1
... ; Story 722746 (elz) increase space to allow for * for dod patients
... W !,COUNT_") ",?3,$P(DATA,"^",5),?22,$P(DATA,"^"),?53,$P(DATA,"^",2),?64,$$FMTE^XLFDT($P(DATA,"^",3),2),?76,$P(DATA,"^",4)
; Story 722746 (elz) if any are deceased, display message
I DODFLG W !!,"*Candidate list includes a deceased patient"
S XMPIVER("COUNT")=$G(COUNT)
S ENOUGH=0
W !
D ASK I ENOUGH G ASK2
I XCNT'="" W !,"Please wait..." D EXDISP(XCNT)
W !!
K DIR,DA S DIR(0)="Y",DIR("B")="NO",DIR("A")="Would you like to see another record" D ^DIR
I $D(DTOUT)!($D(DUOUT))!(Y=0) S ENOUGH=1 G ASK2
I Y G DISP2
EXIT K DA,X,Y,XMPIVER("MPIVER") W !! Q
HDR(HDL) ;Header
W !,"--- Records meet the"_HDL_" MATCH criteria ---"
Q
HDR1 ;Repeating header
; Story 503957 (elz) Added 'Birth' above 'Sex'
W:$X>50 ! W ?74,"BIRTH"
; Stroy 722746 space out name for dod patients
W !,?3,$S(EFLG=1:"EDIPI",1:"ICN"),?22,"NAME",?53,"SSN",?64,"DOB",?75,"SEX"
Q
ASK ;
N COUNT,DIR,DA,DR,ND,SC,CNTR,BC,QFLG
S BC=1,COUNT=$G(XMPIVER("COUNT"))
K DIR,X,Y S DIR(0)="NA^"_BC_":"_COUNT,DIR("A")="Enter the Number to display the details: ",DIR("?")="Enter the number from range of "_BC_" to "_COUNT D ^DIR
I $D(DTOUT)!($D(DUOUT)) S ENOUGH=1 Q
I Y S XCNT=$$CNTR(Y)
Q
;
CNTR(Y) ;
N SC,ND,CNTR,QFLG
S QFLG=0,XCNT=""
F I="E","P" D
. S SC=0 F S SC=$O(XMPIVER("MPIVER",I,SC)) Q:+SC=0!(QFLG) D
.. S CNTR=0 F S CNTR=$O(XMPIVER("MPIVER",I,SC,CNTR)) Q:+CNTR=0!(QFLG) D
... S ND=$O(XMPIVER("MPIVER",I,SC,CNTR,""))
... I ND=+Y S QFLG=1,XCNT=CNTR
Q XCNT
ASK2 ;
N X,Y,DIR,DA,DR,BC,COUNT
S BC=1
S COUNT=$G(XMPIVER("COUNT"))
;**65 - Story 557826 (ckn)
;For below prompt - set default value to YES only if any query result
;have at least one Exact match returned. set to NO if only Potential
;matches are returned.
K DIR,X,Y S DIR(0)="Y",DIR("B")=$S($D(XMPIVER("MPIVER","E")):"YES",1:"NO"),DIR("A")="Would you like to select a patient from above Enterprise Search" D ^DIR
I $D(DTOUT)!($D(DUOUT)) S ENOUGH=1 G EXIT
I Y D
.K DIR,X,Y S DIR(0)="NA^"_BC_":"_COUNT,DIR("A")="Enter the Number to select the patient: ",DIR("?")="Enter the number from range of "_BC_" to "_COUNT D ^DIR
I $D(DTOUT)!($D(DUOUT)) Q
I Y S XCNTR=$$CNTR(Y) D
.;W !,"Patient: "_XCNTR_" selected"
Q
EXDISP(XCNT) ;Extended display for selected patient **79 (cmc) VAMPI-16603 INCLUDE CORRESPONDENCE AND WORK ADDRESS, CELL AND WORK PHONE
;Get all traits from original results
N FNAME,LNAME,MNAME,CITY,COUNTRY,DOB,GENDER,ICN,L1,L2,L3,MMN,PCODE,DOD
N POBCTY,POBCNTRY,POBST,PREF,SUFFIX,PROVINCE,RESCITY,RESCNTRY
N RESADD1,RESADD2,RESADD3,RESPCODE,RESPROV,RESST,RESZIP,RESPHN
N SSN,ALFNM,ALLNM,ALSSN,ALSFX,ALCNT,ALMNM
S FNAME=$G(RESULTS(XCNT,"FirstName")),LNAME=$G(RESULTS(XCNT,"Surname"))
S MNAME=$G(RESULTS(XCNT,"MiddleName")),DOB=$G(RESULTS(XCNT,"DOB"))
; Story 722746 (elz) need dod if there is one
I $G(RESULTS(XCNT,"DOD")) S DOD=RESULTS(XCNT,"DOD")
S GENDER=$G(RESULTS(XCNT,"Gender")),ICN=$G(RESULTS(XCNT,"ICN"))
S MMN=$G(RESULTS(XCNT,"MMN")),POBCTY=$G(RESULTS(XCNT,"POBCity"))
S POBCNTRY=$G(RESULTS(XCNT,"POBCountry")),POBST=$G(RESULTS(XCNT,"POBState"))
S PREF=$G(RESULTS(XCNT,"Prefix")),SUFFIX=$G(RESULTS(XCNT,"Suffix"))
S RESCITY=$G(RESULTS(XCNT,"ResAddCity")),RESCNTRY=$G(RESULTS(XCNT,"ResAddCountry"))
S RESADD1=$G(RESULTS(XCNT,"ResAddL1")),RESADD2=$G(RESULTS(XCNT,"ResAddL2"))
S RESADD3=$G(RESULTS(XCNT,"ResAddL3")),RESPCODE=$G(RESULTS(XCNT,"ResAddPCode"))
S RESPROV=$G(RESULTS(XCNT,"ResAddProvince")),SSN=$G(RESULTS(XCNT,"SSN"))
S RESST=$G(RESULTS(XCNT,"ResAddState")),RESZIP=$G(RESULTS(XCNT,"ResAddZip4"))
S RESPHN=$G(RESULTS(XCNT,"ResPhone"))
W !
W !,?5,"ICN",?17,": "_ICN
W !,?5,"Name",?17,": "_LNAME_","_FNAME_" "_MNAME
W !,?5,"SSN",?17,": "_SSN
W !,?5,"DOB",?17,": "_$$FMTE^XLFDT(DOB)
I $G(RESULTS(XCNT,"MBI"))'="" W !,?5,"MBI",?17,": "_$G(RESULTS(XCNT,"MBI")) ;**79 ADDING MBI
; Story 722746 (elz) if patient is deceased display dod
I $D(DOD) W !,?5,"*DOD",?17,": "_$$FMTE^XLFDT(DOD)
; Story 603957 (elz) changed Gender to Birth Sex
W !,?5,"Birth Sex",?17,": "_GENDER
W !,?5,"MMN",?17,": "_MMN
I POBCTY'="" W !,?5,"POB City",?17,": "_POBCTY
I POBST'="" W !,?5,"POB State",?17,": "_POBST
I POBCNTRY'="" W !,?5,"POB Country",?17,": "_POBCNTRY
I RESADD1'=""!(RESADD2'="")!(RESADD3'="")!(RESCNTRY'="")!(RESCITY'="")!(RESST'="")!(RESPCODE'="")!(RESPROV'="")!(RESZIP'="") D
. W !!,"Residential Address:"
. I RESADD1'="" W !,?5,RESADD1
. I RESADD2'="" W !,?5,RESADD2
. I RESADD3'="" W !,?5,RESADD3
. I RESCNTRY'="",(RESCNTRY="USA") D
.. W !,?5,RESCITY_", "_RESST_" "_RESZIP
. I RESCNTRY'="",(RESCNTRY'="USA") D
.. W !,?5,RESCITY_","_RESPROV_" "_RESPCODE
I RESCNTRY'="" W !,?5,RESCNTRY
;**79 (cmc) VAMPI-16603 WORK AND CORRESPONDENCE ADDRESS, CELL AND WORK PHONE
I $G(RESULTS(XCNT,"CorAddL1"))'="" D
.W !!,"Correspondence Address:"
.W !,?5,$G(RESULTS(XCNT,"CorAddL1"))
.W:$G(RESULTS(XCNT,"CorAddL2"))'="" !,?5,$G(RESULTS(XCNT,"CorAddL2"))
.W:$G(RESULTS(XCNT,"CorAddL3"))'="" !,?5,$G(RESULTS(XCNT,"CorAddL3"))
.I $G(RESULTS(XCNT,"CorAddCountry"))=""!($G(RESULTS(XCNT,"CorAddCountry"))="USA") W !,?5,$G(RESULTS(XCNT,"CorAddCity"))_", "_$G(RESULTS(XCNT,"CorAddState"))_" "_$G(RESULTS(XCNT,"CorAddZip4")),!,?5,"USA"
.I $G(RESULTS(XCNT,"CorAddCountry"))'=""&($G(RESULTS(XCNT,"CorAddCountry"))'="USA") D
..W !,?5,$G(RESULTS(XCNT,"CorAddCity"))_", "_$G(RESULTS(XCNT,"CorAddProvince"))_" "_$G(RESULTS(XCNT,"CorAddPCode")),!,?5,$G(RESULTS(XCNT,"CorAddCountry"))
;
I $G(RESULTS(XCNT,"WrkAddL1"))'="" D
.W !!,"Work Address:"
.W !,?5,$G(RESULTS(XCNT,"WrkAddL1"))
.W:$G(RESULTS(XCNT,"WrkAddL2"))'="" !,?5,$G(RESULTS(XCNT,"WrkAddL2"))
.W:$G(RESULTS(XCNT,"WrkAddL3"))'="" !,?5,$G(RESULTS(XCNT,"WrkAddL3"))
.I $G(RESULTS(XCNT,"WrkAddCountry"))=""!($G(RESULTS(XCNT,"WrkAddCountry"))="USA") W !,?5,$G(RESULTS(XCNT,"WrkAddCity"))_", "_$G(RESULTS(XCNT,"WrkAddState"))_" "_$G(RESULTS(XCNT,"WrkAddZip4")),!,?5,"USA"
.I $G(RESULTS(XCNT,"WrkAddCountry"))'=""&($G(RESULTS(XCNT,"WrkAddCountry"))'="USA") D
..W !,?5,$G(RESULTS(XCNT,"WrkAddCity"))_", "_$G(RESULTS(XCNT,"WrkAddProvince"))_" "_$G(RESULTS(XCNT,"WrkAddPCode")),!,?5,$G(RESULTS(XCNT,"WrkAddCountry"))
;
I RESPHN'="" W !,?5,"Phone: "_RESPHN
;
I $G(RESULTS(XCNT,"CellPhone"))'="" W !,?5,"Cell Phone: ",RESULTS(XCNT,"CellPhone")
I $G(RESULTS(XCNT,"WrkPhone"))'="" W !,?5,"Work Phone: ",RESULTS(XCNT,"WrkPhone")
;
I $D(RESULTS(XCNT,"ALIAS")) D
. W !!,"ALIAS Information"
. W !,?5,"NAME",?45,"SSN"
. S ALCNT=0 F S ALCNT=$O(RESULTS(XCNT,"ALIAS",ALCNT)) Q:+ALCNT=0 D
.. S ALFNM=$G(RESULTS(XCNT,"ALIAS",ALCNT,"FirstName"))
.. S ALLNM=$G(RESULTS(XCNT,"ALIAS",ALCNT,"Surname"))
.. S ALSSN=$G(RESULTS(XCNT,"ALIAS",ALCNT,"SSN"))
.. S ALSFX=$G(RESULTS(XCNT,"ALIAS",ALCNT,"Suffix"))
.. S ALMNM=$G(RESULTS(XCNT,"ALIAS",ALCNT,"MiddleName"))
.. W !,?5,ALLNM_","_ALFNM_" "_ALMNM_" "_ALSFX,?45,ALSSN
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMPIFVER 10358 printed Dec 13, 2024@02:11:47 Page 2
MPIFVER ;ALB/CKN,VISTA ENTERPRISE REGISTRATION ; 7/26/17 2:18pm
+1 ;;1.0;MASTER PATIENT INDEX VISTA;**61,62,65,66,67,79**;30 Apr 99;Build 2
+2 QUIT
ENP(RESULTS,ALTRSHLD,TKTRSHLD) ;
+1 NEW XCNT,XCNTR,DFN,TMPRESLT
+2 SET XCNT=""
SET XCNTR=""
SET DFN=""
+3 DO DISPLAY
+4 IF XCNTR'=""
Begin DoDot:1
+5 MERGE TMPRESLT(1)=RESULTS(XCNTR)
+6 KILL RESULTS
MERGE RESULTS=TMPRESLT
End DoDot:1
+7 SET DFN=$$BR(XCNTR)
+8 QUIT DFN
BR(XCNTR) ;Business rules
+1 NEW ICN,SSN,MPIIDS
+2 ;If no record is selected by user, return empty RESULTS and no DFN
+3 IF XCNTR=""
KILL RESULTS
QUIT ""
+4 ;
+5 SET ICN=$GET(RESULTS(1,"ICN"))
SET SSN=$GET(RESULTS(1,"SSN"))
+6 ;If user select record with NO ICN value, return no DFN and single
+7 ;record in RESULTS
+8 IF ICN=""
QUIT DFN
+9 ;If user select record with ICN value, check PATIENT file for
+10 ;ICN. If it exist, return DFN. If it does not exist, check for
+11 ;SSN. If SSN exist, Notify user and return empty DFN and RESULTS to
+12 ;go back to select patient prompt.
+13 IF $DATA(^DPT("AICN",+ICN))
Begin DoDot:1
+14 SET DFN=$ORDER(^DPT("AICN",+ICN,""))
+15 KILL RESULTS
End DoDot:1
QUIT DFN
+16 IF SSN'=""
IF ($DATA(^DPT("SSN",SSN)))
Begin DoDot:1
+17 NEW IEN,NAME
+18 SET IEN=$ORDER(^DPT("SSN",SSN,""))
SET NAME=$PIECE($GET(^DPT(IEN,0)),"^")
SET DFN=-1
+19 WRITE !,"SSN in selected record already exist in PATIENT file..."
+20 KILL RESULTS
End DoDot:1
QUIT DFN
+21 ;If existing patient not found in VistA,
+22 ;Call Enterprise Get Corresponding IDs, confirm MVI doesn't know
+23 ;this site already (active record) - if the site is already known
+24 ;need use that DFN.
+25 DO GETIDS^MPIFXMLG(.MPIIDS,RESULTS(1,"ICN"))
+26 NEW ID,CN,STNUM,QFLG
+27 SET STNUM=$PIECE($$SITE^VASITE(),"^",3)
SET QFLG=0
+28 SET CN=0
FOR
SET CN=$ORDER(MPIIDS(CN))
if +CN=0!(QFLG)
QUIT
Begin DoDot:1
+29 IF $GET(MPIIDS(CN,"IDType"))="PI"
IF ($GET(MPIIDS(CN,"Source"))=STNUM)
Begin DoDot:2
+30 SET DFN=$GET(MPIIDS(CN,"ID"))
SET QFLG=1
+31 KILL RESULTS
End DoDot:2
QUIT
+32 ;If 200ESR is one of the site, set a flag to trigger Z11 query.
+33 IF $GET(MPIIDS(CN,"Source"))="200ESR"
SET RESULTS(1,"Z11")=1
End DoDot:1
+34 QUIT DFN
DISPLAY ;
+1 NEW CNT1,NAME,FNAME,MNAME,SCORE,SSN,DOB,ICN,SEX,LNAME,M,XMPIVER,EFLG,ECNT,DOD,DODFLG
+2 SET CNT1=0
SET EFLG=0
SET DODFLG=0
+3 FOR
SET CNT1=$ORDER(RESULTS(CNT1))
if +CNT1=0
QUIT
Begin DoDot:1
+4 NEW DOD
+5 SET FNAME=$GET(RESULTS(CNT1,"FirstName"))
SET SSN=$GET(RESULTS(CNT1,"SSN"))
+6 SET DOB=$GET(RESULTS(CNT1,"DOB"))
SET ICN=$GET(RESULTS(CNT1,"ICN"))
+7 ; Story 722746 (elz) need dod if there is one and set flag
+8 IF $DATA(RESULTS(CNT1,"DOD"))
SET DOD=RESULTS(CNT1,"DOD")
SET DODFLG=1
+9 SET SEX=$GET(RESULTS(CNT1,"Gender"))
SET LNAME=$GET(RESULTS(CNT1,"Surname"))
+10 SET MNAME=$GET(RESULTS(CNT1,"MiddleName"))
+11 SET SCORE=+$GET(RESULTS(CNT1,"Score"))
SET NAME=LNAME_","_FNAME_" "_MNAME
+12 IF ICN=""
IF ($DATA(RESULTS(CNT1,"IDS")))
Begin DoDot:2
+13 SET EFLG=1
SET ECNT=0
FOR
SET ECNT=$ORDER(RESULTS(CNT1,"IDS",ECNT))
if +ECNT=0
QUIT
Begin DoDot:3
+14 ;Get EDIPI instead of ICN if from DoD
IF $GET(RESULTS(CNT1,"IDS",ECNT,"SOURCE"))="200DOD"
SET ICN=$GET(RESULTS(CNT1,"IDS",ECNT,"ID"))
End DoDot:3
End DoDot:2
+15 SET M=$SELECT(SCORE>=ALTRSHLD:"E",1:"P")
+16 ;Rearranging array for sectional view display
+17 ;Story 722746 (elz) add "*" to ICN for display if deceased
+18 SET XMPIVER("MPIVER",M,SCORE,CNT1)=NAME_"^"_SSN_"^"_DOB_"^"_SEX_"^"_$SELECT($DATA(DOD):"*",1:"")_ICN
End DoDot:1
DISP2 ;
+1 NEW DIR,DA,DR,Y,X,DATA,ENOUGH,COUNT,I,SCORE,CNTR
+2 SET COUNT=0
+3 WRITE @IOF
+4 FOR I="E","P"
Begin DoDot:1
+5 IF $DATA(XMPIVER("MPIVER",I))
DO HDR($SELECT(I="E":"",I="P":" POTENTIAL",1:""))
+6 SET SCORE=9999999
FOR
SET SCORE=$ORDER(XMPIVER("MPIVER",I,SCORE),-1)
if SCORE=""
QUIT
Begin DoDot:2
+7 SET CNTR=0
FOR
SET CNTR=$ORDER(XMPIVER("MPIVER",I,SCORE,CNTR))
if CNTR=""
QUIT
Begin DoDot:3
+8 SET COUNT=COUNT+1
+9 SET XMPIVER("MPIVER",I,SCORE,CNTR,COUNT)=""
+10 SET DATA=$GET(XMPIVER("MPIVER",I,SCORE,CNTR))
+11 DO HDR1
+12 ; Story 722746 (elz) increase space to allow for * for dod patients
+13 WRITE !,COUNT_") ",?3,$PIECE(DATA,"^",5),?22,$PIECE(DATA,"^"),?53,$PIECE(DATA,"^",2),?64,$$FMTE^XLFDT($PIECE(DATA,"^",3),2),?76,$PIECE(DATA,"^",4)
End DoDot:3
End DoDot:2
End DoDot:1
+14 ; Story 722746 (elz) if any are deceased, display message
+15 IF DODFLG
WRITE !!,"*Candidate list includes a deceased patient"
+16 SET XMPIVER("COUNT")=$GET(COUNT)
+17 SET ENOUGH=0
+18 WRITE !
+19 DO ASK
IF ENOUGH
GOTO ASK2
+20 IF XCNT'=""
WRITE !,"Please wait..."
DO EXDISP(XCNT)
+21 WRITE !!
+22 KILL DIR,DA
SET DIR(0)="Y"
SET DIR("B")="NO"
SET DIR("A")="Would you like to see another record"
DO ^DIR
+23 IF $DATA(DTOUT)!($DATA(DUOUT))!(Y=0)
SET ENOUGH=1
GOTO ASK2
+24 IF Y
GOTO DISP2
EXIT KILL DA,X,Y,XMPIVER("MPIVER")
WRITE !!
QUIT
HDR(HDL) ;Header
+1 WRITE !,"--- Records meet the"_HDL_" MATCH criteria ---"
+2 QUIT
HDR1 ;Repeating header
+1 ; Story 503957 (elz) Added 'Birth' above 'Sex'
+2 if $X>50
WRITE !
WRITE ?74,"BIRTH"
+3 ; Stroy 722746 space out name for dod patients
+4 WRITE !,?3,$SELECT(EFLG=1:"EDIPI",1:"ICN"),?22,"NAME",?53,"SSN",?64,"DOB",?75,"SEX"
+5 QUIT
ASK ;
+1 NEW COUNT,DIR,DA,DR,ND,SC,CNTR,BC,QFLG
+2 SET BC=1
SET COUNT=$GET(XMPIVER("COUNT"))
+3 KILL DIR,X,Y
SET DIR(0)="NA^"_BC_":"_COUNT
SET DIR("A")="Enter the Number to display the details: "
SET DIR("?")="Enter the number from range of "_BC_" to "_COUNT
DO ^DIR
+4 IF $DATA(DTOUT)!($DATA(DUOUT))
SET ENOUGH=1
QUIT
+5 IF Y
SET XCNT=$$CNTR(Y)
+6 QUIT
+7 ;
CNTR(Y) ;
+1 NEW SC,ND,CNTR,QFLG
+2 SET QFLG=0
SET XCNT=""
+3 FOR I="E","P"
Begin DoDot:1
+4 SET SC=0
FOR
SET SC=$ORDER(XMPIVER("MPIVER",I,SC))
if +SC=0!(QFLG)
QUIT
Begin DoDot:2
+5 SET CNTR=0
FOR
SET CNTR=$ORDER(XMPIVER("MPIVER",I,SC,CNTR))
if +CNTR=0!(QFLG)
QUIT
Begin DoDot:3
+6 SET ND=$ORDER(XMPIVER("MPIVER",I,SC,CNTR,""))
+7 IF ND=+Y
SET QFLG=1
SET XCNT=CNTR
End DoDot:3
End DoDot:2
End DoDot:1
+8 QUIT XCNT
ASK2 ;
+1 NEW X,Y,DIR,DA,DR,BC,COUNT
+2 SET BC=1
+3 SET COUNT=$GET(XMPIVER("COUNT"))
+4 ;**65 - Story 557826 (ckn)
+5 ;For below prompt - set default value to YES only if any query result
+6 ;have at least one Exact match returned. set to NO if only Potential
+7 ;matches are returned.
+8 KILL DIR,X,Y
SET DIR(0)="Y"
SET DIR("B")=$SELECT($DATA(XMPIVER("MPIVER","E")):"YES",1:"NO")
SET DIR("A")="Would you like to select a patient from above Enterprise Search"
DO ^DIR
+9 IF $DATA(DTOUT)!($DATA(DUOUT))
SET ENOUGH=1
GOTO EXIT
+10 IF Y
Begin DoDot:1
+11 KILL DIR,X,Y
SET DIR(0)="NA^"_BC_":"_COUNT
SET DIR("A")="Enter the Number to select the patient: "
SET DIR("?")="Enter the number from range of "_BC_" to "_COUNT
DO ^DIR
End DoDot:1
+12 IF $DATA(DTOUT)!($DATA(DUOUT))
QUIT
+13 IF Y
SET XCNTR=$$CNTR(Y)
Begin DoDot:1
+14 ;W !,"Patient: "_XCNTR_" selected"
End DoDot:1
+15 QUIT
EXDISP(XCNT) ;Extended display for selected patient **79 (cmc) VAMPI-16603 INCLUDE CORRESPONDENCE AND WORK ADDRESS, CELL AND WORK PHONE
+1 ;Get all traits from original results
+2 NEW FNAME,LNAME,MNAME,CITY,COUNTRY,DOB,GENDER,ICN,L1,L2,L3,MMN,PCODE,DOD
+3 NEW POBCTY,POBCNTRY,POBST,PREF,SUFFIX,PROVINCE,RESCITY,RESCNTRY
+4 NEW RESADD1,RESADD2,RESADD3,RESPCODE,RESPROV,RESST,RESZIP,RESPHN
+5 NEW SSN,ALFNM,ALLNM,ALSSN,ALSFX,ALCNT,ALMNM
+6 SET FNAME=$GET(RESULTS(XCNT,"FirstName"))
SET LNAME=$GET(RESULTS(XCNT,"Surname"))
+7 SET MNAME=$GET(RESULTS(XCNT,"MiddleName"))
SET DOB=$GET(RESULTS(XCNT,"DOB"))
+8 ; Story 722746 (elz) need dod if there is one
+9 IF $GET(RESULTS(XCNT,"DOD"))
SET DOD=RESULTS(XCNT,"DOD")
+10 SET GENDER=$GET(RESULTS(XCNT,"Gender"))
SET ICN=$GET(RESULTS(XCNT,"ICN"))
+11 SET MMN=$GET(RESULTS(XCNT,"MMN"))
SET POBCTY=$GET(RESULTS(XCNT,"POBCity"))
+12 SET POBCNTRY=$GET(RESULTS(XCNT,"POBCountry"))
SET POBST=$GET(RESULTS(XCNT,"POBState"))
+13 SET PREF=$GET(RESULTS(XCNT,"Prefix"))
SET SUFFIX=$GET(RESULTS(XCNT,"Suffix"))
+14 SET RESCITY=$GET(RESULTS(XCNT,"ResAddCity"))
SET RESCNTRY=$GET(RESULTS(XCNT,"ResAddCountry"))
+15 SET RESADD1=$GET(RESULTS(XCNT,"ResAddL1"))
SET RESADD2=$GET(RESULTS(XCNT,"ResAddL2"))
+16 SET RESADD3=$GET(RESULTS(XCNT,"ResAddL3"))
SET RESPCODE=$GET(RESULTS(XCNT,"ResAddPCode"))
+17 SET RESPROV=$GET(RESULTS(XCNT,"ResAddProvince"))
SET SSN=$GET(RESULTS(XCNT,"SSN"))
+18 SET RESST=$GET(RESULTS(XCNT,"ResAddState"))
SET RESZIP=$GET(RESULTS(XCNT,"ResAddZip4"))
+19 SET RESPHN=$GET(RESULTS(XCNT,"ResPhone"))
+20 WRITE !
+21 WRITE !,?5,"ICN",?17,": "_ICN
+22 WRITE !,?5,"Name",?17,": "_LNAME_","_FNAME_" "_MNAME
+23 WRITE !,?5,"SSN",?17,": "_SSN
+24 WRITE !,?5,"DOB",?17,": "_$$FMTE^XLFDT(DOB)
+25 ;**79 ADDING MBI
IF $GET(RESULTS(XCNT,"MBI"))'=""
WRITE !,?5,"MBI",?17,": "_$GET(RESULTS(XCNT,"MBI"))
+26 ; Story 722746 (elz) if patient is deceased display dod
+27 IF $DATA(DOD)
WRITE !,?5,"*DOD",?17,": "_$$FMTE^XLFDT(DOD)
+28 ; Story 603957 (elz) changed Gender to Birth Sex
+29 WRITE !,?5,"Birth Sex",?17,": "_GENDER
+30 WRITE !,?5,"MMN",?17,": "_MMN
+31 IF POBCTY'=""
WRITE !,?5,"POB City",?17,": "_POBCTY
+32 IF POBST'=""
WRITE !,?5,"POB State",?17,": "_POBST
+33 IF POBCNTRY'=""
WRITE !,?5,"POB Country",?17,": "_POBCNTRY
+34 IF RESADD1'=""!(RESADD2'="")!(RESADD3'="")!(RESCNTRY'="")!(RESCITY'="")!(RESST'="")!(RESPCODE'="")!(RESPROV'="")!(RESZIP'="")
Begin DoDot:1
+35 WRITE !!,"Residential Address:"
+36 IF RESADD1'=""
WRITE !,?5,RESADD1
+37 IF RESADD2'=""
WRITE !,?5,RESADD2
+38 IF RESADD3'=""
WRITE !,?5,RESADD3
+39 IF RESCNTRY'=""
IF (RESCNTRY="USA")
Begin DoDot:2
+40 WRITE !,?5,RESCITY_", "_RESST_" "_RESZIP
End DoDot:2
+41 IF RESCNTRY'=""
IF (RESCNTRY'="USA")
Begin DoDot:2
+42 WRITE !,?5,RESCITY_","_RESPROV_" "_RESPCODE
End DoDot:2
End DoDot:1
+43 IF RESCNTRY'=""
WRITE !,?5,RESCNTRY
+44 ;**79 (cmc) VAMPI-16603 WORK AND CORRESPONDENCE ADDRESS, CELL AND WORK PHONE
+45 IF $GET(RESULTS(XCNT,"CorAddL1"))'=""
Begin DoDot:1
+46 WRITE !!,"Correspondence Address:"
+47 WRITE !,?5,$GET(RESULTS(XCNT,"CorAddL1"))
+48 if $GET(RESULTS(XCNT,"CorAddL2"))'=""
WRITE !,?5,$GET(RESULTS(XCNT,"CorAddL2"))
+49 if $GET(RESULTS(XCNT,"CorAddL3"))'=""
WRITE !,?5,$GET(RESULTS(XCNT,"CorAddL3"))
+50 IF $GET(RESULTS(XCNT,"CorAddCountry"))=""!($GET(RESULTS(XCNT,"CorAddCountry"))="USA")
WRITE !,?5,$GET(RESULTS(XCNT,"CorAddCity"))_", "_$GET(RESULTS(XCNT,"CorAddState"))_" "_$GET(RESULTS(XCNT,"CorAddZip4")),!,?5,"USA"
+51 IF $GET(RESULTS(XCNT,"CorAddCountry"))'=""&($GET(RESULTS(XCNT,"CorAddCountry"))'="USA")
Begin DoDot:2
+52 WRITE !,?5,$GET(RESULTS(XCNT,"CorAddCity"))_", "_$GET(RESULTS(XCNT,"CorAddProvince"))_" "_$GET(RESULTS(XCNT,"CorAddPCode")),!,?5,$GET(RESULTS(XCNT,"CorAddCountry"))
End DoDot:2
End DoDot:1
+53 ;
+54 IF $GET(RESULTS(XCNT,"WrkAddL1"))'=""
Begin DoDot:1
+55 WRITE !!,"Work Address:"
+56 WRITE !,?5,$GET(RESULTS(XCNT,"WrkAddL1"))
+57 if $GET(RESULTS(XCNT,"WrkAddL2"))'=""
WRITE !,?5,$GET(RESULTS(XCNT,"WrkAddL2"))
+58 if $GET(RESULTS(XCNT,"WrkAddL3"))'=""
WRITE !,?5,$GET(RESULTS(XCNT,"WrkAddL3"))
+59 IF $GET(RESULTS(XCNT,"WrkAddCountry"))=""!($GET(RESULTS(XCNT,"WrkAddCountry"))="USA")
WRITE !,?5,$GET(RESULTS(XCNT,"WrkAddCity"))_", "_$GET(RESULTS(XCNT,"WrkAddState"))_" "_$GET(RESULTS(XCNT,"WrkAddZip4")),!,?5,"USA"
+60 IF $GET(RESULTS(XCNT,"WrkAddCountry"))'=""&($GET(RESULTS(XCNT,"WrkAddCountry"))'="USA")
Begin DoDot:2
+61 WRITE !,?5,$GET(RESULTS(XCNT,"WrkAddCity"))_", "_$GET(RESULTS(XCNT,"WrkAddProvince"))_" "_$GET(RESULTS(XCNT,"WrkAddPCode")),!,?5,$GET(RESULTS(XCNT,"WrkAddCountry"))
End DoDot:2
End DoDot:1
+62 ;
+63 IF RESPHN'=""
WRITE !,?5,"Phone: "_RESPHN
+64 ;
+65 IF $GET(RESULTS(XCNT,"CellPhone"))'=""
WRITE !,?5,"Cell Phone: ",RESULTS(XCNT,"CellPhone")
+66 IF $GET(RESULTS(XCNT,"WrkPhone"))'=""
WRITE !,?5,"Work Phone: ",RESULTS(XCNT,"WrkPhone")
+67 ;
+68 IF $DATA(RESULTS(XCNT,"ALIAS"))
Begin DoDot:1
+69 WRITE !!,"ALIAS Information"
+70 WRITE !,?5,"NAME",?45,"SSN"
+71 SET ALCNT=0
FOR
SET ALCNT=$ORDER(RESULTS(XCNT,"ALIAS",ALCNT))
if +ALCNT=0
QUIT
Begin DoDot:2
+72 SET ALFNM=$GET(RESULTS(XCNT,"ALIAS",ALCNT,"FirstName"))
+73 SET ALLNM=$GET(RESULTS(XCNT,"ALIAS",ALCNT,"Surname"))
+74 SET ALSSN=$GET(RESULTS(XCNT,"ALIAS",ALCNT,"SSN"))
+75 SET ALSFX=$GET(RESULTS(XCNT,"ALIAS",ALCNT,"Suffix"))
+76 SET ALMNM=$GET(RESULTS(XCNT,"ALIAS",ALCNT,"MiddleName"))
+77 WRITE !,?5,ALLNM_","_ALFNM_" "_ALMNM_" "_ALSFX,?45,ALSSN
End DoDot:2
End DoDot:1
+78 QUIT
