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

SCCVDEL.m

Go to the documentation of this file. 
  1. SCCVDEL ;ALB/TMP - OLD SCHED VISITS FILE DELETE; [ 03/04/98  09:39 AM ]
  1.  ;;5.3;Scheduling;**211,1015**;Aug 13, 1993;Build 21
  1.  ;
  1. EN ; Main entry point - display scheduling files to delete
  1.  N Z
  1.  D DT^DICRW
  1.  D FULL^VALM1
  1.  W !!,*7,"                 *** WARNING ***"
  1.  W !,"This action allows PERMANENT DELETION of old Scheduling files!"
  1.  W !,"If you are at all uncertain about this option, DO NOT delete any files.",!!
  1.  D PAUSE^SCCVU
  1.  D EN^VALM("SCCV CONV DELETE FILE MENU")
  1.  Q
  1.  ;
  1. INIT ; -- set up initial variables
  1.  D FNL
  1.  S U="^",VALMCNT=0,VALMBG=1
  1.  D BLD
  1.  Q
  1.  ;
  1. FNL ; Clean up
  1.  K ^TMP("SCCV.DELETE",$J),^TMP("SCCV.DELETE.DX",$J)
  1.  K SCCVFIL
  1.  S VALMBCK="Q"
  1.  Q
  1.  ;
  1. BLD ;Build parameter display
  1.  N SCCVFIL,SCCVFNM,SCCVGBL,SCCVST,SCCVDDT,SCCVEDT
  1.  S SCCVEDT=+$G(^SD(404.91,1,"CNV")) IF 'SCCVEDT S SCCVEDT=9999999 ; earliest date
  1.  S VALMBG=1
  1.  K ^TMP("SCCV.DELETE",$J),^TMP("SCCV.DELETE.DX",$J)
  1.  S VALMCNT=0
  1.  F SCCVFIL=40.1,40.15,409.5,409.43,409.44 D
  1.  . S VALMCNT=VALMCNT+1,X=""
  1.  . S SCCVFNM=$$FNAME(SCCVFIL)
  1.  . S SCCVGBL=$$FGLB(SCCVFIL)
  1.  . S SCCVDDT=$$FDELDT(SCCVFIL)
  1.  . S SCCVST=2                                 ; nothing deleted
  1.  . IF SCCVDDT<SCCVEDT S SCCVST=3              ; can't delete
  1.  . IF $D(@SCCVGBL)=0 S SCCVST=0               ; data deleted
  1.  . IF SCCVST,$D(^DIC(SCCVFIL,0))=0 S SCCVST=1 ; dd deleted
  1.  . S X=$$SETFLD^VALM1(VALMCNT,X,"NUMBER")
  1.  . S X=$$SETFLD^VALM1(SCCVFIL,X,"FNUMBER")
  1.  . S X=$$SETFLD^VALM1(SCCVFNM,X,"FNAME")
  1.  . S X=$$SETFLD^VALM1(SCCVGBL,X,"GLOBAL")
  1.  . S X=$$SETFLD^VALM1($S('SCCVST:"Data and DD Deleted",SCCVST=1:"DD Deleted Only",SCCVST=2:"Nothing Deleted",1:"Deletion Not Allowed"),X,"STATUS")
  1.  . ;
  1.  . S ^TMP("SCCV.DELETE",$J,VALMCNT,0)=X
  1.  . S ^TMP("SCCV.DELETE",$J,"IDX",VALMCNT,VALMCNT)=""
  1.  . S ^TMP("SCCV.DELETE"_".DX",$J,VALMCNT)=SCCVFIL_U_SCCVST_U_"("_SCCVFNM_")"
  1.  Q
  1.  ;
  1. DELDD ; Delete DDs and templates for files
  1.  N VALMY,SCCV,SCCVFIL
  1.  D FULL^VALM1
  1.  W !
  1.  ;
  1.  IF '$$GAP() G DELDDQ
  1.  ;
  1.  IF '$$COMPL() G DELDDQ
  1.  ;
  1.  I '$O(^SD(404.98,0))!'$$COMPL^SCCVPAR(1) D  G:'SCOK DELDDQ
  1.  . N DIR,Y
  1.  . S DIR("B")="NO"
  1.  . S DIR(0)="YA"
  1.  . S DIR("A",1)="It appears that no conversion was completed at your site."
  1.  . S DIR("A",2)="If you choose to continue, all data in the old Scheduling files could be lost."
  1.  . S DIR("A")="Are you sure you want to do this?: "
  1.  . D ^DIR K DIR
  1.  . S SCOK=(Y=1)
  1.  ;
  1.  S DIR(0)="YA"
  1.  S DIR("A",1)="This action will PERMANENTLY DELETE any selected files!"
  1.  S DIR("A")="Are you absolutely sure you want to do this?: "
  1.  S DIR("B")="NO"
  1.  D ^DIR K DIR
  1.  G:Y'=1 DELDDQ
  1.  ;
  1.  W !
  1.  D EN^VALM2($G(XQORNOD(0)))
  1.  S SCCV=0 F  S SCCV=$O(VALMY(SCCV)) Q:'SCCV  D
  1.  . S SCCVFIL=$G(^TMP("SCCV.DELETE.DX",$J,SCCV))
  1.  . IF $P(SCCVFIL,U,2)=3 D  Q
  1.  . . W !!,"Deleting File # "_+SCCVFIL_" "_$P(SCCVFIL,U,3)," is not allowed."
  1.  . . W !,"You did not convert back to '"_$$FMTE^XLFDT($$FDELDT(+SCCVFIL),"5Z")_"'."
  1.  . . D PAUSE^SCCVU
  1.  . . ;
  1.  . IF $P(SCCVFIL,U,2)'=2 D  Q
  1.  . . W !!,"DD and templates for File # "_+SCCVFIL_" "_$P(SCCVFIL,U,3)
  1.  . . W !,"have already been deleted!"
  1.  . . D PAUSE^SCCVU
  1.  . D DELFIL(+SCCVFIL,$P(SCCVFIL,U,3))
  1.  D BLD
  1. DELDDQ S VALMBCK="R"
  1.  Q
  1.  ;
  1. GAP() ; -- check to see if there gaps in conversion
  1.  ; -- return: 1 - no gap | 0 - gaps exist
  1.  N SCOK
  1.  S SCOK=0
  1.  I $$SEQGAP^SCCVPAR() D  G GAPQ
  1.  . N DIR,Y,SCDT1
  1.  . S SCDT1=$P($G(^SD(404.91,1,"CNV")),U)
  1.  . S:SCDT1 SCDT1=$$FMTE^XLFDT(SCDT1,"5Z")
  1.  . W !,"You have one or more gaps in conversion dates from your earliest"
  1.  . W !,"date to convert ("_$S(SCDT1'="":SCDT1,1:"NOT ENTERED")_") to 09/30/1996."
  1.  . W !,"You must finish converting before you can delete any of these files."
  1.  . D PAUSE^SCCVU
  1.  S SCOK=1
  1. GAPQ Q SCOK
  1.  ;
  1. COMPL() ; -- check if conversion complete flag is set
  1.  ; -- return: 1 - set | 0 - not set
  1.  N SCOK
  1.  S SCOK=0
  1.  I '$P($G(^SD(404.91,1,"CNV")),U,4) D  G COMPLQ
  1.  . W !,"No file deletes can be performed until a date has been"
  1.  . W !,"recorded in the conversion site parameters indicating"
  1.  . W !,"that the conversion is complete."
  1.  . D PAUSE^SCCVU
  1.  S SCOK=1
  1. COMPLQ Q SCOK
  1.  ;
  1. DELFIL(FNO,FNM) ;Delete dd and templates for the specified file #FNO
  1.  ; FNM = the file name in ()
  1.  N DIR,Y,SCOK
  1.  S SCOK=0
  1.  ;
  1.  S DIR(0)="YA"
  1.  S DIR("B")="NO"
  1.  S DIR("A",1)="I am about to PERMANENTLY DELETE file #"_FNO_" "_FNM_"!"
  1.  S DIR("A")="Are you absolutely sure you want to do this? "
  1.  D ^DIR
  1.  K DIR
  1.  S SCOK=Y
  1.  ;
  1.  IF SCOK=1 D
  1.  . S DIR(0)="YA"
  1.  . S DIR("B")="NO"
  1.  . S DIR("A")="Does your site have a backup/archive of this file? "
  1.  . D ^DIR
  1.  . K DIR
  1.  . S SCOK=Y
  1.  . ;
  1.  . ; -- log user and date/time info
  1.  . IF SCOK=1 D
  1.  . . S Y=$$LOG(FNO,$G(DUZ),"DD")
  1.  . . S SCOK=+Y
  1.  . . IF 'Y D
  1.  . . . W !,"Cannot delete data dictionary and templates for file!"
  1.  . . . W !,$P(Y,U,2)
  1.  ;
  1.  I SCOK=1 D  G DFQ
  1.  . W !!,"Data Dictionary and Template Deletion of"
  1.  . W !,"file # "_FNO_" "_FNM_" is in process...",!
  1.  . S DIU=FNO
  1.  . S DIU(0)="ET"
  1.  . D EN^DIU2
  1.  . W !!,"Data Dictionary and Templates for File # "_FNO_" "_FNM
  1.  . W !,"have been deleted."
  1.  . D MSG(FNO)
  1.  ;
  1.  W !,"Data Dictionary and Templates for File # "_FNO_" "_FNM
  1.  W !,"have NOT been deleted."
  1.  ;
  1. DFQ D PAUSE^SCCVU
  1.  Q
  1.  ;
  1. MSG(FNO) ; -- display protect message
  1.  N SCGLB
  1.  S SCGLB=$$FGLB(FNO)
  1.  W !
  1.  W !,"NOTE:  Only the data dictionary and templates have been"
  1.  W !,"       deleted."
  1.  W !
  1.  W !,"       In order to delete the data, execute the following action:"
  1.  W !,"                  Data Global Deletion"
  1.  W !
  1.  ;
  1.  IF FNO=409.43!(FNO=409.44) G MSGQ
  1.  ;
  1.  W !,"       However, you must first determine if KILLing at the global"
  1.  W !,"       root level is allowed for this global '",SCGLB,"' on your"
  1.  W !,"       system."
  1.  W !
  1.  W !,"       Unfortunately, there is no programmer API to check this"
  1.  W !,"       global characteristic using Kernel tools."
  1.  W !
  1.  W !,"       If you need help checking and setting this global parameter,"
  1.  W !,"       please contact National VistA Support (NVS)."
  1.  W !
  1. MSGQ Q
  1.  ;
  1. LOG(FILE,USER,TYPE) ; -- log file deletion
  1.  N SCFIN,SCRET,SCDEL,DIE,DA,Y,DR,X
  1.  S SCRET="1^Log data successfully filed."
  1.  ;
  1.  IF $G(TYPE)="DD"!(TYPE="DATA") D
  1.  . S SCDEL("TYPE")=TYPE
  1.  ELSE  D
  1.  . S SCRET="0^Not a valid deletion type"
  1.  ;
  1.  IF 'SCRET G LOGQ
  1.  ;
  1.  IF $G(FILE) D
  1.  . IF FILE=409.5!(FILE=409.43)!(FILE=409.44)!(FILE=40.1)!(FILE=40.15) D
  1.  . . S SCDEL("FILE")=FILE
  1.  . ELSE  D
  1.  . . S SCRET="0^Not a file that can be deleted."
  1.  ELSE  D
  1.  . S SCRET="0^No file specified."
  1.  ;
  1.  IF 'SCRET G LOGQ
  1.  ;
  1.  IF $G(USER) D
  1.  . S SCDEL("USER")=USER
  1.  ELSE  D
  1.  . S SCRET="0^No user specified."
  1.  ;
  1.  IF 'SCRET G LOGQ
  1.  ;
  1.  S SCDEL("DATE/TIME")=$$NOW^XLFDT
  1.  ;
  1.  L +^SD(404.91,1):2
  1.  IF '$T S SCRET="0^Unable to lock SCHEDULING PARAMETER file." G LOGQ
  1.  S DIE="^SD(404.91,",DA=1,DR="[SCCV CONV FILE DELETION LOG]" D ^DIE
  1.  L -^SD(404.91,1)
  1.  IF '$G(SCFIN) S SCRET="0^Filing of deletion log data failed." G LOGQ
  1.  ;
  1. LOGQ Q SCRET
  1.  ;
  1. FNAME(FNO) ; -- get file name
  1.  N F
  1.  S F(40.1)="OPC"
  1.  S F(40.15)="OPC ERRORS"
  1.  S F(409.5)="SCHEDULING VISITS"
  1.  S F(409.43)="OUTPATIENT DIAGNOSIS"
  1.  S F(409.44)="OUTPATIENT PROVIDER"
  1.  Q F(FNO)
  1.  ;
  1. FGLB(FNO) ; -- get data global for file
  1.  N F
  1.  S F(40.1)="^SDASF"
  1.  S F(40.15)="^SDASE"
  1.  S F(409.5)="^SDV"
  1.  S F(409.43)="^SDD(409.43)"
  1.  S F(409.44)="^SDD(409.44)"
  1.  Q F(FNO)
  1.  ;
  1. FDELDT(FNO) ; -- get date the site must convert back to in order to delete
  1.  ; file dd and data
  1.  N F
  1.  S F(40.1)=9999998
  1.  S F(40.15)=9999998
  1.  S F(409.5)=2871001
  1.  S F(409.43)=2931001
  1.  S F(409.44)=2931001
  1.  Q F(FNO)
  1.  ;