source: WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMGECL.m@ 1800

Last change on this file since 1800 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.0 KB
RevLine 
[613]1PXRMGECL ;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 ;
5CNT(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
11POST ;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 ;
39REOPEN(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 ;
Note: See TracBrowser for help on using the repository browser.