| [623] | 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 | ;
|
|---|
