source: WorldVistAEHR/trunk/r/MENTAL_HEALTH-YS-RUCL-YI-YT/YTAPI9.m@ 1093

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

initial load of WorldVistAEHR

File size: 2.5 KB
RevLine 
[613]1YTAPI9 ;ASF/ALB- ASI PROCEDURES ;1/30/02 12:57
2 ;;5.01;MENTAL HEALTH;**71**;Dec 30, 1994
3 Q
4SNDBUL(YSDATA,YS) ;send message to psych test ordering clinician
5 N I,XMB,YSORD,YSDFN,Y,YSDT
6 S YSDFN=$G(YS("DFN")) I YSDFN="" S YSDATA(1)="[ERROR]",YSDATA(2)="NO DFN" Q ;--> out
7 S YSORD=$G(YS("ORD")) I YSORD="" S YSDATA(1)="[ERROR]",YSDATA(2)="NO ORD" Q ;--> out
8 F I=6:1:15 S XMB(I)=$G(YS("TEST"_(I-5)))
9 I XMB(6)="" S YSDATA(1)="[ERROR]",YSDATA(2)="no tests" Q ;--> out
10 S Y=DT X ^DD("DD") S YSDT(1)=Y
11 D ENBUL^YSUTL
12 S YSDATA(1)="[DATA]",YSDATA(2)="OK"
13 Q
14CLERK(YSDATA,YS) ; get responses
15 N YSITEM,YSQ,YSET,YSCODE
16 S YSCODE=$G(YS("CODE")) I YSCODE="" S YSDATA(1)="[ERROR]",YSDATA(2)="no code" Q ;-->out
17 S YSET=$O(^YTT(601,"B",YSCODE,0)) IF YSET'>0 S YSDATA(1)="[ERROR]",YSDATA(2)="bad code" Q ;--> out
18 S YSQ=1
19 S YSITEM=0
20 F S YSITEM=$O(^YTT(601,YSET,"Q",YSITEM)) Q:YSITEM'>0 D RESP^YTAPI6
21 M YSDATA=^TMP($J,"YSDATA")
22 S YSDATA(1)="[DATA]"
23 Q
24SAVASI(YSDATA,YS) ;
25 N RESULT,YSCK,G,YSF,YSV,N,YSIEN
26 S YSCK=0
27 S YSIEN=YS("YSIEN")
28 S N=0 F S N=$O(YS(N)) Q:N'>0 D Q:YSCK
29 . S G=YS(N)
30 . S YSF=$P(G,U),YSV=$P(G,U,2)
31 . I YSF=".02"&YSV'?1N.N S YSCK=1 Q
32 . I YSF=".09"&YSV'?1N.N S YSCK=1 Q
33 . I YSF=".81"&YSV'?1N.N S YSCK=1 Q ;ASF 1/30/02
34 . D:(YSF'=".02")&(YSF'=".09")&(YSF'=".81") CHK^DIE(604,YSF,"",YSV,.RESULT) ;ASF 1/30/02
35 . I $G(RESULT)="^" S YSCK=1 Q
36 . S ^TMP("YSASI",$J,604,YSIEN,YSF)=$S(YSF=".02":YSV,YSF=".09":YSV,YSF=".81":YSV,1:RESULT) ;ASF 1/30/02
37 . Q
38 I YSCK S YSDATA(1)="[ERROR]",YSDATA(2)="BAD FIELD "_YSF_": "_YSV Q ;-->out
39 D FILE^DIE("K","^TMP(""YSASI"",$J)","YSERR")
40 S YSDATA(1)="[DATA]",YSDATA(2)="OK ASI SAVE "_YSIEN
41 Q
42ASIPN(YSDATA,YS) ;save narrative progress note
43 N YSTIUT,YSTIUTS,YSAUTOSG,YSASDA
44 S YSTIUT=0,YSTIUTS=0 D ASTIT^YSASPNT
45 I (YSTIUT'>0)!(YSTIUTS'?1"ACT".E) S YSDATA(1)="[ERROR]",YSDATA(2)="ASI-TIU not fully ready" Q ;-->out
46 S YSASDA=$G(YS("YSIEN"))
47 I YSASDA="" S YSDATA(1)="[ERROR]",YSDATA(2)="BAD ASI IEN" Q ;-->out
48 D NARSET^YSASPNT
49PUTPN ;create Pnote
50 D NEW^TIUPNAPI(.YSPIFN,DFN,YSASAUTH,YSNOW,YSTIUT,"","","","","") ;YSAUTOSG,TIUASKVS)
51 S YSDATA(1)=$S(+YSPIFN:"[DATA]",1:"[ERROR]")
52 S YSDATA(2)=$S(+YSPIFN:"OK Progress Note created",1:"No Pnote entered")
53 Q
54BATT(YSDATA) ;get battery
55 N I,J,N,YSN,G,T
56 S YSDATA(1)="[DATA]"
57 S J=1
58 S N=0 F S N=$O(^YTT(601,N)) Q:N'>0 D
59 . S G=^YTT(601,N,0),T=$P(G,U,9)
60 . Q:T'="B"
61 . S A=$G(^YTT(601,N,"A")),A=$E(A,14,$L(A)-2)
62 . D:+A
63 .. S J=J+1,YSDATA(J)=$P(G,U)
64 .. F I=1:1 S YSN=$P(A,U,I) Q:YSN="" S YSDATA(J)=YSDATA(J)_U_$P(^YTT(601,YSN,0),U)
65 Q
Note: See TracBrowser for help on using the repository browser.