YTATQ.m

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 ---YTATQ   452     printed  Apr 09, 2024@21:19:26                                                                                                                                                                                                        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