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

YTSPOQ.m

Go to the documentation of this file.
  1. YTSPOQ ;SLC/PIJ - Score POQ ; 01/08/2016
  1. ;;5.01;MENTAL HEALTH;**123**;DEC 30,1994;Build 73
  1. ;
  1. ;Public, Supported ICRs
  1. ; #2056 - Fileman API - $$GET1^DIQ
  1. ;
  1. Q
  1. ;
  1. DATA1 ;
  1. S YSINSNAM=$P($G(YSDATA(2)),U,3)
  1. I $G(YSINSNAM)="" S YSINSNAM=$G(YS("CODE"),"NO NAME PASSED")
  1. S NODE=2 F S NODE=$O(YSDATA(NODE)) Q:NODE="" D
  1. .S DATA=YSDATA(NODE)
  1. .S YSQN=$P(DATA,U,1)
  1. .S ANS=$P($G(DATA),U,3) ; questions 2-20, track bar, 3rd piece answer value
  1. .D DESGNTR^YTSCORE(YSQN,.DES)
  1. .I ANS'?1N.N Q
  1. .I (DES=1) Q
  1. .I (DES=2) S PAIN=PAIN+ANS Q
  1. .I (DES=3)!(DES=4)!(DES=5)!(DES=6) D Q
  1. ..S MOBIL=MOBIL+ANS
  1. .I (DES=7)!(DES=8)!(DES=9)!(DES=10) D Q
  1. ..S ADL=ADL+ANS
  1. .I (DES=12)!(DES=13)!(DES=14) D Q
  1. ..S VITAL=VITAL+(10-ANS)
  1. .I (DES=11)!(DES=15)!(DES=16)!(DES=19)!(DES=20) D Q
  1. ..S NA=NA+ANS
  1. .I (DES=17) D Q
  1. ..S FEAR=FEAR+ANS
  1. .I (DES=18) S FEAR=FEAR+(10-ANS)
  1. S TOTAL=PAIN+ADL+FEAR+MOBIL+VITAL+NA
  1. Q
  1. ;
  1. STRING ;
  1. N PADSPACE
  1. I '$D(^TMP($J,"YSCOR")) D Q
  1. .S STRING="| "_YSINSNAM_" score could not be determined. "
  1. ;
  1. S PAIN=$P($G(^TMP($J,"YSCOR",2)),"=",2)
  1. S ADL=$P($G(^TMP($J,"YSCOR",3)),"=",2)
  1. S FEAR=$P($G(^TMP($J,"YSCOR",4)),"=",2)
  1. S MOBIL=$P($G(^TMP($J,"YSCOR",5)),"=",2)
  1. S NA=$P($G(^TMP($J,"YSCOR",6)),"=",2)
  1. S VITAL=$P($G(^TMP($J,"YSCOR",7)),"=",2)
  1. S TOTAL=$P($G(^TMP($J,"YSCOR",8)),"=",2)
  1. ; PAIN
  1. D PAIN,PAD(PAIN)
  1. S STRING=STRING_" Pain "_PAIN_$J(IPCT,PADSPACE)_$J(OPCT,13)
  1. ; ADL
  1. D ADL,PAD(ADL)
  1. S STRING=STRING_"| ADL "_ADL_$J(IPCT,PADSPACE)_$J(OPCT,13)
  1. ; FEAR
  1. D FEAR,PAD(FEAR)
  1. S STRING=STRING_"| Fear "_FEAR_$J(IPCT,PADSPACE)_$J(OPCT,13)
  1. ; MOBILITY
  1. D MOBIL,PAD(MOBIL)
  1. S STRING=STRING_"| Mobility "_MOBIL_$J(IPCT,PADSPACE)_$J(OPCT,13)
  1. ; NEGATIVLY AFFECTED
  1. D NA,PAD(NA)
  1. S STRING=STRING_"| Neg Affect "_NA_$J(IPCT,PADSPACE)_$J(OPCT,13)
  1. ; VITALITY
  1. D VITAL,PAD(VITAL)
  1. S STRING=STRING_"| Vitality "_VITAL_$J(IPCT,PADSPACE)_$J(OPCT,13)
  1. ; TOTAL
  1. S STRING=STRING_"|| Total "_TOTAL_"|"
  1. Q
  1. ;
  1. ADL ;
  1. S (IPCT,OPCT)=0
  1. I ADL=0 S IPCT=6,OPCT=12 Q
  1. I ADL=1 S IPCT=13,OPCT=25 Q
  1. I ADL=2 S IPCT=15,OPCT=28 Q
  1. I ADL=3 S IPCT=18,OPCT=31 Q
  1. I ADL=4 S IPCT=22,OPCT=36 Q
  1. I ADL=5 S IPCT=26,OPCT=42 Q
  1. I ADL=6 S IPCT=29,OPCT=47 Q
  1. I ADL=7 S IPCT=32,OPCT=50 Q
  1. I ADL=8 S IPCT=36,OPCT=53 Q
  1. I ADL=9 S IPCT=40,OPCT=55 Q
  1. I ADL=10 S IPCT=44,OPCT=57 Q
  1. I ADL=11 S IPCT=47,OPCT=59 Q
  1. I ADL=12 S IPCT=50,OPCT=61 Q
  1. I ADL=13 S IPCT=53,OPCT=63 Q
  1. I ADL=14 S IPCT=55,OPCT=64 Q
  1. I ADL=15 S IPCT=58,OPCT=66 Q
  1. I ADL=16 S IPCT=61,OPCT=67 Q
  1. I ADL=17 S IPCT=64,OPCT=68 Q
  1. I ADL=18 S IPCT=67,OPCT=70 Q
  1. I ADL=19 S IPCT=69,OPCT=71 Q
  1. I ADL=20 S IPCT=72,OPCT=73 Q
  1. I ADL=21 S IPCT=74,OPCT=76 Q
  1. I ADL=22 S IPCT=76,OPCT=78 Q
  1. I ADL=23 S IPCT=78,OPCT=80 Q
  1. I ADL=24 S IPCT=80,OPCT=83 Q
  1. I ADL=25 S IPCT=83,OPCT=85 Q
  1. I ADL=26 S IPCT=85,OPCT=86 Q
  1. I ADL=27 S IPCT=86,OPCT=88 Q
  1. I ADL=28 S IPCT=87,OPCT=89 Q
  1. I ADL=29 S IPCT=88,OPCT=90 Q
  1. I ADL=30 S IPCT=89,OPCT=91 Q
  1. I ADL=31 S IPCT=90,OPCT=92 Q
  1. I ADL=32 S IPCT=92,OPCT=93 Q
  1. I ADL=33 S IPCT=93,OPCT=94 Q
  1. I ADL=34 S IPCT=94,OPCT=95 Q
  1. I ADL=35 S IPCT=95,OPCT=96 Q
  1. I ADL=36 S IPCT=96,OPCT=96 Q
  1. I ADL=37 S IPCT=96,OPCT=96 Q
  1. I ADL=38 S IPCT=97,OPCT=97 Q
  1. I ADL=39 S IPCT=97,OPCT=97 Q
  1. I ADL=40 S IPCT=99,OPCT=99 Q
  1. Q
  1. FEAR ;
  1. S (IPCT,OPCT)=0
  1. I FEAR=0 S IPCT=2,OPCT=2 Q
  1. I FEAR=1 S IPCT=4,OPCT=3 Q
  1. I FEAR=2 S IPCT=4,OPCT=4 Q
  1. I FEAR=3 S IPCT=6,OPCT=6 Q
  1. I FEAR=4 S IPCT=8,OPCT=7 Q
  1. I FEAR=5 S IPCT=10,OPCT=10 Q
  1. I FEAR=6 S IPCT=13,OPCT=14 Q
  1. I FEAR=7 S IPCT=16,OPCT=16 Q
  1. I FEAR=8 S IPCT=19,OPCT=19 Q
  1. I FEAR=9 S IPCT=24,OPCT=22 Q
  1. I FEAR=10 S IPCT=32,OPCT=28 Q
  1. I FEAR=11 S IPCT=42,OPCT=35 Q
  1. I FEAR=12 S IPCT=50,OPCT=41 Q
  1. I FEAR=13 S IPCT=58,OPCT=48 Q
  1. I FEAR=14 S IPCT=66,OPCT=54 Q
  1. I FEAR=15 S IPCT=75,OPCT=61 Q
  1. I FEAR=16 S IPCT=82,OPCT=69 Q
  1. I FEAR=17 S IPCT=88,OPCT=75 Q
  1. I FEAR=18 S IPCT=93,OPCT=83 Q
  1. I FEAR=19 S IPCT=97,OPCT=90 Q
  1. I FEAR=20 S IPCT=99,OPCT=96 Q
  1. Q
  1. ;
  1. MOBIL ;
  1. S (IPCT,OPCT)=0
  1. I MOBIL=0 S IPCT=1,OPCT=1 Q
  1. I MOBIL=1 S IPCT=1,OPCT=1 Q
  1. I MOBIL=2 S IPCT=2,OPCT=1 Q
  1. I MOBIL=3 S IPCT=2,OPCT=2 Q
  1. I MOBIL=4 S IPCT=2,OPCT=2 Q
  1. I MOBIL=5 S IPCT=3,OPCT=2 Q
  1. I MOBIL=6 S IPCT=3,OPCT=3 Q
  1. I MOBIL=7 S IPCT=3,OPCT=3 Q
  1. I MOBIL=8 S IPCT=4,OPCT=4 Q
  1. I MOBIL=9 S IPCT=5,OPCT=5 Q
  1. I MOBIL=10 S IPCT=6,OPCT=7 Q
  1. I MOBIL=11 S IPCT=7,OPCT=9 Q
  1. I MOBIL=12 S IPCT=9,OPCT=10 Q
  1. I MOBIL=13 S IPCT=10,OPCT=12 Q
  1. I MOBIL=14 S IPCT=12,OPCT=14 Q
  1. I MOBIL=15 S IPCT=14,OPCT=16 Q
  1. I MOBIL=16 S IPCT=16,OPCT=19 Q
  1. I MOBIL=17 S IPCT=17,OPCT=21 Q
  1. I MOBIL=18 S IPCT=20,OPCT=25 Q
  1. I MOBIL=19 S IPCT=22,OPCT=29 Q
  1. I MOBIL=20 S IPCT=25,OPCT=32 Q
  1. I MOBIL=21 S IPCT=28,OPCT=37 Q
  1. I MOBIL=22 S IPCT=32,OPCT=41 Q
  1. I MOBIL=23 S IPCT=35,OPCT=43 Q
  1. I MOBIL=24 S IPCT=38,OPCT=46 Q
  1. I MOBIL=25 S IPCT=42,OPCT=49 Q
  1. I MOBIL=26 S IPCT=46,OPCT=52 Q
  1. I MOBIL=27 S IPCT=50,OPCT=55 Q
  1. I MOBIL=28 S IPCT=53,OPCT=57 Q
  1. I MOBIL=29 S IPCT=56,OPCT=59 Q
  1. I MOBIL=30 S IPCT=60,OPCT=61 Q
  1. I MOBIL=31 S IPCT=65,OPCT=65 Q
  1. I MOBIL=32 S IPCT=68,OPCT=68 Q
  1. I MOBIL=33 S IPCT=72,OPCT=70 Q
  1. I MOBIL=34 S IPCT=76,OPCT=73 Q
  1. I MOBIL=35 S IPCT=80,OPCT=77 Q
  1. I MOBIL=36 S IPCT=83,OPCT=80 Q
  1. I MOBIL=37 S IPCT=86,OPCT=83 Q
  1. I MOBIL=38 S IPCT=90,OPCT=87 Q
  1. I MOBIL=39 S IPCT=93,OPCT=90 Q
  1. I MOBIL=40 S IPCT=97,OPCT=95 Q
  1. Q
  1. ;
  1. NA ;
  1. S (IPCT,OPCT)=0
  1. I NA=0 S IPCT=1,OPCT=1 Q
  1. I NA=1 S IPCT=1,OPCT=3 Q
  1. I NA=2 S IPCT=1,OPCT=4 Q
  1. I NA=3 S IPCT=2,OPCT=5 Q
  1. I NA=4 S IPCT=2,OPCT=6 Q
  1. I NA=5 S IPCT=2,OPCT=7 Q
  1. I NA=6 S IPCT=3,OPCT=8 Q
  1. I NA=7 S IPCT=4,OPCT=9 Q
  1. I NA=8 S IPCT=5,OPCT=10 Q
  1. I NA=9 S IPCT=5,OPCT=11 Q
  1. I NA=10 S IPCT=6,OPCT=14 Q
  1. I NA=11 S IPCT=7,OPCT=17 Q
  1. I NA=12 S IPCT=8,OPCT=19 Q
  1. I NA=13 S IPCT=9,OPCT=21 Q
  1. I NA=14 S IPCT=9,OPCT=22 Q
  1. I NA=15 S IPCT=10,OPCT=24 Q
  1. I NA=16 S IPCT=12,OPCT=27 Q
  1. I NA=17 S IPCT=15,OPCT=29 Q
  1. I NA=18 S IPCT=17,OPCT=30 Q
  1. I NA=19 S IPCT=18,OPCT=32 Q
  1. I NA=20 S IPCT=20,OPCT=34 Q
  1. I NA=21 S IPCT=22,OPCT=36 Q
  1. I NA=22 S IPCT=24,OPCT=39 Q
  1. I NA=23 S IPCT=27,OPCT=42 Q
  1. I NA=24 S IPCT=30,OPCT=43 Q
  1. I NA=25 S IPCT=32,OPCT=45 Q
  1. I NA=26 S IPCT=36,OPCT=47 Q
  1. I NA=27 S IPCT=39,OPCT=49 Q
  1. I NA=28 S IPCT=42,OPCT=52 Q
  1. I NA=29 S IPCT=45,OPCT=54 Q
  1. I NA=30 S IPCT=49,OPCT=57 Q
  1. I NA=31 S IPCT=52,OPCT=60 Q
  1. I NA=32 S IPCT=56,OPCT=62 Q
  1. I NA=33 S IPCT=60,OPCT=64 Q
  1. I NA=34 S IPCT=64,OPCT=68 Q
  1. I NA=35 S IPCT=68,OPCT=72 Q
  1. I NA=36 S IPCT=72,OPCT=76 Q
  1. I NA=37 S IPCT=75,OPCT=80 Q
  1. I NA=38 S IPCT=79,OPCT=83 Q
  1. I NA=39 S IPCT=82,OPCT=86 Q
  1. I NA=40 S IPCT=85,OPCT=87 Q
  1. I NA=41 S IPCT=88,OPCT=89 Q
  1. I NA=42 S IPCT=90,OPCT=91 Q
  1. I NA=43 S IPCT=92,OPCT=92 Q
  1. I NA=44 S IPCT=94,OPCT=93 Q
  1. I NA=45 S IPCT=95,OPCT=94 Q
  1. I NA=46 S IPCT=97,OPCT=95 Q
  1. I NA=47 S IPCT=98,OPCT=96 Q
  1. I NA=48 S IPCT=99,OPCT=97 Q
  1. I NA=49 S IPCT=99,OPCT=97 Q
  1. I NA=50 S IPCT=99,OPCT=99 Q
  1. Q
  1. ;
  1. PAIN ;
  1. S (IPCT,OPCT)=0
  1. I PAIN=0 S IPCT=1,OPCT=1
  1. I PAIN=1 S IPCT=1,OPCT=1
  1. I PAIN=2 S IPCT=1,OPCT=1
  1. I PAIN=3 S IPCT=1,OPCT=2
  1. I PAIN=4 S IPCT=5,OPCT=4
  1. I PAIN=5 S IPCT=14,OPCT=11
  1. I PAIN=6 S IPCT=27,OPCT=23
  1. I PAIN=7 S IPCT=47,OPCT=43
  1. I PAIN=8 S IPCT=72,OPCT=69
  1. I PAIN=9 S IPCT=90,OPCT=86
  1. I PAIN=10 S IPCT=97,OPCT=96
  1. Q
  1. ;
  1. VITAL ;
  1. S (IPCT,OPCT)=0
  1. I VITAL=0 S IPCT=1,OPCT=1 Q
  1. I VITAL=1 S IPCT=1,OPCT=1 Q
  1. I VITAL=2 S IPCT=1,OPCT=1 Q
  1. I VITAL=3 S IPCT=1,OPCT=1 Q
  1. I VITAL=4 S IPCT=1,OPCT=1 Q
  1. I VITAL=5 S IPCT=1,OPCT=1 Q
  1. I VITAL=6 S IPCT=2,OPCT=2 Q
  1. I VITAL=7 S IPCT=3,OPCT=2 Q
  1. I VITAL=8 S IPCT=3,OPCT=3 Q
  1. I VITAL=9 S IPCT=3,OPCT=3 Q
  1. I VITAL=10 S IPCT=4,OPCT=5 Q
  1. I VITAL=11 S IPCT=6,OPCT=7 Q
  1. I VITAL=12 S IPCT=7,OPCT=9 Q
  1. I VITAL=13 S IPCT=8,OPCT=9 Q
  1. I VITAL=14 S IPCT=10,OPCT=11 Q
  1. I VITAL=15 S IPCT=13,OPCT=15 Q
  1. I VITAL=16 S IPCT=18,OPCT=19 Q
  1. I VITAL=17 S IPCT=23,OPCT=24 Q
  1. I VITAL=18 S IPCT=29,OPCT=30 Q
  1. I VITAL=19 S IPCT=35,OPCT=35 Q
  1. I VITAL=20 S IPCT=41,OPCT=41 Q
  1. I VITAL=21 S IPCT=50,OPCT=49 Q
  1. I VITAL=22 S IPCT=60,OPCT=57 Q
  1. I VITAL=23 S IPCT=68,OPCT=65 Q
  1. I VITAL=24 S IPCT=76,OPCT=72 Q
  1. I VITAL=25 S IPCT=83,OPCT=78 Q
  1. I VITAL=26 S IPCT=88,OPCT=82 Q
  1. I VITAL=27 S IPCT=92,OPCT=87 Q
  1. I VITAL=28 S IPCT=95,OPCT=92 Q
  1. I VITAL=29 S IPCT=97,OPCT=95 Q
  1. I VITAL=30 S IPCT=99,OPCT=98 Q
  1. Q
  1. ;
  1. ; Pad results with spaces in order to line up the numbers.
  1. PAD(RAW) ;
  1. S PADSPACE=0
  1. I $L(RAW)=1 S PADSPACE=13
  1. I $L(RAW)=2 S PADSPACE=12
  1. Q
  1. ;
  1. SCORESV ;
  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)=YSINSNAM_" Scale not found"
  1. ;
  1. K ^TMP($J,"YSCOR")
  1. S ^TMP($J,"YSCOR",1)="[DATA]"
  1. S ^TMP($J,"YSCOR",2)=$$GET1^DIQ(601.87,1080_",",3,"I")_"="_PAIN
  1. S ^TMP($J,"YSCOR",3)=$$GET1^DIQ(601.87,1081_",",3,"I")_"="_ADL
  1. S ^TMP($J,"YSCOR",4)=$$GET1^DIQ(601.87,1082_",",3,"I")_"="_FEAR
  1. S ^TMP($J,"YSCOR",5)=$$GET1^DIQ(601.87,1083_",",3,"I")_"="_MOBIL
  1. S ^TMP($J,"YSCOR",6)=$$GET1^DIQ(601.87,1084_",",3,"I")_"="_NA
  1. S ^TMP($J,"YSCOR",7)=$$GET1^DIQ(601.87,1085_",",3,"I")_"="_VITAL
  1. S ^TMP($J,"YSCOR",8)=$$GET1^DIQ(601.87,1086_",",3,"I")_"="_TOTAL
  1. Q
  1. DLLSTR(YSDATA,YS,YSTRNG) ;
  1. ; YSTRNG = 1 Score Instrument
  1. ; YSTRNG = 2 get Report Answers and Text
  1. N DATA,DES,NODE,ANS,YSQN
  1. N YSINSNAM,STRING
  1. N ADL,FEAR,PAIN,NA,MOBIL,TOTAL,VITAL
  1. N IPCT,OPCT
  1. ;
  1. S (ADL,FEAR,NA,PAIN,MOBIL,VITAL,TOTAL)=0
  1. S (IPCT,OPCT)=0
  1. S STRING=""
  1. ;
  1. I YSTRNG=1 D
  1. .D DATA1
  1. .D SCORESV
  1. ;
  1. I YSTRNG=2 D
  1. .D LDSCORES^YTSCORE(.YSDATA,.YS)
  1. .D STRING
  1. .S YSDATA($O(YSDATA(""),-1)+1)=999999999999_U_U_STRING
  1. Q