- YTSFAST ;SLC/KCM - Score FAST ; 01/08/2016
- ;;5.01;MENTAL HEALTH;**123,202,208**;DEC 30,1994;Build 23
- ;
- ; Reference to GET1^DIQ in ICR #2056
- ;
- Q
- ;
- DLLSTR(YSDATA,YS,YSTRNG) ; compute scores or report text based on YSTRNG
- ; input
- ; YSDATA(2)=adminId^patientDFN^instrumentName^dateGiven^isComplete
- ; YSDATA(2+n)=questionId^sequence^choiceId
- ; YS("AD")=adminId
- ; YSTRNG=1 for score, 2 for report
- ; output if YSTRNG=1: ^TMP($J,"YSCOR",n)=scaleId=score
- ; output if YSTRNG=2: append special "answers" to YSDATA
- ;
- I YSTRNG=1 D SCORESV
- I YSTRNG=2 D
- . N SCORES,N
- . D LDSCORES^YTSCORE(.YSDATA,.YS) ; puts score into ^TMP($J,"YSCOR",2)
- . D REPORT(.YSDATA)
- Q
- OLDFAST() ;
- ; expects YSDATA from DLLSTR
- N NODE,DATA,YSQN,YSCDA,DES,LEG
- S STAGE=1
- S NODE=2 F S NODE=$O(YSDATA(NODE)) Q:NODE="" D ; Start at YSDATA(3)
- .S DATA=YSDATA(NODE)
- .S YSQN=$P(DATA,U,1)
- .S YSCDA=$P($G(DATA),U,3)
- .D DESGNTR^YTSCORE(YSQN,.DES)
- .S LEG=$$GET1^DIQ(601.75,YSCDA_",",4,"I")
- .I (DES=2),(LEG="Y") S:STAGE<2 STAGE=2
- .I (DES=3),(LEG="Y") S:STAGE<3 STAGE=3
- .I (DES=4),(LEG="Y") S:STAGE<4 STAGE=4
- .I (DES=5),(LEG="Y") S:STAGE<5 STAGE=5
- .I ($E(DES)=6),(LEG="Y") S:STAGE<6 STAGE=6
- .I ($E(DES)=7),(LEG="Y") S:STAGE<7 STAGE=7
- Q STAGE
- ;
- SCORESV ; calculate the score
- ; expects YSDATA from DLLSTR (YSDATA from LOADANSW^YTSCORE,SCALEG^YTQAPI3)
- ;
- N I,J,CID,QSTN,STAGE
- S QSTN=$P($G(YSDATA(3)),U),CID=$P($G(YSDATA(3)),U,3)
- I QSTN=8788 D ; new algorithm for single-question FAST
- . S STAGE=$P($G(^YTT(601.75,+CID,0)),U,2)
- E S STAGE=$$OLDFAST() ; different algorithm for multi-question FAST
- ;
- ; set scores into ^TMP($J,"YSCOR",n)=scaleName=score {rawScore^tScore}
- K ^TMP($J,"YSCOR")
- I $D(^TMP($J,"YSG",1)),^TMP($J,"YSG",1)="[ERROR]" D Q ;-->out
- . S ^TMP($J,"YSCOR",1)="[ERROR]"
- . S ^TMP($J,"YSCOR",2)="No Scale found for ADMIN"
- ;
- N SCLID,SCLNM
- S ^TMP($J,"YSCOR",1)="[DATA]"
- S I=2,J=1 F S I=$O(^TMP($J,"YSG",I)) Q:'I D
- . S SCLID=+$P(^TMP($J,"YSG",I),"=",2)
- . S SCLNM=$P(^TMP($J,"YSG",I),U,4)
- . S J=J+1
- . I SCLID=509 S ^TMP($J,"YSCOR",J)=SCLNM_"="_STAGE
- Q
- ;
- REPORT(YSDATA) ; build the scoring display for the report
- ; expects ^TMP($J,"YSCOR",...) and ^TMP($J,"YSG") from DLLSTR
- ; .YSDATA from DLLSTR
- N I,QID,CID,QLST
- S I=2 F S I=$O(YSDATA(I)) Q:'I D
- . S QID=$P(YSDATA(I),U),CID=$P(YSDATA(I),U,3)
- . I CID=1155!(CID=1156)!(CID=1157) Q ; leave skipped questions undefined
- . S QLST(QID)=$$GET1^DIQ(601.75,CID_",",3,"I")
- ;
- N X,OLDFAST,THISCID,NODE,QNUM,OLDQSTN,QCID,QTXT,THISCID,ANSID,ANSWER
- S OLDFAST=$P($G(YSDATA(3)),U)'=8788
- S THISCID=$S(OLDFAST:"",1:$P($G(YSDATA(3)),U,3))
- S NODE=$O(YSDATA(""),-1) ; get last node
- F QNUM=1:1:16 D
- . S X=$P($T(QSTNS+QNUM),";;",2,999)
- . S OLDQSTN=$P(X,U),QCID=$P(X,U,2),QTXT=$P(X,U,3)
- . S ANSID=7770+QNUM ; computed answer question IDs are 7771 thru 7787
- . I OLDFAST S ANSWER=QLST(OLDQSTN)
- . I 'OLDFAST S ANSWER=$S(QCID=THISCID:"Yes",1:"No")
- . S NODE=NODE+1,YSDATA(NODE)=ANSID_"^9999;1^"_$S(ANSWER="No":"[ ]",1:"[x]")_" "_QTXT
- Q
- QSTNS ; FAST questions -- ;;oldQuestionID^newChoiceID^QuestionText
- ;;3909^5335^1. No difficulties, either subjectively or objectively.
- ;;3916^5336^2. Complains of forgetting location of objects. Subjective word finding| difficulties.
- ;;3917^5337^3. Decreased job function evident to co-workers; difficulty in traveling to| new locations. Decreased organizational capacity.
- ;;3918^5338^4. Decreased ability to perform complex tasks (e.g., planning dinner for| guests), handling personal finances (forgetting to pay bills),| difficulty marketing, etc.
- ;;3919^5339^5. Requires assistance in choosing proper clothing to wear for day, season,| or occasion.
- ;;3920^5340^6a. Difficulty putting clothing on properly without assistance.
- ;;3921^5341^6b. Unable to bathe properly; (e.g., difficulty adjusting bath water| temperature) occasionally or more frequently over the past weeks.
- ;;3922^5342^6c. Inability to handle mechanics of toileting (e.g., forgets to flush| the toilet, does not wipe properly or properly dispose of toilet| tissue) occasionally or more frequently over the past weeks.
- ;;3923^5343^6d. Urinary incontinence, occasional or more frequent.
- ;;3924^5344^6e. Fecal incontinence, occasional or more frequently over the past week.
- ;;3925^5345^7a. Ability to speak limited to approximately a half dozen different words or| fewer, in the course of an average day or in the course of an intensive| interview.
- ;;3926^5346^7b. Speech ability limited to the use of a single intelligible word in an| average day or in the course of an interview (the person may repeat| the word over and over).
- ;;3927^5347^7c. Ambulatory ability lost (cannot walk without personal assistance).
- ;;3928^5348^7d. Ability to sit up without assistance lost (e.g., the individual will fall| over if there are no lateral rests [arms] on the chair).
- ;;3929^5349^7e. Loss of the ability to smile.
- ;;3932^5350^7f. Unable to hold head up.
- ;;zzzzz
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYTSFAST 5143 printed Feb 18, 2025@23:46:08 Page 2
- YTSFAST ;SLC/KCM - Score FAST ; 01/08/2016
- +1 ;;5.01;MENTAL HEALTH;**123,202,208**;DEC 30,1994;Build 23
- +2 ;
- +3 ; Reference to GET1^DIQ in ICR #2056
- +4 ;
- +5 QUIT
- +6 ;
- DLLSTR(YSDATA,YS,YSTRNG) ; compute scores or report text based on YSTRNG
- +1 ; input
- +2 ; YSDATA(2)=adminId^patientDFN^instrumentName^dateGiven^isComplete
- +3 ; YSDATA(2+n)=questionId^sequence^choiceId
- +4 ; YS("AD")=adminId
- +5 ; YSTRNG=1 for score, 2 for report
- +6 ; output if YSTRNG=1: ^TMP($J,"YSCOR",n)=scaleId=score
- +7 ; output if YSTRNG=2: append special "answers" to YSDATA
- +8 ;
- +9 IF YSTRNG=1
- DO SCORESV
- +10 IF YSTRNG=2
- Begin DoDot:1
- +11 NEW SCORES,N
- +12 ; puts score into ^TMP($J,"YSCOR",2)
- DO LDSCORES^YTSCORE(.YSDATA,.YS)
- +13 DO REPORT(.YSDATA)
- End DoDot:1
- +14 QUIT
- OLDFAST() ;
- +1 ; expects YSDATA from DLLSTR
- +2 NEW NODE,DATA,YSQN,YSCDA,DES,LEG
- +3 SET STAGE=1
- +4 ; Start at YSDATA(3)
- SET NODE=2
- FOR
- SET NODE=$ORDER(YSDATA(NODE))
- if NODE=""
- QUIT
- Begin DoDot:1
- +5 SET DATA=YSDATA(NODE)
- +6 SET YSQN=$PIECE(DATA,U,1)
- +7 SET YSCDA=$PIECE($GET(DATA),U,3)
- +8 DO DESGNTR^YTSCORE(YSQN,.DES)
- +9 SET LEG=$$GET1^DIQ(601.75,YSCDA_",",4,"I")
- +10 IF (DES=2)
- IF (LEG="Y")
- if STAGE<2
- SET STAGE=2
- +11 IF (DES=3)
- IF (LEG="Y")
- if STAGE<3
- SET STAGE=3
- +12 IF (DES=4)
- IF (LEG="Y")
- if STAGE<4
- SET STAGE=4
- +13 IF (DES=5)
- IF (LEG="Y")
- if STAGE<5
- SET STAGE=5
- +14 IF ($EXTRACT(DES)=6)
- IF (LEG="Y")
- if STAGE<6
- SET STAGE=6
- +15 IF ($EXTRACT(DES)=7)
- IF (LEG="Y")
- if STAGE<7
- SET STAGE=7
- End DoDot:1
- +16 QUIT STAGE
- +17 ;
- SCORESV ; calculate the score
- +1 ; expects YSDATA from DLLSTR (YSDATA from LOADANSW^YTSCORE,SCALEG^YTQAPI3)
- +2 ;
- +3 NEW I,J,CID,QSTN,STAGE
- +4 SET QSTN=$PIECE($GET(YSDATA(3)),U)
- SET CID=$PIECE($GET(YSDATA(3)),U,3)
- +5 ; new algorithm for single-question FAST
- IF QSTN=8788
- Begin DoDot:1
- +6 SET STAGE=$PIECE($GET(^YTT(601.75,+CID,0)),U,2)
- End DoDot:1
- +7 ; different algorithm for multi-question FAST
- IF '$TEST
- SET STAGE=$$OLDFAST()
- +8 ;
- +9 ; set scores into ^TMP($J,"YSCOR",n)=scaleName=score {rawScore^tScore}
- +10 KILL ^TMP($JOB,"YSCOR")
- +11 ;-->out
- IF $DATA(^TMP($JOB,"YSG",1))
- IF ^TMP($JOB,"YSG",1)="[ERROR]"
- Begin DoDot:1
- +12 SET ^TMP($JOB,"YSCOR",1)="[ERROR]"
- +13 SET ^TMP($JOB,"YSCOR",2)="No Scale found for ADMIN"
- End DoDot:1
- QUIT
- +14 ;
- +15 NEW SCLID,SCLNM
- +16 SET ^TMP($JOB,"YSCOR",1)="[DATA]"
- +17 SET I=2
- SET J=1
- FOR
- SET I=$ORDER(^TMP($JOB,"YSG",I))
- if 'I
- QUIT
- Begin DoDot:1
- +18 SET SCLID=+$PIECE(^TMP($JOB,"YSG",I),"=",2)
- +19 SET SCLNM=$PIECE(^TMP($JOB,"YSG",I),U,4)
- +20 SET J=J+1
- +21 IF SCLID=509
- SET ^TMP($JOB,"YSCOR",J)=SCLNM_"="_STAGE
- End DoDot:1
- +22 QUIT
- +23 ;
- REPORT(YSDATA) ; build the scoring display for the report
- +1 ; expects ^TMP($J,"YSCOR",...) and ^TMP($J,"YSG") from DLLSTR
- +2 ; .YSDATA from DLLSTR
- +3 NEW I,QID,CID,QLST
- +4 SET I=2
- FOR
- SET I=$ORDER(YSDATA(I))
- if 'I
- QUIT
- Begin DoDot:1
- +5 SET QID=$PIECE(YSDATA(I),U)
- SET CID=$PIECE(YSDATA(I),U,3)
- +6 ; leave skipped questions undefined
- IF CID=1155!(CID=1156)!(CID=1157)
- QUIT
- +7 SET QLST(QID)=$$GET1^DIQ(601.75,CID_",",3,"I")
- End DoDot:1
- +8 ;
- +9 NEW X,OLDFAST,THISCID,NODE,QNUM,OLDQSTN,QCID,QTXT,THISCID,ANSID,ANSWER
- +10 SET OLDFAST=$PIECE($GET(YSDATA(3)),U)'=8788
- +11 SET THISCID=$SELECT(OLDFAST:"",1:$PIECE($GET(YSDATA(3)),U,3))
- +12 ; get last node
- SET NODE=$ORDER(YSDATA(""),-1)
- +13 FOR QNUM=1:1:16
- Begin DoDot:1
- +14 SET X=$PIECE($TEXT(QSTNS+QNUM),";;",2,999)
- +15 SET OLDQSTN=$PIECE(X,U)
- SET QCID=$PIECE(X,U,2)
- SET QTXT=$PIECE(X,U,3)
- +16 ; computed answer question IDs are 7771 thru 7787
- SET ANSID=7770+QNUM
- +17 IF OLDFAST
- SET ANSWER=QLST(OLDQSTN)
- +18 IF 'OLDFAST
- SET ANSWER=$SELECT(QCID=THISCID:"Yes",1:"No")
- +19 SET NODE=NODE+1
- SET YSDATA(NODE)=ANSID_"^9999;1^"_$SELECT(ANSWER="No":"[ ]",1:"[x]")_" "_QTXT
- End DoDot:1
- +20 QUIT
- QSTNS ; FAST questions -- ;;oldQuestionID^newChoiceID^QuestionText
- +1 ;;3909^5335^1. No difficulties, either subjectively or objectively.
- +2 ;;3916^5336^2. Complains of forgetting location of objects. Subjective word finding| difficulties.
- +3 ;;3917^5337^3. Decreased job function evident to co-workers; difficulty in traveling to| new locations. Decreased organizational capacity.
- +4 ;;3918^5338^4. Decreased ability to perform complex tasks (e.g., planning dinner for| guests), handling personal finances (forgetting to pay bills),| difficulty marketing, etc.
- +5 ;;3919^5339^5. Requires assistance in choosing proper clothing to wear for day, season,| or occasion.
- +6 ;;3920^5340^6a. Difficulty putting clothing on properly without assistance.
- +7 ;;3921^5341^6b. Unable to bathe properly; (e.g., difficulty adjusting bath water| temperature) occasionally or more frequently over the past weeks.
- +8 ;;3922^5342^6c. Inability to handle mechanics of toileting (e.g., forgets to flush| the toilet, does not wipe properly or properly dispose of toilet| tissue) occasionally or more frequently over the past weeks.
- +9 ;;3923^5343^6d. Urinary incontinence, occasional or more frequent.
- +10 ;;3924^5344^6e. Fecal incontinence, occasional or more frequently over the past week.
- +11 ;;3925^5345^7a. Ability to speak limited to approximately a half dozen different words or| fewer, in the course of an average day or in the course of an intensive| interview.
- +12 ;;3926^5346^7b. Speech ability limited to the use of a single intelligible word in an| average day or in the course of an interview (the person may repeat| the word over and over).
- +13 ;;3927^5347^7c. Ambulatory ability lost (cannot walk without personal assistance).
- +14 ;;3928^5348^7d. Ability to sit up without assistance lost (e.g., the individual will fall| over if there are no lateral rests [arms] on the chair).
- +15 ;;3929^5349^7e. Loss of the ability to smile.
- +16 ;;3932^5350^7f. Unable to hold head up.
- +17 ;;zzzzz