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