Index: FOIAVistA/tag/r/CLINICAL_INFO_RESOURCE_NETWORK-MRF-RGE--RG--RGED--RGUT--RGWB/RGEVPRG.m
===================================================================
--- FOIAVistA/trunk/r/CLINICAL_INFO_RESOURCE_NETWORK-MRF-RGE--RG--RGED--RGUT--RGWB/RGEVPRG.m	(revision 631)
+++ FOIAVistA/tag/r/CLINICAL_INFO_RESOURCE_NETWORK-MRF-RGE--RG--RGED--RGUT--RGWB/RGEVPRG.m	(revision 636)
@@ -1,4 +1,4 @@
 RGEVPRG ;BAY/ALS-OPTIONS TO PURGE MPI/PD EXCEPTIONS ;08/23/99
- ;;1.0;CLINICAL INFO RESOURCE NETWORK;**3,12,19,32,35,43,44,50**;30 Apr 99;Build 3
+ ;;1.0;CLINICAL INFO RESOURCE NETWORK;**3,12,19,32,35,43,44**;30 Apr 99;Build 8
  ;
 MAIN ;
@@ -108,9 +108,9 @@
  ;K ETYPE,CNT,IEN,IEN2,NUM,X,Y
  ;Q
-PRGDUP ;Purge Duplicate Entries; retain most recent for all except types.
- ;**50 through remainder of module.
+PRGDUP ; Purge Duplicate Entries; retain most recent for all types except 234.
  S EXCTYP="",CNT=0
  K ^TMP("RGEVDUP",$J)
  F  S EXCTYP=$O(^RGHL7(991.1,"ADFN",EXCTYP)) Q:'EXCTYP  D
+ . I EXCTYP=234 Q  ;**44 process 234s separately below
  . S RGDFN=""
  . F  S RGDFN=$O(^RGHL7(991.1,"ADFN",EXCTYP,RGDFN)) Q:'RGDFN  D
@@ -119,27 +119,69 @@
  ... S IEN2=0
  ... F  S IEN2=$O(^RGHL7(991.1,"ADFN",EXCTYP,RGDFN,IEN,IEN2)) Q:'IEN2  D
- .... I $P($G(^RGHL7(991.1,IEN,1,IEN2,0)),"^",5)=1 K ^RGHL7(991.1,"ADFN",EXCTYP,RGDFN,IEN,IEN2) Q  ;exception processed
- .... S EXCDT=$P($G(^RGHL7(991.1,IEN,0)),"^",3) ;incoming date
+ .... S EXCDT=$P(^RGHL7(991.1,IEN,0),"^",3)
  .... I '$D(^TMP("RGEVDUP",$J,RGDFN,EXCTYP)) D  Q
  ..... S ^TMP("RGEVDUP",$J,RGDFN,EXCTYP)=EXCDT_"^"_IEN_"^"_IEN2
- .... I $D(^TMP("RGEVDUP",$J,RGDFN,EXCTYP)) D  ;duplicate exists; compare incoming to previous.
+ .... I $D(^TMP("RGEVDUP",$J,RGDFN,EXCTYP)) D
  ..... S OLDNODE=^TMP("RGEVDUP",$J,RGDFN,EXCTYP)
- ..... S OLDDT=$P(OLDNODE,"^"),OLDIEN=$P(OLDNODE,"^",2),OLDIEN2=$P(OLDNODE,"^",3)
- ..... I EXCDT>OLDDT D  Q  ;incoming date greater than previous? purge old, keep new.
+ ..... S OLDDT=$P(OLDNODE,"^")
+ ..... I EXCDT>OLDDT D  Q
  ...... S NUM="" S NUM=$P(^RGHL7(991.1,IEN,1,0),"^",4)
- ...... I NUM=1 S DIK="^RGHL7(991.1,",DA=OLDIEN D ^DIK K DIK,DA
- ...... I NUM>1 D
- ....... S DA(1)=OLDIEN,DA=OLDIEN2
+ ...... I NUM=1 S DIK="^RGHL7(991.1,",DA=$P(OLDNODE,"^",2) D ^DIK K DIK,DA
+ ...... E  I NUM>1 D
+ ....... S DA(1)=$P(OLDNODE,"^",2),DA=$P(OLDNODE,"^",3)
  ....... S DIK="^RGHL7(991.1,"_DA(1)_",1," D ^DIK K DIK,DA
+ ...... S CNT=CNT+1
  ...... S ^TMP("RGEVDUP",$J,RGDFN,EXCTYP)=EXCDT_"^"_IEN_"^"_IEN2
- ..... ;
- ..... I OLDDT>EXCDT!(OLDDT=EXCDT) D  ;previous date greater or equal incoming? purge new, keep old.
+ ..... I OLDDT>EXCDT!(OLDDT=EXCDT) D
  ...... S NUM="" S NUM=$P(^RGHL7(991.1,IEN,1,0),"^",4)
- ...... I NUM=1 S DIK="^RGHL7(991.1,",DA=IEN D ^DIK K DIK,DA
- ...... I NUM>1 D DEL
- ...... ;
- K CNT,EXCDT,EXCTYP,IEN,IEN2,NUM,OLDDT,OLDIEN,OLDIEN2,OLDNODE,RGDFN,RGDT,^TMP("RGEVDUP")
- Q
- ;
+ ...... I NUM=1 S DIK="^RGHL7(991.1,",DA=IEN D ^DIK K DIK,DA S CNT=CNT+1
+ ...... E  I NUM>1 D DEL
+ ; W !,CNT_" Duplicate entries"
+ ;Process PRIMARY VIEW REJECT (234) duplicates; purge if for SAME day.
+ ;**44 through remainder of module.
+ K ^TMP("RGDFNDT",$J) S RGDFN=""
+ F  S RGDFN=$O(^RGHL7(991.1,"ADFN",234,RGDFN)) Q:'RGDFN  D
+ .S IEN=0
+ .F  S IEN=$O(^RGHL7(991.1,"ADFN",234,RGDFN,IEN)) Q:'IEN  D
+ ..S IEN2=0
+ ..F  S IEN2=$O(^RGHL7(991.1,"ADFN",234,RGDFN,IEN,IEN2)) Q:'IEN2  D
+ ...S EXCDT=$P(^RGHL7(991.1,IEN,0),"^",3)
+ ...;How many for each DFN? Store in ^TMP("RGDFNDT")
+ ...I '$D(^TMP("RGDFNDT",$J,RGDFN)) S ^TMP("RGDFNDT",$J,RGDFN)=0
+ ...I $D(^TMP("RGDFNDT",$J,RGDFN)) D
+ ....S ^TMP("RGDFNDT",$J,RGDFN)=^TMP("RGDFNDT",$J,RGDFN)+1
+ ....S ^TMP("RGDFNDT",$J,RGDFN,IEN,IEN2)=$P(EXCDT,".") ;date only/no time
+ ;If RGDFN has more than 1 exception, see if any are for same DAY.
+ ;Process the ^TMP("RGDFNDT",$J global to build LOC array.
+ I $D(^TMP("RGDFNDT",$J)) D
+ .S RGDFN=""
+ .F  S RGDFN=$O(^TMP("RGDFNDT",$J,RGDFN)) Q:'RGDFN  D
+ ..;If only one 234 exception for DFN ignore it.
+ ..I ^TMP("RGDFNDT",$J,RGDFN)=1 Q
+ ..;More than one for this DFN?  How many for same day?
+ ..S IEN=0 K LOC
+ ..F  S IEN=$O(^TMP("RGDFNDT",$J,RGDFN,IEN)) Q:'IEN  D
+ ...S (IEN2,VAL)=0
+ ...F  S IEN2=$O(^TMP("RGDFNDT",$J,RGDFN,IEN,IEN2)) Q:'IEN2  D
+ ....S VAL=$P(^TMP("RGDFNDT",$J,RGDFN,IEN,IEN2),"^")
+ ....I '$D(LOC(VAL)) S LOC(VAL)=0
+ ....I $D(LOC(VAL)) D
+ .....S LOC(VAL)=LOC(VAL)+1
+ .....S LOC(VAL,IEN,IEN2)=""
+ ..;Process the LOC array; contains numbers / day / DFN.
+ ..;If only 1 exception / day, keep it.
+ ..S RGDT=0 K CTR,TOT
+ ..F  S RGDT=$O(LOC(RGDT)) Q:'RGDT  D
+ ...S TOT=LOC(RGDT)
+ ...I TOT=1 K TOT Q  ;only 1.
+ ...;More than 1, delete all except 1.
+ ...S TOT=TOT-1 ;leave 1; doesn't matter which - all are same day.
+ ...S IEN=0,CTR=0
+ ...F  S IEN=$O(LOC(RGDT,IEN)) Q:'IEN  D
+ ....I CTR=TOT Q
+ ....S CTR=CTR+1,IEN2=0
+ ....F  S IEN2=$O(LOC(RGDT,IEN,IEN2)) Q:'IEN2  D DEL ;delete entry
+ K CNT,CTR,EXCDT,IEN,IEN2,LOC,NUM,OLDDT,OLDNODE,RGDFN,RGDT,TOT,VAL,^TMP("RGDFNDT")
+ Q
 PRGZZ ;Purge if name field is null (incomplete record)
  ;Purge if -9 node exists, this indicates the record has been merged.
Index: FOIAVistA/tag/r/CLINICAL_INFO_RESOURCE_NETWORK-MRF-RGE--RG--RGED--RGUT--RGWB/RGEX06.m
===================================================================
--- FOIAVistA/trunk/r/CLINICAL_INFO_RESOURCE_NETWORK-MRF-RGE--RG--RGED--RGUT--RGWB/RGEX06.m	(revision 631)
+++ FOIAVistA/tag/r/CLINICAL_INFO_RESOURCE_NETWORK-MRF-RGE--RG--RGED--RGUT--RGWB/RGEX06.m	(revision 636)
@@ -1,4 +1,4 @@
 RGEX06 ;BIR/PTD-LIST MANAGER ROUTINE FOR REMOTE MPI PRIMARY VIEW PDAT ;5/17/07
- ;;1.0;CLINICAL INFO RESOURCE NETWORK;**48,53**;30 Apr 99;Build 2
+ ;;1.0;CLINICAL INFO RESOURCE NETWORK;**48**;30 Apr 99;Build 3
  ;
  ;Reference to ^XWB2HL7 supported by IA #3144
@@ -18,7 +18,7 @@
  I '$D(ICN) G EXIT
  S LIN=1,X=0,STR="",TXT=""
- I '$D(^XTMP("RGPVMPI"_ICN,"DATA")) S TXT=" - No MPI Primary View data exists for this patient." D ADDTMP
+ I '$D(^XTMP("RGPVMPI",ICN)) S TXT=" - No MPI Primary View data exists for this patient." D ADDTMP
  N STATUS,R,RETURN,RESULT,RET
- I $D(^XTMP("RGPVMPI"_ICN,"DATA")) S RETURN(0)=$P(^XTMP("RGPVMPI"_ICN,"DATA"),"^") D
+ I $D(^XTMP("RGPVMPI",ICN)) S RETURN(0)=$P(^XTMP("RGPVMPI",ICN),"^") D
  .D RPCCHK^XWB2HL7(.RESULT,RETURN(0)) I +RESULT(0)=1 D
  ..;Retrieve the data
@@ -51,7 +51,7 @@
  ;
 SAPV(ICN) ;Print stand alone Primary View display
- I '$D(^XTMP("RGPVMPI"_ICN,"DATA")) W !," - No MPI Primary View data exists for this patient." Q
+ I '$D(^XTMP("RGPVMPI",ICN)) W !," - No MPI Primary View data exists for this patient." Q
  N STATUS,R,RETURN,RESULT,RET
- I $D(^XTMP("RGPVMPI"_ICN,"DATA")) S RETURN(0)=$P(^XTMP("RGPVMPI"_ICN,"DATA"),"^") D
+ I $D(^XTMP("RGPVMPI",ICN)) S RETURN(0)=$P(^XTMP("RGPVMPI",ICN),"^") D
  .D RPCCHK^XWB2HL7(.RESULT,RETURN(0)) I +RESULT(0)=1 D
  ..;Retrieve the data
Index: FOIAVistA/tag/r/CLINICAL_INFO_RESOURCE_NETWORK-MRF-RGE--RG--RGED--RGUT--RGWB/RGEX07.m
===================================================================
--- FOIAVistA/trunk/r/CLINICAL_INFO_RESOURCE_NETWORK-MRF-RGE--RG--RGED--RGUT--RGWB/RGEX07.m	(revision 631)
+++ FOIAVistA/tag/r/CLINICAL_INFO_RESOURCE_NETWORK-MRF-RGE--RG--RGED--RGUT--RGWB/RGEX07.m	(revision 636)
@@ -1,4 +1,4 @@
 RGEX07 ;BIR/PTD-LIST MANAGER ROUTINE FOR REMOTE PRIMARY VIEW DISPLAY ;10/17/06
- ;;1.0;CLINICAL INFO RESOURCE NETWORK;**44,53**;30 Apr 99;Build 2
+ ;;1.0;CLINICAL INFO RESOURCE NETWORK;**44**;30 Apr 99;Build 8
  ;
  ;Reference to ^XWB2HL7 supported by IA #3144
@@ -19,7 +19,7 @@
  I '$D(EXCDT) G EXIT
  S LIN=1,X=0,STR="",TXT=""
- I '$D(^XTMP("RGPVREJ"_ICN,EXCDT)) S TXT=" - No Primary View Reject data exists for this patient/exception date." D ADDTMP
+ I '$D(^XTMP("RGPVREJ",ICN,EXCDT)) S TXT=" - No Primary View Reject data exists for this patient/exception date." D ADDTMP
  N STATUS,R,RETURN,RESULT,RET
- I $D(^XTMP("RGPVREJ"_ICN,EXCDT)) S RETURN(0)=$P(^XTMP("RGPVREJ"_ICN,EXCDT),"^") D
+ I $D(^XTMP("RGPVREJ",ICN,EXCDT)) S RETURN(0)=$P(^XTMP("RGPVREJ",ICN,EXCDT),"^") D
  .D RPCCHK^XWB2HL7(.RESULT,RETURN(0)) I +RESULT(0)=1 D
  ..;Retrieve the data
