YTKILINC ;SLC/TGA-KILL INCOMPLETE TESTS ;11/19/90 16:41 ;
;;5.01;MENTAL HEALTH;;Dec 30, 1994
;
; Called from the top by MENU option YSKILLINC
S ;
W !!,"This option deletes incomplete tests and interviews which",!,"have been incomplete for longer than 30 days."
W !!,"Are you sure you wish to delete discontinued sessions now? N// " R A:DTIME S YSTOUT='$T,YSUOUT=A["^" G:YSTOUT!YSUOUT END S A=$TR($E(A_"N"),"yn","YN") G END:"N"[A I "Y"'[A W:A'["?" " ?",$C(7) G S
W !!,"I will list any instruments I delete.",!! S %ZIS="Q" D ^%ZIS G:POP END I $D(IO("Q")) S ZTRTN="ENP^YTKILINC",ZTDESC="YS MH INST DELETE" D ^%ZTLOAD G END
ENP ;
S YSLFT=0 U IO D HD F P=0:0 S P=$O(^YTD(601.4,P)) Q:'P F T=0:0 S T=$O(^YTD(601.4,P,1,T)) Q:'T S X2=$P($G(^(T,0)),U,2) D D
Q:YSLFT I IOST?1"C-".E D WAIT^YSUTL
W ! D KILL^%ZTLOAD,^%ZISC
END ;
K %Y,A,DA,DIK,P,T,X,X1,X2,YSLFT,YSX,Z,ZTSK Q
D ;
K %Y S X1=DT D ^%DTC I $D(%Y),%Y,X<31 Q
I $Y+$S(IOST?1"C-".E:3,1:5)>IOSL D WAIT^YSUTL:IOST?1"C-".E G:YSLFT END D HD
S YSX=X,DIK="^YTD(601.4,P,1,",DA(1)=P,DA=T D ^DIK W !,"DELETED ",$S($D(^YTT(601,T,0)):$P(^(0),U),1:"UNKOWN INSTRUMENT")," FOR ",$S($D(^DPT(P,0)):$P(^(0),U),1:"UNKNOWN PATIENT")," - ",$S(YSX:YSX,1:"?")," DAYS OLD" Q
HD ;
W @IOF,!,"Deleted Incomplete Tests/Interviews",!!
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYTKILINC 1289 printed Oct 16, 2024@18:18:05 Page 2
YTKILINC ;SLC/TGA-KILL INCOMPLETE TESTS ;11/19/90 16:41 ;
+1 ;;5.01;MENTAL HEALTH;;Dec 30, 1994
+2 ;
+3 ; Called from the top by MENU option YSKILLINC
S ;
+1 WRITE !!,"This option deletes incomplete tests and interviews which",!,"have been incomplete for longer than 30 days."
+2 WRITE !!,"Are you sure you wish to delete discontinued sessions now? N// "
READ A:DTIME
SET YSTOUT='$TEST
SET YSUOUT=A["^"
if YSTOUT!YSUOUT
GOTO END
SET A=$TRANSLATE($EXTRACT(A_"N"),"yn","YN")
if "N"[A
GOTO END
IF "Y"'[A
if A'["?"
WRITE " ?",$CHAR(7)
GOTO S
+3 WRITE !!,"I will list any instruments I delete.",!!
SET %ZIS="Q"
DO ^%ZIS
if POP
GOTO END
IF $DATA(IO("Q"))
SET ZTRTN="ENP^YTKILINC"
SET ZTDESC="YS MH INST DELETE"
DO ^%ZTLOAD
GOTO END
ENP ;
+1 SET YSLFT=0
USE IO
DO HD
FOR P=0:0
SET P=$ORDER(^YTD(601.4,P))
if 'P
QUIT
FOR T=0:0
SET T=$ORDER(^YTD(601.4,P,1,T))
if 'T
QUIT
SET X2=$PIECE($GET(^(T,0)),U,2)
DO D
+2 if YSLFT
QUIT
IF IOST?1"C-".E
DO WAIT^YSUTL
+3 WRITE !
DO KILL^%ZTLOAD
DO ^%ZISC
END ;
+1 KILL %Y,A,DA,DIK,P,T,X,X1,X2,YSLFT,YSX,Z,ZTSK
QUIT
D ;
+1 KILL %Y
SET X1=DT
DO ^%DTC
IF $DATA(%Y)
IF %Y
IF X<31
QUIT
+2 IF $Y+$SELECT(IOST?1"C-".E:3,1:5)>IOSL
if IOST?1"C-".E
DO WAIT^YSUTL
if YSLFT
GOTO END
DO HD
+3 SET YSX=X
SET DIK="^YTD(601.4,P,1,"
SET DA(1)=P
SET DA=T
DO ^DIK
WRITE !,"DELETED ",$SELECT($DATA(^YTT(601,T,0)):$PIECE(^(0),U),1:"UNKOWN INSTRUMENT")," FOR ",$SELECT($DATA(^DPT(P,0)):$PIECE(^(0),U),1:"UNKNOWN PATIENT")," - ",$SELECT(YSX:YSX,1:"?")," DAYS OLD"
QUIT
HD ;
+1 WRITE @IOF,!,"Deleted Incomplete Tests/Interviews",!!
