YTKIL ;SLC/TGA-KILL TEST/INTERVIEW DATA ;4/21/92 08:50 ; 10/31/07 12:41pm
;;5.01;MENTAL HEALTH;**37,85,100**;Dec 30, 1994;Build 2
;
; Called from the top by MENU option YSMKIL
;
S YSO=0,YSNOKILL=1 W @IOF,!!,"Delete Patient Data"
W ! D ^YSLRP G:YSDFN<1 END
S DIR(0)="Y",DIR("A")="Delete MH administration/test data",DIR("B")="No" D ^DIR
Q:$G(DIRUT)
IF Y D EN^YTQKIL Q ;-->out
I '$D(^YTD(601.2,YSDFN)),'$D(^YTD(601.4,YSDFN)) W !!,"NO DATA ON THIS PATIENT!" G END
R ;
R !!,"Delete All tests and interviews? N// ",A:DTIME S YSTOUT='$T,YSUOUT=A["^" G:YSTOUT!YSUOUT END S A=$TR($E(A_"N"),"yn","YN") I "YN"'[A W:A'["?" " ?",$C(7) G R
I "Y"[A S DIK="^YTD(601.2,",DA=YSDFN D ^DIK S DIK="^YTD(601.4,",DA=YSDFN D ^DIK W !!,"DELETED!" G END
S T(0)=0 G:'$O(^YTD(601.4,YSDFN,1,0)) C W !!,"Incomplete tests and Interviews",! S YTC=$O(^YTT(601,"B","CLERK",0))
S T=0
F S T=$O(^YTD(601.4,YSDFN,1,T)) G:'T C S T(0)=T(0)+1 G:YSTOUT!YSUOUT END S X=^(T,0),P=$P(X,U),D=$P(X,U,2),DA=P S:P=YTC P=$P(X,U,6),DA=YTC W !!,$$TN(+YSDFN,+T,+P),?10,$$FMTE^XLFDT(D,"5ZD") D DI
DI ;
R " ...Delete? N// ",K:DTIME S YSTOUT='$T,YSUOUT=K["^",K=$E(K) Q:"Nn"[K I YSTOUT!YSUOUT Q
I "Yy"'[K W:K'["?" " ?",$C(7) G DI
S DIK="^YTD(601.4,YSDFN,1,",DA(1)=YSDFN D ^DIK W ?40,"DELETED!" Q
C ;
G:'$D(^YTD(601.2,YSDFN,1,0)) E W !!,"Completed Tests and Interviews"
S T=0
F S T=$O(^YTD(601.2,YSDFN,1,T)) G:'T!YSUOUT END F D=0:0 S D=$O(^YTD(601.2,YSDFN,1,T,1,D)) Q:'D S T(0)=T(0)+1 Q:YSTOUT!YSUOUT Q:'$D(^YTT(601,T)) W !!,$P(^YTT(601,T,0),U),?10,$$FMTE^XLFDT(D,"5ZD") D DC
DC ;
R " ...Delete? N// ",K:DTIME S YSTOUT='$T,YSUOUT=K["^",K=$E(K) Q:"Nn"[K I YSTOUT!YSUOUT Q
I "Yy"'[K W:K'["?" " ?",$C(7) G DC
S DIK="^YTD(601.2,YSDFN,1,T,1,",DA=D,DA(1)=T,DA(2)=YSDFN D ^DIK W ?40,"DELETED" Q
E ;
W:'T(0) !!,"NO TESTS/INTERVIEWS FOUND!"
END ;
K %,A,D,DA,DIC,DIK,K,P,T,X,YSAGE,YSDFN,YSDOB,YSE,YSN,YSNM,YSNOKILL,YSO,YSS,YSSEX,YSSSN,YTC
QUIT
;
TN(DFN,TN6014,TN601) ;Print test name...
; TN6014 = IEN of ^YTD(601.4,+DFN,1,+TN6014...
; TN601 = IEN of ^YTT(601,+TN601...
N TESTNAME,X
S X=$P($G(^YTT(601,+TN601,0)),U),TESTNAME=$S(X']"":"Unknown",1:X)
I $G(^YTD(601.4,+DFN,1,+TN6014,99))'="MMPIR" QUIT TESTNAME ;->
QUIT $S(TN601=60:"MMPIR",TN601=61:"MMPR",1:"Unknown") ;->
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYTKIL 2292 printed Dec 13, 2024@02:17:22 Page 2
YTKIL ;SLC/TGA-KILL TEST/INTERVIEW DATA ;4/21/92 08:50 ; 10/31/07 12:41pm
+1 ;;5.01;MENTAL HEALTH;**37,85,100**;Dec 30, 1994;Build 2
+2 ;
+3 ; Called from the top by MENU option YSMKIL
+4 ;
+5 SET YSO=0
SET YSNOKILL=1
WRITE @IOF,!!,"Delete Patient Data"
+6 WRITE !
DO ^YSLRP
if YSDFN<1
GOTO END
+7 SET DIR(0)="Y"
SET DIR("A")="Delete MH administration/test data"
SET DIR("B")="No"
DO ^DIR
+8 if $GET(DIRUT)
QUIT
+9 ;-->out
IF Y
DO EN^YTQKIL
QUIT
+10 IF '$DATA(^YTD(601.2,YSDFN))
IF '$DATA(^YTD(601.4,YSDFN))
WRITE !!,"NO DATA ON THIS PATIENT!"
GOTO END
R ;
+1 READ !!,"Delete All tests and interviews? N// ",A:DTIME
SET YSTOUT='$TEST
SET YSUOUT=A["^"
if YSTOUT!YSUOUT
GOTO END
SET A=$TRANSLATE($EXTRACT(A_"N"),"yn","YN")
IF "YN"'[A
if A'["?"
WRITE " ?",$CHAR(7)
GOTO R
+2 IF "Y"[A
SET DIK="^YTD(601.2,"
SET DA=YSDFN
DO ^DIK
SET DIK="^YTD(601.4,"
SET DA=YSDFN
DO ^DIK
WRITE !!,"DELETED!"
GOTO END
+3 SET T(0)=0
if '$ORDER(^YTD(601.4,YSDFN,1,0))
GOTO C
WRITE !!,"Incomplete tests and Interviews",!
SET YTC=$ORDER(^YTT(601,"B","CLERK",0))
+4 SET T=0
+5 FOR
SET T=$ORDER(^YTD(601.4,YSDFN,1,T))
if 'T
GOTO C
SET T(0)=T(0)+1
if YSTOUT!YSUOUT
GOTO END
SET X=^(T,0)
SET P=$PIECE(X,U)
SET D=$PIECE(X,U,2)
SET DA=P
if P=YTC
SET P=$PIECE(X,U,6)
SET DA=YTC
WRITE !!,$$TN(+YSDFN,+T,+P),?10,$$FMTE^XLFDT(D,"5ZD")
DO DI
DI ;
+1 READ " ...Delete? N// ",K:DTIME
SET YSTOUT='$TEST
SET YSUOUT=K["^"
SET K=$EXTRACT(K)
if "Nn"[K
QUIT
IF YSTOUT!YSUOUT
QUIT
+2 IF "Yy"'[K
if K'["?"
WRITE " ?",$CHAR(7)
GOTO DI
+3 SET DIK="^YTD(601.4,YSDFN,1,"
SET DA(1)=YSDFN
DO ^DIK
WRITE ?40,"DELETED!"
QUIT
C ;
+1 if '$DATA(^YTD(601.2,YSDFN,1,0))
GOTO E
WRITE !!,"Completed Tests and Interviews"
+2 SET T=0
+3 FOR
SET T=$ORDER(^YTD(601.2,YSDFN,1,T))
if 'T!YSUOUT
GOTO END
FOR D=0:0
SET D=$ORDER(^YTD(601.2,YSDFN,1,T,1,D))
if 'D
QUIT
SET T(0)=T(0)+1
if YSTOUT!YSUOUT
QUIT
if '$DATA(^YTT(601,T))
QUIT
WRITE !!,$PIECE(^YTT(601,T,0),U),?10,$$FMTE^XLFDT(D,"5ZD")
DO DC
DC ;
+1 READ " ...Delete? N// ",K:DTIME
SET YSTOUT='$TEST
SET YSUOUT=K["^"
SET K=$EXTRACT(K)
if "Nn"[K
QUIT
IF YSTOUT!YSUOUT
QUIT
+2 IF "Yy"'[K
if K'["?"
WRITE " ?",$CHAR(7)
GOTO DC
+3 SET DIK="^YTD(601.2,YSDFN,1,T,1,"
SET DA=D
SET DA(1)=T
SET DA(2)=YSDFN
DO ^DIK
WRITE ?40,"DELETED"
QUIT
E ;
+1 if 'T(0)
WRITE !!,"NO TESTS/INTERVIEWS FOUND!"
END ;
+1 KILL %,A,D,DA,DIC,DIK,K,P,T,X,YSAGE,YSDFN,YSDOB,YSE,YSN,YSNM,YSNOKILL,YSO,YSS,YSSEX,YSSSN,YTC
+2 QUIT
+3 ;
TN(DFN,TN6014,TN601) ;Print test name...
+1 ; TN6014 = IEN of ^YTD(601.4,+DFN,1,+TN6014...
+2 ; TN601 = IEN of ^YTT(601,+TN601...
+3 NEW TESTNAME,X
+4 SET X=$PIECE($GET(^YTT(601,+TN601,0)),U)
SET TESTNAME=$SELECT(X']"":"Unknown",1:X)
+5 ;->
IF $GET(^YTD(601.4,+DFN,1,+TN6014,99))'="MMPIR"
QUIT TESTNAME
+6 ;->
QUIT $SELECT(TN601=60:"MMPIR",TN601=61:"MMPR",1:"Unknown")
+7 ;
