source: FOIAVistA/trunk/r/MENTAL_HEALTH-YS-RUCL-YI-YT/YTAPI5.m@ 1397

Last change on this file since 1397 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 2.8 KB
Line 
1YTAPI5 ;ALB/ASF- MH API NOTES ; 7/24/07 4:11pm
2 ;;5.01;MENTAL HEALTH;**62,85**;Dec 30, 1994;Build 48
3 Q
4OUTNOTE(YSDATA) ;
5 N G,I,N,P,R,X,Y,YS2,YSADATE,YSCODE,YSGG,YSGG1,YSGG2,YSJ,YSJJ,YSNCODE,YSSET,YSSR,YSST,YSX1,YSX2,YSX3,YIN,YSINN,YSINE,YSMC
6 I $G(YSDATA(1))?1"[ERROR".E Q ;---->
7 I '$D(YSDATA(5)) S YSDATA(1)="[ERROR]",YSDATA(2)="bad ysdata to outnote" Q ;--->
8 S YS2=$G(YSDATA(2))
9 S YSCODE=$P(YS2,U,2)
10 S YSADATE=$P(YS2,U,4)
11 S YSNCODE=$O(^YTT(601,"B",YSCODE,-1))
12 S YSX1=$P(YSDATA(3),U,2)
13 S YSX2=$P(YSDATA(4),U,2)
14 S YSX3=$P(YSDATA(5),U,2)
15 S YSSR=$P(YSDATA(6),U,3)
16 S YSST=$P(YSDATA(6),U,4)
17 S Y=$G(^YTT(601.6,YSNCODE,2))
18 I Y="" S YSDATA(1)="[ERROR]",YSDATA(2)="no mh mult outcome code" Q ;--->
19 ;
20 X Y
21 I X'>0 S YSDATA(1)="[ERROR]",YSDATA(2)="bad M executable" Q ;--->
22LD ;LOAD NOTE
23 S N=0
24 F S N=$O(^YTT(601.6,YSNCODE,3,X,1,N)) Q:N'>0 D
25 . S YSDATA("ON",N,0)=^YTT(601.6,YSNCODE,3,X,1,N,0)
26REP ;replace ||
27 S N=0
28 F S N=$O(YSDATA("ON",N)) Q:N'>0 D
29 . S G=YSDATA("ON",N,0)
30 . S R=""
31 . F I=1:1:$L(G,"|") D
32 .. S P=$P(G,"|",I)
33 .. D:P?1"RSCORE".1N.N RSCORE
34 .. D:P?1"SSCORE".1N.N SSCORE
35 .. D:P?1"ITEM".1N.E ITEM
36 .. D:P?1"EXECUTE".E MC
37 .. S R=R_P
38 . S YSDATA("ON",N,0)=R
39 Q
40RSCORE ; raw scores
41 S YSJ=$E(P,7,99),P=$P(YSDATA(YSJ+5),U,3)
42 Q
43SSCORE ;scaled score
44 S YSJ=$E(P,7,99),P=$P(YSDATA(YSJ+5),U,4)
45 Q
46ITEM ;items resolution
47 S YSIN=$E(P,5,999)
48 S YSSET=$P(YSIN,";",2)
49 S YSIN=$P(YSIN,";",1)
50 S YSINN=$S(YSIN>400:5,YSIN>200:4,1:3)
51 S YSINE=$S(YSIN#200=0:200,1:YSIN)
52 S P=$P(YSDATA(YSINN),U,2)
53 S P=$E(P,YSINE)
54 Q:YSSET=""
55 F YSJJ=1:1:$L(YSSET,",") D
56 . S YSGG=$P(YSSET,",",YSJJ),YSGG1=$P(YSGG,":"),YSGG2=$P(YSGG,":",2)
57 . S:P=YSGG1 P=YSGG2
58 Q
59MC ;mumps executable setting P
60 S YSMC=$P(P,";",2)
61 X YSMC
62 Q
63GAFURL(YSDATA) ;returns MH GAF horizontal sheet
64 S YSDATA(1)="[DATA]"
65 S YSDATA(2)="http://vaww.mentalhealth.med.va.gov/gafsheet.htm"
66 Q
67PRIVL(YSDATA,YS) ;check privileges
68 N YSCODE,YSET
69 S YSCODE=$G(YS("CODE"),-1)
70 ;ASF 03/08/06
71 I (YSCODE="GAF")!(YSCODE="ASI") S YSDATA(1)="[DATA]",YSDATA(2)="1^exempt test" Q ;-->out test exempt
72 I $D(^YTT(601.71,"B",YSCODE)) D Q ;--> out
73 . S YSET=$O(^YTT(601.71,"B",YSCODE,0))
74 . S YSDATA(1)="[DATA]"
75 . S YSKEY=$$GET1^DIQ(601.71,YSET_",",9)
76 . I YSKEY="" S YSDATA(2)="1^exempt test" Q ;-->out
77 . I $D(^XUSEC(YSKEY,DUZ)) S YSDATA(2)="1^user privileged" Q ;-->out has key
78 . S YSDATA(2)="0^no access" Q ;->out
79 ;
80 I '$D(^YTT(601,"B",YSCODE)) S YSDATA(1)="[ERROR]",YSDATA(2)="BAD TEST CODE" Q ;--> out
81 S YSET=$O(^YTT(601,"B",YSCODE,0))
82 S YSDATA(1)="[DATA]"
83 I $D(^XUSEC("YSP",DUZ)) S YSDATA(2)="1^user privileged for all tests" Q ;has key
84 I $P(^YTT(601,YSET,0),U,10)="Y"!(YSCODE="GAF")!(YSCODE="ASI") S YSDATA(2)="1^exempt test" Q ;test exempt
85 I $P(^YTT(601,YSET,0),U,9)="I" S YSDATA(2)="1^interview" Q ;interview
86 S YSDATA(2)="0^no access"
87 Q
Note: See TracBrowser for help on using the repository browser.