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

YTQAPI8.m

Go to the documentation of this file.
  1. YTQAPI8 ;ASF/ALB - MHA SCORING ; 11/15/07 11:14am
  1. ;;5.01;MENTAL HEALTH;**85,121,123,142**;Dec 30, 1994;Build 14
  1. ;
  1. Q
  1. OLDSCORE ;score answers fro 601.2
  1. D SCOREIT^YTQAPI14(.YSDATA,.YS)
  1. I YSDATA(1)="[ERROR]" S ^TMP($J,"YSCOR",1)="[ERROR]",^TMP($J,"YSCOR",2)="bad OLDSCORE" Q ;-->out
  1. I YSDATA(1)="[ERROR SCORE1+5]" S ^TMP($J,"YSCOR",1)="[ERROR]",^TMP($J,"YSCOR",2)="no administration found" Q ;-->out
  1. D MVSCORE
  1. Q
  1. LGSCORE ;score legacy test in 84
  1. N YSEE,YSLGRSP
  1. S YSEE=0
  1. S X1=^YTT(601.84,YSAD,0)
  1. S DFN=$P(X1,U,2),YSDATE=$P(X1,U,4)
  1. S YSOLDI=$O(^YTT(601,"B",YSCODE,0))
  1. S YSQN=0,N=1,X=""
  1. F S YSQN=$O(^YTT(601.85,"AC",YSAD,YSQN)) Q:YSQN'>0 D
  1. .S YSANSI=$O(^YTT(601.85,"AC",YSAD,YSQN,0))
  1. .S YSCI=$P($G(^YTT(601.85,YSANSI,0)),U,4)
  1. .I YSCI'?1N.N S YSEE=1 Q ;-->out ASF 3/7/07
  1. .I '$D(^YTT(601.75,YSCI)) S YSEE=1 Q ;-->out ASF 3/7/07
  1. .S YSLG=$P(^YTT(601.75,YSCI,0),U,2) S:YSLG="" YSLG=" "
  1. .S X=X_YSLG
  1. .I $L(X)=200 S YSLGRSP(N)=X,X="",N=N+1
  1. I YSEE K ^YTD(601.2,DFN,1,YSOLDI,1,YSDATE) S ^TMP($J,"YSCOR",1)="[ERROR]",^TMP($J,"YSCOR",2)="bad LG CHOICE" Q ;-->out
  1. L +^YTD(601.2,DFN,1,YSOLDI,1,YSDATE):DILOCKTM E S ^TMP($J,"YSCOR",1)="[ERROR]",^(2)="lock failed" Q ;-->out
  1. I $D(YSLGRSP) M ^YTD(601.2,DFN,1,YSOLDI,1,YSDATE)=YSLGRSP
  1. S:$L(X) ^YTD(601.2,DFN,1,YSOLDI,1,YSDATE,N)=X
  1. S ^YTD(601.2,DFN,1,YSOLDI,1,YSDATE,0)=YSDATE_U_U_$P(X1,U,6)_U_$P(X1,U,7)
  1. S YS("DFN")=DFN,YS("CODE")=YSCODE,YS("ADATE")=YSDATE
  1. D SCOREIT^YTQAPI14(.YSDATA,.YS) ;ASF 7/12/07
  1. K ^YTD(601.2,DFN,1,YSOLDI,1,YSDATE)
  1. L -^YTD(601.2,DFN,1,YSOLDI,1,YSDATE)
  1. I YSDATA(1)="[ERROR]" S ^TMP($J,"YSCOR",1)="[ERROR]",^TMP($J,"YSCOR",2)="bad LG SCORE" Q ;-->out
  1. I YSDATA(1)="[ERROR SCORE1+5]" S ^TMP($J,"YSCOR",1)="[ERROR]",^TMP($J,"YSCOR",2)="no administration found" Q ;-->out
  1. D MVSCORE
  1. Q
  1. MVSCORE ;move results
  1. K ^TMP($J,"YSCOR")
  1. S ^TMP($J,"YSCOR",1)="[DATA]"
  1. S N1=1,N2=5
  1. F S N2=$O(YSDATA(N2)) Q:N2'>0 S N1=N1+1,^TMP($J,"YSCOR",N1)=$P(YSDATA(N2),U,2)_"="_$P(YSDATA(N2),U,3)_U_$P(YSDATA(N2),U,4)
  1. K YSDATA S YSDATA=$NA(^TMP($J,"YSCOR"))
  1. Q
  1. GETSCORE(YSDATA,YS) ;get scales and scale grps for a test
  1. ; input: AD as administration ID
  1. ; output: Scale name=Raw Score
  1. N YSCODE,YSCODEN,N,N2,X,X1,I,YSAD,YSAI,YSTARG,YSAN,YSCALEI,YSKEYI,YSQN,YSRAW,YSVAL,YSDA,YSLG,N1,YSADATE,YSANSI,YSCI
  1. N YSDATE,YSDFN,YSOLDI,YSLIMIT,YSXT,DFN,YSSPEC,YSSCRD
  1. N REVSCR71,REVSCR84
  1. K ^TMP($J,"YSCOR") S YSDATA=$NA(^TMP($J,"YSCOR"))
  1. S YSAD=$G(YS("AD"))
  1. S YSADATE=$G(YS("ADATE")),YSCODE=$G(YS("CODE")),DFN=$G(YS("DFN"))
  1. I (YSADATE?7N.E)&(YSAD'?1N.N) D OLDSCORE Q ;-->out Score answers from 601.2
  1. I YSAD'?1N.N S ^TMP($J,"YSCOR",1)="[ERROR]",^TMP($J,"YSCOR",2)="bad ad num in GETSCORE" Q ;-->out
  1. I '$D(^YTT(601.85,"AC",YSAD)) S ^TMP($J,"YSCOR",1)="[ERROR]",^TMP($J,"YSCOR",2)="no such reference" Q ;-->out ;
  1. S YSCODE=$$GET1^DIQ(601.84,YSAD_",",2)
  1. S YSCODEN=$$GET1^DIQ(601.84,YSAD_",",2,"I")
  1. I '$D(^YTT(601.71,"B",YSCODE)) S ^TMP($J,"YSCOR",1)="[ERROR]",^TMP($J,"YSCOR",2)="no ins" Q ;-->out
  1. S YSDA=$O(^YTT(601.71,"B",YSCODE,0))
  1. S YSLG=$$GET1^DIQ(601.71,YSDA_",",23)
  1. I YSLG="Yes" D LGSCORE Q ;-->out Score legacy answers in 601.85
  1. ;
  1. ; patch 123, check for scoring discrepancy, if so, rescore and load scores
  1. I 'YSDA S ^TMP($J,"YSCOR",1)="[ERROR]",^TMP($J,"YSCOR",2)="Getscore err, No Instrument IEN" Q ;-->out
  1. D LDSCORES^YTSCORE(.YSDATA,.YS)
  1. Q
  1. ;
  1. OLDGSCRE(YSDATA,YS) ;get scales and scale grps for a test
  1. ; input: AD as administration ID
  1. ; output: Scale name=Raw Score
  1. N YSCODE,YSCODEN,N,N2,X,X1,I,YSAD,YSAI,YSTARG,YSAN,YSCALEI,YSKEYI,YSQN,YSRAW,YSVAL,YSDA,YSLG,N1,YSADATE,YSANSI,YSCI,YSDATE,YSDFN,YSOLDI,YSLIMIT,YSXT,DFN
  1. K ^TMP($J,"YSCOR") S YSDATA=$NA(^TMP($J,"YSCOR"))
  1. S YSAD=$G(YS("AD"))
  1. S YSADATE=$G(YS("ADATE")),YSCODE=$G(YS("CODE")),DFN=$G(YS("DFN"))
  1. I (YSADATE?7N.E)&(YSAD'?1N.N) D OLDSCORE Q ;-->out Score answers from 601.2
  1. I YSAD'?1N.N S ^TMP($J,"YSCOR",1)="[ERROR]",^TMP($J,"YSCOR",2)="bad ad num" Q ;-->out
  1. I '$D(^YTT(601.85,"AC",YSAD)) S ^TMP($J,"YSCOR",1)="[ERROR]",^TMP($J,"YSCOR",2)="no such reference" Q ;-->out
  1. S YSCODE=$$GET1^DIQ(601.84,YSAD_",",2)
  1. S YSCODEN=$$GET1^DIQ(601.84,YSAD_",",2,"I")
  1. I '$D(^YTT(601.71,"B",YSCODE)) S ^TMP($J,"YSCOR",1)="[ERROR]",^TMP($J,"YSCOR",2)="no ins" Q ;-->out
  1. S YSDA=$O(^YTT(601.71,"B",YSCODE,0))
  1. S YSLG=$$GET1^DIQ(601.71,YSDA_",",23)
  1. I YSLG="Yes" D LGSCORE Q ;-->out Score legacy answers in 601.85
  1. I '$D(^YTT(601.86,"AC",YSCODEN)) S ^TMP($J,"YSCOR",1)="[ERROR]",^TMP($J,"YSCOR",2)="no scale grps found" Q ;-->out
  1. S YS("CODE")=YSCODE
  1. D SCALEG^YTQAPI3(.YSDATA,.YS)
  1. S YSDATA=$NA(^TMP($J,"YSCOR"))
  1. S ^TMP($J,"YSCOR",1)="[DATA]",N=1
  1. F I=2:1 Q:'$D(^TMP($J,"YSG",I)) I ^TMP($J,"YSG",I)?1"Scale".E S YSRAW="0",N=N+1,^TMP($J,"YSCOR",N)=$P(^TMP($J,"YSG",I),U,4)_"=" D S ^TMP($J,"YSCOR",N)=^TMP($J,"YSCOR",N)_YSRAW
  1. .S YSCALEI=$P(^TMP($J,"YSG",I),U),YSCALEI=$P(YSCALEI,"=",2)
  1. .S YSKEYI=0 F S YSKEYI=$O(^YTT(601.91,"AC",YSCALEI,YSKEYI)) Q:YSKEYI'>0 D
  1. ..S G=^YTT(601.91,YSKEYI,0)
  1. ..S YSQN=$P(G,U,3),YSTARG=$P(G,U,4),YSVAL=$P(G,U,5)
  1. ..S YSAI=$O(^YTT(601.85,"AC",YSAD,YSQN,0))
  1. ..Q:YSAI'>0
  1. ..Q:'$D(^YTT(601.85,YSAI,0)) ;ASF 11/15/07
  1. ..S YSAN=""
  1. ..I $D(^YTT(601.85,YSAI,1,1,0)) S YSAN=^YTT(601.85,YSAI,1,1,0)
  1. ..I $P(^YTT(601.85,YSAI,0),U,4)?1N.N S YSAN=$P(^YTT(601.85,YSAI,0),U,4),YSAN=$G(^YTT(601.75,YSAN,1))
  1. ..I YSAN=YSTARG S YSRAW=YSRAW+YSVAL
  1. Q
  1. ;
  1. DELSG(YSDATA,YS) ; DELETE SCALES AND SCALEGROUP-careful!!!
  1. ;input: ID as ien of 601.86 scalegroup
  1. ;output DATAvsERROR
  1. N YSIEN,YSID,I,N,DA,DIK
  1. S YSID=$G(YS("ID"),-1)
  1. I '$D(^YTT(601.86,YSID,0)) S YSDATA(1)="[ERROR]",YSDATA(2)="bad id" Q ;-->out
  1. S N=0,YSDATA(1)="[DATA]"
  1. S YSEQ=0 F S YSEQ=$O(^YTT(601.87,"AC",YSID,YSEQ)) Q:YSEQ'>0 D
  1. .S DA=$O(^YTT(601.87,"AC",YSID,YSEQ,0))
  1. .S DIK="^YTT(601.87,"
  1. .S N=N+1
  1. .D ^DIK
  1. S DA=YSID,DIK="^YTT(601.86," D ^DIK
  1. S YSDATA(2)=N_" scales deleted"
  1. Q
  1. SCALEGRP(YSDATA,YS) ;return scalegroup info
  1. ; input: CODE as instrument name
  1. ; output: SCALEGROUP ID^INSTRUMENT ID^SCALEGROUP NAME^GROUP SEQUENCE^ORDINATE TITLE^ORDINATEMIN^ORDINATEINCREMENT^ORDINATEMAX^GRID1^GRID2^GRID3
  1. N YSCODE,YSCODEN,YSEQ,G,YSIEN,N
  1. K ^TMP($J,"YSSG")
  1. S YSDATA=$NA(^TMP($J,"YSSG"))
  1. S YSCODE=$G(YS("CODE"),0)
  1. I '$D(^YTT(601.71,"B",YSCODE)) S ^TMP($J,"YSSG",1)="[ERROR]",^TMP($J,"YSSG",2)="no ins" Q ;-->out
  1. S YSCODEN=$O(^YTT(601.71,"B",YSCODE,0))
  1. I '$D(^YTT(601.86,"AC",YSCODEN)) S ^TMP($J,"YSSG",1)="[ERROR]",^TMP($J,"YSSG",2)="no scale grps here" Q ;-->out
  1. S N=1,^TMP($J,"YSSG",1)="[DATA]"
  1. S YSEQ=0 F S YSEQ=$O(^YTT(601.86,"AC",YSCODEN,YSEQ)) Q:YSEQ="" D
  1. . S YSIEN=$O(^YTT(601.86,"AC",YSCODEN,YSEQ,0))
  1. . S G=^YTT(601.86,YSIEN,0)
  1. . S N=N+1,^TMP($J,"YSSG",N)=G
  1. Q
  1. LEGACY(YSDATA,YS) ; RPC: YTQ LEGACY REPORT
  1. N YSLGRSP
  1. K ^TMP("YSDATA",$J) S YSDATA=$NA(^TMP("YSDATA",$J))
  1. S YSAD=$G(YS("AD"))
  1. I YSAD'?1N.N S YSDATA(1)="[ERROR]",YSDATA(2)="bad ad num" Q ;-->out
  1. I '$D(^YTT(601.85,"AC",YSAD)) S YSDATA(1)="[ERROR]",YSDATA(2)="no such reference" Q ;-->out
  1. S YSDATA(1)="[DATA]"
  1. S X1=^YTT(601.84,YSAD,0)
  1. S DFN=$P(X1,U,2),YSDATE=$P(X1,U,4)
  1. S YSCODE=$$GET1^DIQ(601.84,YSAD_",",2)
  1. S YSOLDI=$O(^YTT(601,"B",YSCODE,0))
  1. S YSQN=0,N=1,X=""
  1. F S YSQN=$O(^YTT(601.85,"AC",YSAD,YSQN)) Q:YSQN'>0 D
  1. . S YSANSI=$O(^YTT(601.85,"AC",YSAD,YSQN,0))
  1. . S YSCI=$P(^YTT(601.85,YSANSI,0),U,4)
  1. . Q:YSCI'?1N.N
  1. . S YSLG=$P(^YTT(601.75,YSCI,0),U,2) S:YSLG="" YSLG=" "
  1. . S X=X_YSLG
  1. . I $L(X)=200 S YSLGRSP(N)=X,X="",N=N+1
  1. L +^YTD(601.2,DFN,1,YSOLDI,1,YSDATE):DILOCKTM E S YSDATA(1)="[ERROR]",YSDATA(2)="lock failed" Q ;-->out
  1. I $D(YSLGRSP) M ^YTD(601.2,DFN,1,YSOLDI,1,YSDATE)=YSLGRSP
  1. S:$L(X) ^YTD(601.2,DFN,1,YSOLDI,1,YSDATE,N)=X
  1. S ^YTD(601.2,DFN,1,YSOLDI,1,YSDATE,0)=YSDATE_U_U_$P(X1,U,6)_U_$P(X1,U,7)
  1. S YSDFN=DFN,YSXT=YSDATE_","_YSOLDI D INTRMNT^YTRPWRP(.YSDATA,YSDFN,YSXT)
  1. K ^YTD(601.2,DFN,1,YSOLDI,1,YSDATE)
  1. L -^YTD(601.2,DFN,1,YSOLDI,1,YSDATE)
  1. Q