Changeset 623 for WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMETXU.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMETXU.m
r613 r623 1 PXRMETXU ; SLC/PJH - Extract utilities ;09/06/2007 2 ;;2.0;CLINICAL REMINDERS;**4,6**;Feb 04, 2005;Build 123 3 ; 4 HELP(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' if this extract will replace the scheduled" 16 .S HTEXT(3)="extract. Enter 'N' if you still want the scheduled extract" 17 .S HTEXT(4)="to run." 18 ; 19 D HELP^PXRMEUT(.HTEXT) 20 Q 21 ; 22 DELETE(IEN) ;Delete an extract summary. 23 I IEN="" Q 24 N DA,DELOK,DIK,NAME 25 S DELOK=1 26 S NAME=$P(^PXRMXT(810.3,IEN,0),U,1) 27 ;Must have PXRM MANAGER key in order to delete national extracts. 28 I $P($G(^PXRMXT(810.3,IEN,100)),U,1)="N" D 29 . S DELOK=$S($D(^XUSEC("PXRM MANAGER",DUZ)):1,1:0) 30 . I 'DELOK D 31 .. W !!,NAME," is national." 32 .. W !,"You cannot delete a national extract summary." 33 .. H 2 34 I 'DELOK Q 35 ;Double check the user really wants to delete. 36 S TEXT="Are you sure you want to delete "_NAME 37 S DELOK=$$ASKYN^PXRMEUT("N","Are you sure you want to delete "_NAME) 38 I 'DELOK Q 39 S DA=IEN 40 S DIK="^PXRMXT(810.3," 41 D ^DIK 42 W !,"Deleting ",NAME 43 H 2 44 Q 45 ; 46 PRGES ;Delete any Extract Summaries over 5 years old 47 N DIFF,EDATE,OLD 48 S OLD=0 49 F S OLD=$O(^PXRMXT(810.3,OLD)) Q:'OLD D 50 .I +$G(^PXRMXT(810.3,OLD,50))'=1 Q 51 .;Extract Date 52 .S EDATE=$P($G(^PXRMXT(810.3,OLD,0)),U,6) 53 .;Ignore if < 5 years (1826 days) since creation 54 .I $$FMDIFF^XLFDT(DT,EDATE,1)<1826 Q 55 .;Otherwise delete 56 .N DIK,DA 57 .S DIK="^PXRMXT(810.3,",DA=OLD D ^DIK 58 Q 59 ; 60 PRGPL ;Delete any Patient Lists over 5 years old 61 N LDATE,OLD 62 S OLD=0 63 F S OLD=$O(^PXRMXP(810.5,OLD)) Q:'OLD D 64 .I +$G(^PXRMXP(810.5,OLD,50))'=1 Q 65 .;Patient List Date 66 .S LDATE=$P($G(^PXRMXP(810.5,OLD,0)),U,4) 67 .;Ignore if < 5 years (1826 days) since creation 68 .I $$FMDIFF^XLFDT(DT,LDATE,1)<1826 Q 69 .;Otherwise delete 70 .N DIK,DA 71 .S DIK="^PXRMXP(810.5,",DA=OLD D ^DIK 72 Q 73 ; 1 PXRMETXU ; SLC/PJH - Extract utilities ;08/03/2005 2 ;;2.0;CLINICAL REMINDERS;**4**;Feb 04, 2005;Build 21 3 ; 4 HELP(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 ; 22 PRGES ;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 ; 36 PRGPL ;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 TracChangeset
for help on using the changeset viewer.
