- 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 Jan 18, 2025@03:19:44 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