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