source: FOIAVistA/tag/r/ZZREGIONAL-A1C-A5C-CRHD-RGED-RGUT-RGWB-RG/RGMTETOT.m

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

initial load of FOIAVistA 6/30/08 version
File size: 5.0 KB
RevLine 
[628]1RGMTETOT ;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 ;
11DUMP1 ;Use this call to dump all data in ascii format for table
12 S DUMP=1 G START
13 ;
14DUMP2 ;Use this call to dump data in ascii format for table - just for exceptions sites have to deal with
15 S DUMP=2
16 ;
17START ;
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 ;
33PRT ;
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 ;
38PRT0 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 ;
48PRT1 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 ;
58PRT2 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 ;
68QUIT ;
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 ;
74PURGE ;
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 ;
124SETTMP ;set TMP global for patient check
125 S ^XTMP("RGMT","ETOT",RGDFN)=EXCDT_"^"_IEN_"^"_IEN2
126 Q
127 ;
128DELDUP ;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 ;
134215 ;;(Death Entry on MPI not in VISTA)
135216 ;;(Death Entry on Vista not in MPI)
136217 ;;(Death Entries Mismatch)
137218 ;;(Potential Matches Returned)
138227 ;;(Multiple ICNs)
139234 ;;(Primary View Reject)
Note: See TracBrowser for help on using the repository browser.