source: WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMETXU.m@ 701

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

revised back to 6/30/08 version

File size: 1.4 KB
Line 
1PXRMETXU ; SLC/PJH - Extract utilities ;08/03/2005
2 ;;2.0;CLINICAL REMINDERS;**4**;Feb 04, 2005;Build 21
3 ;
4HELP(CALL) ;General help text routine
5 N HTEXT
6 I CALL=1 D
7 .S HTEXT(1)="Enter 'Y' to overwrite this existing list. Enter 'N' to"
8 .S HTEXT(2)="use a different patient list name."
9 ;
10 I CALL=3 D
11 .S HTEXT(1)="Enter 'Y' to transmit extract. Otherwise enter 'N'."
12 ;
13 I CALL=4 D
14 .S HTEXT(1)="The selected period is the same as next scheduled extract."
15 .S HTEXT(2)="Enter 'Y' to if this extract will replace the scheduled"
16 .S HTEXT(3)="extract. Enter 'N' if you still want the scheduled extract"
17 .S HTEXT(3)="to run."
18 ;
19 D HELP^PXRMEUT(.HTEXT)
20 Q
21 ;
22PRGES ;Delete any Extract Summaries over 5 years old
23 N DIFF,EDATE,OLD
24 S OLD=0
25 F S OLD=$O(^PXRMXT(810.3,OLD)) Q:'OLD D
26 .I +$G(^PXRMXT(810.3,OLD,50))'=1 Q
27 .;Extract Date
28 .S EDATE=$P($G(^PXRMXT(810.3,OLD,0)),U,6)
29 .;Ignore if < 5 years (1826 days) since creation
30 .I $$FMDIFF^XLFDT(DT,EDATE,1)<1826 Q
31 .;Otherwise delete
32 .N DIK,DA
33 .S DIK="^PXRMXT(810.3,",DA=OLD D ^DIK
34 Q
35 ;
36PRGPL ;Delete any Patient Lists over 5 years old
37 N LDATE,OLD
38 S OLD=0
39 F S OLD=$O(^PXRMXP(810.5,OLD)) Q:'OLD D
40 .I +$G(^PXRMXP(810.5,OLD,50))'=1 Q
41 .;Patient List Date
42 .S LDATE=$P($G(^PXRMXP(810.5,OLD,0)),U,4)
43 .;Ignore if < 5 years (1826 days) since creation
44 .I $$FMDIFF^XLFDT(DT,LDATE,1)<1826 Q
45 .;Otherwise delete
46 .N DIK,DA
47 .S DIK="^PXRMXP(810.5,",DA=OLD D ^DIK
48 Q
49 ;
Note: See TracBrowser for help on using the repository browser.