source: FOIAVistA/tag/r/MENTAL_HEALTH-YS-RUCL-YI-YT/YTQAPI2.m@ 636

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

initial load of FOIAVistA 6/30/08 version
File size: 4.5 KB
Line 
1YTQAPI2 ;ASF/ALB- MHAX REMOTE PROCEDURES cont ;6/10/03 10:19am ; 4/3/07 11:41am
2 ;;5.01;MENTAL HEALTH;**85**;Dec 30, 1994;Build 48
3 Q
4LISTER(YSDATA,YS) ;list entries
5 ;input: CODE as test name
6 ;output: Field^Value
7 N YSFIELD,YSFILEN,N,C,YSNUMBER,YSFLAG,YSFROM,YSINDEX
8 S YSFILEN=$G(YS("FILEN"),0) S X=$$VFILE^DILFD(YSFILEN) I X=0 S YSDATA(1)="[ERROR]",YSDATA(2)="BAD FILE N" Q ;--->out
9 S YSFIELD=$G(YS("FIELD"),0) S X=$$VFIELD^DILFD(YSFILEN,YSFIELD) I X=0 S YSDATA(1)="[ERROR]",YSDATA(2)="BAD FIELD N" Q ;--->out
10 S YSFLAG=$G(YS("FLAG"))
11 S YSNUMBER=$G(YS("NUMBER"),500)
12 S YSFROM("IEN")=$G(YS("FROM"))
13 S YSINDEX=$G(YS("INDEX"))
14 D LIST^DIC(YSFILEN,,YSFIELD,YSFLAG,YSNUMBER,.YSFROM,,YSINDEX)
15 I $D(^TMP("DIERR",$J)) S YSDATA(1)="[ERROR]",YSDATA(2)=$G(^TMP("DIERR",$J,1,"TEXT",1)) Q ;--> out
16 S YSDATA(1)="[DATA]"
17 S YSDATA(2)=^TMP("DILIST",$J,0)
18 S C=2,N=0
19 F S N=$O(^TMP("DILIST",$J,2,N)) Q:N'>0 D
20 . S C=C+1
21 . S YSDATA(C)=^TMP("DILIST",$J,2,N)_U_$G(^TMP("DILIST",$J,"ID",N,YSFIELD))
22 K ^TMP("DILIST",$J)
23 Q
24ALLANS(YSDATA,YS) ;get all answers
25 ;input:AD = ADMINISTRATION #
26 ;output: [DATA]
27 ; ADMIN ID^DFN^INSTRUMENT^DATE GIVEN^IS COMPLETE
28 ;QUESTION #^seq^ANSWER
29 N G,G1,N,YSAD,YSQN
30 S YSAD=$G(YS("AD"))
31 I YSAD'?1N.N S YSDATA(1)="[ERROR]",YSDATA(2)="bad ad num" Q ;-->out
32 I '$D(^YTT(601.85,"AC",YSAD)) S YSDATA(1)="[ERROR]",YSDATA(2)="no such reference" Q ;-->out
33 S YSDATA(1)="[DATA]"
34 S YSDATA(2)=YSAD_U_$$GET1^DIQ(601.84,YSAD_",",1,"I")_U_$$GET1^DIQ(601.84,YSAD_",",2,"E")_U_$$GET1^DIQ(601.84,YSAD_",",3,"I")_U_$$GET1^DIQ(601.84,YSAD_",",8,"I")
35 S YSQN=0,N=2
36 F S YSQN=$O(^YTT(601.85,"AC",YSAD,YSQN)) Q:YSQN'>0 S G=0 D
37 . S G=$O(^YTT(601.85,"AC",YSAD,YSQN,G)) Q:G'>0 S G1=0 D
38 .. S:$P(^YTT(601.85,G,0),U,4)?1N.N N=N+1,YSDATA(N)=YSQN_"^1^"_$P(^YTT(601.85,G,0),U,4)
39 .. F S G1=$O(^YTT(601.85,G,1,G1)) Q:G1'>0 S N=N+1,YSDATA(N)=YSQN_U_G1_U_$G(^YTT(601.85,G,1,G1,0))
40 Q
41SETANS(YSDATA,YS) ;save an answer
42 ;input: AD = ADMINISTRATION #
43 ;input: QN= QUESTION #
44 ;input: CHOICE= Choice ID [optional]
45 ;input: YS(1) thru YS(N) WP entries
46 ;output: [DATA] vs [ERROR]
47 N G,G1,N,N1,YSIENS,YSAD,YSQN,YSCI,YSCODE,YSOP
48 S YSDATA(1)="[ERROR]"
49 S YSAD=$G(YS("AD"))
50 S YSQN=$G(YS("QN"))
51 S YSCI=$G(YS("CHOICE"))
52 I YSAD'?1N.N S YSDATA(2)="bad ad num" Q ;-->out
53 I YSQN'?1N.N S YSDATA(2)="bad quest num" Q ;-->out
54 I $D(^YTT(601.85,"AC",YSAD,YSQN)) S YSIENS=$O(^YTT(601.85,"AC",YSAD,YSQN,0))
55 I '$D(^YTT(601.85,"AC",YSAD,YSQN)) D ; set new entry
56 . S YSIENS=""
57 . S YSIENS=$$NEW^YTQLIB(601.85)
58 . Q:YSIENS'?1N.N
59 . L +^YTT(601.85,YSIENS)
60 . S ^YTT(601.85,YSIENS,0)=YSIENS_U_YSAD_U_YSQN
61 . L -^YTT(601.85,YSIENS)
62 . S ^YTT(601.85,0)="MH ANSWERS^601.85^"_YSIENS_U_($P(^YTT(601.85,0),U,4)+1)
63 . S ^YTT(601.85,"B",YSIENS,YSIENS)=""
64 . S ^YTT(601.85,"AC",YSAD,YSQN,YSIENS)=""
65 . S ^YTT(601.85,"AD",YSAD,YSIENS)=""
66 ;enter or delete Answers
67 S $P(^YTT(601.85,YSIENS,0),U,4)=YSCI
68 K ^YTT(601.85,YSIENS,1)
69 S N=0,N1=0
70 F S N=$O(YS(N)) Q:N'>0 S N1=N1+1,^YTT(601.85,YSIENS,1,N1,0)=YS(N)
71 S:N1 ^YTT(601.85,YSIENS,1,0)=U_U_N1_U_N1_U_DT_U
72 S YSDATA(1)="[DATA]",YSDATA(2)="OK"
73 ;set has been operational
74 S YSCODE=$P(^YTT(601.84,YSAD,0),U,3)
75 S YSOP=$P($G(^YTT(601.71,YSCODE,2)),U,2)
76 S:YSOP="Y" $P(^YTT(601.71,YSCODE,2),U,5)="Y"
77 Q
78ADMINS(YSDATA,YS) ;administration retrevial
79 ;input : DFN
80 ;output:AdministrationID=InstrumentName^DateGiven^DateSaved^OrderedBy^AdministeredBy^Signed^IsComplete^NumberOfQuestionsAnswered
81 N N,G,DFN,YSIENS
82 S DFN=$G(YS("DFN"))
83 I DFN'?1N.N S YSDATA(1)="[ERROR]",YSDATA(2)="bad DFN" Q ;-->out
84 I '$D(^DPT(DFN,0)) S YSDATA(1)="[ERROR]",YSDATA(2)="nO pt" Q ;-->out
85 S YSIENS=0,N=2
86 S YSDATA(1)="[DATA]"
87 F S YSIENS=$O(^YTT(601.84,"C",DFN,YSIENS)) Q:YSIENS'>0 D
88 . S N=N+1
89 . S G=$G(^YTT(601.84,YSIENS,0))
90 . I G="" S YSDATA(1)="[ERROR]",YSDATA(2)=YSIENS_" bad ien in 84" Q ;-->out
91 . S YSDATA(N)=YSIENS_"="_$$GET1^DIQ(601.84,YSIENS_",",2)_U_$P(G,U,4)_U_$P(G,U,5)
92 . S YSDATA(N)=YSDATA(N)_U_$$GET1^DIQ(601.84,YSIENS_",",5,"I")_U_$$GET1^DIQ(601.84,YSIENS_",",6,"I")
93 . S YSDATA(N)=YSDATA(N)_U_$$GET1^DIQ(601.84,YSIENS_",",7)_U_$$GET1^DIQ(601.84,YSIENS_",",8)_U_$$GET1^DIQ(601.84,YSIENS_",",9)
94 S:YSDATA(1)="[DATA]" YSDATA(2)=(N-2)_" administrations"
95 Q
96CCALL(YSDATA) ;
97 ;all choices returned
98 ;output: 601.75(1) CHOICETYPE ID^SEQUENCE^CHOICE IFN^CHOICE TEXT
99 N YSTESTN,YSTEST,YSF,YSV,N,G,YSCTYP,YSCTYPID,G,G1,X,YSCDA,YSN,YSN1
100 S YSN=0,N=1
101 S YSDATA(1)="[DATA]"
102 F S YSN=$O(^YTT(601.751,YSN)) Q:YSN'>0 D
103 . S YSN1=0 F S YSN1=$O(^YTT(601.751,"AC",YSN,YSN1)) Q:YSN1'>0 D
104 .. S YSCDA=0 F S YSCDA=$O(^YTT(601.751,"AC",YSN,YSN1,YSCDA)) Q:YSCDA'>0 D
105 ... S N=N+1
106 ... S YSDATA(N)=YSN_U_YSN1_U_YSCDA_U_$G(^YTT(601.75,YSCDA,1))
107 Q
Note: See TracBrowser for help on using the repository browser.