- YTSISS2 ;SLC/MJB- SCORE ISS2 ; 10/30/18 9:35am
- ;;5.01;MENTAL HEALTH;**151**;Dec 30, 1994;Build 92
- ;
- ; This routine was split from YTQAPI2A.
- ; This routine handles limited complex reporting requirements without
- ; modifying YS_AUX.DLL by adding free text "answers" that can be used by
- ; a report.
- ;,
- ; Assumptions: EDIT incomplete instrument should ignore the extra answers
- ; since there are no associated questions. GRAPHING should ignore the
- ; answers since they not numeric.
- ;
- Q
- ;
- DLLSTR(YSDATA,YS,YSTRNG) ;
- ;
- N TOTAL,TXT,YSMED,YSOVER,YSTOTAL,YSCALEI,STRING,YSINSNAM,I,NODE,YSQN,YSCDA,DATA
- N YSCAL,YSVAL,YSCALVI,YTSCOR,YSVALA,YSRSC1,YSRSC2,YSRSC3,YSRSC4,YSRSC5
- N II,ISS2,YSCALIEN,YSSCNAM,YSRSC,YSMOOD,STRING1
- S N=N+1,II=0
- IF YSTRNG=1 D SCORESV
- I YSTRNG=2 D
- .D LDSCORES^YTSCORE(.YSDATA,.YS)
- .D STRING(.STRING1)
- .S YSDATA($O(YSDATA(""),-1)+1)=999999999999_U_U_STRING1
- Q
- ;
- SCORESV ;
- D DATA1 D YSRAW
- 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)=$G(YSINSNAM)_" Scale not found"
- S YSSCNAM=$P($G(^TMP($J,"YSG",3)),U,4) ; Scale Name
- ;
- K ^TMP($J,"YSCOR")
- S ^TMP($J,"YSCOR",1)="[DATA]"
- S I=2
- F S I=$O(^TMP($J,"YSG",I)) Q:'I D
- .S YSCALIEN=$P($P(^TMP($J,"YSG",I),"^",1),"=",2)
- .S YSRSC="YSRSC"_(I-2)
- .S ^TMP($J,"YSCOR",I)=$$GET1^DIQ(601.87,YSCALIEN_",",3,"I")_"="_@YSRSC
- Q
- ;
- DATA1 ;
- S NODE=2 F S NODE=$O(YSDATA(NODE)) Q:NODE="" D
- .S DATA=YSDATA(NODE)
- .S YSQN=$P(DATA,U,1)
- .S YSCDA=$P($G(DATA),U,3)
- .S ISS2(NODE)=$$GET1^DIQ(601.75,YSCDA_",",4,"I")
- YSRAW ;
- S YSRSC1=0,YSRSC2=0,YSRSC3=0,YSRSC4=0,YSRSC5=0
- S YSRSC1=$G(ISS2(8))+$G(ISS2(10))+$G(ISS2(12))+$G(ISS2(14))+$G(ISS2(15))
- S YSRSC2=$G(ISS2(5))+$G(ISS2(7))+$G(ISS2(17))
- S YSRSC3=$G(ISS2(4))+$G(ISS2(3))+$G(ISS2(6))+$G(ISS2(13))+$G(ISS2(16))
- S YSRSC4=$G(ISS2(9))+$G(ISS2(11))
- S YSRSC5=$G(ISS2(18))
- Q
- ;
- STRING(STRING1) ;
- F I=2 S YSRSC1=$P($G(^TMP($J,"YSCOR",2)),"=",2)
- F I=3 S YSRSC2=$P($G(^TMP($J,"YSCOR",3)),"=",2)
- F I=4 S YSRSC3=$P($G(^TMP($J,"YSCOR",4)),"=",2)
- F I=5 S YSRSC4=$P($G(^TMP($J,"YSCOR",5)),"=",2)
- F I=6 S YSRSC5=$P($G(^TMP($J,"YSCOR",6)),"=",2)
- I (YSRSC2>=125)&(YSRSC1<=155) S YSMOOD="EUTHYMIC"
- I (YSRSC2>=125)&(YSRSC1>=155) S YSMOOD="MANIC OR HYPOMANIC"
- I (YSRSC2<125)&(YSRSC1<155) S YSMOOD="DEPRESSED"
- I (YSRSC2<125)&(YSRSC1>=155) S YSMOOD="MIXED"
- ;S YSDATA(N)="7771^9999;1^"_$$PAD(YSRSC1,2) S N=N+1
- ;S YSDATA(N)="7772^9999;1^"_$$PAD(YSRSC2,2) S N=N+1
- ;S YSDATA(N)="7773^9999;1^"_$$PAD(YSRSC3,2) S N=N+1
- ;S YSDATA(N)="7774^9999;1^"_$$PAD(YSRSC4,2) S N=N+1
- ;S YSDATA(N)="7775^9999;1^"_$$PAD(YSRSC5,2) S N=N+1
- S YSDATA(N)="7776^9999;1^"_YSMOOD S N=N+1
- D SCALES(.STRING1)
- Q
- ;
- YSARRAY(YSDATA) ;
- S NODE=2 F S NODE=$O(YSDATA(NODE)) Q:NODE="" D
- .S DATA=YSDATA(NODE)
- .S YSQN=$P(DATA,U,1)
- .S YSCDA=$P($G(DATA),U,3)
- .S ISS2(NODE)=$$GET1^DIQ(601.75,YSCDA_",",4,"I")
- Q
- PAD(VAL,LENGTH) ; padds the value with spaces at beginning
- N RETURN,PADDING
- I VAL="Left blank by the user." S VAL="--"
- S PADDING=LENGTH-$L(VAL)
- I PADDING'>0 Q VAL
- S $P(RETURN," ",PADDING+1)=VAL
- Q RETURN
- ;
- SCALES(STRING1) ;
- S STRING1="SCALES|"
- S STRING1=STRING1_" Activation: "_$J(YSRSC1,3)_" (Manic Symptoms, Range 0 to 500)|"
- S STRING1=STRING1_" Well Being: "_$J(YSRSC2,3)_" (Range 0 to 300)|"
- S STRING1=STRING1_" Perceived Conflict: "_$J(YSRSC3,3)_" (Global Psychopathology Range 0 to 500)|"
- S STRING1=STRING1_" Depression Index: "_$J(YSRSC4,3)_" (Range 0 to 200)|"
- S STRING1=STRING1_"Global Bipolar Scale: "_$J(YSRSC5,3)_" (0=depressed/down < 50=normal > 100=high/manic)|"
- ;
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYTSISS2 3735 printed Feb 18, 2025@23:46:14 Page 2
- YTSISS2 ;SLC/MJB- SCORE ISS2 ; 10/30/18 9:35am
- +1 ;;5.01;MENTAL HEALTH;**151**;Dec 30, 1994;Build 92
- +2 ;
- +3 ; This routine was split from YTQAPI2A.
- +4 ; This routine handles limited complex reporting requirements without
- +5 ; modifying YS_AUX.DLL by adding free text "answers" that can be used by
- +6 ; a report.
- +7 ;,
- +8 ; Assumptions: EDIT incomplete instrument should ignore the extra answers
- +9 ; since there are no associated questions. GRAPHING should ignore the
- +10 ; answers since they not numeric.
- +11 ;
- +12 QUIT
- +13 ;
- DLLSTR(YSDATA,YS,YSTRNG) ;
- +1 ;
- +2 NEW TOTAL,TXT,YSMED,YSOVER,YSTOTAL,YSCALEI,STRING,YSINSNAM,I,NODE,YSQN,YSCDA,DATA
- +3 NEW YSCAL,YSVAL,YSCALVI,YTSCOR,YSVALA,YSRSC1,YSRSC2,YSRSC3,YSRSC4,YSRSC5
- +4 NEW II,ISS2,YSCALIEN,YSSCNAM,YSRSC,YSMOOD,STRING1
- +5 SET N=N+1
- SET II=0
- +6 IF YSTRNG=1
- DO SCORESV
- +7 IF YSTRNG=2
- Begin DoDot:1
- +8 DO LDSCORES^YTSCORE(.YSDATA,.YS)
- +9 DO STRING(.STRING1)
- +10 SET YSDATA($ORDER(YSDATA(""),-1)+1)=999999999999_U_U_STRING1
- End DoDot:1
- +11 QUIT
- +12 ;
- SCORESV ;
- +1 DO DATA1
- DO YSRAW
- +2 ;-->out
- IF $DATA(^TMP($JOB,"YSG",1))
- IF ^TMP($JOB,"YSG",1)="[ERROR]"
- Begin DoDot:1
- +3 KILL ^TMP($JOB,"YSCOR")
- +4 SET ^TMP($JOB,"YSCOR",1)="[ERROR]"
- +5 SET ^TMP($JOB,"YSCOR",2)=$GET(YSINSNAM)_" Scale not found"
- End DoDot:1
- QUIT
- +6 ; Scale Name
- SET YSSCNAM=$PIECE($GET(^TMP($JOB,"YSG",3)),U,4)
- +7 ;
- +8 KILL ^TMP($JOB,"YSCOR")
- +9 SET ^TMP($JOB,"YSCOR",1)="[DATA]"
- +10 SET I=2
- +11 FOR
- SET I=$ORDER(^TMP($JOB,"YSG",I))
- if 'I
- QUIT
- Begin DoDot:1
- +12 SET YSCALIEN=$PIECE($PIECE(^TMP($JOB,"YSG",I),"^",1),"=",2)
- +13 SET YSRSC="YSRSC"_(I-2)
- +14 SET ^TMP($JOB,"YSCOR",I)=$$GET1^DIQ(601.87,YSCALIEN_",",3,"I")_"="_@YSRSC
- End DoDot:1
- +15 QUIT
- +16 ;
- DATA1 ;
- +1 SET NODE=2
- FOR
- SET NODE=$ORDER(YSDATA(NODE))
- if NODE=""
- QUIT
- Begin DoDot:1
- +2 SET DATA=YSDATA(NODE)
- +3 SET YSQN=$PIECE(DATA,U,1)
- +4 SET YSCDA=$PIECE($GET(DATA),U,3)
- +5 SET ISS2(NODE)=$$GET1^DIQ(601.75,YSCDA_",",4,"I")
- End DoDot:1
- YSRAW ;
- +1 SET YSRSC1=0
- SET YSRSC2=0
- SET YSRSC3=0
- SET YSRSC4=0
- SET YSRSC5=0
- +2 SET YSRSC1=$GET(ISS2(8))+$GET(ISS2(10))+$GET(ISS2(12))+$GET(ISS2(14))+$GET(ISS2(15))
- +3 SET YSRSC2=$GET(ISS2(5))+$GET(ISS2(7))+$GET(ISS2(17))
- +4 SET YSRSC3=$GET(ISS2(4))+$GET(ISS2(3))+$GET(ISS2(6))+$GET(ISS2(13))+$GET(ISS2(16))
- +5 SET YSRSC4=$GET(ISS2(9))+$GET(ISS2(11))
- +6 SET YSRSC5=$GET(ISS2(18))
- +7 QUIT
- +8 ;
- STRING(STRING1) ;
- +1 FOR I=2
- SET YSRSC1=$PIECE($GET(^TMP($JOB,"YSCOR",2)),"=",2)
- +2 FOR I=3
- SET YSRSC2=$PIECE($GET(^TMP($JOB,"YSCOR",3)),"=",2)
- +3 FOR I=4
- SET YSRSC3=$PIECE($GET(^TMP($JOB,"YSCOR",4)),"=",2)
- +4 FOR I=5
- SET YSRSC4=$PIECE($GET(^TMP($JOB,"YSCOR",5)),"=",2)
- +5 FOR I=6
- SET YSRSC5=$PIECE($GET(^TMP($JOB,"YSCOR",6)),"=",2)
- +6 IF (YSRSC2>=125)&(YSRSC1<=155)
- SET YSMOOD="EUTHYMIC"
- +7 IF (YSRSC2>=125)&(YSRSC1>=155)
- SET YSMOOD="MANIC OR HYPOMANIC"
- +8 IF (YSRSC2<125)&(YSRSC1<155)
- SET YSMOOD="DEPRESSED"
- +9 IF (YSRSC2<125)&(YSRSC1>=155)
- SET YSMOOD="MIXED"
- +10 ;S YSDATA(N)="7771^9999;1^"_$$PAD(YSRSC1,2) S N=N+1
- +11 ;S YSDATA(N)="7772^9999;1^"_$$PAD(YSRSC2,2) S N=N+1
- +12 ;S YSDATA(N)="7773^9999;1^"_$$PAD(YSRSC3,2) S N=N+1
- +13 ;S YSDATA(N)="7774^9999;1^"_$$PAD(YSRSC4,2) S N=N+1
- +14 ;S YSDATA(N)="7775^9999;1^"_$$PAD(YSRSC5,2) S N=N+1
- +15 SET YSDATA(N)="7776^9999;1^"_YSMOOD
- SET N=N+1
- +16 DO SCALES(.STRING1)
- +17 QUIT
- +18 ;
- YSARRAY(YSDATA) ;
- +1 SET NODE=2
- FOR
- SET NODE=$ORDER(YSDATA(NODE))
- if NODE=""
- QUIT
- Begin DoDot:1
- +2 SET DATA=YSDATA(NODE)
- +3 SET YSQN=$PIECE(DATA,U,1)
- +4 SET YSCDA=$PIECE($GET(DATA),U,3)
- +5 SET ISS2(NODE)=$$GET1^DIQ(601.75,YSCDA_",",4,"I")
- End DoDot:1
- +6 QUIT
- PAD(VAL,LENGTH) ; padds the value with spaces at beginning
- +1 NEW RETURN,PADDING
- +2 IF VAL="Left blank by the user."
- SET VAL="--"
- +3 SET PADDING=LENGTH-$LENGTH(VAL)
- +4 IF PADDING'>0
- QUIT VAL
- +5 SET $PIECE(RETURN," ",PADDING+1)=VAL
- +6 QUIT RETURN
- +7 ;
- SCALES(STRING1) ;
- +1 SET STRING1="SCALES|"
- +2 SET STRING1=STRING1_" Activation: "_$JUSTIFY(YSRSC1,3)_" (Manic Symptoms, Range 0 to 500)|"
- +3 SET STRING1=STRING1_" Well Being: "_$JUSTIFY(YSRSC2,3)_" (Range 0 to 300)|"
- +4 SET STRING1=STRING1_" Perceived Conflict: "_$JUSTIFY(YSRSC3,3)_" (Global Psychopathology Range 0 to 500)|"
- +5 SET STRING1=STRING1_" Depression Index: "_$JUSTIFY(YSRSC4,3)_" (Range 0 to 200)|"
- +6 SET STRING1=STRING1_"Global Bipolar Scale: "_$JUSTIFY(YSRSC5,3)_" (0=depressed/down < 50=normal > 100=high/manic)|"
- +7 ;
- +8 QUIT