- PXRMETXU ; SLC/PJH - Extract utilities ;09/06/2007
- ;;2.0;CLINICAL REMINDERS;**4,6**;Feb 04, 2005;Build 123
- ;
- 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' if this extract will replace the scheduled"
- .S HTEXT(3)="extract. Enter 'N' if you still want the scheduled extract"
- .S HTEXT(4)="to run."
- ;
- D HELP^PXRMEUT(.HTEXT)
- Q
- ;
- DELETE(IEN) ;Delete an extract summary.
- I IEN="" Q
- N DA,DELOK,DIK,NAME
- S DELOK=1
- S NAME=$P(^PXRMXT(810.3,IEN,0),U,1)
- ;Must have PXRM MANAGER key in order to delete national extracts.
- I $P($G(^PXRMXT(810.3,IEN,100)),U,1)="N" D
- . S DELOK=$S($D(^XUSEC("PXRM MANAGER",DUZ)):1,1:0)
- . I 'DELOK D
- .. W !!,NAME," is national."
- .. W !,"You cannot delete a national extract summary."
- .. H 2
- I 'DELOK Q
- ;Double check the user really wants to delete.
- S TEXT="Are you sure you want to delete "_NAME
- S DELOK=$$ASKYN^PXRMEUT("N","Are you sure you want to delete "_NAME)
- I 'DELOK Q
- S DA=IEN
- S DIK="^PXRMXT(810.3,"
- D ^DIK
- W !,"Deleting ",NAME
- H 2
- 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
- ;
- PXRMETXU ; SLC/PJH - Extract utilities ;09/06/2007
- +1 ;;2.0;CLINICAL REMINDERS;**4,6**;Feb 04, 2005;Build 123
- +2 ;
- HELP(CALL) ;General help text routine
- +1 NEW HTEXT
- +2 IF CALL=1
- Begin DoDot:1
- +3 SET HTEXT(1)="Enter 'Y' to overwrite this existing list. Enter 'N' to"
- +4 SET HTEXT(2)="use a different patient list name."
- End DoDot:1
- +5 ;
- +6 IF CALL=3
- Begin DoDot:1
- +7 SET HTEXT(1)="Enter 'Y' to transmit extract. Otherwise enter 'N'."
- End DoDot:1
- +8 ;
- +9 IF CALL=4
- Begin DoDot:1
- +10 SET HTEXT(1)="The selected period is the same as next scheduled extract."
- +11 SET HTEXT(2)="Enter 'Y' if this extract will replace the scheduled"
- +12 SET HTEXT(3)="extract. Enter 'N' if you still want the scheduled extract"
- +13 SET HTEXT(4)="to run."
- End DoDot:1
- +14 ;
- +15 DO HELP^PXRMEUT(.HTEXT)
- +16 QUIT
- +17 ;
- DELETE(IEN) ;Delete an extract summary.
- +1 IF IEN=""
- QUIT
- +2 NEW DA,DELOK,DIK,NAME
- +3 SET DELOK=1
- +4 SET NAME=$PIECE(^PXRMXT(810.3,IEN,0),U,1)
- +5 ;Must have PXRM MANAGER key in order to delete national extracts.
- +6 IF $PIECE($GET(^PXRMXT(810.3,IEN,100)),U,1)="N"
- Begin DoDot:1
- +7 SET DELOK=$SELECT($DATA(^XUSEC("PXRM MANAGER",DUZ)):1,1:0)
- +8 IF 'DELOK
- Begin DoDot:2
- +9 WRITE !!,NAME," is national."
- +10 WRITE !,"You cannot delete a national extract summary."
- +11 HANG 2
- End DoDot:2
- End DoDot:1
- +12 IF 'DELOK
- QUIT
- +13 ;Double check the user really wants to delete.
- +14 SET TEXT="Are you sure you want to delete "_NAME
- +15 SET DELOK=$$ASKYN^PXRMEUT("N","Are you sure you want to delete "_NAME)
- +16 IF 'DELOK
- QUIT
- +17 SET DA=IEN
- +18 SET DIK="^PXRMXT(810.3,"
- +19 DO ^DIK
- +20 WRITE !,"Deleting ",NAME
- +21 HANG 2
- +22 QUIT
- +23 ;
- PRGES ;Delete any Extract Summaries over 5 years old
- +1 NEW DIFF,EDATE,OLD
- +2 SET OLD=0
- +3 FOR
- SET OLD=$ORDER(^PXRMXT(810.3,OLD))
- IF 'OLD
- QUIT
- Begin DoDot:1
- +4 IF +$GET(^PXRMXT(810.3,OLD,50))'=1
- QUIT
- +5 ;Extract Date
- +6 SET EDATE=$PIECE($GET(^PXRMXT(810.3,OLD,0)),U,6)
- +7 ;Ignore if < 5 years (1826 days) since creation
- +8 IF $$FMDIFF^XLFDT(DT,EDATE,1)<1826
- QUIT
- +9 ;Otherwise delete
- +10 NEW DIK,DA
- +11 SET DIK="^PXRMXT(810.3,"
- SET DA=OLD
- DO ^DIK
- End DoDot:1
- +12 QUIT
- +13 ;
- PRGPL ;Delete any Patient Lists over 5 years old
- +1 NEW LDATE,OLD
- +2 SET OLD=0
- +3 FOR
- SET OLD=$ORDER(^PXRMXP(810.5,OLD))
- IF 'OLD
- QUIT
- Begin DoDot:1
- +4 IF +$GET(^PXRMXP(810.5,OLD,50))'=1
- QUIT
- +5 ;Patient List Date
- +6 SET LDATE=$PIECE($GET(^PXRMXP(810.5,OLD,0)),U,4)
- +7 ;Ignore if < 5 years (1826 days) since creation
- +8 IF $$FMDIFF^XLFDT(DT,LDATE,1)<1826
- QUIT
- +9 ;Otherwise delete
- +10 NEW DIK,DA
- +11 SET DIK="^PXRMXP(810.5,"
- SET DA=OLD
- DO ^DIK
- End DoDot:1
- +12 QUIT
- +13 ;
