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