- YTATQ ;SLC/DKG-TEST PKG: SCORING FOR AUTOMATIC THOUGHTS QUESTIONNAIRE ; 10/20/88 12:38 ;
- ;;5.01;MENTAL HEALTH;;Dec 30, 1994
- ;
- S YSRR=^YTD(601.2,YSDFN,1,YSET,1,YSED,1),R=0
- F J=1:1 Q:$E(YSRR,J)="" S R=R+$E(YSRR,J)
- S F(1)="7^10^14^20^26",F(2)="2^3^9^21^23^24^28^",F(3)="17^18",F(4)="29^30",YSAN=0
- F J=1:1:4 S YSAD=F(J) F K=1:1 S YSEX=$P(YSAD,U,K) S:YSEX="" R=R_U_YSAN,YSAN=0 Q:YSEX="" S YSAN=YSAN+$E(YSRR,YSEX)
- K F,YSAD,YSAN,YSEX,YSRR Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYTATQ 452 printed Feb 18, 2025@23:43:15 Page 2
- YTATQ ;SLC/DKG-TEST PKG: SCORING FOR AUTOMATIC THOUGHTS QUESTIONNAIRE ; 10/20/88 12:38 ;
- +1 ;;5.01;MENTAL HEALTH;;Dec 30, 1994
- +2 ;
- +3 SET YSRR=^YTD(601.2,YSDFN,1,YSET,1,YSED,1)
- SET R=0
- +4 FOR J=1:1
- if $EXTRACT(YSRR,J)=""
- QUIT
- SET R=R+$EXTRACT(YSRR,J)
- +5 SET F(1)="7^10^14^20^26"
- SET F(2)="2^3^9^21^23^24^28^"
- SET F(3)="17^18"
- SET F(4)="29^30"
- SET YSAN=0
- +6 FOR J=1:1:4
- SET YSAD=F(J)
- FOR K=1:1
- SET YSEX=$PIECE(YSAD,U,K)
- if YSEX=""
- SET R=R_U_YSAN
- SET YSAN=0
- if YSEX=""
- QUIT
- SET YSAN=YSAN+$EXTRACT(YSRR,YSEX)
- +7 KILL F,YSAD,YSAN,YSEX,YSRR
- QUIT