YTSBBHI2 ;SLC/DJE- ANSWERS SPECIAL HANDLING - BBHI-2 ; 10/16/18 9:35am
;;5.01;MENTAL HEALTH;**139**;;Build 134
;
DATA1(SCORE) ;expects YSDATA, returns SCORE, multiple scales so we use nodes i.e. SCORE(SCALEIEN)=###
;specialized DATA1 uses SCOREDAT table to map question to score relationships
N LINE,TEXT,SKIP,I
F LINE=1:1 S TEXT=$P($T(SCOREDAT+LINE),";",2) Q:TEXT="QUIT" D
.N SCALE,RAWTYPE,QUESTIONS,I
.S SCALE=$P(TEXT,"|",1) S RAWTYPE=$P(TEXT,"|",3) S QUESTIONS=$P(TEXT,"|",4)
.F I=1:1:$L(QUESTIONS,U) D
..N NODE,DATA,RAW
..S NODE=$P(QUESTIONS,U,I)+2 ;YSDATA question nodes start at 3 and also skip question 0
..S DATA=YSDATA(NODE)
..;retrieval method section. For each RAWTYPE assign a value to RAW
..;typical case, YSDATA piece 3 has the MH CHOICE IEN and raw value is in LEGACY field
..I RAWTYPE="LEGACY" S RAW=$$GET1^DIQ(601.75,$P($G(DATA),U,3)_",",4,"I")
..;reverse score legacy field - need to make sure skipped value is not reverse scored
..I RAWTYPE="YCAGEL" D
...S RAW=$$GET1^DIQ(601.75,$P($G(DATA),U,3)_",",4,"I")
...I RAW="X" Q
...S RAW=3-RAW ;0 to 3 -> 3 to 0
..I $G(RAW)="X" S SKIP(SCALE)=$G(SKIP(SCALE))+1 Q
..;raw score is stored directly in YSDATA piece 3 - trackbars do this.
..I RAWTYPE="DIRECT" S RAW=$P($G(DATA),U,3)
..I $G(RAW)="Left blank by the user." S SKIP(SCALE)=$G(SKIP(SCALE))=SKIP(SCALE)+1 Q
..S SCORE(SCALE)=$G(SCORE(SCALE))+RAW
;
;Check scale validity
I $G(SKIP(1225))=10 S SCORE(1225)=""
I $G(SKIP(1226))>2 S SCORE(1226)=""
I $G(SKIP(1227))>2 S SCORE(1227)=""
I $G(SKIP(1228))>1 S SCORE(1228)=""
I $G(SKIP(1229))>1 S SCORE(1229)=""
I $G(SKIP(1230))>2 S SCORE(1230)=""
Q
;
SCOREDAT ; SCALE IEN|SCALE NAME|RAW VALUE STORAGE TYPE|QUES#^QUES#
;1225|Pain Complaints|LEGACY|1^2^3^4^5^6^7^8^9^10
;1226|Somatic Complaints|LEGACY|15^16^17^18^19^20^21^23^24^25
;1227|Defensiveness|LEGACY|43^53^56
;1227|Defensiveness|YCAGEL|47^49^58^60^62
;1228|Depression|LEGACY|46^52^55^57^59
;1228|Depression|YCAGEL|44
;1229|Anxiety|LEGACY|45^48^51^54^61^63
;1230|Functional|LEGACY|27^29^34^39^42
;1230|Functional|YCAGEL|31^32^36^38^41
;QUIT
Q
;
SCORESV(SCORE) ;SCORE(SCALE_IEN)=###
N YSCORNODE,YSGNODE
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)="No Scale found for ADMIN"
;
K ^TMP($J,"YSCOR")
S ^TMP($J,"YSCOR",1)="[DATA]"
S YSCORNODE=2
S YSGNODE=2 F S YSGNODE=$O(^TMP($J,"YSG",YSGNODE)) Q:YSGNODE="" D
.N SCALEIEN
.I $E(^TMP($J,"YSG",YSGNODE),1,5)'="Scale" Q ;only read the lines for scales
.S SCALEIEN=+$P(^TMP($J,"YSG",YSGNODE),"=",2) ;grab the first number after "=" sign
.S ^TMP($J,"YSCOR",YSCORNODE)=$$GET1^DIQ(601.87,SCALEIEN_",",3,"I")_"="_SCORE(SCALEIEN)
.S YSCORNODE=YSCORNODE+1
D TSCORING(.YSDATA)
Q
;
DLLSTR(YSDATA,YS,YSTRNG) ;
N SCORE,TSARR
;
S SCORE=0
I YSTRNG=1 D DATA1(.SCORE),SCORESV(.SCORE)
I YSTRNG=2 D LDTSCOR^YTSCORE(.TSARR,YS("AD")),BUILDANS(.TSARR,.YSDATA)
Q
;
BUILDANS(TSARR,YSDATA) ;
N QUES,I,RANGE,PEAK,PAINTOL,DIAGNOSTIC,YSANSWER,TEXT,VALITEM,DEFRT,VALTEXT,NODE,SCALE,CRITLIST,PAINOMIT,SKIP,MEDIANTEXT,MEDIANLIST
;
S N=N+1
;
;##VALIDITY SECTION
;reuse SCOREDAT table to count skipped questions
F LINE=1:1 S TEXT=$P($T(SCOREDAT+LINE),";",2) Q:TEXT="QUIT" D
.N SCALENAME,QUESTIONS,I
.S SCALENAME=$P(TEXT,"|",2),QUESTIONS=$P(TEXT,"|",4)
.F SCALE=1:1:$L(QUESTIONS,U) D
..N DATA S DATA=$P($G(YSDATA($P(QUESTIONS,U,SCALE)+2)),U,3)
..I DATA=1155 S SKIP(SCALENAME)=$G(SKIP(SCALENAME))+1 Q
..I DATA="Left blank by the user." S SKIP(SCALENAME)=$G(SKIP(SCALENAME))+1
S TEXT=" "
S VALITEM=+$$GET1^DIQ(601.75,$P($G(YSDATA(52)),U,3)_",",4,"I") ;question 50
I VALITEM>1 S TEXT=" Random Responding: Results suggest random responding, review critical items section.|"
S DEFRT=$$RATING("Defensiveness",$P(TSARR("Defensiveness"),U,3)) ;send Defensiveness px t-score for rating
I (DEFRT["Extremely")!(DEFRT["Very") S TEXT=TEXT_"Biased Responding: Results of Defensiveness Scale suggest biased responding.|"
S VALTEXT=""
I $G(SKIP("Pain Complaints")) S VALTEXT="Pain Complaints: check omitted items.|"
I $P(TSARR("Pain Complaints"),U,2)="" S VALTEXT="All Pain Complaints items omitted.|"
F SCALE="Somatic Complaints","Defensiveness","Depression","Anxiety","Functional" D
.I $P(TSARR(SCALE),U,2)="" S VALTEXT=VALTEXT_SCALE_" scale is invalid.|" Q
.I $G(SKIP(SCALE)) S VALTEXT=VALTEXT_SCALE_": check omitted items.|"
I $L(VALTEXT) S TEXT=TEXT_VALTEXT
I TEXT=" " S TEXT=" Valid: No indicators of suspect validity present.|"
S YSDATA(N)="7771^9999;1^"_TEXT,N=N+1
;
;##PAIN AREA SECTION
S QUES(0)=$$GET1^DIQ(601.75,$P($G(YSDATA(66)),U,3)_",",4,"I")
S MEDIANTEXT=$$EPAD($$GET1^DIQ(601.75,$P($G(YSDATA(66)),U,3)_",",3,"I"),15)
S YSDATA(N)="7791^9999;1^"_MEDIANTEXT,N=N+1
I QUES(0)=1 S TEXT="82 patients with headache and head injury pain"
I QUES(0)=2 S TEXT="99 patients with neck pain/injury"
I QUES(0)=3 S TEXT="220 patients with upper extremity pain/injury"
I QUES(0)=4 S TEXT="316 patients with lower back pain/injury"
I QUES(0)=5 S TEXT="182 patients with lower extremity pain/injury"
S YSDATA(N)="7792^9999;1^"_TEXT,N=N+1
S TEXT=" Pain Area Pt "_MEDIANTEXT_" Median for|"
S TEXT=TEXT_" Median* Community**|"
S MEDIANLIST=$P("7273113503^6085115603^4067002302^3041004805^3031003507",U,QUES(0))
F I=1:1:14 D ;store pain question data, including question 0
.N DATA
.S DATA=$P($G(YSDATA(I+2)),U,3)
.S QUES(I)=$$GET1^DIQ(601.75,DATA_",",4,"I")
.I DATA=1155 S QUES(I)="--"
F I=1:1:10 D ;generate text
.N DATA,QTEXT
.S QTEXT=$$GET1^DIQ(601.72,$P($G(YSDATA(I+2)),U,1)_",",1,"","QTEXT")
.S TEXT=TEXT_$$EPAD(QTEXT(1)_":",25)_$$PAD(QUES(I),2)_" "_$E(MEDIANLIST,I)_" "_$E(2020000201,I)_"|"
S YSDATA(N)="7787^9999;1^"_TEXT,N=N+1
;
;##PAIN DIMENSIONS SECTION
;Find peak pain for Q1-10
S PEAK="--"
F I=1:1:10 D
.I QUES(I)="--" Q
.I (QUES(I)>PEAK)!(PEAK="--") S PEAK=QUES(I)
D ;Find pain range
.I QUES(11)_QUES(12)["--" S RANGE="--" Q
.S RANGE=QUES(11)-QUES(12)
;Peak Pain
I QUES(11)="--" S PEAK="--"
I QUES(11)>PEAK S PEAK=QUES(11)
D ;Pain Tolerance
.I (QUES(14)_PEAK)["--" S PAINTOL="--" Q
.S PAINTOL=QUES(14)-PEAK
S YSDATA(N)="7788^9999;1^"_$$PAD(QUES(11),2),N=N+1
S YSDATA(N)="7789^9999;1^"_$$PAD(QUES(12),2)_" "_$E("33232",QUES(0))_" 0",N=N+1
S YSDATA(N)="7790^9999;1^"_$$PAD(QUES(14),2),N=N+1
S YSDATA(N)="7772^9999;1^"_$$PAD(QUES(13),2),N=N+1
S YSDATA(N)="7773^9999;1^"_$$PAD(RANGE,3),N=N+1
S YSDATA(N)="7774^9999;1^"_$$PAD(PEAK,2),N=N+1
S YSDATA(N)="7775^9999;1^"_$$PAD(PAINTOL,3),N=N+1
;
;##PATIENT SCALE SCORES SECTION
S NODE=7777
F SCALE="Defensiveness","Somatic Complaints","Pain Complaints","Functional","Depression","Anxiety" D
.N PROFILETEXT,TPX,TCOM S PROFILETEXT=""
.I $P(TSARR(SCALE),U,2)="" D Q
..S YSDATA(N)=NODE_"^9999;1^ "_$$EPAD(SCALE,19)_"-- -- -- :....:....:"
..S N=N+1,NODE=NODE+1
.S TPX=+$P(TSARR(SCALE),U,3),TCOM=+$P(TSARR(SCALE),U,4)
.S TEXT=$$EPAD(SCALE,19)_$$PAD($P(TSARR(SCALE),U,2),2)_" "_$$PAD(TPX,3)_" "_$$PAD(TCOM,3)
.S TEXT=$$EPAD(TEXT,35) ;profile graph starts at 37 characters
.;the profile graph crops values <10 and >90, squeezes the 80 point range into 40 characters.
.S $E(PROFILETEXT,(40-10)/2)=":....:....:"
.S:TPX<10 TPX=10 S:TCOM<10 TCOM=10 S:TPX>90 TPX=90 S:TCOM>90 TCOM=90 ;crop values outside of graph
.S $E(PROFILETEXT,(TPX-10)/2)="P",$E(PROFILETEXT,(TCOM-10)/2)="C",PROFILETEXT=PROFILETEXT
.I TPX>50 D ARROWS(.PROFILETEXT,(50-10)/2,">",(TPX-10)/2,(TCOM-10)/2)
.I TPX<50 D ARROWS(.PROFILETEXT,(TPX-10)/2,"<",(50-10)/2,(TCOM-10)/2)
.I TCOM>50 D ARROWS(.PROFILETEXT,(50-10)/2,">",(TCOM-10)/2,(TPX-10)/2)
.I TCOM<50 D ARROWS(.PROFILETEXT,(TCOM-10)/2,"<",(50-10)/2,(TPX-10)/2)
.S TEXT=TEXT_PROFILETEXT
.S YSDATA(N)=NODE_"^9999;1^ "_TEXT,N=N+1,NODE=NODE+1 ;nodes 7777 to 7782
;
;##RATING SECTION
S I=0,TEXT=" "
F SCALE="Defensiveness","Somatic Complaints","Pain Complaints","Functional","Depression","Anxiety" D
.N PXT S PXT=$P(TSARR(SCALE),U,3),I=I+1
.I $P(TSARR(SCALE),U,2)="" S TEXT=TEXT_$$EPAD(SCALE_":",21)_$$EPAD("----",16)_" --%|" Q
.S TEXT=TEXT_$$EPAD(SCALE_":",21)_$$EPAD($$RATING(SCALE,PXT),16)_" "_$P(TSARR(SCALE),U,5)_"%|"
S YSDATA(N)="7783^9999;1^ "_TEXT,N=N+1
;
;##CRITICAL ITEMS/AREAS SECTION
S YSDATA(N)="7784^9999;1^"_$$CRITICAL(.YSDATA),N=N+1
;
;##OMITTED ITEMS SECTION
S TEXT=" "
F I=1:1:63 D
.N DATA,SKIP
.S DATA=YSDATA(I+2),SKIP=0
.I ($P($G(DATA),U,3)=1155)!($P($G(DATA),U,3)="Left blank by the user.") D
..N QTEXT
..S QTEXT=$$GET1^DIQ(601.72,$P($G(YSDATA(I+2)),U,1)_",",1,"","QTEXT")
..S TEXT=TEXT_I_". "_QTEXT(1)_"|"
I TEXT=" " S TEXT=" None|"
S YSDATA(N)="7785^9999;1^"_TEXT,N=N+1
;
;##RANDOM RESPONDING CHECK SECTION
S TEXT=" Negative"
I VALITEM>1 S TEXT=" 50. I am allergic to the glass found in jars.| "_(VALITEM+1)_". "_$$GET1^DIQ(601.75,$P($G(YSDATA(52)),U,3)_",",3,"I")
S YSDATA(N)="7786^9999;1^"_TEXT,N=N+1
Q
EXP(%X) ; e to the X power
D EXP^XTFN ; takes %X and returns %E
Q %E
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
;
EPAD(VAL,LENGTH) ; padds the value with spaces at end
N RETURN,PADDING
S PADDING=LENGTH-$L(VAL)
I PADDING'>0 Q VAL
S $P(VAL," ",PADDING+1+$L(VAL," "))=""
Q VAL
;
TSCORING(YSDATA) ; add T-scores and percentiles
N IDX,SCORENAME,RAW
I ^TMP($J,"YSCOR",1)'="[DATA]" Q
S IDX=1
F S IDX=$O(^TMP($J,"YSCOR",IDX)) Q:'IDX D
.S SCORENAME=$P(^TMP($J,"YSCOR",IDX),"=",1)
.S RAW=$P(^TMP($J,"YSCOR",IDX),"=",2)
.I RAW="" Q ;Invalid scale
.S ^TMP($J,"YSCOR",IDX)=^TMP($J,"YSCOR",IDX)_U_$$GETTPER(RAW,SCORENAME)
;
GETTPER(RAW,SCORENAME) ; get the T score and percentile given a score's raw #
N LINE,TEXT,TABLE,X,RETURN
;special formatting for raw and scorename
S SCORENAME=$$UP^XLFSTR(SCORENAME)
S TABLE=$E(SCORENAME,1,4)_"T"
S RAW="|"_RAW_U
;get t-scores, there are two: patient and community
F LINE=1:1 S TEXT=$T(@TABLE+LINE) D Q:TEXT["Q"
.I TEXT[RAW D ;if this line contains the raw number
..S TEXT=$P(TEXT,RAW,2) ;strip up to raw
..S RETURN=$P(TEXT,"|") ;get t scores
..S TEXT="Q"
;Patient percentile
S X="|"_$P(RETURN,U)_U ;use patient T score to retrieve
S TABLE=$E(SCORENAME,1,4)_"P"
I TABLE="PAINP" S X=RAW ;pain table uses raw
F LINE=1:1 S TEXT=$T(@TABLE+LINE) D Q:TEXT["Q"
.I TEXT[X D ;if this line contains the index
..S TEXT=$P(TEXT,X,2) ;strip up to index
..S RETURN=RETURN_U_$P(TEXT,"|") ;get percentile
..S TEXT="Q"
;The community percentile is defined in the PDD but we don't use it in this instrument's report
;In any case, we only have fields for three extra scores
Q RETURN
PAINT ; Pain T Scores table |raw^px T score^community T score|
;|0^34^39|1^35^40|2^35^40|3^36^41|4^37^42|5^37^42|6^38^43|7^38^44|
;|8^39^44|9^39^45|10^40^45|11^40^46|12^41^47|13^42^47|14^42^48|
;|15^43^49|16^43^49|17^44^50|18^44^50|19^45^51|20^45^52|21^46^52|
;|22^47^53|23^47^54|24^48^54|25^48^55|26^49^56|27^49^56|28^50^57|
;|29^50^57|30^51^58|31^52^59|32^52^59|33^53^60|34^53^61|35^54^61|
;|36^54^62|37^55^62|38^56^63|39^56^64|40^57^64|41^57^65|42^58^66|
;|43^58^66|44^59^67|45^59^68|46^60^68|47^61^69|48^61^69|49^62^70|
;|50^62^71|51^63^71|52^63^72|53^64^73|54^64^73|55^65^74|56^66^74|
;|57^66^75|58^67^76|59^67^76|60^68^77|61^68^78|62^69^78|63^69^79|
;|64^70^80|65^71^80|66^71^81|67^72^81|68^72^82|69^73^83|70^73^83|
;|71^74^84|72^74^85|73^75^85|74^76^86|75^76^86|76^77^87|77^77^88|
;|78^78^88|79^78^89|80^79^90|81^80^90|82^80^91|83^81^92|84^81^92|
;|85^82^93|86^82^93|87^83^94|88^83^95|89^84^95|90^85^96|91^85^97|
;|92^86^97|93^86^98|94^87^98|95^87^99|96^88^100|97^88^100|98^89^101|
;|99^90^102|100^90^102|
Q
;
SOMAT ; Somatic T Scores table |raw^px T score^community T score|
;|0^37^39|1^39^42|2^41^44|3^42^46|4^44^48|5^45^50|6^47^52|7^49^54|
;|8^50^56|9^52^59|10^53^61|11^55^63|12^57^65|13^58^67|14^60^69|
;|15^62^71|16^63^73|17^65^75|18^66^78|19^68^80|20^70^82|21^71^84|
;|22^73^86|23^75^88|24^76^90|25^78^92|26^79^95|27^81^97|28^83^99|
;|29^84^101|30^86^103|
Q
;
DEFET ; Defensiveness T Scores table |raw^px T score^community T score|
;|0^20^12|1^22^14|2^25^17|3^27^19|4^29^21|5^31^24|6^34^26|7^36^29|
;|8^38^31|9^40^33|10^42^36|11^45^38|12^47^40|13^49^43|14^51^45|
;|15^54^47|16^56^50|17^58^52|18^60^54|19^63^57|20^65^59|21^67^62|
;|22^69^64|23^71^66|24^74^69|
Q
;
DEPRT ; Depression T Scores table |raw^px T score^community T score|
;|0^31^35|1^34^38|2^37^41|3^40^44|4^43^47|5^46^51|6^48^54|7^51^57|
;|8^54^60|9^57^63|10^60^66|11^63^69|12^66^72|13^69^76|14^72^79|
;|15^74^82|16^77^85|17^80^88|18^83^91|
Q
;
ANXIT ; Anxiety T Scores table |raw^px T score|community T score|
;|0^26^30|1^30^34|2^33^37|3^37^41|4^40^44|5^43^47|6^47^51|7^50^54|
;|8^54^58|9^57^61|10^61^65|11^64^68|12^68^72|13^71^75|14^74^79|
;|15^78^82|16^81^86|17^85^89|18^88^92|
Q
;
FUNCT ; Functional T Scores table |raw^px T score^community T score|
;|0^25^30|1^27^33|2^29^35|3^30^37|4^32^40|5^34^42|6^36^44|7^38^46|
;|8^40^49|9^42^51|10^44^53|11^46^56|12^47^58|13^49^60|14^51^62|
;|15^53^65|16^55^67|17^57^69|18^59^72|19^61^74|20^63^76|21^64^78|
;|22^66^81|23^68^83|24^70^85|25^72^88|26^74^90|27^76^92|28^78^94|
;|29^80^97|30^81^99|
Q
PAINP ; Pain px percentiles table |raw^px percentile|
;|0^1|1^2|2^3|3^4|4^5|5^6|6^7|7^9|8^11|9^13|10^15|11^17|12^19|
;|13^22|14^24|15^28|16^30|17^31|18^34|19^36|20^38|21^40|22^43|
;|23^45|24^48|25^51|26^53|27^55|28^57|29^59|30^60|31^62|32^63|
;|33^65|34^67|35^69|36^71|37^72|38^73|39^75|40^76|41^77|42^78|
;|43^79|44^80|45^81|46^82|47^84|48^85|49^86|50^88|51^89|52^90|
;|53^90|54^91|55^91|56^92|57^93|58^94|59^95|60^95|61^95|62^95|
;|63^96|64^96|65^96|66^97|67^97|68^97|69^98|70^98|71^98|72^99|
;|73^99|74^99|75^99|76^99|77^99|78^99|79^99|80^99|81^99|82^99|
;|83^99|84^99|85^99|86^99|87^99|88^99|89^99|90^99|91^99|92^99|
;|93^99|94^99|95^99|96^99|97^99|98^99|99^99|100^99|
Q
SOMAP ; Somatic px percentiles table |px T score^px percentile|
;|37^4|39^12|41^19|42^25|44^32|45^40|47^46|49^53|50^58|52^62|53^67|
;|55^73|57^78|58^82|60^85|62^87|63^88|65^90|66^91|68^92|70^93|71^95|
;|73^97|75^99|76^99|78^99|79^99|81^99|83^99|84^99|86^99|
Q
DEFEP ; Defensiveness px percentiles table |px T score^px percentile|
;|20^1|22^1|25^1|27^2|29^2|31^4|34^6|36^8|38^11|40^17|42^24|45^31|
;|47^37|49^44|51^53|54^63|56^73|58^81|60^86|63^91|65^94|67^95|69^97|
;|71^98|74^99|
Q
DEPRP ; Depression px percentiles table |px T score^px percentile|
;|31^1|34^5|37^8|40^14|43^23|46^35|48^48|51^61|54^71|57^78|60^83|
;|63^88|66^92|69^95|72^97|74^98|77^99|80^99|83^99|
Q
ANXIP ; Anxiety px percentiles table |px T score^px percentile|
;|26^1|30^3|33^6|37^11|40^17|43^24|47^36|50^50|54^65|57^78|61^86|
;|64^92|68^96|71^98|74^99|78^99|81^99|85^99|88^99|
Q
FUNCP ; Functional px percentiles table |px T score^px percentile|
;|25^1|27^1|29^1|30^1|32^2|34^5|36^9|38^12|40^16|42^20|44^27|46^35|
;|47^43|49^50|51^58|53^65|55^71|57^76|59^81|61^85|63^89|64^92|66^94|
;|68^95|70^97|72^98|74^98|76^99|78^99|80^99|81^99|
Q
;
RATING(SCALE,PXT) ;Get scale rating given px t-score
N TSCORERANGES,I,RANGE,RATING
F I=1:1:6 D
.I $P($T(RATEDATA+I),"|",1)'[SCALE Q
.S TSCORERANGES=$P($T(RATEDATA+I),"|",2)
Q:$G(TSCORERANGES)="" -1
S I=0 F S I=I+1,RANGE=$P(TSCORERANGES,U,I) Q:RANGE="" Q:(PXT'<+RANGE)&(PXT'>+$P(RANGE,"-",2))
Q $P(RANGE,"=",2)
;
RATEDATA ;
;Pain Complaints|34-34=Extremely Low^35-37=Very Low^38-40=Low^41-52=Average^53-59=Moderately High^60-66=High^67-72=Very High^73-90=Extremely High
;Somatic Complaints|37-37=Very Low^39-39=Low^41-52=Average^53-58=Moderately High^60-70=High^71-73=Very High^75-86=Extremely High
;Defensiveness|20-25=Extremely Low^27-31=Very Low^34-40=Low^42-47=Moderately Low^49-58=Average^60-65=High^67-69=Very High^71-74=Extremely High
;Depression|31-31=Extremely Low^34-34=Very Low^37-40=Low^43-51=Average^54-57=Moderately High^60-66=High^69-72=Very High^74-83=Extremely High
;Anxiety|26-26=Extremely Low^30-33=Very Low^37-40=Low^43-54=Average^57-57=Moderately High^61-64=High^68-68=Very High^71-88=Extremely High
;Functional|25-30=Extremely Low^32-34=Very Low^36-40=Low^42-47=Average^49-59=Moderately High^61-64=High^66-68=Very High^70-81=Extremely High
;
CRITICAL(YSDATA) ;
N TEXT
S TEXT=" "
F I=1:1:16 D
.N DATA,QUESTION,AREA,QTEXT,ANSTEXT,VALUE
.S DATA=$T(CRITDATA+I)
.S QUESTION=$P(DATA,U,2)
.S VALUE=+$$GET1^DIQ(601.75,$P($G(YSDATA(QUESTION+2)),U,3)_",",4,"I")
.I "31,33,26"[QUESTION S VALUE=3-VALUE ;these three questions have reverse scoring 0->3,3->0
.I VALUE<2 Q ;question scored as 0 or 1, exit.
.S AREA=$P(DATA,U,3)_"|"
.I TEXT'[AREA S TEXT=TEXT_AREA ;Skip if we already have printed the area
.S QTEXT=$$GET1^DIQ(601.72,$P($G(YSDATA(QUESTION+2)),U,1)_",",1,"","QTEXT")
.S ANSTEXT=$$GET1^DIQ(601.75,$P($G(YSDATA(QUESTION+2)),U,3)_",",3,"I")
.;use only first one or two words
.S ANSTEXT=$P(ANSTEXT," ",1,2)
.I ($P(ANSTEXT," ",1)="Disagree")!($P(ANSTEXT," ",1)="Agree") S ANSTEXT=$P(ANSTEXT," ",1)
.S TEXT=TEXT_" "_QUESTION_". "_QTEXT(1)_" ("_ANSTEXT_")|"
I TEXT=" " S TEXT=" The patient did not endorse any of the 17 critical items"
Q TEXT
;
CRITDATA ;
;^35^Compensation Focus
;^31^Sleep Disorder
;^51^Death Anxiety
;^52^Suicidal Ideation
;^28^Chemical Dependency
;^33^Chemical Dependency
;^37^Doctor Dissatisfaction
;^22^Psychosis
;^26^Satisfaction with Care
;^34^Perceived Disability
;^40^Pain Fixation
;^30^Home Life Problems
;^15^Vegative Depression
;^24^Vegative Depression
;^21^Anxiety/Panic
;^19^PTSD/Dissociation
;
ARROWS(LINETEXT,START,FILL,END,NOWRITE) ;fill linetext from start position to end position
N I
S START=$P(START,"."),END=$P(END,"."),NOWRITE=$P(NOWRITE,".") ;strip decimals
F I=(START+1):1:(END-1) D
.I I=NOWRITE Q
.S $E(LINETEXT,I)=FILL
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYTSBBHI2 18364 printed Dec 13, 2024@02:19:21 Page 2
YTSBBHI2 ;SLC/DJE- ANSWERS SPECIAL HANDLING - BBHI-2 ; 10/16/18 9:35am
+1 ;;5.01;MENTAL HEALTH;**139**;;Build 134
+2 ;
DATA1(SCORE) ;expects YSDATA, returns SCORE, multiple scales so we use nodes i.e. SCORE(SCALEIEN)=###
+1 ;specialized DATA1 uses SCOREDAT table to map question to score relationships
+2 NEW LINE,TEXT,SKIP,I
+3 FOR LINE=1:1
SET TEXT=$PIECE($TEXT(SCOREDAT+LINE),";",2)
if TEXT="QUIT"
QUIT
Begin DoDot:1
+4 NEW SCALE,RAWTYPE,QUESTIONS,I
+5 SET SCALE=$PIECE(TEXT,"|",1)
SET RAWTYPE=$PIECE(TEXT,"|",3)
SET QUESTIONS=$PIECE(TEXT,"|",4)
+6 FOR I=1:1:$LENGTH(QUESTIONS,U)
Begin DoDot:2
+7 NEW NODE,DATA,RAW
+8 ;YSDATA question nodes start at 3 and also skip question 0
SET NODE=$PIECE(QUESTIONS,U,I)+2
+9 SET DATA=YSDATA(NODE)
+10 ;retrieval method section. For each RAWTYPE assign a value to RAW
+11 ;typical case, YSDATA piece 3 has the MH CHOICE IEN and raw value is in LEGACY field
+12 IF RAWTYPE="LEGACY"
SET RAW=$$GET1^DIQ(601.75,$PIECE($GET(DATA),U,3)_",",4,"I")
+13 ;reverse score legacy field - need to make sure skipped value is not reverse scored
+14 IF RAWTYPE="YCAGEL"
Begin DoDot:3
+15 SET RAW=$$GET1^DIQ(601.75,$PIECE($GET(DATA),U,3)_",",4,"I")
+16 IF RAW="X"
QUIT
+17 ;0 to 3 -> 3 to 0
SET RAW=3-RAW
End DoDot:3
+18 IF $GET(RAW)="X"
SET SKIP(SCALE)=$GET(SKIP(SCALE))+1
QUIT
+19 ;raw score is stored directly in YSDATA piece 3 - trackbars do this.
+20 IF RAWTYPE="DIRECT"
SET RAW=$PIECE($GET(DATA),U,3)
+21 IF $GET(RAW)="Left blank by the user."
SET SKIP(SCALE)=$GET(SKIP(SCALE))=SKIP(SCALE)+1
QUIT
+22 SET SCORE(SCALE)=$GET(SCORE(SCALE))+RAW
End DoDot:2
End DoDot:1
+23 ;
+24 ;Check scale validity
+25 IF $GET(SKIP(1225))=10
SET SCORE(1225)=""
+26 IF $GET(SKIP(1226))>2
SET SCORE(1226)=""
+27 IF $GET(SKIP(1227))>2
SET SCORE(1227)=""
+28 IF $GET(SKIP(1228))>1
SET SCORE(1228)=""
+29 IF $GET(SKIP(1229))>1
SET SCORE(1229)=""
+30 IF $GET(SKIP(1230))>2
SET SCORE(1230)=""
+31 QUIT
+32 ;
SCOREDAT ; SCALE IEN|SCALE NAME|RAW VALUE STORAGE TYPE|QUES#^QUES#
+1 ;1225|Pain Complaints|LEGACY|1^2^3^4^5^6^7^8^9^10
+2 ;1226|Somatic Complaints|LEGACY|15^16^17^18^19^20^21^23^24^25
+3 ;1227|Defensiveness|LEGACY|43^53^56
+4 ;1227|Defensiveness|YCAGEL|47^49^58^60^62
+5 ;1228|Depression|LEGACY|46^52^55^57^59
+6 ;1228|Depression|YCAGEL|44
+7 ;1229|Anxiety|LEGACY|45^48^51^54^61^63
+8 ;1230|Functional|LEGACY|27^29^34^39^42
+9 ;1230|Functional|YCAGEL|31^32^36^38^41
+10 ;QUIT
+11 QUIT
+12 ;
SCORESV(SCORE) ;SCORE(SCALE_IEN)=###
+1 NEW YSCORNODE,YSGNODE
+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)="No Scale found for ADMIN"
End DoDot:1
QUIT
+6 ;
+7 KILL ^TMP($JOB,"YSCOR")
+8 SET ^TMP($JOB,"YSCOR",1)="[DATA]"
+9 SET YSCORNODE=2
+10 SET YSGNODE=2
FOR
SET YSGNODE=$ORDER(^TMP($JOB,"YSG",YSGNODE))
if YSGNODE=""
QUIT
Begin DoDot:1
+11 NEW SCALEIEN
+12 ;only read the lines for scales
IF $EXTRACT(^TMP($JOB,"YSG",YSGNODE),1,5)'="Scale"
QUIT
+13 ;grab the first number after "=" sign
SET SCALEIEN=+$PIECE(^TMP($JOB,"YSG",YSGNODE),"=",2)
+14 SET ^TMP($JOB,"YSCOR",YSCORNODE)=$$GET1^DIQ(601.87,SCALEIEN_",",3,"I")_"="_SCORE(SCALEIEN)
+15 SET YSCORNODE=YSCORNODE+1
End DoDot:1
+16 DO TSCORING(.YSDATA)
+17 QUIT
+18 ;
DLLSTR(YSDATA,YS,YSTRNG) ;
+1 NEW SCORE,TSARR
+2 ;
+3 SET SCORE=0
+4 IF YSTRNG=1
DO DATA1(.SCORE)
DO SCORESV(.SCORE)
+5 IF YSTRNG=2
DO LDTSCOR^YTSCORE(.TSARR,YS("AD"))
DO BUILDANS(.TSARR,.YSDATA)
+6 QUIT
+7 ;
BUILDANS(TSARR,YSDATA) ;
+1 NEW QUES,I,RANGE,PEAK,PAINTOL,DIAGNOSTIC,YSANSWER,TEXT,VALITEM,DEFRT,VALTEXT,NODE,SCALE,CRITLIST,PAINOMIT,SKIP,MEDIANTEXT,MEDIANLIST
+2 ;
+3 SET N=N+1
+4 ;
+5 ;##VALIDITY SECTION
+6 ;reuse SCOREDAT table to count skipped questions
+7 FOR LINE=1:1
SET TEXT=$PIECE($TEXT(SCOREDAT+LINE),";",2)
if TEXT="QUIT"
QUIT
Begin DoDot:1
+8 NEW SCALENAME,QUESTIONS,I
+9 SET SCALENAME=$PIECE(TEXT,"|",2)
SET QUESTIONS=$PIECE(TEXT,"|",4)
+10 FOR SCALE=1:1:$LENGTH(QUESTIONS,U)
Begin DoDot:2
+11 NEW DATA
SET DATA=$PIECE($GET(YSDATA($PIECE(QUESTIONS,U,SCALE)+2)),U,3)
+12 IF DATA=1155
SET SKIP(SCALENAME)=$GET(SKIP(SCALENAME))+1
QUIT
+13 IF DATA="Left blank by the user."
SET SKIP(SCALENAME)=$GET(SKIP(SCALENAME))+1
End DoDot:2
End DoDot:1
+14 SET TEXT=" "
+15 ;question 50
SET VALITEM=+$$GET1^DIQ(601.75,$PIECE($GET(YSDATA(52)),U,3)_",",4,"I")
+16 IF VALITEM>1
SET TEXT=" Random Responding: Results suggest random responding, review critical items section.|"
+17 ;send Defensiveness px t-score for rating
SET DEFRT=$$RATING("Defensiveness",$PIECE(TSARR("Defensiveness"),U,3))
+18 IF (DEFRT["Extremely")!(DEFRT["Very")
SET TEXT=TEXT_"Biased Responding: Results of Defensiveness Scale suggest biased responding.|"
+19 SET VALTEXT=""
+20 IF $GET(SKIP("Pain Complaints"))
SET VALTEXT="Pain Complaints: check omitted items.|"
+21 IF $PIECE(TSARR("Pain Complaints"),U,2)=""
SET VALTEXT="All Pain Complaints items omitted.|"
+22 FOR SCALE="Somatic Complaints","Defensiveness","Depression","Anxiety","Functional"
Begin DoDot:1
+23 IF $PIECE(TSARR(SCALE),U,2)=""
SET VALTEXT=VALTEXT_SCALE_" scale is invalid.|"
QUIT
+24 IF $GET(SKIP(SCALE))
SET VALTEXT=VALTEXT_SCALE_": check omitted items.|"
End DoDot:1
+25 IF $LENGTH(VALTEXT)
SET TEXT=TEXT_VALTEXT
+26 IF TEXT=" "
SET TEXT=" Valid: No indicators of suspect validity present.|"
+27 SET YSDATA(N)="7771^9999;1^"_TEXT
SET N=N+1
+28 ;
+29 ;##PAIN AREA SECTION
+30 SET QUES(0)=$$GET1^DIQ(601.75,$PIECE($GET(YSDATA(66)),U,3)_",",4,"I")
+31 SET MEDIANTEXT=$$EPAD($$GET1^DIQ(601.75,$PIECE($GET(YSDATA(66)),U,3)_",",3,"I"),15)
+32 SET YSDATA(N)="7791^9999;1^"_MEDIANTEXT
SET N=N+1
+33 IF QUES(0)=1
SET TEXT="82 patients with headache and head injury pain"
+34 IF QUES(0)=2
SET TEXT="99 patients with neck pain/injury"
+35 IF QUES(0)=3
SET TEXT="220 patients with upper extremity pain/injury"
+36 IF QUES(0)=4
SET TEXT="316 patients with lower back pain/injury"
+37 IF QUES(0)=5
SET TEXT="182 patients with lower extremity pain/injury"
+38 SET YSDATA(N)="7792^9999;1^"_TEXT
SET N=N+1
+39 SET TEXT=" Pain Area Pt "_MEDIANTEXT_" Median for|"
+40 SET TEXT=TEXT_" Median* Community**|"
+41 SET MEDIANLIST=$PIECE("7273113503^6085115603^4067002302^3041004805^3031003507",U,QUES(0))
+42 ;store pain question data, including question 0
FOR I=1:1:14
Begin DoDot:1
+43 NEW DATA
+44 SET DATA=$PIECE($GET(YSDATA(I+2)),U,3)
+45 SET QUES(I)=$$GET1^DIQ(601.75,DATA_",",4,"I")
+46 IF DATA=1155
SET QUES(I)="--"
End DoDot:1
+47 ;generate text
FOR I=1:1:10
Begin DoDot:1
+48 NEW DATA,QTEXT
+49 SET QTEXT=$$GET1^DIQ(601.72,$PIECE($GET(YSDATA(I+2)),U,1)_",",1,"","QTEXT")
+50 SET TEXT=TEXT_$$EPAD(QTEXT(1)_":",25)_$$PAD(QUES(I),2)_" "_$EXTRACT(MEDIANLIST,I)_" "_$EXTRACT(2020000201,I)_"|"
End DoDot:1
+51 SET YSDATA(N)="7787^9999;1^"_TEXT
SET N=N+1
+52 ;
+53 ;##PAIN DIMENSIONS SECTION
+54 ;Find peak pain for Q1-10
+55 SET PEAK="--"
+56 FOR I=1:1:10
Begin DoDot:1
+57 IF QUES(I)="--"
QUIT
+58 IF (QUES(I)>PEAK)!(PEAK="--")
SET PEAK=QUES(I)
End DoDot:1
+59 ;Find pain range
Begin DoDot:1
+60 IF QUES(11)_QUES(12)["--"
SET RANGE="--"
QUIT
+61 SET RANGE=QUES(11)-QUES(12)
End DoDot:1
+62 ;Peak Pain
+63 IF QUES(11)="--"
SET PEAK="--"
+64 IF QUES(11)>PEAK
SET PEAK=QUES(11)
+65 ;Pain Tolerance
Begin DoDot:1
+66 IF (QUES(14)_PEAK)["--"
SET PAINTOL="--"
QUIT
+67 SET PAINTOL=QUES(14)-PEAK
End DoDot:1
+68 SET YSDATA(N)="7788^9999;1^"_$$PAD(QUES(11),2)
SET N=N+1
+69 SET YSDATA(N)="7789^9999;1^"_$$PAD(QUES(12),2)_" "_$EXTRACT("33232",QUES(0))_" 0"
SET N=N+1
+70 SET YSDATA(N)="7790^9999;1^"_$$PAD(QUES(14),2)
SET N=N+1
+71 SET YSDATA(N)="7772^9999;1^"_$$PAD(QUES(13),2)
SET N=N+1
+72 SET YSDATA(N)="7773^9999;1^"_$$PAD(RANGE,3)
SET N=N+1
+73 SET YSDATA(N)="7774^9999;1^"_$$PAD(PEAK,2)
SET N=N+1
+74 SET YSDATA(N)="7775^9999;1^"_$$PAD(PAINTOL,3)
SET N=N+1
+75 ;
+76 ;##PATIENT SCALE SCORES SECTION
+77 SET NODE=7777
+78 FOR SCALE="Defensiveness","Somatic Complaints","Pain Complaints","Functional","Depression","Anxiety"
Begin DoDot:1
+79 NEW PROFILETEXT,TPX,TCOM
SET PROFILETEXT=""
+80 IF $PIECE(TSARR(SCALE),U,2)=""
Begin DoDot:2
+81 SET YSDATA(N)=NODE_"^9999;1^ "_$$EPAD(SCALE,19)_"-- -- -- :....:....:"
+82 SET N=N+1
SET NODE=NODE+1
End DoDot:2
QUIT
+83 SET TPX=+$PIECE(TSARR(SCALE),U,3)
SET TCOM=+$PIECE(TSARR(SCALE),U,4)
+84 SET TEXT=$$EPAD(SCALE,19)_$$PAD($PIECE(TSARR(SCALE),U,2),2)_" "_$$PAD(TPX,3)_" "_$$PAD(TCOM,3)
+85 ;profile graph starts at 37 characters
SET TEXT=$$EPAD(TEXT,35)
+86 ;the profile graph crops values <10 and >90, squeezes the 80 point range into 40 characters.
+87 SET $EXTRACT(PROFILETEXT,(40-10)/2)=":....:....:"
+88 ;crop values outside of graph
if TPX<10
SET TPX=10
if TCOM<10
SET TCOM=10
if TPX>90
SET TPX=90
if TCOM>90
SET TCOM=90
+89 SET $EXTRACT(PROFILETEXT,(TPX-10)/2)="P"
SET $EXTRACT(PROFILETEXT,(TCOM-10)/2)="C"
SET PROFILETEXT=PROFILETEXT
+90 IF TPX>50
DO ARROWS(.PROFILETEXT,(50-10)/2,">",(TPX-10)/2,(TCOM-10)/2)
+91 IF TPX<50
DO ARROWS(.PROFILETEXT,(TPX-10)/2,"<",(50-10)/2,(TCOM-10)/2)
+92 IF TCOM>50
DO ARROWS(.PROFILETEXT,(50-10)/2,">",(TCOM-10)/2,(TPX-10)/2)
+93 IF TCOM<50
DO ARROWS(.PROFILETEXT,(TCOM-10)/2,"<",(50-10)/2,(TPX-10)/2)
+94 SET TEXT=TEXT_PROFILETEXT
+95 ;nodes 7777 to 7782
SET YSDATA(N)=NODE_"^9999;1^ "_TEXT
SET N=N+1
SET NODE=NODE+1
End DoDot:1
+96 ;
+97 ;##RATING SECTION
+98 SET I=0
SET TEXT=" "
+99 FOR SCALE="Defensiveness","Somatic Complaints","Pain Complaints","Functional","Depression","Anxiety"
Begin DoDot:1
+100 NEW PXT
SET PXT=$PIECE(TSARR(SCALE),U,3)
SET I=I+1
+101 IF $PIECE(TSARR(SCALE),U,2)=""
SET TEXT=TEXT_$$EPAD(SCALE_":",21)_$$EPAD("----",16)_" --%|"
QUIT
+102 SET TEXT=TEXT_$$EPAD(SCALE_":",21)_$$EPAD($$RATING(SCALE,PXT),16)_" "_$PIECE(TSARR(SCALE),U,5)_"%|"
End DoDot:1
+103 SET YSDATA(N)="7783^9999;1^ "_TEXT
SET N=N+1
+104 ;
+105 ;##CRITICAL ITEMS/AREAS SECTION
+106 SET YSDATA(N)="7784^9999;1^"_$$CRITICAL(.YSDATA)
SET N=N+1
+107 ;
+108 ;##OMITTED ITEMS SECTION
+109 SET TEXT=" "
+110 FOR I=1:1:63
Begin DoDot:1
+111 NEW DATA,SKIP
+112 SET DATA=YSDATA(I+2)
SET SKIP=0
+113 IF ($PIECE($GET(DATA),U,3)=1155)!($PIECE($GET(DATA),U,3)="Left blank by the user.")
Begin DoDot:2
+114 NEW QTEXT
+115 SET QTEXT=$$GET1^DIQ(601.72,$PIECE($GET(YSDATA(I+2)),U,1)_",",1,"","QTEXT")
+116 SET TEXT=TEXT_I_". "_QTEXT(1)_"|"
End DoDot:2
End DoDot:1
+117 IF TEXT=" "
SET TEXT=" None|"
+118 SET YSDATA(N)="7785^9999;1^"_TEXT
SET N=N+1
+119 ;
+120 ;##RANDOM RESPONDING CHECK SECTION
+121 SET TEXT=" Negative"
+122 IF VALITEM>1
SET TEXT=" 50. I am allergic to the glass found in jars.| "_(VALITEM+1)_". "_$$GET1^DIQ(601.75,$PIECE($GET(YSDATA(52)),U,3)_",",3,"I")
+123 SET YSDATA(N)="7786^9999;1^"_TEXT
SET N=N+1
+124 QUIT
EXP(%X) ; e to the X power
+1 ; takes %X and returns %E
DO EXP^XTFN
+2 QUIT %E
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 ;
EPAD(VAL,LENGTH) ; padds the value with spaces at end
+1 NEW RETURN,PADDING
+2 SET PADDING=LENGTH-$LENGTH(VAL)
+3 IF PADDING'>0
QUIT VAL
+4 SET $PIECE(VAL," ",PADDING+1+$LENGTH(VAL," "))=""
+5 QUIT VAL
+6 ;
TSCORING(YSDATA) ; add T-scores and percentiles
+1 NEW IDX,SCORENAME,RAW
+2 IF ^TMP($JOB,"YSCOR",1)'="[DATA]"
QUIT
+3 SET IDX=1
+4 FOR
SET IDX=$ORDER(^TMP($JOB,"YSCOR",IDX))
if 'IDX
QUIT
Begin DoDot:1
+5 SET SCORENAME=$PIECE(^TMP($JOB,"YSCOR",IDX),"=",1)
+6 SET RAW=$PIECE(^TMP($JOB,"YSCOR",IDX),"=",2)
+7 ;Invalid scale
IF RAW=""
QUIT
+8 SET ^TMP($JOB,"YSCOR",IDX)=^TMP($JOB,"YSCOR",IDX)_U_$$GETTPER(RAW,SCORENAME)
End DoDot:1
+9 ;
GETTPER(RAW,SCORENAME) ; get the T score and percentile given a score's raw #
+1 NEW LINE,TEXT,TABLE,X,RETURN
+2 ;special formatting for raw and scorename
+3 SET SCORENAME=$$UP^XLFSTR(SCORENAME)
+4 SET TABLE=$EXTRACT(SCORENAME,1,4)_"T"
+5 SET RAW="|"_RAW_U
+6 ;get t-scores, there are two: patient and community
+7 FOR LINE=1:1
SET TEXT=$TEXT(@TABLE+LINE)
Begin DoDot:1
+8 ;if this line contains the raw number
IF TEXT[RAW
Begin DoDot:2
+9 ;strip up to raw
SET TEXT=$PIECE(TEXT,RAW,2)
+10 ;get t scores
SET RETURN=$PIECE(TEXT,"|")
+11 SET TEXT="Q"
End DoDot:2
End DoDot:1
if TEXT["Q"
QUIT
+12 ;Patient percentile
+13 ;use patient T score to retrieve
SET X="|"_$PIECE(RETURN,U)_U
+14 SET TABLE=$EXTRACT(SCORENAME,1,4)_"P"
+15 ;pain table uses raw
IF TABLE="PAINP"
SET X=RAW
+16 FOR LINE=1:1
SET TEXT=$TEXT(@TABLE+LINE)
Begin DoDot:1
+17 ;if this line contains the index
IF TEXT[X
Begin DoDot:2
+18 ;strip up to index
SET TEXT=$PIECE(TEXT,X,2)
+19 ;get percentile
SET RETURN=RETURN_U_$PIECE(TEXT,"|")
+20 SET TEXT="Q"
End DoDot:2
End DoDot:1
if TEXT["Q"
QUIT
+21 ;The community percentile is defined in the PDD but we don't use it in this instrument's report
+22 ;In any case, we only have fields for three extra scores
+23 QUIT RETURN
PAINT ; Pain T Scores table |raw^px T score^community T score|
+1 ;|0^34^39|1^35^40|2^35^40|3^36^41|4^37^42|5^37^42|6^38^43|7^38^44|
+2 ;|8^39^44|9^39^45|10^40^45|11^40^46|12^41^47|13^42^47|14^42^48|
+3 ;|15^43^49|16^43^49|17^44^50|18^44^50|19^45^51|20^45^52|21^46^52|
+4 ;|22^47^53|23^47^54|24^48^54|25^48^55|26^49^56|27^49^56|28^50^57|
+5 ;|29^50^57|30^51^58|31^52^59|32^52^59|33^53^60|34^53^61|35^54^61|
+6 ;|36^54^62|37^55^62|38^56^63|39^56^64|40^57^64|41^57^65|42^58^66|
+7 ;|43^58^66|44^59^67|45^59^68|46^60^68|47^61^69|48^61^69|49^62^70|
+8 ;|50^62^71|51^63^71|52^63^72|53^64^73|54^64^73|55^65^74|56^66^74|
+9 ;|57^66^75|58^67^76|59^67^76|60^68^77|61^68^78|62^69^78|63^69^79|
+10 ;|64^70^80|65^71^80|66^71^81|67^72^81|68^72^82|69^73^83|70^73^83|
+11 ;|71^74^84|72^74^85|73^75^85|74^76^86|75^76^86|76^77^87|77^77^88|
+12 ;|78^78^88|79^78^89|80^79^90|81^80^90|82^80^91|83^81^92|84^81^92|
+13 ;|85^82^93|86^82^93|87^83^94|88^83^95|89^84^95|90^85^96|91^85^97|
+14 ;|92^86^97|93^86^98|94^87^98|95^87^99|96^88^100|97^88^100|98^89^101|
+15 ;|99^90^102|100^90^102|
+16 QUIT
+17 ;
SOMAT ; Somatic T Scores table |raw^px T score^community T score|
+1 ;|0^37^39|1^39^42|2^41^44|3^42^46|4^44^48|5^45^50|6^47^52|7^49^54|
+2 ;|8^50^56|9^52^59|10^53^61|11^55^63|12^57^65|13^58^67|14^60^69|
+3 ;|15^62^71|16^63^73|17^65^75|18^66^78|19^68^80|20^70^82|21^71^84|
+4 ;|22^73^86|23^75^88|24^76^90|25^78^92|26^79^95|27^81^97|28^83^99|
+5 ;|29^84^101|30^86^103|
+6 QUIT
+7 ;
DEFET ; Defensiveness T Scores table |raw^px T score^community T score|
+1 ;|0^20^12|1^22^14|2^25^17|3^27^19|4^29^21|5^31^24|6^34^26|7^36^29|
+2 ;|8^38^31|9^40^33|10^42^36|11^45^38|12^47^40|13^49^43|14^51^45|
+3 ;|15^54^47|16^56^50|17^58^52|18^60^54|19^63^57|20^65^59|21^67^62|
+4 ;|22^69^64|23^71^66|24^74^69|
+5 QUIT
+6 ;
DEPRT ; Depression T Scores table |raw^px T score^community T score|
+1 ;|0^31^35|1^34^38|2^37^41|3^40^44|4^43^47|5^46^51|6^48^54|7^51^57|
+2 ;|8^54^60|9^57^63|10^60^66|11^63^69|12^66^72|13^69^76|14^72^79|
+3 ;|15^74^82|16^77^85|17^80^88|18^83^91|
+4 QUIT
+5 ;
ANXIT ; Anxiety T Scores table |raw^px T score|community T score|
+1 ;|0^26^30|1^30^34|2^33^37|3^37^41|4^40^44|5^43^47|6^47^51|7^50^54|
+2 ;|8^54^58|9^57^61|10^61^65|11^64^68|12^68^72|13^71^75|14^74^79|
+3 ;|15^78^82|16^81^86|17^85^89|18^88^92|
+4 QUIT
+5 ;
FUNCT ; Functional T Scores table |raw^px T score^community T score|
+1 ;|0^25^30|1^27^33|2^29^35|3^30^37|4^32^40|5^34^42|6^36^44|7^38^46|
+2 ;|8^40^49|9^42^51|10^44^53|11^46^56|12^47^58|13^49^60|14^51^62|
+3 ;|15^53^65|16^55^67|17^57^69|18^59^72|19^61^74|20^63^76|21^64^78|
+4 ;|22^66^81|23^68^83|24^70^85|25^72^88|26^74^90|27^76^92|28^78^94|
+5 ;|29^80^97|30^81^99|
+6 QUIT
PAINP ; Pain px percentiles table |raw^px percentile|
+1 ;|0^1|1^2|2^3|3^4|4^5|5^6|6^7|7^9|8^11|9^13|10^15|11^17|12^19|
+2 ;|13^22|14^24|15^28|16^30|17^31|18^34|19^36|20^38|21^40|22^43|
+3 ;|23^45|24^48|25^51|26^53|27^55|28^57|29^59|30^60|31^62|32^63|
+4 ;|33^65|34^67|35^69|36^71|37^72|38^73|39^75|40^76|41^77|42^78|
+5 ;|43^79|44^80|45^81|46^82|47^84|48^85|49^86|50^88|51^89|52^90|
+6 ;|53^90|54^91|55^91|56^92|57^93|58^94|59^95|60^95|61^95|62^95|
+7 ;|63^96|64^96|65^96|66^97|67^97|68^97|69^98|70^98|71^98|72^99|
+8 ;|73^99|74^99|75^99|76^99|77^99|78^99|79^99|80^99|81^99|82^99|
+9 ;|83^99|84^99|85^99|86^99|87^99|88^99|89^99|90^99|91^99|92^99|
+10 ;|93^99|94^99|95^99|96^99|97^99|98^99|99^99|100^99|
+11 QUIT
SOMAP ; Somatic px percentiles table |px T score^px percentile|
+1 ;|37^4|39^12|41^19|42^25|44^32|45^40|47^46|49^53|50^58|52^62|53^67|
+2 ;|55^73|57^78|58^82|60^85|62^87|63^88|65^90|66^91|68^92|70^93|71^95|
+3 ;|73^97|75^99|76^99|78^99|79^99|81^99|83^99|84^99|86^99|
+4 QUIT
DEFEP ; Defensiveness px percentiles table |px T score^px percentile|
+1 ;|20^1|22^1|25^1|27^2|29^2|31^4|34^6|36^8|38^11|40^17|42^24|45^31|
+2 ;|47^37|49^44|51^53|54^63|56^73|58^81|60^86|63^91|65^94|67^95|69^97|
+3 ;|71^98|74^99|
+4 QUIT
DEPRP ; Depression px percentiles table |px T score^px percentile|
+1 ;|31^1|34^5|37^8|40^14|43^23|46^35|48^48|51^61|54^71|57^78|60^83|
+2 ;|63^88|66^92|69^95|72^97|74^98|77^99|80^99|83^99|
+3 QUIT
ANXIP ; Anxiety px percentiles table |px T score^px percentile|
+1 ;|26^1|30^3|33^6|37^11|40^17|43^24|47^36|50^50|54^65|57^78|61^86|
+2 ;|64^92|68^96|71^98|74^99|78^99|81^99|85^99|88^99|
+3 QUIT
FUNCP ; Functional px percentiles table |px T score^px percentile|
+1 ;|25^1|27^1|29^1|30^1|32^2|34^5|36^9|38^12|40^16|42^20|44^27|46^35|
+2 ;|47^43|49^50|51^58|53^65|55^71|57^76|59^81|61^85|63^89|64^92|66^94|
+3 ;|68^95|70^97|72^98|74^98|76^99|78^99|80^99|81^99|
+4 QUIT
+5 ;
RATING(SCALE,PXT) ;Get scale rating given px t-score
+1 NEW TSCORERANGES,I,RANGE,RATING
+2 FOR I=1:1:6
Begin DoDot:1
+3 IF $PIECE($TEXT(RATEDATA+I),"|",1)'[SCALE
QUIT
+4 SET TSCORERANGES=$PIECE($TEXT(RATEDATA+I),"|",2)
End DoDot:1
+5 if $GET(TSCORERANGES)=""
QUIT -1
+6 SET I=0
FOR
SET I=I+1
SET RANGE=$PIECE(TSCORERANGES,U,I)
if RANGE=""
QUIT
if (PXT'<+RANGE)&(PXT'>+$PIECE(RANGE,"-",2))
QUIT
+7 QUIT $PIECE(RANGE,"=",2)
+8 ;
RATEDATA ;
+1 ;Pain Complaints|34-34=Extremely Low^35-37=Very Low^38-40=Low^41-52=Average^53-59=Moderately High^60-66=High^67-72=Very High^73-90=Extremely High
+2 ;Somatic Complaints|37-37=Very Low^39-39=Low^41-52=Average^53-58=Moderately High^60-70=High^71-73=Very High^75-86=Extremely High
+3 ;Defensiveness|20-25=Extremely Low^27-31=Very Low^34-40=Low^42-47=Moderately Low^49-58=Average^60-65=High^67-69=Very High^71-74=Extremely High
+4 ;Depression|31-31=Extremely Low^34-34=Very Low^37-40=Low^43-51=Average^54-57=Moderately High^60-66=High^69-72=Very High^74-83=Extremely High
+5 ;Anxiety|26-26=Extremely Low^30-33=Very Low^37-40=Low^43-54=Average^57-57=Moderately High^61-64=High^68-68=Very High^71-88=Extremely High
+6 ;Functional|25-30=Extremely Low^32-34=Very Low^36-40=Low^42-47=Average^49-59=Moderately High^61-64=High^66-68=Very High^70-81=Extremely High
+7 ;
CRITICAL(YSDATA) ;
+1 NEW TEXT
+2 SET TEXT=" "
+3 FOR I=1:1:16
Begin DoDot:1
+4 NEW DATA,QUESTION,AREA,QTEXT,ANSTEXT,VALUE
+5 SET DATA=$TEXT(CRITDATA+I)
+6 SET QUESTION=$PIECE(DATA,U,2)
+7 SET VALUE=+$$GET1^DIQ(601.75,$PIECE($GET(YSDATA(QUESTION+2)),U,3)_",",4,"I")
+8 ;these three questions have reverse scoring 0->3,3->0
IF "31,33,26"[QUESTION
SET VALUE=3-VALUE
+9 ;question scored as 0 or 1, exit.
IF VALUE<2
QUIT
+10 SET AREA=$PIECE(DATA,U,3)_"|"
+11 ;Skip if we already have printed the area
IF TEXT'[AREA
SET TEXT=TEXT_AREA
+12 SET QTEXT=$$GET1^DIQ(601.72,$PIECE($GET(YSDATA(QUESTION+2)),U,1)_",",1,"","QTEXT")
+13 SET ANSTEXT=$$GET1^DIQ(601.75,$PIECE($GET(YSDATA(QUESTION+2)),U,3)_",",3,"I")
+14 ;use only first one or two words
+15 SET ANSTEXT=$PIECE(ANSTEXT," ",1,2)
+16 IF ($PIECE(ANSTEXT," ",1)="Disagree")!($PIECE(ANSTEXT," ",1)="Agree")
SET ANSTEXT=$PIECE(ANSTEXT," ",1)
+17 SET TEXT=TEXT_" "_QUESTION_". "_QTEXT(1)_" ("_ANSTEXT_")|"
End DoDot:1
+18 IF TEXT=" "
SET TEXT=" The patient did not endorse any of the 17 critical items"
+19 QUIT TEXT
+20 ;
CRITDATA ;
+1 ;^35^Compensation Focus
+2 ;^31^Sleep Disorder
+3 ;^51^Death Anxiety
+4 ;^52^Suicidal Ideation
+5 ;^28^Chemical Dependency
+6 ;^33^Chemical Dependency
+7 ;^37^Doctor Dissatisfaction
+8 ;^22^Psychosis
+9 ;^26^Satisfaction with Care
+10 ;^34^Perceived Disability
+11 ;^40^Pain Fixation
+12 ;^30^Home Life Problems
+13 ;^15^Vegative Depression
+14 ;^24^Vegative Depression
+15 ;^21^Anxiety/Panic
+16 ;^19^PTSD/Dissociation
+17 ;
ARROWS(LINETEXT,START,FILL,END,NOWRITE) ;fill linetext from start position to end position
+1 NEW I
+2 ;strip decimals
SET START=$PIECE(START,".")
SET END=$PIECE(END,".")
SET NOWRITE=$PIECE(NOWRITE,".")
+3 FOR I=(START+1):1:(END-1)
Begin DoDot:1
+4 IF I=NOWRITE
QUIT
+5 SET $EXTRACT(LINETEXT,I)=FILL
End DoDot:1
+6 QUIT
