source: FOIAVistA/trunk/r/CLINICAL_INFO_RESOURCE_NETWORK-MRF-RGE--RG--RGED--RGUT--RGWB/RGEVPM.m@ 1398

Last change on this file since 1398 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 4.4 KB
Line 
1RGEVPM ;BIR/CML-VIEW POTENTIAL MATCH PATIENT LIST ;07/20/99
2 ;;1.0;CLINICAL INFO RESOURCE NETWORK;**1,3,19**;30 Apr 99
3 S QFLG=1
4BEGIN ;
5 W !!,"This report prints a list of patients who have been identified as having"
6 W !,"multiple Potential Matches on the Master Patient Index (MPI) and who haven't"
7 W !,"yet been resolved using the option ""Single Patient Initialization to MPI""."
8 W !,"Status is current as of the date/time the report is generated."
9 W !!,"This data is pulled from the CIRN HL7 EXCEPTION LOG file (#991.1)."
10 W !,"Prior to producing the report, duplicate POTENTIAL MATCH patients will be"
11 W !,"purged from the file."
12 ;
13 D EXCTMP
14 I XCNT=0 W !!,"There are no patients identified as Potential Matches." G QUIT
15DEV ;
16 W !!,"The right margin for this report is 80.",!!
17 D EN^XUTMDEVQ("START^RGEVPM","MPI/PD - Potential Match Patient List") I 'POP Q
18 W !,"NO DEVICE SELECTED OR REPORT PRINTED!!"
19 G QUIT
20START ;
21 S HOME=$$SITE^VASITE() ;institution file ptr^station name^station number
22 ;
23LOOP ;Search ^RGHL7(991.1,"ADFN" to see how many patients need to be resolved to MPI
24 K ^TMP("RGEVPM",$J)
25 ;
26 S (RCNT,RGDFN)=0
27 F S RGDFN=$O(^RGHL7(991.1,"ADFN",218,RGDFN)) Q:'RGDFN D
28 .S ICN=+$$GETICN^MPIF001(RGDFN)
29 .I $E(ICN,1,3)=$P(HOME,"^",3)!(ICN<0) D
30 ..S RCNT=RCNT+1
31 ..S DFN=RGDFN D DEM^VADPT
32 ..S ^TMP("RGEVPM",$J,VADM(1),RGDFN)=$P(VADM(2),"^")_"^"_$P(VADM(3),"^",2)
33 ;
34PRT ;Print report
35 S (PG,QFLG)=0,$P(LN,"-",81)="",LOCSITE=$P(HOME,"^",2)
36 D NOW^%DTC S HDT=$$FMTE^XLFDT($E(%,1,12))
37 D HDR
38 I '$D(^TMP("RGEVPM",$J)) W !!,"No patients found who need to be resolved to the MPI." G QUIT
39 ;
40 ;count the number of patients who need to be resolved
41 S PTNM="",CNT=0
42 F S PTNM=$O(^TMP("RGEVPM",$J,PTNM)) Q:PTNM="" Q:QFLG D
43 .S RGDFN=0
44 .F S RGDFN=$O(^TMP("RGEVPM",$J,PTNM,RGDFN)) Q:'RGDFN S CNT=CNT+1
45 ;
46 S PTNM=""
47 F S PTNM=$O(^TMP("RGEVPM",$J,PTNM)) Q:PTNM="" Q:QFLG D
48 .S RGDFN=0
49 .F S RGDFN=$O(^TMP("RGEVPM",$J,PTNM,RGDFN)) Q:'RGDFN Q:QFLG D
50 ..S SSN=$P(^TMP("RGEVPM",$J,PTNM,RGDFN),"^")
51 ..S DOB=$P(^TMP("RGEVPM",$J,PTNM,RGDFN),"^",2)
52 ..D:$Y+4>IOSL HDR Q:QFLG W !,PTNM,?36,SSN,?50,DOB,?68,$J(RGDFN,9)
53 W !!,"TOTAL: ",CNT
54 ;
55QUIT ;
56 I $E(IOST,1,2)="C-"&('QFLG) S DIR(0)="E" D D ^DIR K DIR
57 .S SS=22-$Y F JJ=1:1:SS W !
58 K ^TMP("RGEVPM",$J)
59 K %,CNT,DA,DFN,DIK,DIR,DOB,DUPCNT,EXCDT,HDT,HOME,ICN,IEN,IEN2,JJ,LCNT,LN,LOCSITE
60 K NCNT,NODE,OLDDT,OLDNODE,PG,PTNM,QFLG,RCNT,RDT,RGDFN,SS,SSN,VADM,X,XCNT,Y,ZTSK
61 D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@" Q
62 ;
63HDR ;HEADER
64 I $E(IOST,1,2)="C-" S SS=22-$Y F JJ=1:1:SS W !
65 I $E(IOST,1,2)="C-",PG>0 S DIR(0)="E" W ! D ^DIR K DIR I 'Y S QFLG=1 Q
66 S PG=PG+1 W:$Y!($E(IOST,1,2)="C-") @IOF
67 W !,"PATIENT LIST of Potential Matches to be Resolved",?72,"Page: ",PG
68 W !,"Printed at ",LOCSITE," on ",HDT
69 W !!,"Patient Name",?39,"SSN",?52,"DOB",?70,"DFN",!,LN
70 Q
71 ;
72EXCTMP ;Count number of POTENTIAL MATCH type entries (IEN=218) in CIRN HL7 EXCEPTION LOG
73 ;file 991.1, build XTMP global of unique patients and purge dup entries in file.
74 W !!,"...one moment please..",!
75 K ^TMP("RGEVPM",$J)
76 S (RGDFN,CNT,XCNT,DUPCNT)=0
77 F S RGDFN=$O(^RGHL7(991.1,"ADFN",218,RGDFN)) Q:'RGDFN D
78 .S IEN=0
79 .F S IEN=$O(^RGHL7(991.1,"ADFN",218,RGDFN,IEN)) Q:'IEN D
80 ..S IEN2=0
81 ..F S IEN2=$O(^RGHL7(991.1,"ADFN",218,RGDFN,IEN,IEN2)) Q:'IEN2 D
82 ...S CNT=CNT+1
83 ...S EXCDT=$P(^RGHL7(991.1,IEN,0),"^",3)
84 ...I '$D(^TMP("RGEVPM",$J,RGDFN)) D Q
85 ....S XCNT=XCNT+1
86 ....D SETTMP
87 ...I $D(^TMP("RGEVPM",$J,RGDFN)) D
88 ....S OLDNODE=^TMP("RGEVPM",$J,RGDFN)
89 ....S OLDDT=$P(OLDNODE,"^")
90 ....I EXCDT>OLDDT D Q
91 .....S DA(1)=$P(OLDNODE,"^",2),DA=$P(OLDNODE,"^",3)
92 .....D DELDUP
93 .....D SETTMP
94 ....I OLDDT>EXCDT!(OLDDT=EXCDT) D
95 .....S DA(1)=IEN,DA=IEN2
96 .....D DELDUP
97 W !,DUPCNT," duplicate patient entries for POTENTIAL MATCH exceptions were identified"
98 W !,"and deleted from the CIRN HL7 EXCEPTION LOG file (#991.1)."
99 Q
100 ;
101SETTMP ;set TMP global for patient check
102 S ^TMP("RGEVPM",$J,RGDFN)=EXCDT_"^"_IEN_"^"_IEN2
103 Q
104 ;
105DELDUP ;delete patient dups from file
106 S DUPCNT=DUPCNT+1
107 S DIK="^RGHL7(991.1,"_DA(1)_",1,"
108 D ^DIK K DIK,DA
109 Q
110 ;
111CURPM() ;Call to check if there are any patients in the CIRN HL7 EXCEPTION LOG
112 ;file (#991.1) with an exception TYPE of "POTENTIAL MATCH" who currently need
113 ;to be resolved to the MPI.
114 ;returns a value of "1" if any are found, "0" if none are found
115 N LOC,RGDFN,GOT,ICN
116 S LOC=$P($$SITE^VASITE(),"^",3)
117 S (GOT,RGDFN)=0
118 F S RGDFN=$O(^RGHL7(991.1,"ADFN",218,RGDFN)) Q:'RGDFN D Q:GOT
119 .S ICN=+$$GETICN^MPIF001(RGDFN)
120 .I $E(ICN,1,3)=LOC!(ICN<0) S GOT=1 Q
121 I GOT Q 1
122 Q 0
Note: See TracBrowser for help on using the repository browser.