source: FOIAVistA/tag/r/CLINICAL_REMINDERS-PXRM/PXRMGECW.m@ 636

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

initial load of FOIAVistA 6/30/08 version

File size: 2.8 KB
Line 
1PXRMGECW ;SLC/JVS -Extract data for GEC Reports Cont'd ;5/23/03 12:49
2 ;;2.0;CLINICAL REMINDERS;;Feb 04, 2005
3 Q
4 ;
5 ;Arrays
6 ;^TMP("PXRMGEC",$J, = Root Reference
7 ;"REF",DATE,DFN) = Number of HF in Referral
8 ;"REFDFN",DFN) = Number of Referrals per Patient
9 ;"HS" = Heath Summary Array
10 Q
11 ;
12PATIENT ;Patient,Count
13 K ^TMP("PXRMGEC",$J,"REFDFNN")
14 K ^TMP("PXRMGEC",$J,"REFDFN")
15 N DATE,DFN,SSN
16 S DATE="" F S DATE=$O(^TMP("PXRMGEC",$J,"REF",DATE)) Q:DATE="" D
17 .S DFN="" F S DFN=$O(^TMP("PXRMGEC",$J,"REF",DATE,DFN)) Q:DFN="" D
18 ..S DFNXX=$P($G(^DPT(DFN,0)),"^",1)
19 ..S SSN=$P($G(^DPT(DFN,0)),"^",9)
20 ..I $D(^TMP("PXRMGEC",$J,"REFDFN",DFN)) S ^TMP("PXRMGEC",$J,"REFDFN",DFN)=$G(^TMP("PXRMGEC",$J,"REFDFN",DFN))+1
21 ..E S ^TMP("PXRMGEC",$J,"REFDFN",DFN)=1
22 ..I $D(^TMP("PXRMGEC",$J,"REFDFNN",DFNXX)) S ^TMP("PXRMGEC",$J,"REFDFNN",DFNXX)=$G(^TMP("PXRMGEC",$J,"REFDFNN",DFNXX))+1
23 ..E S ^TMP("PXRMGEC",$J,"REFDFNN",DFNXX)=1
24 ..I $D(^TMP("PXRMGEC",$J,"REFDFNN",DFNXX,SSN)) S ^TMP("PXRMGEC",$J,"REFDFNN",DFNXX,SSN)=$G(^TMP("PXRMGEC",$J,"REFDFNN",DFNXX,SSN))+1
25 ..E S ^TMP("PXRMGEC",$J,"REFDFNN",DFNXX,SSN)=1
26 ;
27 Q
28LOCCNT ;Count by date
29 N LOC,DATE
30 S LOC="" F S LOC=$O(^TMP("PXRMGEC",$J,"REFLOC",LOC)) Q:LOC="" D
31 .S DATE=0 F S DATE=$O(^TMP("PXRMGEC",$J,"REFLOC",LOC,DATE)) Q:DATE="" D
32 ..I $D(^TMP("PXRMGEC",$J,"REFLOCC",LOC)) S ^TMP("PXRMGEC",$J,"REFLOCC",LOC)=$G(^TMP("PXRMGEC",$J,"REFLOCC",LOC))+1
33 ..E S ^TMP("PXRMGEC",$J,"REFLOCC",LOC)=1
34 Q
35 ;
36DOCCNT ;Count by date
37 N DOC,DATE,DIEN
38 S DOC="" F S DOC=$O(^TMP("PXRMGEC",$J,"REFDOC",DOC)) Q:DOC="" D
39 .S DATE=0 F S DATE=$O(^TMP("PXRMGEC",$J,"REFDOC",DOC,DATE)) Q:DATE="" D
40 ..S DIEN=0 F S DIEN=$O(^TMP("PXRMGEC",$J,"REFDOC",DOC,DATE,DIEN)) Q:DIEN="" D
41 ...I $D(^TMP("PXRMGEC",$J,"REFDOCC",DOC,DIEN)) S ^TMP("PXRMGEC",$J,"REFDOCC",DOC,DIEN)=$G(^TMP("PXRMGEC",$J,"REFDOCC",DOC,DIEN))+1
42 ...E S ^TMP("PXRMGEC",$J,"REFDOCC",DOC,DIEN)=1
43 Q
44 ;
45DATECNT ;Count by date
46 N DATE,DFN
47 S DATE=0 F S DATE=$O(^TMP("PXRMGEC",$J,"REF",DATE)) Q:DATE="" D
48 .S DFN=0 F S DFN=$O(^TMP("PXRMGEC",$J,"REF",DATE,DFN)) Q:DFN="" D
49 ..I $D(^TMP("PXRMGEC",$J,"REFDATE",$P(DATE,".",1))) S ^TMP("PXRMGEC",$J,"REFDATE",$P(DATE,".",1))=$G(^TMP("PXRMGEC",$J,"REFDATE",$P(DATE,".",1)))+1
50 ..E S ^TMP("PXRMGEC",$J,"REFDATE",$P(DATE,".",1))=1
51 Q
52 ;
53INIT ;Initialize values in PCE DATA SOURCE FILE
54 N GEX,FLAG,III
55 S FLAG=0
56 I '$D(^PX(839.7,"B","GEC1")) S GEX(1,839.7,"+1,",.01)="GEC1",FLAG=1
57 I '$D(^PX(839.7,"B","GEC2")) S GEX(1,839.7,"+2,",.01)="GEC2",FLAG=1
58 I '$D(^PX(839.7,"B","GEC3")) S GEX(1,839.7,"+3,",.01)="GEC3",FLAG=1
59 I '$D(^PX(839.7,"B","GECF")) S GEX(1,839.7,"+4,",.01)="GECF",FLAG=1
60 I FLAG D UPDATE^DIE("","GEX(1)")
61 ;CLEAN OUT 801.5
62 I $D(^PXRMD(801.5)) D
63 .S DIK="^PXRMD(801.5,"
64 .F III=1:1:1000 S DA=III D ^DIK
65 .K ^PXRMD(801.5,"ACOPY")
66 Q
Note: See TracBrowser for help on using the repository browser.