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