Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: MAGVD001

MAGVD001.m

Go to the documentation of this file. 
  1. MAGVD001 ;WOIFO/BT,NST,DAC,PMK - Delete Study By Accession Number ; Feb 15, 2022@10:23:58
  1.  ;;3.0;IMAGING;**118,138,231,305**;Mar 19, 2002;Build 3
  1.  ;; Per VHA Directive 2004-038, this routine should not be modified.
  1.  ;; +---------------------------------------------------------------+
  1.  ;; | Property of the US Government.                                |
  1.  ;; | No permission to copy or redistribute this software is given. |
  1.  ;; | Use of unreleased versions of this software requires the user |
  1.  ;; | to execute a written test agreement with the VistA Imaging    |
  1.  ;; | Development Office of the Department of Veterans Affairs,     |
  1.  ;; | telephone (301) 734-0100.                                     |
  1.  ;; | The Food and Drug Administration classifies this software as  |
  1.  ;; | a medical device.  As such, it may not be changed in any way. |
  1.  ;; | Modifications to this software may result in an adulterated   |
  1.  ;; | medical device under 21CFR820, the use of which is considered |
  1.  ;; | to be a violation of US Federal Statutes.                     |
  1.  ;; +---------------------------------------------------------------+
  1.  ;;
  1.  Q
  1.  ;
  1. DELSTUDY ; Delete Study by Accession Number (option MAG SYS-DELETE STUDY)
  1.  N ACCNUM,SENSEMP,ERR,MAGDFN,REASON
  1.  N OUT,MAGARR,SSEP,RES,Y,DG1,DGOPT,DIC
  1.  S SSEP=$$STATSEP^MAGVRS41
  1.  ;
  1.  F  S ACCNUM=$$GETACC^MAGVD001() Q:ACCNUM=""  D
  1.  . D GIBYACC^MAGVD007(.OUT,ACCNUM,.MAGARR)  ; Get Images to be deleted
  1.  . I OUT<0 D EN^DDIOL($P(OUT,SSEP,2),"","!!") Q 
  1.  . I '$D(MAGARR) D EN^DDIOL("No image found for this accession number","","!!") Q 
  1.  . S MAGDFN=MAGARR(1,"MAGDFN")  ; get the patient
  1.  . S SENSEMP=$$ISPATSEN^MAGVD001(MAGDFN) ;is sensitive patient?
  1.  . I SENSEMP,'$$CONFSENS^MAGVD001() D EN^DDIOL("Deletion Canceled. Study was not deleted.","","!!") Q
  1.  . S Y=MAGDFN,DG1="",DGOPT="MAG SYS-DELETE STUDY",DIC(0)=""
  1.  . D:SENSEMP SETLOG^DGSEC ; IA #2242 - Log sensitive patient access
  1.  . D SHOWINFO^MAGVD004(ACCNUM,.MAGARR)
  1.  . S REASON=$$GETRSN^MAGVD001()
  1.  . I REASON="" D EN^DDIOL("Deletion Canceled. Study was not deleted.","","!!") Q
  1.  . I '$$CONFIRM^MAGVD001(ACCNUM) D EN^DDIOL("Deletion Canceled. Study was not deleted.","","!!") Q
  1.  . D DELACC^MAGVD002(.OUT,.MAGARR,REASON)  ; delete images provided
  1.  . S RES=$P(OUT,SSEP)
  1.  . S ERR=$P(OUT,SSEP,2)
  1.  . I RES=0 D EN^DDIOL("Deletion successfully completed!","","!!") Q
  1.  . D EN^DDIOL(ERR,"","!!")
  1.  . Q
  1.  Q
  1.  ;
  1. GETACC() ; Get Accession Number
  1.  N DIR,X,Y
  1.  S DIR(0)="FO^^K:'$$ISMSKOK^MAGVD001(X) X"
  1.  S DIR("A")="Enter an Accession Number"
  1.  S DIR("A",1)=""
  1.  S DIR("??")="^D GETACCHELP^MAGVD001"
  1.  S DIR("?",1)="Enter Accession Number, e.g. 660-GMR-123, 111231-345, 660-111231-345," ; P231 PMK 4/4/2020
  1.  S DIR("?",2)="GMRC-123, SP 21 12345 or ""^"" to exit."  ; P305 PMK 01/04/2022
  1.  S DIR("?")=" "
  1.  D ^DIR
  1.  S:Y="^" Y=""
  1.  Q Y
  1.  ;
  1. GETACCHELP ; double quote help message
  1.  W !,"By Entering Accession Number, all Studies with this Accession Number"
  1.  W !,"will be deleted."
  1.  Q
  1.  ;
  1. ISMSKOK(Y) ; Verify accession number format - 0 invalid; 1 - valid
  1.  N OK
  1.  S OK=0
  1.  S Y=$$UP^MAGDFCNV(Y)
  1.  D  ; needed for QUITs
  1.  . I $L(Y,"-")=3 I Y?3N.N1"-"6N1"-"1.N S OK=1 Q  ; radiology SSS-MMDDYY-NNNNN format
  1.  . I $L(Y,"-")=2 I Y?6N1"-"1.N S OK=1 Q  ; radiology MMDDYY-NNNNN format
  1.  . I $$GMRCIEN^MAGDFCNV(Y) S OK=1 Q  ; consult format
  1.  . I $L(Y," ")=3 I Y?.E1" "2N1" "1N.N S OK=1 Q  ; anatomic pathology format - P305 PMK 01/03/2022
  1.  . Q
  1.  Q OK
  1.  ;
  1. ISPATSEN(MAGDFN) ; Return 1 if patient for the study is a sensitive, 0 otherwise
  1.  N SENSEMP
  1.  S SENSEMP=$$SENSEMP^MAGUPSE(MAGDFN)
  1.  Q (SENSEMP>0)
  1.  ;
  1. CONFSENS() ; Continue processing confirmation for sensitive patient
  1.  N DIR,X,Y
  1.  S DIR(0)="FO",DIR("A")="Sensitive Patient. Enter 'OK' to continue"
  1.  S DIR("?")="Enter 'OK' to continue or '^' to skip"
  1.  D ^DIR
  1.  Q ($$UC^MAGVD001(Y)="OK")
  1.  ;
  1. GETRSN() ; Select reason for deletion
  1.  N DIC,DTOUT,DUOUT,TODAY,X,Y
  1.  S TODAY=+$$NOW^XLFDT
  1.  W !
  1.  S DIC="^MAG(2005.88,",DIC(0)="AEQVZN",DIC("S")="I ($P(^(0),U,2)[""D""&(($P(^(0),U,3)="""")!(TODAY<($P(^(0),U,3)))))",DIC("W")=""
  1.  S DIC("A")="Select a reason for deletion: "
  1.  D ^DIC
  1.  I $D(DTOUT)!$D(DUOUT) Q ""
  1.  I (Y="")!(Y="^") Q ""
  1.  Q $P(Y,U,2) ; Return reason for deletion
  1. CONFIRM(ACCNUM) ; Confirmation - last chance to cancel
  1.  N DIR,X,Y
  1.  S DIR(0)="Y",DIR("A")="ARE YOU SURE YOU WANT TO DELETE STUDIES FOR ACCESSION #: "_ACCNUM
  1.  S DIR("B")="NO"
  1.  D ^DIR
  1.  Q Y
  1.  ;
  1. UC(STR) ;Convert to upper case
  1.  N X,Y
  1.  S X=STR X ^%ZOSF("UPPERCASE")
  1.  Q Y
  1.  ;