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

YTSBBHI2.m

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