Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: YTSMCMI4

YTSMCMI4.m

Go to the documentation of this file.
  1. YTSMCMI4 ;BAL/KTL - MHAX ANSWERS SPECIAL HANDLING #2 ; 9/14/18 3:19pm
  1. ;;5.01;MENTAL HEALTH;**151,187,202,217,221,234**;Dec 30, 1994;Build 38
  1. ;
  1. ; MCMI4
  1. ;
  1. DLLSTR(YSDATA,YS,YSTRNG) ;
  1. ; YSTRNG = 1 Score Instr
  1. ; YSTRNG = 2 get Rpt Ans and Text
  1. N YSCNT,YSIND,CNT,YSCOD,YSINVRPT,YSCALRSL,YSRAWRSL,YSQANS,YSQANS2,YSQSCAL,YSNOGRPH,HIARR,SCALOD
  1. N YBRS,YPRS ;Calc Base Rate, Calc PR
  1. N YSNOTE ;Noteworthy
  1. N HIHIT,GRSHIT ;High 3 Persnlty Scale Hit & Grossman >75 Hit
  1. S N=N+1
  1. D INICOD^YTSMCMIB ;YSCOD(scalename)=scalecode
  1. D INIBRS^YTSMCMIC ;YBRS(scalecode,"STR") -get Base Rate for each scale Raw
  1. D INIPRS^YTSMCMID ;YPRS(scalecode,"STR") -get Percentile for scale Raw (Facet)/Adj Base Rate (Non-Facet)
  1. D YSQ^YTSMCMIB ;YSQSCAL(scalcode)=questions. chck if any scales are invld.
  1. D DATA1
  1. I YSTRNG=1 Q
  1. ; Genrate Rpt Sections
  1. D MODIND ;Mod Indices
  1. D CPP ;Clin Patterns
  1. D SPP ;Sevr Path
  1. D CS ;Clinical Syndr
  1. D SCS ;Sevr Clinical Syndr
  1. D TOP3 ;3 Highest Grossman Scales
  1. D FACET ;All Facet Scales
  1. D RSLWRN ;Rsl Warning
  1. D NTWRTHY
  1. D RESP ;Set up Responses
  1. Q
  1. DATA1 ;Extract results&calc
  1. ;I YSTRNG=1, add up RAW values for scaleN calc adj BR and PR
  1. ;I YSTRNG=2, extract from saved values, Do rpt calcs
  1. I YSTRNG=1 D Q
  1. .D EXTANS ;Extrct T/F responses
  1. .D ^YTSMCMIA
  1. D LDSCORES^YTSCORE(.YSDATA,.YS)
  1. ;Extract Raw Scale Rsl;Get the High Point;Get BR Adj Hdr;Get V rsl for Invalidity;Get W rsl for Inconsistency
  1. D EXTRSL,EXTANS,HIGHPT,BRADJH,INVDH,INCNH
  1. S YSINVRPT=$$INVRPT() ; See if INVALID Rpt cond
  1. I YSINVRPT'="" D INVALID(YSINVRPT)
  1. D INVSCL ;Any Scale invalid
  1. D ELEV ;Top 3 Grossman
  1. D NOTEW ;Noteworthy Responses
  1. Q
  1. INVRPT() ;
  1. ; Check for Invalid Report
  1. ; Raw V > 1 ;Invalidity Index elev
  1. ; Raw X > 114 ! Raw X < 7 ;Scale X outside range
  1. ; All Scales 1-8B Base Rate < 60 ; All scls too low
  1. ; Raw W > 19 ;Inconsistency Index elevated
  1. ; More than 13 responses skipped for X
  1. ; INVRPT of 1 = YES, INVALID
  1. ; 0 = NO, OK TO PROCEED
  1. N INVSTR,SCALSTR,SCAL,CHK,XQUES,QUES,I,SKIPS
  1. I YSRAWRSL("V Invalidity")>1 S INVSTR="The Invalidity Index is elevated." Q INVSTR
  1. I YSRAWRSL("X Disclosure")<7!(YSRAWRSL("X Disclosure")>114) S INVSTR="Scale X is outside of an acceptable range." Q INVSTR
  1. S CHK=""
  1. F I=1145:1:1156 D
  1. .S SCAL=$$GET1^DIQ(601.87,I_",",3,"I")
  1. .S SCAL=$G(YBRS(SCAL,"RSL"))
  1. .Q:SCAL<60
  1. .S CHK=1
  1. I CHK="" S INVSTR="Scales 1-8B are all less than 60 BR" Q INVSTR
  1. I $G(YSRAWRSL("W Inconsistency"))>19 S INVSTR="The Inconsistency Index is elevated." Q INVSTR
  1. ; Check if X scale>13 omits
  1. S XQUES=YSQSCAL("X Disclosure")
  1. S CHK=0
  1. F I=1:1:$L(XQUES,U) D
  1. . S QUES=$P(XQUES,U,I) I YSQANS(QUES)="X" S CHK=CHK+1
  1. I CHK>13 S INVSTR="Scale X omits greater than 13" Q INVSTR
  1. ; Check all scale>13 omits
  1. S CHK=0,SCAL=""
  1. ;F S SCAL=$O(YSQSCAL(SCAL)) Q:SCAL="" D
  1. ;. S XQUES=YSQSCAL(SCAL)
  1. ;. F I=1:1:$L(XQUES,U) D
  1. ;.. S QUES=$P(XQUES,U,I) Q:QUES="" Q:YSQANS(QUES)'="X"
  1. ;.. Q:$D(SKIPS(QUES)) ;already counted from another scale
  1. ;.. S CHK=CHK+1,SKIPS(QUES)=""
  1. S QUES="" F S QUES=$O(YSQANS(QUES)) Q:QUES="" D
  1. . Q:YSQANS(QUES)'="X"
  1. . Q:$D(SKIPS(QUES))
  1. . S CHK=CHK+1,SKIPS(QUES)=""
  1. I CHK>13 S INVSTR="Invalid responses greater than 13" Q INVSTR
  1. Q ""
  1. INVALID(INVSTR) ;
  1. ; Text for invalid rpt
  1. N I,DONE
  1. S DONE=""
  1. S I="" F S I=$O(YSDATA(I)) Q:I=""!(DONE=1) D
  1. .I YSDATA(I)["7771" S $P(YSDATA(I),U,3)="",DONE=1 ;If INVALID, do not display HP Code
  1. S N=N+1,YSDATA(N)="7783^9999;1^INVALID PROFILE: "_INVSTR_"|"
  1. S YSNOGRPH=1 ;Don't Graph BR Scores
  1. Q
  1. INVSCL ;
  1. ;Any scale>2 or 4 omits
  1. N OMITS,SCALSTR,SCAL,QUES,RSL,CNT,I,II
  1. F I=1140:1:1143,1145:1:1169,1240:1:1284 D
  1. .S SCAL=$$GET1^DIQ(601.87,I_",",3,"I")
  1. .S CNT=0
  1. .I SCAL="X Disclosure"!(SCAL="W Inconsistency") Q
  1. .S OMITS=4 I SCAL="V Invalidity" S OMITS=2
  1. .F II=1:1:$L(YSQSCAL(SCAL),U) D
  1. ..S QUES=$P(YSQSCAL(SCAL),U,II),RSL=YSQANS(QUES)
  1. ..I RSL'=1,(RSL'=2) S CNT=CNT+1
  1. .I CNT>OMITS D
  1. ..S YSRAWRSL(SCAL)="-"
  1. ..S YBRS(SCAL,"RSL")="-"
  1. ..S YPRS(SCAL,"RSL")="-"
  1. Q
  1. EXTANS ;
  1. ;Extract the T/F from YSDATA
  1. ;TRUE=1 FALSE=2
  1. N X,QUEST,ANS,STR,PTR,DATA
  1. S X=2
  1. F S X=$O(YSDATA(X)) Q:+X=0 D
  1. .S DATA=YSDATA(X)
  1. .S ANS=$$GET1^DIQ(601.75,$P($G(DATA),U,3)_",",4,"I")
  1. .S QUES=$P(DATA,U,2),PTR=$P(DATA,U)
  1. .S YSQANS(QUES)=ANS
  1. .S YSQANS(QUES,"PTR")=PTR
  1. .S YSQANS2(PTR)=ANS
  1. Q
  1. EXTRSL ;
  1. ; Extract the Raw score-store by Scale Name
  1. N I,SCAL,VAL,BR,PR,RAW,YSAD,YSCALE,G,SCLNAM
  1. S I=1 F S I=$O(^TMP($J,"YSCOR",I)) Q:I="" D
  1. .S VAL=^TMP($J,"YSCOR",I),SCAL=$P(VAL,"="),VAL=$P(VAL,"=",2)
  1. .S RAW=$P(VAL,U),YSRAWRSL(SCAL)=RAW
  1. .S BR=$P(VAL,U,2),BR=$$BRFIX^YTSMCMIA(BR),YBRS(SCAL,"RSL")=BR ;PATCH X
  1. .S PR=$P(VAL,U,3),YPRS(SCAL,"RSL")=PR
  1. .S SCLNAM(SCAL)=I ;^TMP($J,"YSCOR") by scalename-extract calculated results below
  1. D EX2
  1. Q
  1. EX2 ;T-SCORE NOT IN ^TMP($J,"YSCOR")
  1. S YSAD=$G(YS("AD"))
  1. S YSCALE=""
  1. F S YSCALE=$O(^YTT(601.92,"AC",YSAD,YSCALE)) Q:'YSCALE D
  1. .S G=$G(^YTT(601.92,YSCALE,0))
  1. .S SCAL=$P(G,U,3)
  1. .S RAW=$P(G,U,4),BR=$P(G,U,5),BR=$$BRFIX^YTSMCMIA(BR),PR=$P(G,U,6) ;PATCH X
  1. .S YBRS(SCAL,"RSL")=BR
  1. .S YPRS(SCAL,"RSL")=PR
  1. Q
  1. HIGHPT ; Highpoint Hdr
  1. S N=N+1
  1. N TEXT1,SCAL,SCALC,SCALSTR,SCALCOD,I,HI,DONE,SCALR
  1. S TEXT1=""
  1. S SCALCOD="1 ^2A^2B^3 ^4A^4B^5 ^6A^6B^7 ^8A^8B"
  1. F I=1145:1:1156 D
  1. .S SCAL=$$GET1^DIQ(601.87,I_",",3,"I")
  1. .S SCALR=$G(YBRS(SCAL,"RSL"))
  1. .Q:SCALR'>59
  1. .S SCALC=YSCOD("NAME",SCAL) S:$L(SCALC)=1 SCALC=SCALC_" " ;Sort numbers vs strings correctly
  1. .S HI(-SCALR,SCALC)=""
  1. S DONE=0,I=0
  1. S SCAL="" F S SCAL=$O(HI(SCAL)) Q:SCAL=""!DONE D
  1. .S SCALC="" F S SCALC=$O(HI(SCAL,SCALC)) Q:SCALC=""!DONE D
  1. ..S SCALCOD=SCALC
  1. ..S:SCALCOD[" " SCALCOD=+SCALCOD
  1. ..S TEXT1=TEXT1_SCALCOD_" ",I=I+1
  1. ..I I=3 S DONE=1
  1. I $L(TEXT1)>0 S TEXT1=$E(TEXT1,1,$L(TEXT1)-1)
  1. S YSDATA(N)="7771^9999;1^"_TEXT1
  1. Q
  1. BRADJH ; BR Adjustment Hdr
  1. N X,ACC,A,CC,TEXT1
  1. S TEXT1=""
  1. S X=YSRAWRSL("X Disclosure")
  1. S A=YBRS("A Generalized Anxiety","RSL")
  1. S CC=YBRS("CC Major Depression","RSL")
  1. I ((X>0)&(X<21))!((X>61)&(X<122)) S TEXT1="X"
  1. I (A>74)!(CC>74) S TEXT1=$S(TEXT1="":"A/CC",1:TEXT1_", A/CC")
  1. S:TEXT1="" TEXT1="None"
  1. S N=N+1,YSDATA(N)="7772^9999;1^"_TEXT1
  1. Q
  1. INVDH ; Invalidity Hdr
  1. N TEXT1
  1. S TEXT1=$G(YSRAWRSL("V Invalidity"))
  1. S N=N+1,YSDATA(N)="7773^9999;1^"_TEXT1
  1. Q
  1. INCNH ; Inconsistency Hdr
  1. N TEXT1
  1. S TEXT1=$G(YSRAWRSL("W Inconsistency"))
  1. S N=N+1,YSDATA(N)="7774^9999;1^"_TEXT1
  1. S YSRAWRSL("W Inconsistency")=0
  1. Q
  1. CALCW ; Calc the W Scale
  1. N PAIR
  1. S YSRAWRSL("W Inconsistency")=0
  1. F PAIR="22-170","125-143","47-157","40-181","81-116","85-126","76-150","25-94","44-121","39-59","17-184","33-89","78-164","38-171","74-115","46-154","26-99","20-174","32-122","13-112","55-110","173-194","95-127","60-162","15-149" D
  1. .D WADD(PAIR)
  1. S N=N+1,YSDATA(N)="7774^9999;1^"_YSRAWRSL("W Inconsistency")
  1. Q
  1. WADD(PAIR) ;
  1. N Q1,Q2,ADD
  1. S Q1=$G(YSQANS($P(PAIR,"-"))) S:Q1=2 Q1=0 ;False=0 instead of 2
  1. S Q2=$G(YSQANS($P(PAIR,"-",2))) S:Q2=2 Q2=0 ;
  1. S ADD=$TR((Q1-Q2),"-") ;W ?30,ADD
  1. S YSRAWRSL("W Inconsistency")=YSRAWRSL("W Inconsistency")+ADD
  1. Q
  1. ELEV ; Calc 3 highest Personality Scores from BR
  1. ; Order of Importance after BR: S,C,P,1,2A,2B,3,4A,4B,5,6A,6B,7,8A,8B
  1. ; Result is HIARR("FINAL")
  1. N SCALSTR,SCAL,SCD,BR,TOPN,CNT,SCCOD,SCDF,SCALF,I,J
  1. F I=1157:1:1159,1145:1:1156 D
  1. .S SCAL=$$GET1^DIQ(601.87,I_",",3,"I")
  1. .S BR=YBRS(SCAL,"RSL")
  1. .Q:BR<60
  1. .S HIARR("RSL",-BR,SCAL)=""
  1. S TOPN=3
  1. S CNT=0,BR="" F S BR=$O(HIARR("RSL",BR)) Q:BR=""!(CNT>TOPN) D
  1. .F I=1157:1:1159,1145:1:1156 D
  1. ..S SCAL=$$GET1^DIQ(601.87,I_",",3,"I")
  1. ..Q:CNT>TOPN
  1. ..S SCD=YSCOD("NAME",SCAL)
  1. ..Q:'$D(HIARR("RSL",BR,SCAL))
  1. ..S CNT=CNT+1,HIARR("FINAL",CNT)=SCAL_U_SCD
  1. S SCAL="" F S SCAL=$O(YSCOD("NAME",SCAL)) Q:SCAL="" S SCCOD(YSCOD("NAME",SCAL))=SCAL ;SCCOD of Scale Codes=Scale Name
  1. F I=1:1:TOPN D
  1. .Q:'$D(HIARR("FINAL",I))
  1. .S SCAL=HIARR("FINAL",I),SCD=$P(SCAL,U,2),SCAL=$P(SCAL,U)
  1. .F J=1:1:3 D
  1. ..S SCDF=SCD_"."_J,SCALF=SCCOD(SCDF)
  1. ..S HIARR("FINAL",I,J)=SCALF_U_SCDF_U_YSRAWRSL(SCALF)_U_YBRS(SCALF,"RSL")_U_YPRS(SCALF,"RSL")
  1. Q
  1. NOTEW ; Noteworthy
  1. ; Use YSQANS(question number)=1/2 (True/False)
  1. ; YSQANS(question number,"PTR")=pointer to MH QUESTION
  1. N CNT,CAT,QUESTR,QUES,CATTOT
  1. S CNT=1
  1. S CAT="Adult ADHD",CATTOT=0
  1. F QUES=56,77,82,92,108,-63 D SETNOT
  1. I CATTOT<4 K YSNOTE(CNT) ;Must be>=4 endorsed responses
  1. S CNT=CNT+1
  1. S CAT="Autism Spectrum",CATTOT=0
  1. F QUES=92,119,138,163,165,179,190 D SETNOT
  1. I CATTOT<4 K YSNOTE(CNT)
  1. S CNT=CNT+1
  1. S CAT="Childhood Abuse"
  1. F QUES=47,157 D SETNOT
  1. S CNT=CNT+1
  1. S CAT="Eating Disorder"
  1. F QUES=69,86,102,186 D SETNOT
  1. S CNT=CNT+1
  1. S CAT="Emotional Dyscontrol"
  1. F QUES=27,36,45,56,72,80,127,177 D SETNOT
  1. S CNT=CNT+1
  1. S CAT="Explosively Angry"
  1. F QUES=11,74,115,145,168,191 D SETNOT
  1. S CNT=CNT+1
  1. S CAT="Health Preoccupied"
  1. F QUES=7,41,57,113,120,146 D SETNOT
  1. S CNT=CNT+1
  1. S CAT="Interpersonally Alienated"
  1. F QUES=4,104,182,190 D SETNOT
  1. S CNT=CNT+1
  1. S CAT="Prescription Drug Abuse"
  1. F QUES=124,176 D SETNOT
  1. S CNT=CNT+1
  1. S CAT="Self-Destructive Potential"
  1. F QUES=14,32,34,39,59,101,107,114,126,151,164 D SETNOT
  1. S CNT=CNT+1
  1. S CAT="Self-Injurious Behavior/Tendency"
  1. F QUES=40,181 D SETNOT
  1. S CNT=CNT+1
  1. S CAT="Traumatic Brain Injury"
  1. F QUES=55,110 D SETNOT
  1. S CNT=CNT+1
  1. S CAT="Vengefully Prone"
  1. F QUES=22,37,78,100,103,111,136,167,178,192 D SETNOT
  1. Q
  1. SETNOT ;
  1. N CHK
  1. S CHK=1 ;True
  1. I QUES<0 S QUES=-QUES,CHK=2 ;Minus Ques#-check for a False
  1. S ANS=YSQANS(QUES) Q:ANS'=CHK
  1. S:'$D(YSNOTE(CNT,"CAT")) YSNOTE(CNT,"CAT")=CAT
  1. S YSNOTE(CNT,"CAT",QUES)=YSQANS(QUES,"PTR")_U_ANS,CATTOT=CATTOT+1
  1. Q
  1. MODIND ;
  1. N SCALSTR,SCAL,XSCAL,SCALCOD,ZTXT,STR,GRPH,I,ANS,RAW,BR
  1. S ANS=7775,STR=" "
  1. S SCALSTR="X Disclosure^Y Desirability^Z Debasement"
  1. D RPTBLK(ANS,SCALSTR)
  1. Q
  1. CPP ;
  1. N SCALSTR,SCAL,XSCAL,SCALCOD,ZTXT,STR,GRPH,I,ANS,RAW,BR
  1. S ANS=7776,STR=" "
  1. S SCALSTR="1 Schizoid^2A Avoidant^2B Melancholic^3 Dependent^4A Histrionic^4B Turbulent^5 Narcissistic^6A Antisocial^6B Sadistic^7 Compulsive^8A Negativistic^8B Masochistic"
  1. D RPTBLK1(ANS,SCALSTR)
  1. Q
  1. SPP ;
  1. N SCALSTR,SCAL,XSCAL,SCALCOD,ZTXT,STR,GRPH,I,ANS,RAW,BR
  1. S ANS=7777,STR=" "
  1. S SCALSTR="S Schizotypal^C Borderline^P Paranoid"
  1. D RPTBLK1(ANS,SCALSTR)
  1. Q
  1. CS ;
  1. N SCALSTR,SCAL,XSCAL,SCALCOD,ZTXT,STR,GRPH,I,ANS,RAW,BR
  1. S ANS=7778,STR=" "
  1. S SCALSTR="A Generalized Anxiety^H Somatic Symptom^N Bipolar Spectrum^D Persistent Depression^B Alcohol Use^T Drug Use^R Post-Traumatic Stress"
  1. D RPTBLK1(ANS,SCALSTR)
  1. Q
  1. SCS ;
  1. N SCALSTR,SCAL,XSCAL,SCALCOD,ZTXT,STR,GRPH,I,ANS,RAW,BR
  1. S ANS=7779,STR=" "
  1. S SCALSTR="SS Schizophrenic Spectrum^CC Major Depression^PP Delusional"
  1. D RPTBLK1(ANS,SCALSTR)
  1. Q
  1. TOP3 ;
  1. N SCALSTR,SCAL,XSCAL,SCALCOD,ZTXT,STR,GRPH,I,ANS,RAW,BR,TCNT,TCNT2,HD
  1. S ANS=7780,STR=" ",HIHIT=0
  1. Q:'$D(HIARR)
  1. F TCNT=1:1:3 D
  1. .Q:'$D(HIARR("FINAL",TCNT))
  1. .S HD=HIARR("FINAL",TCNT),SCAL=$P(HD,U),SCALCOD=$P(HD,U,2),HIHIT=1
  1. .S ZTXT=$$MAKSTR(SCAL,39,"L"),STR=STR_ZTXT_"|"
  1. .S TCNT2="" F S TCNT2=$O(HIARR("FINAL",TCNT,TCNT2)) Q:TCNT2="" D
  1. ..S HD=HIARR("FINAL",TCNT,TCNT2),SCAL=$P(HD,U),SCALCOD=$P(HD,U,2)
  1. ..S RAW=$P(HD,U,3),BR=$P(HD,U,4),PR=$P(HD,U,5)
  1. ..S ZTXT=$$MAKSTR(SCAL,39,"L"),STR=STR_ZTXT
  1. ..S ZTXT=$$MAKSTR(RAW,4,"R"),STR=STR_ZTXT
  1. ..S ZTXT=$$MAKSTR(PR,4,"R"),STR=STR_ZTXT
  1. ..S ZTXT=$$MAKSTR(BR,4,"R"),STR=STR_ZTXT
  1. ..S GRPH=$$MAKGRP(BR,100),STR=STR_" "_GRPH_"|"
  1. .S STR=STR_"|"
  1. S N=N+1,YSDATA(N)=ANS_"^9999;1^"_STR
  1. Q
  1. FACET ;
  1. N SCAL,SCALCOD,GSCAL,GCOD,ZTXT,STR,SCALXRF,I,II
  1. ;Make SCALXRF by Scale Code to get to the each Grossman Facet Scale Names
  1. S SCAL="" F S SCAL=$O(YSCOD("NAME",SCAL)) Q:SCAL="" S SCALXRF(YSCOD("NAME",SCAL))=SCAL
  1. S ANS=7781,STR=" ",GRSHIT=0
  1. F I=1145:1:1159 D
  1. .S SCAL=$$GET1^DIQ(601.87,I_",",3,"I")
  1. .S SCALCOD=YSCOD("NAME",SCAL)
  1. .S ZTXT=$$MAKSTR(SCAL,39,"L"),STR=STR_ZTXT_"|"
  1. .F II=1:1:3 D
  1. ..S GCOD=SCALCOD_"."_II
  1. ..S GSCAL=SCALXRF(GCOD)
  1. ..S ZTXT=$$MAKSTR(GSCAL,39,"L"),STR=STR_ZTXT
  1. ..S RAW=YSRAWRSL(GSCAL),PR=YPRS(GSCAL,"RSL"),BR=YBRS(GSCAL,"RSL")
  1. ..I BR>74 S GRSHIT=1 ;At least one Grossman Facet >=75
  1. ..S ZTXT=$$MAKSTR(RAW,4,"R"),STR=STR_ZTXT
  1. ..S ZTXT=$$MAKSTR(PR,4,"R"),STR=STR_ZTXT
  1. ..S ZTXT=$$MAKSTR(BR,4,"R"),STR=STR_ZTXT_"|"
  1. .S STR=STR_"|"
  1. S N=N+1,YSDATA(N)=ANS_"^9999;1^"_STR
  1. Q
  1. RSLWRN ; Result warning
  1. N STR
  1. ;S HIHIT=1,GRSHIT=0 ;TESTING
  1. Q:HIHIT=0 ;No Personality Scale >= 60
  1. Q:GRSHIT=1 ;At least one Grossman Facet >=75
  1. S STR="Generally, two conditions must be met in order for a Grossman Facet scale score |"
  1. S STR=STR_"to be considered interpretable. The first is that a primary personality scale |"
  1. S STR=STR_"must be at or above BR 60. The second is that one or more of its facet scales |"
  1. S STR=STR_"must be at or above BR 75. Since none of this patient's facet scale scores are|"
  1. S STR=STR_"at or above BR 75, no facet scale interpretations are included in this report.|"
  1. S N=N+1,YSDATA(N)=ANS_"^9999;1^"_STR
  1. Q
  1. NTWRTHY ;
  1. N I,II,CAT,QUES,QPTR,QTXT,ZTXT,STR,QANS
  1. Q:'$D(YSNOTE)
  1. S ANS=7782
  1. S STR=" "
  1. S I=0 F S I=$O(YSNOTE(I)) Q:I="" D
  1. .S CAT=YSNOTE(I,"CAT")
  1. .S STR=STR_CAT_"|"
  1. .S QUES="" F S QUES=$O(YSNOTE(I,"CAT",QUES)) Q:QUES="" D
  1. ..S ZTXT=$$MAKSTR(QUES_". ",5,"R"),STR=STR_ZTXT
  1. ..S QPTR=$P(YSNOTE(I,"CAT",QUES),U),QANS=$P(YSNOTE(I,"CAT",QUES),U,2)
  1. ..S QANS=$S(QANS=1:"(True)",QANS=2:"(False)",1:"")
  1. ..S QTXT="",II=0 F S II=$O(^YTT(601.72,QPTR,1,II)) Q:+II=0 D
  1. ... S QTXT=QTXT_^YTT(601.72,QPTR,1,II,0) ;Space between lines?
  1. ..S STR=STR_QTXT_" "_QANS_"|"
  1. .S STR=STR_"|"
  1. S N=N+1,YSDATA(N)=ANS_"^9999;1^"_STR
  1. Q
  1. RESP ;
  1. N I,STR,NUM,QUES,ANS
  1. S ANS=7784
  1. S STR="||ITEM RESPONSES |"
  1. I '$D(YSQANS) S STR=STR_"Could not create list of responses for the report|" S N=N+1,YSDATA(N)=ANS_"^9999;1^"_STR Q
  1. F I=1:1:195 D
  1. .S NUM=YSQANS(I) I NUM="" S NUM="X"
  1. .S STR=STR_$$MAKSTR(I_": ",5,"R")_NUM_" " I I#10=0 S STR=STR_"|"
  1. S N=N+1,YSDATA(N)=ANS_"^9999;1^"_STR
  1. Q
  1. RPTBLK(ANS,SCALSTR) ;
  1. ;Report Block no PR
  1. F I=1:1:$L(SCALSTR,U) D
  1. .S SCAL=$P(SCALSTR,U,I),SCALCOD=YSCOD("NAME",SCAL)
  1. .S ZTXT=$$MAKSTR(SCAL,43,"L"),STR=STR_ZTXT
  1. .S RAW=YSRAWRSL(SCAL),BR=YBRS(SCAL,"RSL")
  1. .S ZTXT=$$MAKSTR(RAW,4,"R"),STR=STR_ZTXT
  1. .S ZTXT=$$MAKSTR(BR,4,"R"),STR=STR_ZTXT
  1. .S GRPH=$$MAKGRP(BR,100),STR=STR_" "_GRPH_"|"
  1. S N=N+1,YSDATA(N)=ANS_"^9999;1^"_STR
  1. Q
  1. RPTBLK1(ANS,SCALSTR) ;
  1. ;Report Block+PR
  1. F I=1:1:$L(SCALSTR,U) D
  1. .S SCAL=$P(SCALSTR,U,I),SCALCOD=YSCOD("NAME",SCAL)
  1. .S ZTXT=$$MAKSTR(SCAL,39,"L"),STR=STR_ZTXT
  1. .S RAW=YSRAWRSL(SCAL),PR=YPRS(SCAL,"RSL"),BR=YBRS(SCAL,"RSL")
  1. .S ZTXT=$$MAKSTR(RAW,4,"R"),STR=STR_ZTXT
  1. .S ZTXT=$$MAKSTR(PR,4,"R"),STR=STR_ZTXT
  1. .S ZTXT=$$MAKSTR(BR,4,"R"),STR=STR_ZTXT
  1. .S GRPH=$$MAKGRP(BR,115),STR=STR_" "_GRPH_"|"
  1. S N=N+1,YSDATA(N)=ANS_"^9999;1^"_STR
  1. Q
  1. MAKSTR(TXT,LEN,JUST,CHAR) ;
  1. ; TXT =Text
  1. ; LEN =Total Len
  1. ; JUST=R/L Justified, def=R
  1. ; CHAR=Char PAD, def=" "
  1. N STR,TXTL
  1. S TXTL=$L(TXT),STR=""
  1. I TXT[" " S TXT=$TR(TXT," ",$C(0))
  1. I $G(CHAR)="" S CHAR=" "
  1. I $G(JUST)="" S JUST="R"
  1. I JUST="L" D
  1. .S STR=TXT
  1. .Q:(LEN-TXTL+1)'>1 ;String is full len, don't justify
  1. .S $P(STR,CHAR,LEN-TXTL+1)=""
  1. I JUST="R" D
  1. .I (LEN-TXTL+1)>1 S $P(STR,CHAR,LEN-TXTL+1)=""
  1. .S STR=STR_TXT
  1. S:STR[$C(0) STR=$TR(STR,$C(0)," ") ;XLAT out $C(0)
  1. Q STR
  1. MAKGRP(NUM,MAX) ;
  1. ; String of "*" for graph
  1. N GRP,LEN,RND,J,NCHAR
  1. S LEN=50 ;Graph #of Chars.
  1. I NUM="-"!($G(YSNOGRPH)=1) D Q GRP
  1. .S GRP=$$MAKSTR("",LEN,"L")
  1. S NCHAR=LEN/MAX*NUM,RND="."_$P(NCHAR,".",2),NCHAR=$P(NCHAR,".")
  1. I RND>.5 S NCHAR=NCHAR+1
  1. S $P(GRP,"*",NCHAR+1)="",GRP=$$MAKSTR(GRP,LEN,"L")
  1. Q GRP
  1. YSARRAY(YSARRAY) ;
  1. N II,YSVAL,YSCALEI,YSCALEN,YSKEYI,G,YSQN,YSAI,YSAN,YSTARG
  1. K YSARRAY
  1. S II=1
  1. F I=2:1 Q:'$D(^TMP($J,"YSG",I)) I ^TMP($J,"YSG",I)?1"Scale".E D
  1. . S YSCALEI=$P(^TMP($J,"YSG",I),U),YSCALEI=$P(YSCALEI,"=",2)
  1. . S YSCALEN=$P(^TMP($J,"YSG",I),U,4)
  1. . S YSKEYI=0 F S YSKEYI=$O(^YTT(601.91,"AC",YSCALEI,YSKEYI)) Q:YSKEYI'>0 D
  1. ..S G=^YTT(601.91,YSKEYI,0)
  1. ..S YSQN=$P(G,U,3),YSTARG=$P(G,U,4),YSVAL=$P(G,U,5)
  1. ..S YSAI=$O(^YTT(601.85,"AC",YSAD,YSQN,0))
  1. ..Q:YSAI'>0
  1. ..Q:'$D(^YTT(601.85,YSAI,0))
  1. ..S YSAN=""
  1. ..I $D(^YTT(601.85,YSAI,1,1,0)) S YSAN=^YTT(601.85,YSAI,1,1,0)
  1. ..I $P(^YTT(601.85,YSAI,0),U,4)?1N.N S YSAN=$P(^YTT(601.85,YSAI,0),U,4),YSAN=$G(^YTT(601.75,YSAN,1))
  1. ..I YSAN=YSTARG S YSARRAY(II)=YSVAL,II=II+1
  1. ..S YSARRAY("SCALE",YSCALEN)=$G(YSARRAY("SCALE",YSCALEN))+YSVAL
  1. Q