- YTSCSDD ;SLC/MJB- SCORE CSDD-RS ; 12/05/18 9:35am
- ;;5.01;MENTAL HEALTH;**139**;Dec 30, 1994;Build 134
- ;
- ; 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 YSSCALIEN,LEG,DES,DATA,NODE,YSQN,YSSEQ,YSAN,YSCDA,SCORE
- N YSINSNAM,II,YSSCNAM,YSCSDD
- S N=N+1,II=0
- IF YSTRNG=1 D SCORESV
- I YSTRNG=2 D
- .D LDSCORES^YTSCORE(.YSDATA,.YS)
- .D STRING
- Q
- ;
- SCORESV ;
- D DATA1
- 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 YSSCALIEN=+$P(^TMP($J,"YSG",3),"=",2)
- S ^TMP($J,"YSCOR",2)=$$GET1^DIQ(601.87,YSSCALIEN_",",3,"I")_"="_SCORE
- Q
- ;
- DATA1 ;
- S YSINSNAM=$P(YSDATA(2),U,3) S SCORE=0
- I $G(YSINSNAM)="" S YSINSNAM=$G(YS("CODE"),"NO NAME PASSED")
- S NODE=2 F S NODE=$O(YSDATA(NODE)) Q:NODE>21 D ; Start at YSDATA(3)
- .S DATA=YSDATA(NODE)
- .S YSQN=$P($G(DATA),U,1)
- .S YSSEQ=$P($G(DATA),U,2)
- .S YSCDA=$P($G(DATA),U,3)
- .S YSAN=$$GET1^DIQ(601.75,YSCDA_",",3,"I")
- .S DES=YSSEQ
- .S LEG=$$GET1^DIQ(601.75,YSCDA_",",4,"I")
- .S SCORE=SCORE+LEG
- Q
- ;
- STRING ;
- S YSCSDD=+$P(^TMP($J,"YSCOR",2),"=",2)
- S YSDATA(N)="7771^9999;1^"_YSCSDD S N=N+1
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYTSCSDD 1716 printed Feb 18, 2025@23:46 Page 2
- YTSCSDD ;SLC/MJB- SCORE CSDD-RS ; 12/05/18 9:35am
- +1 ;;5.01;MENTAL HEALTH;**139**;Dec 30, 1994;Build 134
- +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 YSSCALIEN,LEG,DES,DATA,NODE,YSQN,YSSEQ,YSAN,YSCDA,SCORE
- +3 NEW YSINSNAM,II,YSSCNAM,YSCSDD
- +4 SET N=N+1
- SET II=0
- +5 IF YSTRNG=1
- DO SCORESV
- +6 IF YSTRNG=2
- Begin DoDot:1
- +7 DO LDSCORES^YTSCORE(.YSDATA,.YS)
- +8 DO STRING
- End DoDot:1
- +9 QUIT
- +10 ;
- SCORESV ;
- +1 DO DATA1
- +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 YSSCALIEN=+$PIECE(^TMP($JOB,"YSG",3),"=",2)
- +11 SET ^TMP($JOB,"YSCOR",2)=$$GET1^DIQ(601.87,YSSCALIEN_",",3,"I")_"="_SCORE
- +12 QUIT
- +13 ;
- DATA1 ;
- +1 SET YSINSNAM=$PIECE(YSDATA(2),U,3)
- SET SCORE=0
- +2 IF $GET(YSINSNAM)=""
- SET YSINSNAM=$GET(YS("CODE"),"NO NAME PASSED")
- +3 ; Start at YSDATA(3)
- SET NODE=2
- FOR
- SET NODE=$ORDER(YSDATA(NODE))
- if NODE>21
- QUIT
- Begin DoDot:1
- +4 SET DATA=YSDATA(NODE)
- +5 SET YSQN=$PIECE($GET(DATA),U,1)
- +6 SET YSSEQ=$PIECE($GET(DATA),U,2)
- +7 SET YSCDA=$PIECE($GET(DATA),U,3)
- +8 SET YSAN=$$GET1^DIQ(601.75,YSCDA_",",3,"I")
- +9 SET DES=YSSEQ
- +10 SET LEG=$$GET1^DIQ(601.75,YSCDA_",",4,"I")
- +11 SET SCORE=SCORE+LEG
- End DoDot:1
- +12 QUIT
- +13 ;
- STRING ;
- +1 SET YSCSDD=+$PIECE(^TMP($JOB,"YSCOR",2),"=",2)
- +2 SET YSDATA(N)="7771^9999;1^"_YSCSDD
- SET N=N+1
- +3 QUIT