Changeset 636 for FOIAVistA/tag/r/CLINICAL_INFO_RESOURCE_NETWORK-MRF-RGE--RG--RGED--RGUT--RGWB/RGEVPRG.m

Timestamp:

Dec 4, 2009, 8:26:01 PM (14 years ago)

Author:

George Lilly

Message:

WorldVistAEHR overlayed on FOIAVistA

Location:

FOIAVistA/tag/r

Files:

• . (copied) (copied from FOIAVistA/trunk/r )
• CLINICAL_INFO_RESOURCE_NETWORK-MRF-RGE--RG--RGED--RGUT--RGWB/RGEVPRG.m (modified) (3 diffs)

FOIAVistA/tag/r/CLINICAL_INFO_RESOURCE_NETWORK-MRF-RGE--RG--RGED--RGUT--RGWB/RGEVPRG.m

@@ -1 +1 @@
 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 +108 @@
  ;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 +119 @@
  ... 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.