source: WorldVistAEHR/trunk/r/MENTAL_HEALTH-YS-RUCL-YI-YT/YTQAPI1.m@ 1685

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

initial load of WorldVistAEHR
File size: 4.8 KB
RevLine 
[613]1YTQAPI1 ;ASF/ALB- MHAX REMOTE PROCEDURES ; 4/3/07 10:50am
2 ;;5.01;MENTAL HEALTH;**85**;Dec 30, 1994;Build 49
3 Q
4RULES(YSDATA,YS) ;list rules for a survey
5 ;input: CODE as test name
6 ;output: Field^Value
7 N YSBOOL,YSQID,YSRID,YSTESTN,YSTEST,G,G1,G2,N,N1,N2,Z
8 S YSTEST=$G(YS("CODE"))
9 I YSTEST="" S YSDATA(1)="[ERROR]",YSDATA(2)="NO code" Q ;-->out
10 S YSTESTN=$O(^YTT(601.71,"B",YSTEST,0))
11 I YSTESTN'>0 S YSDATA(1)="[ERROR]",YSDATA(2)="bad code" Q ;-->out
12 S YSDATA(1)="[DATA]"
13 S N1=1
14 I '$D(^YTT(601.83,"C",YSTESTN)) S YSDATA(2)="No Rules" Q ;--> out
15 S N=0 F S N=$O(^YTT(601.83,"C",YSTESTN,N)) Q:N'>0 D
16 . S YSRID=$P(^YTT(601.83,N,0),U,4)
17 . S G=$G(^YTT(601.82,YSRID,0)) Q:G="" ;-->cross bad 83 vs 82
18 . S G1=$G(^YTT(601.82,YSRID,1)),G2=$G(^YTT(601.82,YSRID,2))
19 . S YSQID=$P(G,U,2) S:YSQID="" YSQID=0
20 . S YSBOOL=$P(G,U,6) S:YSBOOL="" YSBOOL=0
21 . S N1=N1+1
22 . S Z(YSQID,YSBOOL,N1,1)=$P(G,U)_"="_$P(G,U,2)_U_$P(G,U,4)_U_$P(G,U,5)_U_$P(G,U,3)_U_$P(G,U,6)_U_$P(G,U,7)
23 . S Z(YSQID,YSBOOL,N1,2)=$P(G1,U,2)_U_$P(G1,U,3)_U_$P(G1,U)
24 . S Z(YSQID,YSBOOL,N1,3)=$P(G2,U)_U_$S($P(G2,U,2)="Y":"YES",$P(G2,U,2)="N":"NO",1:"")
25 S N2=1
26 S YSQID=0 F S YSQID=$O(Z(YSQID)) Q:YSQID'>0 S YSBOOL="Z" F S YSBOOL=$O(Z(YSQID,YSBOOL),-1) Q:YSBOOL="" S N1=0 F S N1=$O(Z(YSQID,YSBOOL,N1)) Q:N1'>0 D
27 . S N2=N2+1,YSDATA(N2)=Z(YSQID,YSBOOL,N1,1)
28 . S N2=N2+1,YSDATA(N2)=Z(YSQID,YSBOOL,N1,2)
29 . S N2=N2+1,YSDATA(N2)=Z(YSQID,YSBOOL,N1,3)
30 Q
31EDAD(YSDATA,YS) ;Edit and Save Data
32 N YSSER,YSX,YSNN,YSRESULT,G,YSF,YSV,N,YSIEN,YSFILEN
33 K ^TMP("YSMHI",$J)
34 S YSFILEN=$G(YS("FILEN"))
35 S YSIEN=$G(YS("IEN"),"?+1")_","
36 I YSFILEN="" S YSDATA(1)="[ERROR]",YSDATA(2)="bad filen " Q ;-->out
37 S N=0 F S N=$O(YS(N)) Q:N'>0 D Q:$G(YSRESULT)="^"
38 . S G=YS(N)
39 . S YSF=$P(G,U),YSV=$P(G,U,2),YSX=$P(G,U,3)
40 . I '$D(^DD(YSFILEN,YSF)) S YSRESULT=1 Q
41 . I YSV="" S YSRESULT=1 Q
42 . S ^TMP("YSMHI",$J,YSFILEN,YSIEN,YSF)=YSV
43 . D:YSX'=1 VAL^DIE(YSFILEN,YSIEN,+YSF,"E",YSV,.YSRESULT)
44 . ;
45 I $G(YSRESULT)="^" S YSDATA(1)="[ERROR]",YSDATA(2)="Value for Field Not Valid^"_YSV_U_YSF Q ;--> out
46 D UPDATE^DIE("E","^TMP(""YSMHI"",$J)","YSNN","YSERR")
47 I $D(YSSER) S YSDATA(1)="[ERROR]",YSDATA(2)="Update Error" Q ;-->out
48 S YSDATA(1)="[DATA]",YSDATA(2)="Update ok^"_$G(YSNN(1))_U_$G(YSNN(1,0))
49 ;
50 Q
51WPED(YSDATA,YS) ;Replace WP field
52 ;INPUT: filen,ien,field,ys(1)...ys(x)= text
53 N YSF,N,YSIEN,YSERR,YSFILEN
54 K ^TMP("YSMHI",$J)
55 S YSFILEN=$G(YS("FILEN"))
56 I YSFILEN="" S YSDATA(1)="[ERROR]",YSDATA(2)="bad filen " Q ;-->out
57 S YSIEN=$G(YS("IEN"))
58 I YSIEN'?1N.N S YSDATA(1)="[ERROR]",YSDATA(2)="bad IEN " Q ;-->out
59 S YSIEN=YSIEN_","
60 S YSF=$G(YS("FIELD")) S X=$$VFIELD^DILFD(YSFILEN,YSF) I X=0 S YSDATA(1)="[ERROR]",YSDATA(2)="BAD FIELD #" Q ;-->out
61 S N=0 F S N=$O(YS(N)) Q:N'>0 D
62 . S ^TMP("YSMHI",$J,N)=$G(YS(N))
63 D WP^DIE(YSFILEN,YSIEN,YSF,,"^TMP(""YSMHI"",$J)","YSERR")
64 I $D(YSERR) S YSDATA(1)="[ERROR]",YSDATA(2)="very BAD Update Error" Q ;-->out
65 S YSDATA(1)="[DATA]",YSDATA(2)="ZZUpdate ok WP "_YSIEN
66 Q
67GETANS(YSDATA,YS) ;get an answer
68 ;AD = ADMINISTRATION #
69 ;QN= QUESTION #
70 N G,G1,N,YSAD,YSQN
71 S YSAD=$G(YS("AD"))
72 S YSQN=$G(YS("QN"))
73 I YSAD'?1N.N S YSDATA(1)="[ERROR]",YSDATA(2)="bad ad num" Q ;-->out
74 I YSQN'?1N.N S YSDATA(1)="[ERROR]",YSDATA(2)="bad quest num" Q ;-->out
75 I '$D(^YTT(601.85,"AC",YSAD,YSQN)) S YSDATA(1)="[ERROR]",YSDATA(2)="no such reference" Q ;-->out
76 S YSDATA(1)="[DATA]"
77 S G=0,N=1
78 S G=$O(^YTT(601.85,"AC",YSAD,YSQN,G)) Q:G'>0 S G1=0 D
79 . S:$P(^YTT(601.85,G,0),U,4)?1N.N N=N+1,YSDATA(N)=$P(^YTT(601.85,G,0),U,4) ;ASF 3/10/04 ***
80 . F S G1=$O(^YTT(601.85,G,1,G1)) Q:G1'>0 S N=N+1,YSDATA(N)=$G(^YTT(601.85,G,1,G1,0))
81 Q
82CAPIE(YSDATA,YS) ;
83 N N,N1,N2,YSFIELDS,YSFILEN,YSIENS,X
84 K ^TMP("YS",$J)
85 K ^TMP("YSDATA",$J) S YSDATA=$NA(^TMP("YSDATA",$J))
86 S ^TMP("YSDATA",$J,1)="[ERROR]"
87 S YSFILEN=$G(YS("FILEN"),0) I $$VFILE^DILFD(YSFILEN)<1 S ^TMP("YSDATA",$J,2)="BAD FILE N" Q ;--->out
88 S YSFIELDS=$G(YS("FIELDS"),"")
89 S:YSFIELDS="*" YSFIELDS="**"
90 I YSFIELDS="**"&(YSFILEN=604) S YSFIELDS=".03:200"
91 I YSFIELDS?1N.N S N=$$VFIELD^DILFD(YSFILEN,YSFIELDS) I N<1 S ^TMP("YSDATA",$J,2)="BAD field" Q ;--> out
92 S YSIENS=$G(YS("IENS")) I YSIENS'?1N.N S ^TMP("YSDATA",$J,2)="BAD IENS" Q ;-->out
93 S YSIENS=YSIENS_","
94 D GETS^DIQ(YSFILEN,YSIENS,YSFIELDS,"IE","^TMP(""YS"",$J")
95 S N=1,^TMP("YSDATA",$J,1)="[DATA]"
96 S N1=0 F S N1=$O(^TMP("YS",$J,YSFILEN,YSIENS,N1)) Q:N1'>0 D
97 . S N2=0 F S N2=$O(^TMP("YS",$J,YSFILEN,YSIENS,N1,N2)) Q:N2'>0 S N=N+1,^TMP("YSDATA",$J,N)=N1_";"_N2_U_$$GET1^DID(YSFILEN,N1,"","LABEL")_U_^TMP("YS",$J,YSFILEN,YSIENS,N1,N2)
98 . I ^TMP("YS",$J,YSFILEN,YSIENS,N1,"I")'?1"^TMP(".E S N=N+1,^TMP("YSDATA",$J,N)=N1_U_$$GET1^DID(YSFILEN,N1,"","LABEL")_U_$G(^TMP("YS",$J,YSFILEN,YSIENS,N1,"I"))
99 . S:(^TMP("YS",$J,YSFILEN,YSIENS,N1,"E")'=^TMP("YS",$J,YSFILEN,YSIENS,N1,"I")) ^TMP("YSDATA",$J,N)=^TMP("YSDATA",$J,N)_U_^TMP("YS",$J,YSFILEN,YSIENS,N1,"E")
100 K ^TMP("YS",$J)
101 Q
Note: See TracBrowser for help on using the repository browser.