PXRMETXU ; SLC/PJH - Extract utilities ;08/03/2005
 ;;2.0;CLINICAL REMINDERS;**4**;Feb 04, 2005;Build 21
 ;
HELP(CALL) ;General help text routine
 N HTEXT
 I CALL=1 D
 .S HTEXT(1)="Enter 'Y' to overwrite this existing list. Enter 'N' to"
 .S HTEXT(2)="use a different patient list name."
 ;
 I CALL=3 D
 .S HTEXT(1)="Enter 'Y' to transmit extract. Otherwise enter 'N'."
 ;
 I CALL=4 D
 .S HTEXT(1)="The selected period is the same as next scheduled extract."
 .S HTEXT(2)="Enter 'Y' to if this extract will replace the scheduled"
 .S HTEXT(3)="extract. Enter 'N' if you still want the scheduled extract"
 .S HTEXT(3)="to run."
 ;
 D HELP^PXRMEUT(.HTEXT)
 Q
 ;
PRGES ;Delete any Extract Summaries over 5 years old
 N DIFF,EDATE,OLD
 S OLD=0
 F  S OLD=$O(^PXRMXT(810.3,OLD)) Q:'OLD  D
 .I +$G(^PXRMXT(810.3,OLD,50))'=1 Q
 .;Extract Date
 .S EDATE=$P($G(^PXRMXT(810.3,OLD,0)),U,6)
 .;Ignore if < 5 years (1826 days) since creation
 .I $$FMDIFF^XLFDT(DT,EDATE,1)<1826 Q
 .;Otherwise delete
 .N DIK,DA
 .S DIK="^PXRMXT(810.3,",DA=OLD D ^DIK
 Q
 ;
PRGPL ;Delete any Patient Lists over 5 years old
 N LDATE,OLD
 S OLD=0
 F  S OLD=$O(^PXRMXP(810.5,OLD)) Q:'OLD  D
 .I +$G(^PXRMXP(810.5,OLD,50))'=1 Q
 .;Patient List Date
 .S LDATE=$P($G(^PXRMXP(810.5,OLD,0)),U,4)
 .;Ignore if < 5 years (1826 days) since creation
 .I $$FMDIFF^XLFDT(DT,LDATE,1)<1826 Q
 .;Otherwise delete
 .N DIK,DA
 .S DIK="^PXRMXP(810.5,",DA=OLD D ^DIK
 Q
 ;