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

YTSFAST.m

Go to the documentation of this file.
  1. YTSFAST ;SLC/KCM - Score FAST ; 01/08/2016
  1. ;;5.01;MENTAL HEALTH;**123,202,208**;DEC 30,1994;Build 23
  1. ;
  1. ; Reference to GET1^DIQ in ICR #2056
  1. ;
  1. Q
  1. ;
  1. DLLSTR(YSDATA,YS,YSTRNG) ; compute scores or report text based on YSTRNG
  1. ; input
  1. ; YSDATA(2)=adminId^patientDFN^instrumentName^dateGiven^isComplete
  1. ; YSDATA(2+n)=questionId^sequence^choiceId
  1. ; YS("AD")=adminId
  1. ; YSTRNG=1 for score, 2 for report
  1. ; output if YSTRNG=1: ^TMP($J,"YSCOR",n)=scaleId=score
  1. ; output if YSTRNG=2: append special "answers" to YSDATA
  1. ;
  1. I YSTRNG=1 D SCORESV
  1. I YSTRNG=2 D
  1. . N SCORES,N
  1. . D LDSCORES^YTSCORE(.YSDATA,.YS) ; puts score into ^TMP($J,"YSCOR",2)
  1. . D REPORT(.YSDATA)
  1. Q
  1. OLDFAST() ;
  1. ; expects YSDATA from DLLSTR
  1. N NODE,DATA,YSQN,YSCDA,DES,LEG
  1. S STAGE=1
  1. S NODE=2 F S NODE=$O(YSDATA(NODE)) Q:NODE="" D ; Start at YSDATA(3)
  1. .S DATA=YSDATA(NODE)
  1. .S YSQN=$P(DATA,U,1)
  1. .S YSCDA=$P($G(DATA),U,3)
  1. .D DESGNTR^YTSCORE(YSQN,.DES)
  1. .S LEG=$$GET1^DIQ(601.75,YSCDA_",",4,"I")
  1. .I (DES=2),(LEG="Y") S:STAGE<2 STAGE=2
  1. .I (DES=3),(LEG="Y") S:STAGE<3 STAGE=3
  1. .I (DES=4),(LEG="Y") S:STAGE<4 STAGE=4
  1. .I (DES=5),(LEG="Y") S:STAGE<5 STAGE=5
  1. .I ($E(DES)=6),(LEG="Y") S:STAGE<6 STAGE=6
  1. .I ($E(DES)=7),(LEG="Y") S:STAGE<7 STAGE=7
  1. Q STAGE
  1. ;
  1. SCORESV ; calculate the score
  1. ; expects YSDATA from DLLSTR (YSDATA from LOADANSW^YTSCORE,SCALEG^YTQAPI3)
  1. ;
  1. N I,J,CID,QSTN,STAGE
  1. S QSTN=$P($G(YSDATA(3)),U),CID=$P($G(YSDATA(3)),U,3)
  1. I QSTN=8788 D ; new algorithm for single-question FAST
  1. . S STAGE=$P($G(^YTT(601.75,+CID,0)),U,2)
  1. E S STAGE=$$OLDFAST() ; different algorithm for multi-question FAST
  1. ;
  1. ; set scores into ^TMP($J,"YSCOR",n)=scaleName=score {rawScore^tScore}
  1. K ^TMP($J,"YSCOR")
  1. I $D(^TMP($J,"YSG",1)),^TMP($J,"YSG",1)="[ERROR]" D Q ;-->out
  1. . S ^TMP($J,"YSCOR",1)="[ERROR]"
  1. . S ^TMP($J,"YSCOR",2)="No Scale found for ADMIN"
  1. ;
  1. N SCLID,SCLNM
  1. S ^TMP($J,"YSCOR",1)="[DATA]"
  1. S I=2,J=1 F S I=$O(^TMP($J,"YSG",I)) Q:'I D
  1. . S SCLID=+$P(^TMP($J,"YSG",I),"=",2)
  1. . S SCLNM=$P(^TMP($J,"YSG",I),U,4)
  1. . S J=J+1
  1. . I SCLID=509 S ^TMP($J,"YSCOR",J)=SCLNM_"="_STAGE
  1. Q
  1. ;
  1. REPORT(YSDATA) ; build the scoring display for the report
  1. ; expects ^TMP($J,"YSCOR",...) and ^TMP($J,"YSG") from DLLSTR
  1. ; .YSDATA from DLLSTR
  1. N I,QID,CID,QLST
  1. S I=2 F S I=$O(YSDATA(I)) Q:'I D
  1. . S QID=$P(YSDATA(I),U),CID=$P(YSDATA(I),U,3)
  1. . I CID=1155!(CID=1156)!(CID=1157) Q ; leave skipped questions undefined
  1. . S QLST(QID)=$$GET1^DIQ(601.75,CID_",",3,"I")
  1. ;
  1. N X,OLDFAST,THISCID,NODE,QNUM,OLDQSTN,QCID,QTXT,THISCID,ANSID,ANSWER
  1. S OLDFAST=$P($G(YSDATA(3)),U)'=8788
  1. S THISCID=$S(OLDFAST:"",1:$P($G(YSDATA(3)),U,3))
  1. S NODE=$O(YSDATA(""),-1) ; get last node
  1. F QNUM=1:1:16 D
  1. . S X=$P($T(QSTNS+QNUM),";;",2,999)
  1. . S OLDQSTN=$P(X,U),QCID=$P(X,U,2),QTXT=$P(X,U,3)
  1. . S ANSID=7770+QNUM ; computed answer question IDs are 7771 thru 7787
  1. . I OLDFAST S ANSWER=QLST(OLDQSTN)
  1. . I 'OLDFAST S ANSWER=$S(QCID=THISCID:"Yes",1:"No")
  1. . S NODE=NODE+1,YSDATA(NODE)=ANSID_"^9999;1^"_$S(ANSWER="No":"[ ]",1:"[x]")_" "_QTXT
  1. Q
  1. QSTNS ; FAST questions -- ;;oldQuestionID^newChoiceID^QuestionText
  1. ;;3909^5335^1. No difficulties, either subjectively or objectively.
  1. ;;3916^5336^2. Complains of forgetting location of objects. Subjective word finding| difficulties.
  1. ;;3917^5337^3. Decreased job function evident to co-workers; difficulty in traveling to| new locations. Decreased organizational capacity.
  1. ;;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.
  1. ;;3919^5339^5. Requires assistance in choosing proper clothing to wear for day, season,| or occasion.
  1. ;;3920^5340^6a. Difficulty putting clothing on properly without assistance.
  1. ;;3921^5341^6b. Unable to bathe properly; (e.g., difficulty adjusting bath water| temperature) occasionally or more frequently over the past weeks.
  1. ;;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.
  1. ;;3923^5343^6d. Urinary incontinence, occasional or more frequent.
  1. ;;3924^5344^6e. Fecal incontinence, occasional or more frequently over the past week.
  1. ;;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.
  1. ;;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).
  1. ;;3927^5347^7c. Ambulatory ability lost (cannot walk without personal assistance).
  1. ;;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).
  1. ;;3929^5349^7e. Loss of the ability to smile.
  1. ;;3932^5350^7f. Unable to hold head up.
  1. ;;zzzzz