RGEVPM ;BIR/CML-VIEW POTENTIAL MATCH PATIENT LIST ;07/20/99
;;1.0;CLINICAL INFO RESOURCE NETWORK;**1,3,19**;30 Apr 99
S QFLG=1
BEGIN ;
W !!,"This report prints a list of patients who have been identified as having"
W !,"multiple Potential Matches on the Master Patient Index (MPI) and who haven't"
W !,"yet been resolved using the option ""Single Patient Initialization to MPI""."
W !,"Status is current as of the date/time the report is generated."
W !!,"This data is pulled from the CIRN HL7 EXCEPTION LOG file (#991.1)."
W !,"Prior to producing the report, duplicate POTENTIAL MATCH patients will be"
W !,"purged from the file."
;
D EXCTMP
I XCNT=0 W !!,"There are no patients identified as Potential Matches." G QUIT
DEV ;
W !!,"The right margin for this report is 80.",!!
D EN^XUTMDEVQ("START^RGEVPM","MPI/PD - Potential Match Patient List") I 'POP Q
W !,"NO DEVICE SELECTED OR REPORT PRINTED!!"
G QUIT
START ;
S HOME=$$SITE^VASITE() ;institution file ptr^station name^station number
;
LOOP ;Search ^RGHL7(991.1,"ADFN" to see how many patients need to be resolved to MPI
K ^TMP("RGEVPM",$J)
;
S (RCNT,RGDFN)=0
F S RGDFN=$O(^RGHL7(991.1,"ADFN",218,RGDFN)) Q:'RGDFN D
.S ICN=+$$GETICN^MPIF001(RGDFN)
.I $E(ICN,1,3)=$P(HOME,"^",3)!(ICN<0) D
..S RCNT=RCNT+1
..S DFN=RGDFN D DEM^VADPT
..S ^TMP("RGEVPM",$J,VADM(1),RGDFN)=$P(VADM(2),"^")_"^"_$P(VADM(3),"^",2)
;
PRT ;Print report
S (PG,QFLG)=0,$P(LN,"-",81)="",LOCSITE=$P(HOME,"^",2)
D NOW^%DTC S HDT=$$FMTE^XLFDT($E(%,1,12))
D HDR
I '$D(^TMP("RGEVPM",$J)) W !!,"No patients found who need to be resolved to the MPI." G QUIT
;
;count the number of patients who need to be resolved
S PTNM="",CNT=0
F S PTNM=$O(^TMP("RGEVPM",$J,PTNM)) Q:PTNM="" Q:QFLG D
.S RGDFN=0
.F S RGDFN=$O(^TMP("RGEVPM",$J,PTNM,RGDFN)) Q:'RGDFN S CNT=CNT+1
;
S PTNM=""
F S PTNM=$O(^TMP("RGEVPM",$J,PTNM)) Q:PTNM="" Q:QFLG D
.S RGDFN=0
.F S RGDFN=$O(^TMP("RGEVPM",$J,PTNM,RGDFN)) Q:'RGDFN Q:QFLG D
..S SSN=$P(^TMP("RGEVPM",$J,PTNM,RGDFN),"^")
..S DOB=$P(^TMP("RGEVPM",$J,PTNM,RGDFN),"^",2)
..D:$Y+4>IOSL HDR Q:QFLG W !,PTNM,?36,SSN,?50,DOB,?68,$J(RGDFN,9)
W !!,"TOTAL: ",CNT
;
QUIT ;
I $E(IOST,1,2)="C-"&('QFLG) S DIR(0)="E" D D ^DIR K DIR
.S SS=22-$Y F JJ=1:1:SS W !
K ^TMP("RGEVPM",$J)
K %,CNT,DA,DFN,DIK,DIR,DOB,DUPCNT,EXCDT,HDT,HOME,ICN,IEN,IEN2,JJ,LCNT,LN,LOCSITE
K NCNT,NODE,OLDDT,OLDNODE,PG,PTNM,QFLG,RCNT,RDT,RGDFN,SS,SSN,VADM,X,XCNT,Y,ZTSK
D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@" Q
;
HDR ;HEADER
I $E(IOST,1,2)="C-" S SS=22-$Y F JJ=1:1:SS W !
I $E(IOST,1,2)="C-",PG>0 S DIR(0)="E" W ! D ^DIR K DIR I 'Y S QFLG=1 Q
S PG=PG+1 W:$Y!($E(IOST,1,2)="C-") @IOF
W !,"PATIENT LIST of Potential Matches to be Resolved",?72,"Page: ",PG
W !,"Printed at ",LOCSITE," on ",HDT
W !!,"Patient Name",?39,"SSN",?52,"DOB",?70,"DFN",!,LN
Q
;
EXCTMP ;Count number of POTENTIAL MATCH type entries (IEN=218) in CIRN HL7 EXCEPTION LOG
;file 991.1, build XTMP global of unique patients and purge dup entries in file.
W !!,"...one moment please..",!
K ^TMP("RGEVPM",$J)
S (RGDFN,CNT,XCNT,DUPCNT)=0
F S RGDFN=$O(^RGHL7(991.1,"ADFN",218,RGDFN)) Q:'RGDFN D
.S IEN=0
.F S IEN=$O(^RGHL7(991.1,"ADFN",218,RGDFN,IEN)) Q:'IEN D
..S IEN2=0
..F S IEN2=$O(^RGHL7(991.1,"ADFN",218,RGDFN,IEN,IEN2)) Q:'IEN2 D
...S CNT=CNT+1
...S EXCDT=$P(^RGHL7(991.1,IEN,0),"^",3)
...I '$D(^TMP("RGEVPM",$J,RGDFN)) D Q
....S XCNT=XCNT+1
....D SETTMP
...I $D(^TMP("RGEVPM",$J,RGDFN)) D
....S OLDNODE=^TMP("RGEVPM",$J,RGDFN)
....S OLDDT=$P(OLDNODE,"^")
....I EXCDT>OLDDT D Q
.....S DA(1)=$P(OLDNODE,"^",2),DA=$P(OLDNODE,"^",3)
.....D DELDUP
.....D SETTMP
....I OLDDT>EXCDT!(OLDDT=EXCDT) D
.....S DA(1)=IEN,DA=IEN2
.....D DELDUP
W !,DUPCNT," duplicate patient entries for POTENTIAL MATCH exceptions were identified"
W !,"and deleted from the CIRN HL7 EXCEPTION LOG file (#991.1)."
Q
;
SETTMP ;set TMP global for patient check
S ^TMP("RGEVPM",$J,RGDFN)=EXCDT_"^"_IEN_"^"_IEN2
Q
;
DELDUP ;delete patient dups from file
S DUPCNT=DUPCNT+1
S DIK="^RGHL7(991.1,"_DA(1)_",1,"
D ^DIK K DIK,DA
Q
;
CURPM() ;Call to check if there are any patients in the CIRN HL7 EXCEPTION LOG
;file (#991.1) with an exception TYPE of "POTENTIAL MATCH" who currently need
;to be resolved to the MPI.
;returns a value of "1" if any are found, "0" if none are found
N LOC,RGDFN,GOT,ICN
S LOC=$P($$SITE^VASITE(),"^",3)
S (GOT,RGDFN)=0
F S RGDFN=$O(^RGHL7(991.1,"ADFN",218,RGDFN)) Q:'RGDFN D Q:GOT
.S ICN=+$$GETICN^MPIF001(RGDFN)
.I $E(ICN,1,3)=LOC!(ICN<0) S GOT=1 Q
I GOT Q 1
Q 0
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRGEVPM 4676 printed Dec 13, 2024@01:41:39 Page 2
RGEVPM ;BIR/CML-VIEW POTENTIAL MATCH PATIENT LIST ;07/20/99
+1 ;;1.0;CLINICAL INFO RESOURCE NETWORK;**1,3,19**;30 Apr 99
+2 SET QFLG=1
BEGIN ;
+1 WRITE !!,"This report prints a list of patients who have been identified as having"
+2 WRITE !,"multiple Potential Matches on the Master Patient Index (MPI) and who haven't"
+3 WRITE !,"yet been resolved using the option ""Single Patient Initialization to MPI""."
+4 WRITE !,"Status is current as of the date/time the report is generated."
+5 WRITE !!,"This data is pulled from the CIRN HL7 EXCEPTION LOG file (#991.1)."
+6 WRITE !,"Prior to producing the report, duplicate POTENTIAL MATCH patients will be"
+7 WRITE !,"purged from the file."
+8 ;
+9 DO EXCTMP
+10 IF XCNT=0
WRITE !!,"There are no patients identified as Potential Matches."
GOTO QUIT
DEV ;
+1 WRITE !!,"The right margin for this report is 80.",!!
+2 DO EN^XUTMDEVQ("START^RGEVPM","MPI/PD - Potential Match Patient List")
IF 'POP
QUIT
+3 WRITE !,"NO DEVICE SELECTED OR REPORT PRINTED!!"
+4 GOTO QUIT
START ;
+1 ;institution file ptr^station name^station number
SET HOME=$$SITE^VASITE()
+2 ;
LOOP ;Search ^RGHL7(991.1,"ADFN" to see how many patients need to be resolved to MPI
+1 KILL ^TMP("RGEVPM",$JOB)
+2 ;
+3 SET (RCNT,RGDFN)=0
+4 FOR
SET RGDFN=$ORDER(^RGHL7(991.1,"ADFN",218,RGDFN))
if 'RGDFN
QUIT
Begin DoDot:1
+5 SET ICN=+$$GETICN^MPIF001(RGDFN)
+6 IF $EXTRACT(ICN,1,3)=$PIECE(HOME,"^",3)!(ICN<0)
Begin DoDot:2
+7 SET RCNT=RCNT+1
+8 SET DFN=RGDFN
DO DEM^VADPT
+9 SET ^TMP("RGEVPM",$JOB,VADM(1),RGDFN)=$PIECE(VADM(2),"^")_"^"_$PIECE(VADM(3),"^",2)
End DoDot:2
End DoDot:1
+10 ;
PRT ;Print report
+1 SET (PG,QFLG)=0
SET $PIECE(LN,"-",81)=""
SET LOCSITE=$PIECE(HOME,"^",2)
+2 DO NOW^%DTC
SET HDT=$$FMTE^XLFDT($EXTRACT(%,1,12))
+3 DO HDR
+4 IF '$DATA(^TMP("RGEVPM",$JOB))
WRITE !!,"No patients found who need to be resolved to the MPI."
GOTO QUIT
+5 ;
+6 ;count the number of patients who need to be resolved
+7 SET PTNM=""
SET CNT=0
+8 FOR
SET PTNM=$ORDER(^TMP("RGEVPM",$JOB,PTNM))
if PTNM=""
QUIT
if QFLG
QUIT
Begin DoDot:1
+9 SET RGDFN=0
+10 FOR
SET RGDFN=$ORDER(^TMP("RGEVPM",$JOB,PTNM,RGDFN))
if 'RGDFN
QUIT
SET CNT=CNT+1
End DoDot:1
+11 ;
+12 SET PTNM=""
+13 FOR
SET PTNM=$ORDER(^TMP("RGEVPM",$JOB,PTNM))
if PTNM=""
QUIT
if QFLG
QUIT
Begin DoDot:1
+14 SET RGDFN=0
+15 FOR
SET RGDFN=$ORDER(^TMP("RGEVPM",$JOB,PTNM,RGDFN))
if 'RGDFN
QUIT
if QFLG
QUIT
Begin DoDot:2
+16 SET SSN=$PIECE(^TMP("RGEVPM",$JOB,PTNM,RGDFN),"^")
+17 SET DOB=$PIECE(^TMP("RGEVPM",$JOB,PTNM,RGDFN),"^",2)
+18 if $Y+4>IOSL
DO HDR
if QFLG
QUIT
WRITE !,PTNM,?36,SSN,?50,DOB,?68,$JUSTIFY(RGDFN,9)
End DoDot:2
End DoDot:1
+19 WRITE !!,"TOTAL: ",CNT
+20 ;
QUIT ;
+1 IF $EXTRACT(IOST,1,2)="C-"&('QFLG)
SET DIR(0)="E"
Begin DoDot:1
+2 SET SS=22-$Y
FOR JJ=1:1:SS
WRITE !
End DoDot:1
DO ^DIR
KILL DIR
+3 KILL ^TMP("RGEVPM",$JOB)
+4 KILL %,CNT,DA,DFN,DIK,DIR,DOB,DUPCNT,EXCDT,HDT,HOME,ICN,IEN,IEN2,JJ,LCNT,LN,LOCSITE
+5 KILL NCNT,NODE,OLDDT,OLDNODE,PG,PTNM,QFLG,RCNT,RDT,RGDFN,SS,SSN,VADM,X,XCNT,Y,ZTSK
+6 DO ^%ZISC
if $DATA(ZTQUEUED)
SET ZTREQ="@"
QUIT
+7 ;
HDR ;HEADER
+1 IF $EXTRACT(IOST,1,2)="C-"
SET SS=22-$Y
FOR JJ=1:1:SS
WRITE !
+2 IF $EXTRACT(IOST,1,2)="C-"
IF PG>0
SET DIR(0)="E"
WRITE !
DO ^DIR
KILL DIR
IF 'Y
SET QFLG=1
QUIT
+3 SET PG=PG+1
if $Y!($EXTRACT(IOST,1,2)="C-")
WRITE @IOF
+4 WRITE !,"PATIENT LIST of Potential Matches to be Resolved",?72,"Page: ",PG
+5 WRITE !,"Printed at ",LOCSITE," on ",HDT
+6 WRITE !!,"Patient Name",?39,"SSN",?52,"DOB",?70,"DFN",!,LN
+7 QUIT
+8 ;
EXCTMP ;Count number of POTENTIAL MATCH type entries (IEN=218) in CIRN HL7 EXCEPTION LOG
+1 ;file 991.1, build XTMP global of unique patients and purge dup entries in file.
+2 WRITE !!,"...one moment please..",!
+3 KILL ^TMP("RGEVPM",$JOB)
+4 SET (RGDFN,CNT,XCNT,DUPCNT)=0
+5 FOR
SET RGDFN=$ORDER(^RGHL7(991.1,"ADFN",218,RGDFN))
if 'RGDFN
QUIT
Begin DoDot:1
+6 SET IEN=0
+7 FOR
SET IEN=$ORDER(^RGHL7(991.1,"ADFN",218,RGDFN,IEN))
if 'IEN
QUIT
Begin DoDot:2
+8 SET IEN2=0
+9 FOR
SET IEN2=$ORDER(^RGHL7(991.1,"ADFN",218,RGDFN,IEN,IEN2))
if 'IEN2
QUIT
Begin DoDot:3
+10 SET CNT=CNT+1
+11 SET EXCDT=$PIECE(^RGHL7(991.1,IEN,0),"^",3)
+12 IF '$DATA(^TMP("RGEVPM",$JOB,RGDFN))
Begin DoDot:4
+13 SET XCNT=XCNT+1
+14 DO SETTMP
End DoDot:4
QUIT
+15 IF $DATA(^TMP("RGEVPM",$JOB,RGDFN))
Begin DoDot:4
+16 SET OLDNODE=^TMP("RGEVPM",$JOB,RGDFN)
+17 SET OLDDT=$PIECE(OLDNODE,"^")
+18 IF EXCDT>OLDDT
Begin DoDot:5
+19 SET DA(1)=$PIECE(OLDNODE,"^",2)
SET DA=$PIECE(OLDNODE,"^",3)
+20 DO DELDUP
+21 DO SETTMP
End DoDot:5
QUIT
+22 IF OLDDT>EXCDT!(OLDDT=EXCDT)
Begin DoDot:5
+23 SET DA(1)=IEN
SET DA=IEN2
+24 DO DELDUP
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+25 WRITE !,DUPCNT," duplicate patient entries for POTENTIAL MATCH exceptions were identified"
+26 WRITE !,"and deleted from the CIRN HL7 EXCEPTION LOG file (#991.1)."
+27 QUIT
+28 ;
SETTMP ;set TMP global for patient check
+1 SET ^TMP("RGEVPM",$JOB,RGDFN)=EXCDT_"^"_IEN_"^"_IEN2
+2 QUIT
+3 ;
DELDUP ;delete patient dups from file
+1 SET DUPCNT=DUPCNT+1
+2 SET DIK="^RGHL7(991.1,"_DA(1)_",1,"
+3 DO ^DIK
KILL DIK,DA
+4 QUIT
+5 ;
CURPM() ;Call to check if there are any patients in the CIRN HL7 EXCEPTION LOG
+1 ;file (#991.1) with an exception TYPE of "POTENTIAL MATCH" who currently need
+2 ;to be resolved to the MPI.
+3 ;returns a value of "1" if any are found, "0" if none are found
+4 NEW LOC,RGDFN,GOT,ICN
+5 SET LOC=$PIECE($$SITE^VASITE(),"^",3)
+6 SET (GOT,RGDFN)=0
+7 FOR
SET RGDFN=$ORDER(^RGHL7(991.1,"ADFN",218,RGDFN))
if 'RGDFN
QUIT
Begin DoDot:1
+8 SET ICN=+$$GETICN^MPIF001(RGDFN)
+9 IF $EXTRACT(ICN,1,3)=LOC!(ICN<0)
SET GOT=1
QUIT
End DoDot:1
if GOT
QUIT
+10 IF GOT
QUIT 1
+11 QUIT 0
