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

YTQPXRM5.m

Go to the documentation of this file.
  1. YTQPXRM5 ;ASF/ALB CLINICAL REMINDERS CONT ; 7/13/07 2:27pm
  1. ;;5.01;MENTAL HEALTH;**85,119**;DEC 30,1994;Build 40
  1. ;
  1. Q
  1. CRTEST(YSDATA,YS) ;clinical reminders approrpiate instruments
  1. ;input: LIMIT highest # of questions allowed (25 is default)
  1. ;output: [DATA] vs [ERROR] 0K vs error msg
  1. ; test_name^601.71 ien^# of questions
  1. N YSLIMIT,YSCODE,YSCODEN,YSNUMB,YSG,YSIEN,YSOPER,YSQG2,YSERR,YSCTYPE,YSCHT,YSCHOICE,YSLEG,YSQN,YSNN
  1. K YSDATA
  1. S YSLIMIT=$G(YS("LIMIT"),25)
  1. S YSDATA(1)="[DATA]",YSNN=1
  1. S YSCODE=""
  1. F S YSCODE=$O(^YTT(601.71,"B",YSCODE)) Q:YSCODE="" S YSERR=0,YSNUMB=0,YSCODEN=$O(^YTT(601.71,"B",YSCODE,0)) D TCK,SETCR
  1. Q
  1. TCK ;check a test for CR
  1. S YSOPER=$$GET1^DIQ(601.71,YSCODEN_",",10,"I")
  1. IF YSOPER="C" S YSNUMB="C" Q ;-->out ASF 11/1/06
  1. Q:(YSOPER'="Y")
  1. S YSIEN=0 F S YSIEN=$O(^YTT(601.76,"AC",YSCODEN,YSIEN)) Q:YSIEN'>0 S YSNUMB=YSNUMB+1
  1. Q
  1. SETCR ;set out queue
  1. I (YSNUMB=0)!(YSNUMB>YSLIMIT)!(YSERR=1) Q ;->out
  1. S YSNN=YSNN+1,YSDATA(YSNN)=YSCODE_U_YSCODEN_U_YSNUMB
  1. Q
  1. ONECR(YSCODEN,YSLIMIT) ;FUNCTION check one test for CR
  1. ;input YSCODEN ien OF 601.71
  1. ; YSLIMIT # OF QUESTIONS (25 DEFAULT)
  1. ;output 1: OK for CR
  1. ;
  1. N YSOPER,YSERR,YSIEN,YSNUMB
  1. S YSOK=0
  1. I '$D(^YTT(601.71,YSCODEN,0)) Q YSOK ;->out
  1. I $P(^YTT(601.71,YSCODEN,0),U)="ASI" Q YSOK ;-->out
  1. I $P($G(^YTT(601.71,YSCODEN,9)),"^",1,2)="DLL^YTSCORE" Q YSOK ;-->out
  1. S YSLIMIT=$G(YSLIMIT,25)
  1. S YSNUMB=0,YSERR=0 D TCK
  1. I (YSNUMB=0)!(YSNUMB>YSLIMIT)!(YSERR=1) Q YSOK ;->out
  1. S YSOK=1
  1. Q YSOK
  1. SHOWALL(YSDATA,YS) ;
  1. ;returns all item information for a specified test
  1. ; same format as SHOWALL^YTAPI3
  1. N G,YSCODE,YSCODEN,YSNUMB,YSEQ,YSIEN,YSR,YSCTYPE,YSG,YSQN,YSQG2,YSCHTSEQ,YSLEG,YSCTEXT,YSCHOICE,YSINTRO,YSLINES,N1
  1. K YSDATA
  1. S YSCODE=$G(YS("CODE"),0)
  1. I '$D(^YTT(601.71,"B",YSCODE)) S YSDATA(1)="[ERROR]",YSDATA(2)="INCORRECT TEST CODE" Q
  1. S YSCODEN=$O(^YTT(601.71,"B",YSCODE,0))
  1. S YSNUMB=0
  1. S YSDATA(1)="[DATA]"
  1. S YSDATA(2)=YSCODE_U_$P(^YTT(601.71,YSCODEN,0),U,3)
  1. ;Loop thru test for all items
  1. S YSEQ=0 F S YSEQ=$O(^YTT(601.76,"AD",YSCODEN,YSEQ)) Q:YSEQ'>0 S YSIEN=$O(^YTT(601.76,"AD",YSCODEN,YSEQ,0)) Q:YSIEN'>0 S YSNUMB=YSNUMB+1,YSR=0 D
  1. . S YSG=^YTT(601.76,YSIEN,0),YSQN=$P(YSG,U,4),YSQG2=$G(^YTT(601.72,YSQN,2))
  1. . D GETTEXT
  1. . S YSCTYPE=$P(YSQG2,U,3) Q:YSCTYPE="" ;->out
  1. . S YSCHTSEQ=0 F S YSCHTSEQ=$O(^YTT(601.751,"AC",YSCTYPE,YSCHTSEQ)) Q:YSCHTSEQ'>0 D
  1. .. S YSCHOICE=$O(^YTT(601.751,"AC",YSCTYPE,YSCHTSEQ,0)) Q:YSCHOICE'>0 D
  1. ... S YSCTEXT=$G(^YTT(601.75,YSCHOICE,1))
  1. ... S YSLEG=$P($G(^YTT(601.75,YSCHOICE,0)),U,2)
  1. ... D RESP
  1. Q
  1. GETTEXT ;pull text and intros
  1. S N1=0,YSLINES=0 F S N1=$O(^YTT(601.72,YSQN,1,N1)) Q:N1'>0 S YSLINES=N1 D
  1. . S YSDATA(YSNUMB,"T",N1)=^YTT(601.72,YSQN,1,N1,0)
  1. S YSLINES=YSLINES+1,YSDATA(YSNUMB,"T",YSLINES)=" "
  1. S YSINTRO=$P($G(^YTT(601.72,YSQN,2)),U)
  1. Q:YSINTRO'?1N.N
  1. S N1=0 F S N1=$O(^YTT(601.73,YSINTRO,1,N1)) Q:N1'>0 D
  1. . S YSDATA(YSNUMB,"I",N1)=^YTT(601.73,YSINTRO,1,N1,0)
  1. Q
  1. RESP ;get approp responses
  1. S YSDATA(YSNUMB,"R",1)="Answer= "
  1. S YSDATA(YSNUMB,"R",0)=$G(YSDATA(YSNUMB,"R",0))_YSLEG
  1. S YSLINES=YSLINES+1,YSDATA(YSNUMB,"T",YSLINES)=YSLEG_". "_YSCTEXT
  1. Q
  1. SCALES(YSDATA,YSCODEN) ;scales for a test
  1. ;input :YSCODEN AS 601.71 IEN
  1. ;output scalename^601.82 ENTRY
  1. N G,YSCODE,N,N1,YS1,YSZ,YS87,YSONLY,YSNAME
  1. ;S YSCODEN=$G(YS("CODE"),0)
  1. I '$D(^YTT(601.71,YSCODEN,0)) S YSDATA(1)="[ERROR]",YSDATA(2)="bad code" Q ;->out
  1. S YSCODE=$P(^YTT(601.71,YSCODEN,0),U)
  1. I YSCODE="ASI" D Q ;-->out
  1. . S YSDATA(1)="[DATA]"
  1. . S YSDATA("S",1)="Medical"
  1. . S YSDATA("S",2)="Employment"
  1. . S YSDATA("S",3)="Alcohol"
  1. . S YSDATA("S",4)="Drug"
  1. . S YSDATA("S",5)="Legal"
  1. . S YSDATA("S",6)="Family"
  1. . S YSDATA("S",7)="Psychiatric"
  1. S YS1("CODE")=YSCODE D SCALEG^YTQAPI3(.YSZ,.YS1)
  1. S YSDATA(1)="[DATA]"
  1. S N=0 F S N=$O(^TMP($J,"YSG",N)) Q:N'>0 D
  1. . S G=^TMP($J,"YSG",N)
  1. . S YSNAME=$P(G,U,4),YS87=$P($P(G,U,1),"=",2)
  1. . Q:G'?1"Scale".E
  1. . S:'$D(YSONLY(YSNAME)) YSONLY(YSNAME)="",YSDATA("S",YS87)=YSNAME
  1. K ^TMP($J,"YSG")
  1. Q
  1. SCNAME(YSIEN) ;get scale name from 601.87 ien
  1. ;input 601.87 ien
  1. N YS87
  1. S YS87=0
  1. Q:YSIEN'?1N.N YS87 ;out-->
  1. Q:'$D(^YTT(601.87,YSIEN)) YS87 ;out-->
  1. S YS87=$$GET1^DIQ(601.87,YSIEN_",",3)
  1. Q YS87
  1. ALLKEYS(YSDATA,YS) ;Return ALL or most KEYS that a user has.
  1. ;input IEN as internal of file 200 [optional/DUZ]
  1. N YSIEN,I,J,K,L K ^TMP("YSXU",$J)
  1. S YSIEN=$G(YS("IEN"))
  1. S:YSIEN="" YSIEN=DUZ
  1. I YSIEN'>0 S YSDATA(1)="[ERROR]" Q
  1. S I=0,L=1,YSDATA(1)="[DATA]"
  1. F S I=$O(^VA(200,YSIEN,51,I)) Q:I'>0 S K=$G(^DIC(19.1,I,0)) D
  1. . S L=L+1,YSDATA(L)=$P(K,U,1)
  1. . Q