MAGVD011 ;WOIFO/NST - Work item deletion utility ; OCT 24, 2018@1:42PM
;;3.0;IMAGING;**201**;Dec 02, 2009;Build 163
;;Per VHA Directive 2004-038, this routine should not be modified.
;; +---------------------------------------------------------------+
;; | Property of the US Government. |
;; | No permission to copy or redistribute this software is given. |
;; | Use of unreleased versions of this software requires the user |
;; | to execute a written test agreement with the VistA Imaging |
;; | Development Office of the Department of Veterans Affairs, |
;; | telephone (301) 734-0100. |
;; | |
;; | The Food and Drug Administration classifies this software as |
;; | a medical device. As such, it may not be changed in any way. |
;; | Modifications to this software may result in an adulterated |
;; | medical device under 21CFR820, the use of which is considered |
;; | to be a violation of US Federal Statutes. |
;; +---------------------------------------------------------------+
;;
Q
;
DELWIDTS ; Delete work items in date range by work item TYPE and SUBTYPE
;
N DIR,X,Y,MAGDATE,MAGFDATE,MAGTDATE,MAGIEN,MAGOUT,MAGTYPE,MAGSUB
;
; Get from date
S DIR(0)="D^::EP",DIR("A")="Enter from date"
S DIR("?")="Enter a date."
D ^DIR
I 'Y!(Y="^") Q
S MAGFDATE=Y\1
;
; Get through date
K X,Y
S DIR(0)="D^::EP",DIR("A")="Enter through date"
S DIR("?")="Enter a date."
D ^DIR
I 'Y!(Y="^") Q
S MAGTDATE=Y\1
;
; Get Type
K X,Y
S DIR(0)="P^2006.9412:E",DIR("A")="Select work item type"
S DIR("?")="Enter a work item type."
D ^DIR
I 'Y!(Y="^") Q
S MAGTYPE=$P(Y,"^",1)
;
; Get Subtype
K X,Y
S DIR(0)="P^2006.9414:E",DIR("A")="Select work item subtype"
S DIR("?")="Enter a work item subtype."
D ^DIR
I 'Y!(Y="^") Q
S MAGSUB=$P(Y,"^",1)
;
; Confirm deletion
K X,Y
S DIR(0)="Y",DIR("A")="ARE YOU SURE YOU WANT TO DELETE WORK ITEMS"
S DIR("B")="NO"
D ^DIR
I 'Y D EN^DDIOL("Deletion Canceled. Work items were not deleted.","","!!") Q
;
S MAGDATE=MAGFDATE-.0000001
S MAGIEN=0
F S MAGDATE=$O(^MAGV(2006.941,"B",MAGDATE)) Q:'MAGDATE!((MAGDATE\1)>MAGTDATE) D
. F S MAGIEN=$O(^MAGV(2006.941,"B",MAGDATE,MAGIEN)) Q:'MAGIEN D
. . Q:$$GET1^DIQ(2006.941,MAGIEN,1,"I")'=MAGTYPE
. . Q:$$GET1^DIQ(2006.941,MAGIEN,2,"I")'=MAGSUB
. . D DELWITEM^MAGVIM01(.MAGOUT,MAGIEN)
. . Q
. Q
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGVD011 2560 printed Dec 13, 2024@02:09:44 Page 2
MAGVD011 ;WOIFO/NST - Work item deletion utility ; OCT 24, 2018@1:42PM
+1 ;;3.0;IMAGING;**201**;Dec 02, 2009;Build 163
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;; +---------------------------------------------------------------+
+4 ;; | Property of the US Government. |
+5 ;; | No permission to copy or redistribute this software is given. |
+6 ;; | Use of unreleased versions of this software requires the user |
+7 ;; | to execute a written test agreement with the VistA Imaging |
+8 ;; | Development Office of the Department of Veterans Affairs, |
+9 ;; | telephone (301) 734-0100. |
+10 ;; | |
+11 ;; | The Food and Drug Administration classifies this software as |
+12 ;; | a medical device. As such, it may not be changed in any way. |
+13 ;; | Modifications to this software may result in an adulterated |
+14 ;; | medical device under 21CFR820, the use of which is considered |
+15 ;; | to be a violation of US Federal Statutes. |
+16 ;; +---------------------------------------------------------------+
+17 ;;
+18 QUIT
+19 ;
DELWIDTS ; Delete work items in date range by work item TYPE and SUBTYPE
+1 ;
+2 NEW DIR,X,Y,MAGDATE,MAGFDATE,MAGTDATE,MAGIEN,MAGOUT,MAGTYPE,MAGSUB
+3 ;
+4 ; Get from date
+5 SET DIR(0)="D^::EP"
SET DIR("A")="Enter from date"
+6 SET DIR("?")="Enter a date."
+7 DO ^DIR
+8 IF 'Y!(Y="^")
QUIT
+9 SET MAGFDATE=Y\1
+10 ;
+11 ; Get through date
+12 KILL X,Y
+13 SET DIR(0)="D^::EP"
SET DIR("A")="Enter through date"
+14 SET DIR("?")="Enter a date."
+15 DO ^DIR
+16 IF 'Y!(Y="^")
QUIT
+17 SET MAGTDATE=Y\1
+18 ;
+19 ; Get Type
+20 KILL X,Y
+21 SET DIR(0)="P^2006.9412:E"
SET DIR("A")="Select work item type"
+22 SET DIR("?")="Enter a work item type."
+23 DO ^DIR
+24 IF 'Y!(Y="^")
QUIT
+25 SET MAGTYPE=$PIECE(Y,"^",1)
+26 ;
+27 ; Get Subtype
+28 KILL X,Y
+29 SET DIR(0)="P^2006.9414:E"
SET DIR("A")="Select work item subtype"
+30 SET DIR("?")="Enter a work item subtype."
+31 DO ^DIR
+32 IF 'Y!(Y="^")
QUIT
+33 SET MAGSUB=$PIECE(Y,"^",1)
+34 ;
+35 ; Confirm deletion
+36 KILL X,Y
+37 SET DIR(0)="Y"
SET DIR("A")="ARE YOU SURE YOU WANT TO DELETE WORK ITEMS"
+38 SET DIR("B")="NO"
+39 DO ^DIR
+40 IF 'Y
DO EN^DDIOL("Deletion Canceled. Work items were not deleted.","","!!")
QUIT
+41 ;
+42 SET MAGDATE=MAGFDATE-.0000001
+43 SET MAGIEN=0
+44 FOR
SET MAGDATE=$ORDER(^MAGV(2006.941,"B",MAGDATE))
if 'MAGDATE!((MAGDATE\1)>MAGTDATE)
QUIT
Begin DoDot:1
+45 FOR
SET MAGIEN=$ORDER(^MAGV(2006.941,"B",MAGDATE,MAGIEN))
if 'MAGIEN
QUIT
Begin DoDot:2
+46 if $$GET1^DIQ(2006.941,MAGIEN,1,"I")'=MAGTYPE
QUIT
+47 if $$GET1^DIQ(2006.941,MAGIEN,2,"I")'=MAGSUB
QUIT
+48 DO DELWITEM^MAGVIM01(.MAGOUT,MAGIEN)
+49 QUIT
End DoDot:2
+50 QUIT
End DoDot:1
+51 QUIT
