YTKILINC.m

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 ---YTKILINC   1289     printed  Apr 09, 2024@21:22:51                                                                                                                                                                                                    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",!!