YTSBSS ;SLC/PIJ - Score BSS ; 01/19/2016
 ;;5.01;MENTAL HEALTH;**123**;Dec 30, 1994;Build 73
 ;
 Q
 ;
DATA1 ;
 S SCORE=0
 S YSINSNAM=$P($G(YSDATA(2)),U,3)
 I $G(YSINSNAM)="" S YSINSNAM=$G(YS("CODE"),"NO NAME PASSED")
 S NODE=2 F  S NODE=$O(YSDATA(NODE)) Q:NODE=""  D  ; Start at YSDATA(3)
 .S DATA=YSDATA(NODE)
 .S YSQN=$P($G(DATA),U,1)
 .S YSSEQ=$P($G(DATA),U,2),DES=YSSEQ
 .S YSCDA=$P($G(DATA),U,3)
 .S YSAN=$$GET1^DIQ(601.75,YSCDA_",",3,"I")
 .S LEG=$$GET1^DIQ(601.75,YSCDA,4,"I")
 .I (NODE'=22),(NODE'=23) D
 ..S SCORE=SCORE+LEG
 .;S STRING=STRING_"| "_DES_". "_YSAN_" ("_LEG_" points)"
 .S STRING=STRING_"| "_DES_". "_YSAN_" ("_LEG
 .S:LEG'=1 STRING=STRING_" points)"
 .S:LEG=1 STRING=STRING_" point)"
 Q
 ;
STRING ;
 I '$D(^TMP($J,"YSCOR")) D  Q
 .S STRING1=STRING1_"| "_YSINSNAM_" score could not be determined."
 .S STRING1=STRING1_"|| Questions and answers"
 ;
 S SCORE=$P($G(^TMP($J,"YSCOR",2)),"=",2)
 S STRING1=STRING1_" "_YSINSNAM_" Score: "_SCORE
 S STRING1=STRING1_"||The BSS is intended to assess thoughts, plans and intent to die by suicide "
 S STRING1=STRING1_"or attempt suicide over the past week. Total scores can range from 0-38."
 S STRING1=STRING1_" There is no specific cut-off score to classify severity or guide patient management, "
 S STRING1=STRING1_"however, increasing scores reflect greater risk, and any positive response to any"
 S STRING1=STRING1_" item may reflect the presence of suicidal intention and should be investigated further. "
 S STRING1=STRING1_"||Questions and answers|"
 Q
 ;
SCORESV ;
 I $D(^TMP($J,"YSG",1)),^TMP($J,"YSG",1)="[ERROR]" D  Q  ;-->out
 .K ^TMP($J,"YSCOR")
 .S ^TMP($J,"YSCOR",1)="[ERROR]"
 .S ^TMP($J,"YSCOR",2)=YSINSNAM_" Scale not found"
 ;
 K ^TMP($J,"YSCOR")
 S ^TMP($J,"YSCOR",1)="[DATA]"
 ;Removed this scale.
 ;S ^TMP($J,"YSCOR",2)=$$GET1^DIQ(601.87,337_",",3,"I")_"="_SCORE  ; Suicidal Ideation
 S ^TMP($J,"YSCOR",2)=$$GET1^DIQ(601.87,900_",",3,"I")_"="_SCORE  ; Score
 Q
 ;
DLLSTR(YSDATA,YS,YSTRNG) ;
 ;  YSTRNG = 1 Score Instrument
 ;  YSTRNG = 2 get Report Answers and Text 
 N DATA,DES,LEG,NODE,YSAN,YSQN,YSCDA,SCORE
 N YSSEQ,YSINSNAM,STRING,STRING1
 ;
 S (STRING,STRING1)=""
 S SCORE=0
 ;
 D DATA1
 I YSTRNG=1 D SCORESV
 I YSTRNG=2 D
 .D LDSCORES^YTSCORE(.YSDATA,.YS)
 .D STRING
 .S STRING1=STRING1_STRING
 .S YSDATA($O(YSDATA(""),-1)+1)=999999999999_U_U_STRING1
 Q
 
--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYTSBSS   2416     printed  Sep 23, 2025@19:55:35                                                                                                                                                                                                      Page 2
YTSBSS    ;SLC/PIJ - Score BSS ; 01/19/2016
 +1       ;;5.01;MENTAL HEALTH;**123**;Dec 30, 1994;Build 73
 +2       ;
 +3        QUIT 
 +4       ;
DATA1     ;
 +1        SET SCORE=0
 +2        SET YSINSNAM=$PIECE($GET(YSDATA(2)),U,3)
 +3        IF $GET(YSINSNAM)=""
               SET YSINSNAM=$GET(YS("CODE"),"NO NAME PASSED")
 +4       ; Start at YSDATA(3)
           SET NODE=2
           FOR 
               SET NODE=$ORDER(YSDATA(NODE))
               if NODE=""
                   QUIT 
               Begin DoDot:1
 +5                SET DATA=YSDATA(NODE)
 +6                SET YSQN=$PIECE($GET(DATA),U,1)
 +7                SET YSSEQ=$PIECE($GET(DATA),U,2)
                   SET DES=YSSEQ
 +8                SET YSCDA=$PIECE($GET(DATA),U,3)
 +9                SET YSAN=$$GET1^DIQ(601.75,YSCDA_",",3,"I")
 +10               SET LEG=$$GET1^DIQ(601.75,YSCDA,4,"I")
 +11               IF (NODE'=22)
                       IF (NODE'=23)
                           Begin DoDot:2
 +12                           SET SCORE=SCORE+LEG
                           End DoDot:2
 +13      ;S STRING=STRING_"| "_DES_". "_YSAN_" ("_LEG_" points)"
 +14               SET STRING=STRING_"| "_DES_". "_YSAN_" ("_LEG
 +15               if LEG'=1
                       SET STRING=STRING_" points)"
 +16               if LEG=1
                       SET STRING=STRING_" point)"
               End DoDot:1
 +17       QUIT 
 +18      ;
STRING    ;
 +1        IF '$DATA(^TMP($JOB,"YSCOR"))
               Begin DoDot:1
 +2                SET STRING1=STRING1_"| "_YSINSNAM_" score could not be determined."
 +3                SET STRING1=STRING1_"|| Questions and answers"
               End DoDot:1
               QUIT 
 +4       ;
 +5        SET SCORE=$PIECE($GET(^TMP($JOB,"YSCOR",2)),"=",2)
 +6        SET STRING1=STRING1_" "_YSINSNAM_" Score: "_SCORE
 +7        SET STRING1=STRING1_"||The BSS is intended to assess thoughts, plans and intent to die by suicide "
 +8        SET STRING1=STRING1_"or attempt suicide over the past week. Total scores can range from 0-38."
 +9        SET STRING1=STRING1_" There is no specific cut-off score to classify severity or guide patient management, "
 +10       SET STRING1=STRING1_"however, increasing scores reflect greater risk, and any positive response to any"
 +11       SET STRING1=STRING1_" item may reflect the presence of suicidal intention and should be investigated further. "
 +12       SET STRING1=STRING1_"||Questions and answers|"
 +13       QUIT 
 +14      ;
SCORESV   ;
 +1       ;-->out
           IF $DATA(^TMP($JOB,"YSG",1))
               IF ^TMP($JOB,"YSG",1)="[ERROR]"
                   Begin DoDot:1
 +2                    KILL ^TMP($JOB,"YSCOR")
 +3                    SET ^TMP($JOB,"YSCOR",1)="[ERROR]"
 +4                    SET ^TMP($JOB,"YSCOR",2)=YSINSNAM_" Scale not found"
                   End DoDot:1
                   QUIT 
 +5       ;
 +6        KILL ^TMP($JOB,"YSCOR")
 +7        SET ^TMP($JOB,"YSCOR",1)="[DATA]"
 +8       ;Removed this scale.
 +9       ;S ^TMP($J,"YSCOR",2)=$$GET1^DIQ(601.87,337_",",3,"I")_"="_SCORE  ; Suicidal Ideation
 +10      ; Score
           SET ^TMP($JOB,"YSCOR",2)=$$GET1^DIQ(601.87,900_",",3,"I")_"="_SCORE
 +11       QUIT 
 +12      ;
DLLSTR(YSDATA,YS,YSTRNG) ;
 +1       ;  YSTRNG = 1 Score Instrument
 +2       ;  YSTRNG = 2 get Report Answers and Text 
 +3        NEW DATA,DES,LEG,NODE,YSAN,YSQN,YSCDA,SCORE
 +4        NEW YSSEQ,YSINSNAM,STRING,STRING1
 +5       ;
 +6        SET (STRING,STRING1)=""
 +7        SET SCORE=0
 +8       ;
 +9        DO DATA1
 +10       IF YSTRNG=1
               DO SCORESV
 +11       IF YSTRNG=2
               Begin DoDot:1
 +12               DO LDSCORES^YTSCORE(.YSDATA,.YS)
 +13               DO STRING
 +14               SET STRING1=STRING1_STRING
 +15               SET YSDATA($ORDER(YSDATA(""),-1)+1)=999999999999_U_U_STRING1
               End DoDot:1
 +16       QUIT