| 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 | 
|---|