- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/ZZREGIONAL-A1C-A5C-CRHD-RGED-RGUT-RGWB-RG/RGMTETOT.m
r613 r623 1 RGMTETOT ;BIR/CML-Compile Totals for Site Exceptions ;11/15/01 2 ;;1.0;CLINICAL INFO RESOURCE NETWORK;**20,30,43,45,52**;30 Apr 99;Build 2 3 ; 4 ;Reference to ^DPT("AICNL" supported by IA #2070 5 ; 6 ;Variable RGHLMQ cannot be killed in this routine, it is needed for the remote query 7 ; 8 ;Use this routine to compile totals of a site's exceptions in file #991.1 9 S DUMP=0 G START 10 ; 11 DUMP1 ;Use this call to dump all data in ascii format for table 12 S DUMP=1 G START 13 ; 14 DUMP2 ;Use this call to dump data in ascii format for table - just for exceptions sites have to deal with 15 S DUMP=2 16 ; 17 START ; 18 ;do purge of any dups for POTENTIAL MATCH Exceptions 19 K TYPEARR,^XTMP("RGMT","HLMQETOT") 20 S ^XTMP("RGMT",0)=$$FMADD^XLFDT(DT,30)_"^"_$$NOW^XLFDT_"^MPI/PD Maintenance Data" 21 D PURGE 22 ;create type array from file 991.11 23 S TYPE=233 F S TYPE=$O(^RGHL7(991.11,TYPE)) Q:'TYPE I TYPE'=218 S TYPEARR(TYPE)=0 ;MPIC_772; **52 remove 215, 216, and 217 24 ; 25 ;start loop 26 S TYPE=233 F S TYPE=$O(^RGHL7(991.1,"AC",TYPE)) Q:'TYPE D ;MPIC_772; **52 remove 215, 216, and 217 27 .Q:TYPE=218 28 .S IEN1=0 F S IEN1=$O(^RGHL7(991.1,"AC",TYPE,IEN1)) Q:'IEN1 D 29 ..S IEN2=0 F S IEN2=$O(^RGHL7(991.1,"AC",TYPE,IEN1,IEN2)) Q:'IEN2 D 30 ...I '$D(^RGHL7(991.1,IEN1,1,IEN2,0)) Q 31 ...S STAT=$P(^RGHL7(991.1,IEN1,1,IEN2,0),"^",5) I STAT<1 S TYPEARR(TYPE)=TYPEARR(TYPE)+1 32 ; 33 PRT ; 34 S GRAND=0 35 S SITENM=$P($$SITE^VASITE(),"^",2),$P(LN,"-",81)="" 36 D NOW^%DTC S RUNDT=$$FMTE^XLFDT($E(%,1,12)) 37 ; 38 PRT0 I 'DUMP D 39 .W !!,"Exception Totals for ",SITENM 40 .W !,"Printed ",RUNDT,!,LN 41 .S TYPE=0 F S TYPE=$O(TYPEARR(TYPE)) Q:'TYPE I +TYPEARR(TYPE) D 42 ..S GRAND=GRAND+TYPEARR(TYPE) 43 ..W !!,"TYPE: ",TYPE,?12,$P($T(@TYPE),";;",2),?67,"TOTAL = ",$J(TYPEARR(TYPE),4) 44 ..W !,"DESCRIPTION:" 45 ..S TXT=0 F S TXT=$O(^RGHL7(991.11,TYPE,99,TXT)) Q:'TXT W !,^RGHL7(991.11,TYPE,99,TXT,0) 46 .W !!?56,"TOTAL EXCEPTIONS: ",$J(GRAND,5) 47 ; 48 PRT1 I DUMP=1 D 49 .W !!,"At this point it is necessary for you to increase the right margin." 50 .W !,"At the DEVICE prompt enter=> ;255" 51 .W ! D ^%ZIS I POP W !,"DOWNLOAD ABORTED!" Q 52 .W !!,"Data string=Site;Run Date;Date CIRN Installed;Exceptions 218 & 234" ;MPIC_772; **52 remove 215, 216, and 217 53 .S STR=SITENM_";"_RUNDT_";" 54 .S TYPE=0 F S TYPE=$O(TYPEARR(TYPE)) Q:'TYPE D 55 ..S STR=STR_";"_TYPEARR(TYPE) 56 .W !!,STR 57 ; 58 PRT2 I DUMP=2 D 59 .S ICN=0,LOCCNT=0 F S ICN=$O(^DPT("AICNL",1,ICN)) Q:'ICN S LOCCNT=LOCCNT+1 60 .S SITEIEN=+$$SITE^VASITE(),STANUM=$P($$SITE^VASITE(),"^",3) 61 .I '$D(RGHLMQ) W !!,"Data string:" 62 .I '$D(RGHLMQ) W !,"Site;Sta#;;;LocICNs,218,234" ;MPIC_772; **52 remove 215, 216, and 217 63 .S STR=SITENM_";"_STANUM_";;;"_LOCCNT 64 .F TYPE=218,234 S STR=STR_";"_TYPEARR(TYPE) ;MPIC_772; **52 remove 215, 216, and 217 65 .I '$D(RGHLMQ) W !!,STR 66 .I $D(RGHLMQ) S ^XTMP("RGMT","HLMQETOT",STANUM,1)=STR 67 ; 68 QUIT ; 69 K %,CIRNIEN,CNT,DA,DIK,DUMP,DUPCNT,EXCDT,GRAND,ICN,IEN,IEN1,IEN2,LN,LOCCNT,OLDDT,OLDNODE,PTNM 70 K RGDFN,RUNDT,SITEIEN,SITENM,STANUM,STAT,STR,TXT,TYPE,XCNT,HOME,DFN,RCNT,VADM 71 K ^XTMP("RGMT","ETOT") 72 Q 73 ; 74 PURGE ; 75 I '$D(RGHLMQ) W !!,"...purging duplicate Potential Match Exceptions",! 76 K ^XTMP("RGMT","ETOT") 77 S (RGDFN,CNT,XCNT,DUPCNT)=0,HOME=$$SITE^VASITE() 78 F S RGDFN=$O(^RGHL7(991.1,"ADFN",218,RGDFN)) Q:'RGDFN D 79 .S IEN=0 80 .F S IEN=$O(^RGHL7(991.1,"ADFN",218,RGDFN,IEN)) Q:'IEN D 81 ..S IEN2=0 82 ..F S IEN2=$O(^RGHL7(991.1,"ADFN",218,RGDFN,IEN,IEN2)) Q:'IEN2 D 83 ...I '$D(^RGHL7(991.1,IEN,0)) Q 84 ...S CNT=CNT+1 85 ...S EXCDT=$P(^RGHL7(991.1,IEN,0),"^",3) 86 ...I '$D(^XTMP("RGMT","ETOT",RGDFN)) D Q 87 ....S XCNT=XCNT+1 88 ....D SETTMP 89 ...I $D(^XTMP("RGMT","ETOT",RGDFN)) D 90 ....S OLDNODE=^XTMP("RGMT","ETOT",RGDFN) 91 ....S OLDDT=$P(OLDNODE,"^") 92 ....I EXCDT>OLDDT D Q 93 .....S DA(1)=$P(OLDNODE,"^",2),DA=$P(OLDNODE,"^",3) 94 .....D DELDUP 95 .....D SETTMP 96 ....I OLDDT>EXCDT!(OLDDT=EXCDT) D 97 .....S DA(1)=IEN,DA=IEN2 98 .....D DELDUP 99 I '$D(RGHLMQ) W !,DUPCNT," duplicate patient entries for POTENTIAL MATCH exceptions were identified" 100 I '$D(RGHLMQ) W !,"and deleted from the CIRN HL7 EXCEPTION LOG file (#991.1)." 101 ; 102 K ^XTMP("RGMT","ETOT") 103 S (RCNT,RGDFN)=0 N IEN,SUB 104 F S RGDFN=$O(^RGHL7(991.1,"ADFN",218,RGDFN)) Q:'RGDFN D 105 .;S ICN=+$$GETICN^MPIF001(RGDFN) 106 .;I $E(ICN,1,3)=$P(HOME,"^",3)!(ICN<0) D 107 .;**43 shouldn't check for locals or no ICN, check for processed/not processed 108 .S IEN=0 F S IEN=$O(^RGHL7(991.1,"ADFN",218,RGDFN,IEN)) Q:IEN="" D 109 ..S SUB=$O(^RGHL7(991.1,"ADFN",218,RGDFN,IEN,"")) 110 ..I $P($G(^RGHL7(991.1,IEN,1,SUB,0)),"^",5)=0 D 111 ...S DFN=RGDFN D DEM^VADPT 112 ...I VADM(1)=""!(VADM(2)="") Q 113 ...S RCNT=RCNT+1 114 ...S ^XTMP("RGMT","ETOT",VADM(1),RGDFN)=$P(VADM(2),"^")_"^"_$P(VADM(3),"^",2) 115 ; 116 ;count the number of patients who need to be resolved 117 S PTNM="",CNT=0 118 F S PTNM=$O(^XTMP("RGMT","ETOT",PTNM)) Q:PTNM="" D 119 .S RGDFN=0 120 .F S RGDFN=$O(^XTMP("RGMT","ETOT",PTNM,RGDFN)) Q:'RGDFN S CNT=CNT+1 121 S TYPEARR(218)=CNT 122 Q 123 ; 124 SETTMP ;set TMP global for patient check 125 S ^XTMP("RGMT","ETOT",RGDFN)=EXCDT_"^"_IEN_"^"_IEN2 126 Q 127 ; 128 DELDUP ;delete patient dups from file 129 S DUPCNT=DUPCNT+1 130 S DIK="^RGHL7(991.1,"_DA(1)_",1," 131 D ^DIK K DIK,DA 132 Q 133 ; 134 218 ;;(Potential Matches Returned) 135 234 ;;(Primary View Reject) 1 RGMTETOT ;BIR/CML-Compile Totals for Site Exceptions ;11/15/01 2 ;;1.0;CLINICAL INFO RESOURCE NETWORK;**20,30,43,45**;30 Apr 99;Build 9 3 ; 4 ;Reference to ^DPT("AICNL" supported by IA #2070 5 ; 6 ;Variable RGHLMQ cannot be killed in this routine, it is needed for the remote query 7 ; 8 ;Use this routine to compile totals of a site's exceptions in file #991.1 9 S DUMP=0 G START 10 ; 11 DUMP1 ;Use this call to dump all data in ascii format for table 12 S DUMP=1 G START 13 ; 14 DUMP2 ;Use this call to dump data in ascii format for table - just for exceptions sites have to deal with 15 S DUMP=2 16 ; 17 START ; 18 ;do purge of any dups for POTENTIAL MATCH Exceptions 19 K TYPEARR,^XTMP("RGMT","HLMQETOT") 20 S ^XTMP("RGMT",0)=$$FMADD^XLFDT(DT,30)_"^"_$$NOW^XLFDT_"^MPI/PD Maintenance Data" 21 D PURGE 22 ;create type array from file 991.11 23 S TYPE=214 F S TYPE=$O(^RGHL7(991.11,TYPE)) Q:'TYPE I TYPE'=218 S TYPEARR(TYPE)=0 24 ; 25 ;start loop 26 S TYPE=214 F S TYPE=$O(^RGHL7(991.1,"AC",TYPE)) Q:'TYPE D 27 .Q:TYPE=218 28 .S IEN1=0 F S IEN1=$O(^RGHL7(991.1,"AC",TYPE,IEN1)) Q:'IEN1 D 29 ..S IEN2=0 F S IEN2=$O(^RGHL7(991.1,"AC",TYPE,IEN1,IEN2)) Q:'IEN2 D 30 ...I '$D(^RGHL7(991.1,IEN1,1,IEN2,0)) Q 31 ...S STAT=$P(^RGHL7(991.1,IEN1,1,IEN2,0),"^",5) I STAT<1 S TYPEARR(TYPE)=TYPEARR(TYPE)+1 32 ; 33 PRT ; 34 S GRAND=0 35 S SITENM=$P($$SITE^VASITE(),"^",2),$P(LN,"-",81)="" 36 D NOW^%DTC S RUNDT=$$FMTE^XLFDT($E(%,1,12)) 37 ; 38 PRT0 I 'DUMP D 39 .W !!,"Exception Totals for ",SITENM 40 .W !,"Printed ",RUNDT,!,LN 41 .S TYPE=0 F S TYPE=$O(TYPEARR(TYPE)) Q:'TYPE I +TYPEARR(TYPE) D 42 ..S GRAND=GRAND+TYPEARR(TYPE) 43 ..W !!,"TYPE: ",TYPE,?12,$P($T(@TYPE),";;",2),?67,"TOTAL = ",$J(TYPEARR(TYPE),4) 44 ..W !,"DESCRIPTION:" 45 ..S TXT=0 F S TXT=$O(^RGHL7(991.11,TYPE,99,TXT)) Q:'TXT W !,^RGHL7(991.11,TYPE,99,TXT,0) 46 .W !!?56,"TOTAL EXCEPTIONS: ",$J(GRAND,5) 47 ; 48 PRT1 I DUMP=1 D 49 .W !!,"At this point it is necessary for you to increase the right margin." 50 .W !,"At the DEVICE prompt enter=> ;255" 51 .W ! D ^%ZIS I POP W !,"DOWNLOAD ABORTED!" Q 52 .W !!,"Data string=Site;Run Date;Date CIRN Installed;Exceptions 215-234" 53 .S STR=SITENM_";"_RUNDT_";" 54 .S TYPE=0 F S TYPE=$O(TYPEARR(TYPE)) Q:'TYPE D 55 ..S STR=STR_";"_TYPEARR(TYPE) 56 .W !!,STR 57 ; 58 PRT2 I DUMP=2 D 59 .S ICN=0,LOCCNT=0 F S ICN=$O(^DPT("AICNL",1,ICN)) Q:'ICN S LOCCNT=LOCCNT+1 60 .S SITEIEN=+$$SITE^VASITE(),STANUM=$P($$SITE^VASITE(),"^",3) 61 .I '$D(RGHLMQ) W !!,"Data string:" 62 .I '$D(RGHLMQ) W !,"Site;Sta#;;;LocICNs,215,216,217,218,227,234" 63 .S STR=SITENM_";"_STANUM_";;;"_LOCCNT 64 .F TYPE=215,216,217,218,227,234 S STR=STR_";"_TYPEARR(TYPE) 65 .I '$D(RGHLMQ) W !!,STR 66 .I $D(RGHLMQ) S ^XTMP("RGMT","HLMQETOT",STANUM,1)=STR 67 ; 68 QUIT ; 69 K %,CIRNIEN,CNT,DA,DIK,DUMP,DUPCNT,EXCDT,GRAND,ICN,IEN,IEN1,IEN2,LN,LOCCNT,OLDDT,OLDNODE,PTNM 70 K RGDFN,RUNDT,SITEIEN,SITENM,STANUM,STAT,STR,TXT,TYPE,XCNT,HOME,DFN,RCNT,VADM 71 K ^XTMP("RGMT","ETOT") 72 Q 73 ; 74 PURGE ; 75 I '$D(RGHLMQ) W !!,"...purging duplicate Potential Match Exceptions",! 76 K ^XTMP("RGMT","ETOT") 77 S (RGDFN,CNT,XCNT,DUPCNT)=0,HOME=$$SITE^VASITE() 78 F S RGDFN=$O(^RGHL7(991.1,"ADFN",218,RGDFN)) Q:'RGDFN D 79 .S IEN=0 80 .F S IEN=$O(^RGHL7(991.1,"ADFN",218,RGDFN,IEN)) Q:'IEN D 81 ..S IEN2=0 82 ..F S IEN2=$O(^RGHL7(991.1,"ADFN",218,RGDFN,IEN,IEN2)) Q:'IEN2 D 83 ...I '$D(^RGHL7(991.1,IEN,0)) Q 84 ...S CNT=CNT+1 85 ...S EXCDT=$P(^RGHL7(991.1,IEN,0),"^",3) 86 ...I '$D(^XTMP("RGMT","ETOT",RGDFN)) D Q 87 ....S XCNT=XCNT+1 88 ....D SETTMP 89 ...I $D(^XTMP("RGMT","ETOT",RGDFN)) D 90 ....S OLDNODE=^XTMP("RGMT","ETOT",RGDFN) 91 ....S OLDDT=$P(OLDNODE,"^") 92 ....I EXCDT>OLDDT D Q 93 .....S DA(1)=$P(OLDNODE,"^",2),DA=$P(OLDNODE,"^",3) 94 .....D DELDUP 95 .....D SETTMP 96 ....I OLDDT>EXCDT!(OLDDT=EXCDT) D 97 .....S DA(1)=IEN,DA=IEN2 98 .....D DELDUP 99 I '$D(RGHLMQ) W !,DUPCNT," duplicate patient entries for POTENTIAL MATCH exceptions were identified" 100 I '$D(RGHLMQ) W !,"and deleted from the CIRN HL7 EXCEPTION LOG file (#991.1)." 101 ; 102 K ^XTMP("RGMT","ETOT") 103 S (RCNT,RGDFN)=0 N IEN,SUB 104 F S RGDFN=$O(^RGHL7(991.1,"ADFN",218,RGDFN)) Q:'RGDFN D 105 .;S ICN=+$$GETICN^MPIF001(RGDFN) 106 .;I $E(ICN,1,3)=$P(HOME,"^",3)!(ICN<0) D 107 .;**43 shouldn't check for locals or no ICN, check for processed/not processed 108 .S IEN=0 F S IEN=$O(^RGHL7(991.1,"ADFN",218,RGDFN,IEN)) Q:IEN="" D 109 ..S SUB=$O(^RGHL7(991.1,"ADFN",218,RGDFN,IEN,"")) 110 ..I $P($G(^RGHL7(991.1,IEN,1,SUB,0)),"^",5)=0 D 111 ...S DFN=RGDFN D DEM^VADPT 112 ...I VADM(1)=""!(VADM(2)="") Q 113 ...S RCNT=RCNT+1 114 ...S ^XTMP("RGMT","ETOT",VADM(1),RGDFN)=$P(VADM(2),"^")_"^"_$P(VADM(3),"^",2) 115 ; 116 ;count the number of patients who need to be resolved 117 S PTNM="",CNT=0 118 F S PTNM=$O(^XTMP("RGMT","ETOT",PTNM)) Q:PTNM="" D 119 .S RGDFN=0 120 .F S RGDFN=$O(^XTMP("RGMT","ETOT",PTNM,RGDFN)) Q:'RGDFN S CNT=CNT+1 121 S TYPEARR(218)=CNT 122 Q 123 ; 124 SETTMP ;set TMP global for patient check 125 S ^XTMP("RGMT","ETOT",RGDFN)=EXCDT_"^"_IEN_"^"_IEN2 126 Q 127 ; 128 DELDUP ;delete patient dups from file 129 S DUPCNT=DUPCNT+1 130 S DIK="^RGHL7(991.1,"_DA(1)_",1," 131 D ^DIK K DIK,DA 132 Q 133 ; 134 215 ;;(Death Entry on MPI not in VISTA) 135 216 ;;(Death Entry on Vista not in MPI) 136 217 ;;(Death Entries Mismatch) 137 218 ;;(Potential Matches Returned) 138 227 ;;(Multiple ICNs) 139 234 ;;(Primary View Reject)
Note:
See TracChangeset
for help on using the changeset viewer.
