| [613] | 1 | PXRMGECL ;SLC/AGP,JVS - Restore Func & Utilities ;7/14/05 10:43
|
|---|
| 2 | ;;2.0;CLINICAL REMINDERS;**4**;Feb 04, 2005;Build 21
|
|---|
| 3 | Q
|
|---|
| 4 | ;
|
|---|
| 5 | CNT(DOC,DFN) ;Count number of referals per Provider and patient
|
|---|
| 6 | N DATE
|
|---|
| 7 | S CNT=0
|
|---|
| 8 | S DATE=0 F S DATE=$O(^TMP("PXRMGEC",$J,"DFNCNT",DOC,DFN,DATE)) Q:DATE="" D
|
|---|
| 9 | .S CNT=CNT+1
|
|---|
| 10 | Q CNT
|
|---|
| 11 | POST ;Post Routine to gather old date from health factors
|
|---|
| 12 | ;
|
|---|
| 13 | D BMES^XPDUTL("Adding data to new file 801.55")
|
|---|
| 14 | D BMES^XPDUTL("Please Wait.....Thank you")
|
|---|
| 15 | N TIME,DFN,GEC,DA,GECX,GECNA,HF0,HF12,CNT
|
|---|
| 16 | S CNT=0
|
|---|
| 17 | S TIME=0 F S TIME=$O(^AUPNVHF("AED",TIME)) Q:TIME="" D
|
|---|
| 18 | .Q:TIME'>3000000
|
|---|
| 19 | .S DFN=0 F S DFN=$O(^AUPNVHF("AED",TIME,DFN)) Q:DFN="" D
|
|---|
| 20 | ..S GEC=0 F S GEC=$O(^AUPNVHF("AED",TIME,DFN,GEC)) Q:GEC="" D
|
|---|
| 21 | ...S GECNA=$P($G(^PX(839.7,GEC,0)),"^",1) Q:GECNA'["GEC"
|
|---|
| 22 | ...S DA=0 F S DA=$O(^AUPNVHF("AED",TIME,DFN,GEC,DA)) Q:DA="" D
|
|---|
| 23 | ....S HF0=$G(^AUPNVHF(DA,0))
|
|---|
| 24 | ....S HF12=$G(^AUPNVHF(DA,12))
|
|---|
| 25 | ....S HF801=$G(^AUPNVHF(DA,801))
|
|---|
| 26 | ....S GECX(1,801.55,"+1,",.01)=DFN
|
|---|
| 27 | ....S GECX(1,801.55,"+1,",.02)=$P(HF12,"^",1)
|
|---|
| 28 | ....S GECX(1,801.55,"+1,",.03)=GECNA
|
|---|
| 29 | ....S GECX(1,801.55,"+1,",.05)=+$P($P(HF801,"^",2)," ",2)
|
|---|
| 30 | ....S GECX(1,801.55,"+1,",.06)=$P($P(HF12,"^",1),".",1)
|
|---|
| 31 | ....I '$D(^PXRMD(801.55,"AE",DFN,$P(HF12,"^",1),GECNA,+$P($P(HF801,"^",2)," ",2))) D
|
|---|
| 32 | .....D UPDATE^DIE("","GECX(1)")
|
|---|
| 33 | .....S CNT=CNT+1
|
|---|
| 34 | .....K GECX,HF0,HF12
|
|---|
| 35 | S DIK="^PXRMXT(810.3,",DIK(1)="6^AHLID"
|
|---|
| 36 | D IXALL^DIK
|
|---|
| 37 | Q
|
|---|
| 38 | ;
|
|---|
| 39 | REOPEN(NUM) ;Move a referral from the Historial 801.55 to 801.5
|
|---|
| 40 | Q:NUM=""
|
|---|
| 41 | N I,GEX
|
|---|
| 42 | S I=0 F S I=$O(^TMP("PXRMGEC_CK2",$J,NUM,I)) Q:I="" D
|
|---|
| 43 | .S DA=0 F S DA=$O(^TMP("PXRMGEC_CK2",$J,NUM,I,DA)) Q:DA="" D
|
|---|
| 44 | ..S GEX(1,801.5,"+1,",.01)=$P(^TMP("PXRMGEC_CK2",$J,NUM,I,DA),"^",1)
|
|---|
| 45 | ..S GEX(1,801.5,"+1,",.02)=$P(^TMP("PXRMGEC_CK2",$J,NUM,I,DA),"^",2)
|
|---|
| 46 | ..S GEX(1,801.5,"+1,",.03)=$P(^TMP("PXRMGEC_CK2",$J,NUM,I,DA),"^",3)
|
|---|
| 47 | ..S GEX(1,801.5,"+1,",.04)=$P(^TMP("PXRMGEC_CK2",$J,NUM,I,DA),"^",4)
|
|---|
| 48 | ..S GEX(1,801.5,"+1,",.05)=$P(^TMP("PXRMGEC_CK2",$J,NUM,I,DA),"^",5)
|
|---|
| 49 | ..S GEX(1,801.5,"+1,",.06)=$P(^TMP("PXRMGEC_CK2",$J,NUM,I,DA),"^",6)
|
|---|
| 50 | ..D UPDATE^DIE("","GEX(1)")
|
|---|
| 51 | Q
|
|---|
| 52 | ;
|
|---|
