| 1 | PXRMGECW ;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 |  ;
 | 
|---|
| 12 | PATIENT ;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
 | 
|---|
| 28 | LOCCNT ;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 |  ;
 | 
|---|
| 36 | DOCCNT ;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 |  ;
 | 
|---|
| 45 | DATECNT ;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 |  ;
 | 
|---|
| 53 | INIT ;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
 | 
|---|