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

YTSLEC.m

Go to the documentation of this file.
  1. YTSLEC ;ISP/LMT - Report for LEC ;Nov 29, 2023@08:59:02
  1. ;;5.01;MENTAL HEALTH;**239**;Dec 30, 1994;Build 16
  1. ;
  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. N YSN,YSTEXT
  1. ;
  1. I YSTRNG=1 QUIT ; There is no custom scoring for this instrument
  1. ;
  1. I YSTRNG=2 D
  1. . S YSTEXT=$$REPORT(.YSDATA)
  1. . S YSN=$O(YSDATA(""),-1) ; get last node
  1. . S YSN=YSN+1
  1. . S YSDATA(YSN)="7771^9999;1^"_YSTEXT
  1. Q
  1. ;
  1. ;
  1. REPORT(YSDATA) ;
  1. ;
  1. N YSANSWER,YSCHOICE,YSCNT,YSHDR,YSI,YSNODE,YSQUESTION,YSRESULT,YSSORT
  1. ;
  1. S YSI=2
  1. F S YSI=$O(YSDATA(YSI)) Q:'YSI D
  1. . S YSNODE=$G(YSDATA(YSI))
  1. . S YSQUESTION=$P(YSNODE,U,1)
  1. . S YSANSWER=$P(YSNODE,U,3)
  1. . I YSQUESTION=""!(YSANSWER="") QUIT
  1. . ;
  1. . F YSCHOICE=5816:1:5819 D
  1. . . I YSANSWER[$G(^YTT(601.75,YSCHOICE,1)) D
  1. . . . S YSSORT(YSCHOICE,YSQUESTION)=""
  1. ;
  1. S YSHDR(5816)="Veteran Experienced:"
  1. S YSHDR(5817)="Veteran Witnessed:"
  1. S YSHDR(5818)="Veteran Learned About:"
  1. S YSHDR(5819)="Job related:"
  1. ;
  1. S YSRESULT=""
  1. F YSCHOICE=5816:1:5819 D
  1. . S YSRESULT=YSRESULT_"||"_YSHDR(YSCHOICE)
  1. . ;
  1. . I '$D(YSSORT(YSCHOICE)) D QUIT
  1. . . S YSRESULT=YSRESULT_"| N/A"
  1. . ;
  1. . S YSCNT=0
  1. . S YSQUESTION=0 F S YSQUESTION=$O(YSSORT(YSCHOICE,YSQUESTION)) Q:'YSQUESTION D
  1. . . S YSCNT=YSCNT+1
  1. . . S YSRESULT=YSRESULT_$$QFORMAT(YSCNT,YSQUESTION,7)
  1. ;
  1. Q YSRESULT
  1. ;
  1. QFORMAT(YSCNT,YSQUESTION,YSINDENT) ; format the question nicely
  1. ;
  1. N DIWF,DIWL,DIWR,X,YSI,YSLINE,YSRESULT
  1. ;
  1. S YSINDENT=$G(YSINDENT,7)
  1. S DIWL=YSINDENT+3
  1. S DIWR="78"
  1. S DIWF="|"
  1. K ^UTILITY($J,"W")
  1. ;
  1. S YSI=0 F S YSI=$O(^YTT(601.72,YSQUESTION,1,YSI)) Q:'YSI D
  1. . S X=$G(^YTT(601.72,YSQUESTION,1,YSI,0))
  1. . D ^DIWP
  1. ;
  1. S YSRESULT=""
  1. S YSI=0 F S YSI=$O(^UTILITY($J,"W",DIWL,YSI)) Q:'YSI D
  1. . S YSLINE=$G(^UTILITY($J,"W",DIWL,YSI,0))
  1. . I YSI=1 D QUIT
  1. . . S YSRESULT="|"_$$RJ^XLFSTR(YSCNT_". ",YSINDENT)_YSLINE
  1. . S YSRESULT=YSRESULT_"|"_$$REPEAT^XLFSTR(" ",YSINDENT)_YSLINE
  1. K ^UTILITY($J,"W")
  1. Q YSRESULT