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

YTQAPI.m

Go to the documentation of this file. 
  1. YTQAPI ;ASF/ALB - MHQ REMOTE PROCEEDURES ; 4/3/07 10:36am
  1.  ;;5.01;MENTAL HEALTH;**85,130,141,182**;Dec 30, 1994;Build 13
  1.  ;
  1.  ; External Reference    ICR#
  1.  ; ------------------   -----
  1.  ; DID                   2052
  1.  ; DIQ                   2056
  1.  ;
  1.  Q
  1. TSLIST(YSDATA) ;list tests and surveys
  1.  ;Input: none
  1.  ;Output: TEST NAME = LAST EDIT DATE^OPERATIONAL^REQUIRES LISCENCE^LISCENCE CURRENT^IS LEGACY^IEN^R PRIVILEGE^IS NATIONAL^HAS BEEN OPERATIONAL
  1.  N YSTESTN,YSTEST,N,G,G1,G2,G3,G4,G5,G6,G7,G8
  1.  K ^TMP($J,"YSTL")
  1.  S YSDATA=$NA(^TMP($J,"YSTL"))
  1.  S N=1,^TMP($J,"YSTL",N)="[DATA]"
  1.  S YSTEST="" F  S YSTEST=$O(^YTT(601.71,"B",YSTEST)) Q:YSTEST=""  D
  1.  . I $E(YSTEST,1,4)="CAT-"!($E(YSTEST,1,4)="CAD-") Q  ;CAT only in MHA-Web
  1.  . S YSTESTN=$O(^YTT(601.71,"B",YSTEST,0))       ;6
  1.  . S N=N+1
  1.  . S G=$$GET1^DIQ(601.71,YSTESTN_",",18,"I")    ;1
  1.  . S G1=$$GET1^DIQ(601.71,YSTESTN_",",10,"E")   ;2
  1.  . S G2=$$GET1^DIQ(601.71,YSTESTN_",",11,"E")   ;3
  1.  . S G3=$$GET1^DIQ(601.71,YSTESTN_",",20,"E")   ;4
  1.  . S G4=$$GET1^DIQ(601.71,YSTESTN_",",23,"E")   ;5
  1.  . S G5=$$GET1^DIQ(601.71,YSTESTN_",",9,"E")    ;7
  1.  . S G6=$$GET1^DIQ(601.71,YSTESTN_",",19,"E")   ;8
  1.  . S G7=$$GET1^DIQ(601.71,YSTESTN_",",10.5,"E") ;9
  1.  . S G8=+$O(^YTT(601.712,"B",YSTESTN,0))        ;instrument hash
  1.  . I G8,$D(^YTT(601.712,G8,0)) S G8=$P(^YTT(601.712,G8,0),U,3)
  1.  . S ^TMP($J,"YSTL",N)=YSTEST_"="_G_U_G1_U_G2_U_G3_U_G4_U_YSTESTN_U_G5_U_G6_U_G7_U_U_G8
  1.  Q
  1. TSLIST1(YSDATA,YS) ;list questions for a single test
  1.  ;input: CODE as test name
  1.  ;output: Field^Value
  1.  N YSTESTN,YSTEST,YSF,YSV,N,I,YSEI
  1.  S YSTEST=$G(YS("CODE"))
  1.  I YSTEST="" S YSDATA(1)="[ERROR]",YSDATA(2)="NO code" Q  ;-->out
  1.  S YSTESTN=$O(^YTT(601.71,"B",YSTEST,0))
  1.  I YSTESTN'>0 S YSDATA(1)="[ERROR]",YSDATA(2)="bad code" Q  ;-->out
  1.  S N=2,YSDATA(1)="[DATA]",YSDATA(2)="IEN="_YSTESTN
  1.  F I=.01,2,3,4,5,7,7.5,8,9,10,10.5,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,100.01,100.02,100.03,100.04 D
  1.  . S N=N+1
  1.  . S YSEI=$S(I=18:"I",1:"E")
  1.  . D FIELD^DID(601.71,I,"","LABEL","YSF")
  1.  . S YSV=$$GET1^DIQ(601.71,YSTESTN_",",I,YSEI)
  1.  . S YSDATA(N)=YSF("LABEL")_"="_YSV
  1.  Q
  1. CHOICES(YSDATA,YS) ;list choices for a question
  1.  ;input: CODE as test name
  1.  ;output: 601.75(1) CHOICETYPE ID^SEQUENCE^CHOICE IFN^CHOICE TEXT^LEGACY VALUE
  1.  N YSCDA,YSIC,YSQN,YSN,YSN1,YSTESTN,YSTEST,YSF,YSV,N,G,YSCTYP,YSCTYPID,G,G1,X
  1.  S YSTEST=$G(YS("CODE"))
  1.  S YSTESTN=$O(^YTT(601.71,"B",YSTEST,0))
  1.  I YSTESTN'>0 S YSDATA(1)="[ERROR]",YSDATA(2)="bad code" Q  ;-->out
  1.  S N=1,YSDATA(1)="[DATA]"
  1.  ;
  1.  S YSIC=0
  1.  F  S YSIC=$O(^YTT(601.76,"AC",YSTESTN,YSIC)) Q:YSIC'>0  S YSQN=$P(^YTT(601.76,YSIC,0),U,4) D
  1.  . S YSCTYP=$P($G(^YTT(601.72,YSQN,2)),U,3)
  1.  . S:YSCTYP'="" YSCTYPID(YSCTYP)=""
  1. C2 ;
  1.  S YSN=0
  1.  F  S YSN=$O(YSCTYPID(YSN)) Q:YSN'>0  D
  1.  . S YSN1=0 F  S YSN1=$O(^YTT(601.751,"AC",YSN,YSN1)) Q:YSN1'>0  D
  1.  .. S YSCDA=0 F  S YSCDA=$O(^YTT(601.751,"AC",YSN,YSN1,YSCDA)) Q:YSCDA'>0  D
  1.  ... S N=N+1
  1.  ... S YSDATA(N)=YSN_U_YSN1_U_YSCDA_U_$G(^YTT(601.75,YSCDA,1))_U_$P($G(^YTT(601.75,YSCDA,0)),U,2)
  1.  Q
  1. SKIPPED(YSDATA,YS) ; skipped questions for an instrument
  1.  ;input: CODE as test name
  1.  ;output: QUESTIONID^SKIPQUESTIONID
  1.  ; for single test in question,skipped order
  1.  N YSTESTN,YSTEST,N,N1,N2,YSQ,YSK,G
  1.  S YSTEST=$G(YS("CODE"))
  1.  S YSTESTN=$O(^YTT(601.71,"B",YSTEST,0))
  1.  I YSTESTN'>0 S YSDATA(1)="[ERROR]",YSDATA(2)="bad code" Q  ;-->out
  1.  I '$D(^YTT(601.79,"AC",YSTESTN)) S YSDATA(1)="[ERROR]",YSDATA(2)="no entries for this code" Q  ;--> out
  1.  S N=1,YSDATA(1)="[DATA]"
  1.  ;
  1.  S N1=0 F  S N1=$O(^YTT(601.79,"AC",YSTESTN,N1)) Q:N1'>0  D
  1.  . S G=^YTT(601.79,N1,0),YSQ=$P(G,U,3),YSK=$P(G,U,4)
  1.  . S:(YSQ?1N.N)&(YSK?1N.N) G(YSQ,YSK)=""
  1.  S N1=0 F  S N1=$O(G(N1)) Q:N1'>0  S N2=0 F  S N2=$O(G(N1,N2)) Q:N2'>0  S N=N+1,YSDATA(N)=N1_U_N2
  1.  Q
  1. SECTION(YSDATA,YS) ;section captions
  1.  ;input: CODE as test name
  1.  ;output: FIRSTQUESTIONID^TABCAPTION^SECTIONCAPTION^DISPLAYID
  1.  ; for single test in questionID order
  1.  N YSTESTN,YSTEST,N,N1,G,YSQ
  1.  S YSTEST=$G(YS("CODE"))
  1.  S YSTESTN=$O(^YTT(601.71,"B",YSTEST,0))
  1.  I YSTESTN'>0 S YSDATA(1)="[ERROR]",YSDATA(2)="bad code" Q  ;-->out
  1.  I '$D(^YTT(601.81,"AC",YSTESTN)) S YSDATA(1)="[DATA]" Q  ;-->out no entries for this code
  1.  S N=1,YSDATA(1)="[DATA]"
  1.  ;
  1.  S N1=0 F  S N1=$O(^YTT(601.81,"AC",YSTESTN,N1)) Q:N1'>0  D
  1.  . S G=^YTT(601.81,N1,0),YSQ=$P(G,U,3)
  1.  . S:(YSQ?1N.N) G(YSQ)=$P(G,U,3,6)
  1.  S N1=0 F  S N1=$O(G(N1)) Q:N1'>0  D
  1.   . S N=N+1,YSDATA(N)=G(N1)
  1.  . S N=N+1,YSDATA(N)="DISPLAY=" S:$P(G(N1),U,4)?1N.N YSDATA(N)=YSDATA(N)_$$DISPEXT^YTQAPI5($P(G(N1),U,4))
  1.  Q
  1.  ;