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

YTAPI9.m

Go to the documentation of this file.
YTAPI9 ;ASF/ALB- ASI PROCEDURES ;1/30/02  12:57
 ;;5.01;MENTAL HEALTH;**71**;Dec 30, 1994
 Q
SNDBUL(YSDATA,YS) ;send message to psych test ordering clinician
 N I,XMB,YSORD,YSDFN,Y,YSDT
 S YSDFN=$G(YS("DFN")) I YSDFN="" S YSDATA(1)="[ERROR]",YSDATA(2)="NO DFN" Q  ;--> out
 S YSORD=$G(YS("ORD")) I YSORD="" S YSDATA(1)="[ERROR]",YSDATA(2)="NO ORD" Q  ;--> out
 F I=6:1:15 S XMB(I)=$G(YS("TEST"_(I-5)))
 I XMB(6)="" S YSDATA(1)="[ERROR]",YSDATA(2)="no tests" Q  ;--> out
 S Y=DT X ^DD("DD") S YSDT(1)=Y
 D ENBUL^YSUTL
 S YSDATA(1)="[DATA]",YSDATA(2)="OK"
 Q
CLERK(YSDATA,YS) ; get responses
 N YSITEM,YSQ,YSET,YSCODE
 S YSCODE=$G(YS("CODE")) I YSCODE="" S YSDATA(1)="[ERROR]",YSDATA(2)="no code" Q  ;-->out
 S YSET=$O(^YTT(601,"B",YSCODE,0)) IF YSET'>0 S YSDATA(1)="[ERROR]",YSDATA(2)="bad code" Q  ;--> out
 S YSQ=1
 S YSITEM=0
 F  S YSITEM=$O(^YTT(601,YSET,"Q",YSITEM)) Q:YSITEM'>0  D RESP^YTAPI6
 M YSDATA=^TMP($J,"YSDATA")
 S YSDATA(1)="[DATA]"
 Q
SAVASI(YSDATA,YS) ;
 N RESULT,YSCK,G,YSF,YSV,N,YSIEN
 S YSCK=0
 S YSIEN=YS("YSIEN")
 S N=0 F  S N=$O(YS(N)) Q:N'>0  D  Q:YSCK
 . S G=YS(N)
 . S YSF=$P(G,U),YSV=$P(G,U,2)
 . I YSF=".02"&YSV'?1N.N S YSCK=1 Q
 . I YSF=".09"&YSV'?1N.N S YSCK=1 Q
 . I YSF=".81"&YSV'?1N.N S YSCK=1 Q  ;ASF 1/30/02
 . D:(YSF'=".02")&(YSF'=".09")&(YSF'=".81") CHK^DIE(604,YSF,"",YSV,.RESULT) ;ASF 1/30/02
 . I $G(RESULT)="^" S YSCK=1 Q
 . S ^TMP("YSASI",$J,604,YSIEN,YSF)=$S(YSF=".02":YSV,YSF=".09":YSV,YSF=".81":YSV,1:RESULT) ;ASF 1/30/02
 . Q
 I YSCK S YSDATA(1)="[ERROR]",YSDATA(2)="BAD FIELD "_YSF_": "_YSV Q  ;-->out
 D FILE^DIE("K","^TMP(""YSASI"",$J)","YSERR")
 S YSDATA(1)="[DATA]",YSDATA(2)="OK ASI SAVE "_YSIEN
 Q
ASIPN(YSDATA,YS) ;save narrative progress note
 N YSTIUT,YSTIUTS,YSAUTOSG,YSASDA
 S YSTIUT=0,YSTIUTS=0 D ASTIT^YSASPNT
 I (YSTIUT'>0)!(YSTIUTS'?1"ACT".E) S YSDATA(1)="[ERROR]",YSDATA(2)="ASI-TIU not fully ready" Q  ;-->out
 S YSASDA=$G(YS("YSIEN"))
 I YSASDA="" S YSDATA(1)="[ERROR]",YSDATA(2)="BAD ASI IEN" Q  ;-->out
 D NARSET^YSASPNT
PUTPN ;create Pnote
 D NEW^TIUPNAPI(.YSPIFN,DFN,YSASAUTH,YSNOW,YSTIUT,"","","","","") ;YSAUTOSG,TIUASKVS)
 S YSDATA(1)=$S(+YSPIFN:"[DATA]",1:"[ERROR]")
 S YSDATA(2)=$S(+YSPIFN:"OK Progress Note created",1:"No Pnote entered")
 Q
BATT(YSDATA) ;get battery
 N I,J,N,YSN,G,T
 S YSDATA(1)="[DATA]"
 S J=1
 S N=0 F  S N=$O(^YTT(601,N)) Q:N'>0  D
 . S G=^YTT(601,N,0),T=$P(G,U,9)
 . Q:T'="B"
 . S A=$G(^YTT(601,N,"A")),A=$E(A,14,$L(A)-2)
 . D:+A
 .. S J=J+1,YSDATA(J)=$P(G,U)
 .. F I=1:1 S YSN=$P(A,U,I) Q:YSN=""  S YSDATA(J)=YSDATA(J)_U_$P(^YTT(601,YSN,0),U)
 Q