YTPCL ;ALB/ASF TEST-PTST CHECKLISTS ; 4/5/07 10:05am
;;5.01;MENTAL HEALTH;**66,85**;Dec 30, 1994;Build 48
;
;Reference to ^DIR supported by IA #10026
;
SCOR ;
S YSTY="W*",YSNOITEM="DONE^YTPCL"
D ^YTREPT
S X=^YTD(601.2,YSDFN,1,YSET,1,YSED,1)
S (B,C,D)=0
F I=1:1:5 S Y=$E(X,I) S:(Y=3)!(Y=4)!(Y=5) B=B+1
F I=6:1:12 S Y=$E(X,I) S:(Y=3)!(Y=4)!(Y=5) C=C+1
F I=13:1:17 S Y=$E(X,I) S:(Y=3)!(Y=4)!(Y=5) D=D+1
ZZ W !!,"DSM-IV PTSD Criteria B ",$S(B>0:"IS met",1:"is NOT met")
W !,"DSM-IV PTSD Criteria C ",$S(C>2:"IS met",1:"is NOT met")
W !,"DSM-IV PTSD Criteria D ",$S(D>1:"IS met",1:"is NOT met")
I (B>0)&(C>2)&(D>1) W !!,"*** PTSD Diagnosis IS SUGGESTED ***"
W !!
I IOST?1"C".E W ! S DIR(0)="E" D ^DIR Q:Y'=1
W !!!,"Items"
F I=1:1:17 D
. W !,I,". ",^YTT(601,YSET,"Q",I,"T",1,0)
. I $D(^YTT(601,YSET,"Q",I,"T",2,0)) W:^(0)'=" " !?7,^(0)
. I I=5 W !?7,^YTT(601,YSET,"Q",I,"T",3,0)
. W " :",$E(^YTD(601.2,YSDFN,1,YSET,1,YSED,1),I)
W !!,"1= Not at all 2= A little bit 3= Moderately 4= Quite a bit 5= Extremely"
Q
SPTSD ;SCREENING REPORT
D DTA^YTREPT
W !!,?7,"Post Traumatic Stress Disorder Screen",!!
S X=^YTD(601.2,YSDFN,1,YSET,1,YSED,1)
W !,"Patient Reports "_$S($E(X,1)="Y":"HAVING",1:"NO")_" traumatic experiences.",!
W:$E(X,2)="Y" !,"In the past month, the patient has been bothered by repeated, disturbing",!,"memories, thoughts, or images of one or more of the stressful events."
W:$E(X,3)="Y" !,"In the past month, has felt distant or cut off from other people."
W:$E(X,4)="Y" !,"Has been 'super alert' or watchful or on guard in the past month."
W:$E(X,2,9)?.E1"Y".E !!,"Please refer to a mental health professional for further evaluation",!,"and treatment of probable PTSD"
I IOST?1"C".E W ! S DIR(0)="E" D ^DIR Q:Y'=1
DONE QUIT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYTPCL 1800 printed Apr 09, 2024@21:24:39 Page 2
YTPCL ;ALB/ASF TEST-PTST CHECKLISTS ; 4/5/07 10:05am
+1 ;;5.01;MENTAL HEALTH;**66,85**;Dec 30, 1994;Build 48
+2 ;
+3 ;Reference to ^DIR supported by IA #10026
+4 ;
SCOR ;
+1 SET YSTY="W*"
SET YSNOITEM="DONE^YTPCL"
+2 DO ^YTREPT
+3 SET X=^YTD(601.2,YSDFN,1,YSET,1,YSED,1)
+4 SET (B,C,D)=0
+5 FOR I=1:1:5
SET Y=$EXTRACT(X,I)
if (Y=3)!(Y=4)!(Y=5)
SET B=B+1
+6 FOR I=6:1:12
SET Y=$EXTRACT(X,I)
if (Y=3)!(Y=4)!(Y=5)
SET C=C+1
+7 FOR I=13:1:17
SET Y=$EXTRACT(X,I)
if (Y=3)!(Y=4)!(Y=5)
SET D=D+1
ZZ WRITE !!,"DSM-IV PTSD Criteria B ",$SELECT(B>0:"IS met",1:"is NOT met")
+1 WRITE !,"DSM-IV PTSD Criteria C ",$SELECT(C>2:"IS met",1:"is NOT met")
+2 WRITE !,"DSM-IV PTSD Criteria D ",$SELECT(D>1:"IS met",1:"is NOT met")
+3 IF (B>0)&(C>2)&(D>1)
WRITE !!,"*** PTSD Diagnosis IS SUGGESTED ***"
+4 WRITE !!
+5 IF IOST?1"C".E
WRITE !
SET DIR(0)="E"
DO ^DIR
if Y'=1
QUIT
+6 WRITE !!!,"Items"
+7 FOR I=1:1:17
Begin DoDot:1
+8 WRITE !,I,". ",^YTT(601,YSET,"Q",I,"T",1,0)
+9 IF $DATA(^YTT(601,YSET,"Q",I,"T",2,0))
if ^(0)'=" "
WRITE !?7,^(0)
+10 IF I=5
WRITE !?7,^YTT(601,YSET,"Q",I,"T",3,0)
+11 WRITE " :",$EXTRACT(^YTD(601.2,YSDFN,1,YSET,1,YSED,1),I)
End DoDot:1
+12 WRITE !!,"1= Not at all 2= A little bit 3= Moderately 4= Quite a bit 5= Extremely"
+13 QUIT
SPTSD ;SCREENING REPORT
+1 DO DTA^YTREPT
+2 WRITE !!,?7,"Post Traumatic Stress Disorder Screen",!!
+3 SET X=^YTD(601.2,YSDFN,1,YSET,1,YSED,1)
+4 WRITE !,"Patient Reports "_$SELECT($EXTRACT(X,1)="Y":"HAVING",1:"NO")_" traumatic experiences.",!
+5 if $EXTRACT(X,2)="Y"
WRITE !,"In the past month, the patient has been bothered by repeated, disturbing",!,"memories, thoughts, or images of one or more of the stressful events."
+6 if $EXTRACT(X,3)="Y"
WRITE !,"In the past month, has felt distant or cut off from other people."
+7 if $EXTRACT(X,4)="Y"
WRITE !,"Has been 'super alert' or watchful or on guard in the past month."
+8 if $EXTRACT(X,2,9)?.E1"Y".E
WRITE !!,"Please refer to a mental health professional for further evaluation",!,"and treatment of probable PTSD"
+9 IF IOST?1"C".E
WRITE !
SET DIR(0)="E"
DO ^DIR
if Y'=1
QUIT
DONE QUIT
