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

YTSPHI.m

Go to the documentation of this file.
  1. YTSPHI ;SLC/KCM - Score PHI and format report ; 01/08/2016
  1. ;;5.01;MENTAL HEALTH;**172**;DEC 30,1994;Build 10
  1. ;
  1. DATA1 ; Loop YSDATA and map questions to choice values
  1. ; expects YTRESP from DLLSTR
  1. N YTI,YTQSTN,YTCHC
  1. F YTI=8555:1:8576 S YTRESP(YTI)="" ; ensure something is there
  1. S YTI=2 F S YTI=$O(YSDATA(YTI)) Q:'YTI D ; set actual choice values
  1. . S YTQSTN=$P(YSDATA(YTI),U),YTCHC=$P(YSDATA(YTI),U,3)
  1. . I YTQSTN=8558!(YTQSTN=8577)!(YTQSTN=8578) D Q ; handle text answers
  1. . . S YTRESP(YTQSTN)=$G(YTRESP(YTQSTN))_$P(YSDATA(YTI),U,3,99)
  1. . S YTRESP(YTQSTN)=$$MAPCHC(YTCHC)
  1. Q
  1. MAPCHC(YTCHC) ; Map score to choice
  1. ; expects YSTRNG from DLLSTR
  1. I YTCHC=1155!(YTCHC=1156)!(YTCHC=1157) Q $S(YSTRNG=2:"SKIPPED",1:0)
  1. I $D(^YTT(601.75,YTCHC,0)) Q +$P(^YTT(601.75,YTCHC,0),U,2)
  1. Q YTCHC
  1. ;
  1. SCORESV ; Save the scores (only used for graphing for PHI)
  1. ; expects YTRESP from DLLSTR
  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. S ^TMP($J,"YSCOR",1)="[DATA]"
  1. N X,YTI,YTS,YTSCALE
  1. S YTI=1 F S YTI=$O(^TMP($J,"YSG",YTI)) Q:'YTI D
  1. . S X=^TMP($J,"YSG",YTI) I $E(X,1,5)'="Scale" Q
  1. . S X=$P(X,"=",2,99)
  1. . S YTSCALE($P(X,U))=$P(X,U,4)_"="
  1. S YTS=0,YTI=1 F S YTS=$O(YTSCALE(YTS)) Q:'YTS D
  1. . I YTS=1354 S X=YTRESP(8555) ; Physical Well-Being
  1. . I YTS=1355 S X=YTRESP(8556) ; Mental Well-Being
  1. . I YTS=1356 S X=YTRESP(8557) ; Life Day-to-Day
  1. . I YTS=1357 S X=YTRESP(8559) ; Moving the Body...Now
  1. . I YTS=1358 S X=YTRESP(8560) ; Moving the Body...To Be
  1. . I YTS=1359 S X=YTRESP(8561) ; Recharge...Now
  1. . I YTS=1360 S X=YTRESP(8562) ; Recharge...To Be
  1. . I YTS=1361 S X=YTRESP(8563) ; Food and Drink...Now
  1. . I YTS=1362 S X=YTRESP(8564) ; Food and Drink...To Be
  1. . I YTS=1363 S X=YTRESP(8565) ; Personal Development...Now
  1. . I YTS=1364 S X=YTRESP(8566) ; Personal Development...To Be
  1. . I YTS=1365 S X=YTRESP(8567) ; Family, Friends...Now
  1. . I YTS=1366 S X=YTRESP(8568) ; Family, Friends...To Be
  1. . I YTS=1367 S X=YTRESP(8569) ; Spirit and Soul...Now
  1. . I YTS=1368 S X=YTRESP(8570) ; Spirit and Soul...To Be
  1. . I YTS=1369 S X=YTRESP(8571) ; Surroundings...Now
  1. . I YTS=1370 S X=YTRESP(8572) ; Surroundings...To Be
  1. . I YTS=1371 S X=YTRESP(8573) ; Power of the Mind...Now
  1. . I YTS=1372 S X=YTRESP(8574) ; Power of the Mind...To Be
  1. . I YTS=1373 S X=YTRESP(8575) ; Professional Care...Now
  1. . I YTS=1374 S X=YTRESP(8576) ; Professional Care...To Be
  1. . S YTI=YTI+1,^TMP($J,"YSCOR",YTI)=YTSCALE(YTS)_X
  1. Q
  1. ;
  1. REPORT(REFLECT,CARE) ; Set the special text for the report
  1. ; expects YTRESP from DLLSTR
  1. N X
  1. S X=""
  1. S X=X_"|Physical Well-Being: "_YTRESP(8555)
  1. S X=X_"|Mental/Emotional Well-Being: "_YTRESP(8556)
  1. S X=X_"|Life: How is it to live your day-to-day life? "_YTRESP(8557)
  1. S REFLECT=X,X=""
  1. S X=X_"|Moving the Body "_YTRESP(8559)_$$SPACED(8560)
  1. S X=X_"|Recharge "_YTRESP(8561)_$$SPACED(8562)
  1. S X=X_"|Food and Drink "_YTRESP(8563)_$$SPACED(8564)
  1. S X=X_"|Personal Development "_YTRESP(8565)_$$SPACED(8566)
  1. S X=X_"|Family, Friends, and Co-Workers "_YTRESP(8567)_$$SPACED(8568)
  1. S X=X_"|Spirit and Soul "_YTRESP(8569)_$$SPACED(8570)
  1. S X=X_"|Surroundings "_YTRESP(8571)_$$SPACED(8572)
  1. S X=X_"|Power of the Mind "_YTRESP(8573)_$$SPACED(8574)
  1. S X=X_"|Professional Care "_YTRESP(8575)_$$SPACED(8576)
  1. S CARE=X
  1. Q
  1. SPACED(QSTN) ; Return answer text with aligned spacing
  1. N SPACES S SPACES=" "
  1. Q $E(SPACES,1,21-$L(YTRESP(QSTN-1)))_YTRESP(QSTN)
  1. ;
  1. WRAPPED(TX,MAX) ; Wrap the response using "|" delimiters
  1. N OUT,I,J,X,Y,YNEW
  1. F I=1:1:$L(TX,"|") S X=$P(TX,"|",I) D
  1. . I $L(X)'>MAX D ADDOUT(X) QUIT
  1. . S Y=""
  1. . F J=1:1:$L(X," ") D
  1. . . S YNEW=Y_$S(J=1:"",1:" ")_$P(X," ",J)
  1. . . I $L(YNEW)>MAX D ADDOUT(Y) S Y=$P(X," ",J) I 1
  1. . . E S Y=YNEW
  1. . D ADDOUT(Y) ; add any remaining
  1. S X="",I=0 F S I=$O(OUT(I)) Q:'I S X=X_$S(I=1:"",1:"|")_OUT(I)
  1. Q X
  1. ;
  1. ADDOUT(S) ; add string to out array (expects OUT)
  1. S OUT=+$G(OUT)+1,OUT(OUT)=S
  1. Q
  1. ;
  1. DLLSTR(YSDATA,YS,YSTRNG) ;
  1. ; input
  1. ; YSDATA(2)=adminId^patientDFN^instrumentName^dateGiven^complete?
  1. ; YSDATA(2+n)=questionId^sequence^choiceId
  1. ; YS("AD")=adminId
  1. ; YSTRNG=1 for score, 2 for report
  1. ; output if YSTRNG=1
  1. ; ^TMP($J,"YSCOR",n)=scaleId=score
  1. ; output if YSTRNG=2
  1. ; append special "answers" to YSDATA
  1. ;
  1. N YTRESP
  1. D DATA1
  1. I YSTRNG=1 D SCORESV
  1. I YSTRNG=2 D
  1. . N REFLECT,CARE,N
  1. . D REPORT(.REFLECT,.CARE)
  1. . S N=$O(YSDATA(""),-1) ; get last node
  1. . S YSDATA(N+1)="7771^9999;1^"_REFLECT
  1. . S YSDATA(N+2)="7772^9999;1^"_CARE
  1. . S YSDATA(N+3)="7773^9999;1^"_$$WRAPPED(YTRESP(8558),76)
  1. . S YSDATA(N+4)="7774^9999;1^"_$$WRAPPED(YTRESP(8577),76)
  1. . S YSDATA(N+5)="7775^9999;1^"_$$WRAPPED(YTRESP(8578),76)
  1. Q