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