DGPTBEP ;ALB/BOK - PURGE DRG BREAKEVEN DATA ; 26 MAR 87
;;5.3;Registration;**158**;Aug 13, 1993
D LO^DGUTL
START R !,"Purge BREAKEVEN data for Fiscal Year: ",DGFY:DTIME Q:DGFY["^"!('$T)!(DGFY']"")
I DGFY'?2N W !?2,"Enter Fiscal Year as 86 for FY 86." G START
S DGFY2K=$$DGY2K^DGPTOD0(DGFY) ; y2k compatible
I $E(DGFY2K,1,3)'<$E(DT,1,3) W !?2,*7,"Fiscal Year must be a PREVIOUS year." G START
;
W !!?2,"If the BREAKEVEN data for Fiscal Year `",DGFY," is deleted then"
W !?2,"the PTF DRG outputs CAN NOT be run for this time frame.",!
SURE W !?2,"Are you sure you want to purge Fiscal Year `",DGFY," BREAKEVEN data? "
S %=2 D YN^DICN G QUIT:%=2!(%=-1)
I %=0 W !?4,"Answer 'YES' to purge data or 'NO' not to purge data.",! G SURE
;
S DGFY=$$FMTE^XLFDT(DGFY2K)_0,DGFYQ=DGFY+4
KIL F I=0:0 S I=$O(^ICD(I)) Q:I'>0 W "." F K=DGFY:0 S K=$O(^ICD(I,"BE",K)) Q:K'>0!(K>DGFYQ) S DA(1)=I,DA=K,DIK="^ICD("_DA(1)_",""BE""," D ^DIK K DIK,DA
QUIT K DGFY,DGFYQ,DGFY2K,I,K,X Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGPTBEP 988 printed Dec 13, 2024@02:51:46 Page 2
DGPTBEP ;ALB/BOK - PURGE DRG BREAKEVEN DATA ; 26 MAR 87
+1 ;;5.3;Registration;**158**;Aug 13, 1993
+2 DO LO^DGUTL
START READ !,"Purge BREAKEVEN data for Fiscal Year: ",DGFY:DTIME
if DGFY["^"!('$TEST)!(DGFY']"")
QUIT
+1 IF DGFY'?2N
WRITE !?2,"Enter Fiscal Year as 86 for FY 86."
GOTO START
+2 ; y2k compatible
SET DGFY2K=$$DGY2K^DGPTOD0(DGFY)
+3 IF $EXTRACT(DGFY2K,1,3)'<$EXTRACT(DT,1,3)
WRITE !?2,*7,"Fiscal Year must be a PREVIOUS year."
GOTO START
+4 ;
+5 WRITE !!?2,"If the BREAKEVEN data for Fiscal Year `",DGFY," is deleted then"
+6 WRITE !?2,"the PTF DRG outputs CAN NOT be run for this time frame.",!
SURE WRITE !?2,"Are you sure you want to purge Fiscal Year `",DGFY," BREAKEVEN data? "
+1 SET %=2
DO YN^DICN
if %=2!(%=-1)
GOTO QUIT
+2 IF %=0
WRITE !?4,"Answer 'YES' to purge data or 'NO' not to purge data.",!
GOTO SURE
+3 ;
+4 SET DGFY=$$FMTE^XLFDT(DGFY2K)_0
SET DGFYQ=DGFY+4
KIL FOR I=0:0
SET I=$ORDER(^ICD(I))
if I'>0
QUIT
WRITE "."
FOR K=DGFY:0
SET K=$ORDER(^ICD(I,"BE",K))
if K'>0!(K>DGFYQ)
QUIT
SET DA(1)=I
SET DA=K
SET DIK="^ICD("_DA(1)_",""BE"","
DO ^DIK
KILL DIK,DA
QUIT KILL DGFY,DGFYQ,DGFY2K,I,K,X
QUIT
