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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYTAPI9 2609 printed Dec 13, 2024@02:16:54 Page 2
YTAPI9 ;ASF/ALB- ASI PROCEDURES ;1/30/02 12:57
+1 ;;5.01;MENTAL HEALTH;**71**;Dec 30, 1994
+2 QUIT
SNDBUL(YSDATA,YS) ;send message to psych test ordering clinician
+1 NEW I,XMB,YSORD,YSDFN,Y,YSDT
+2 ;--> out
SET YSDFN=$GET(YS("DFN"))
IF YSDFN=""
SET YSDATA(1)="[ERROR]"
SET YSDATA(2)="NO DFN"
QUIT
+3 ;--> out
SET YSORD=$GET(YS("ORD"))
IF YSORD=""
SET YSDATA(1)="[ERROR]"
SET YSDATA(2)="NO ORD"
QUIT
+4 FOR I=6:1:15
SET XMB(I)=$GET(YS("TEST"_(I-5)))
+5 ;--> out
IF XMB(6)=""
SET YSDATA(1)="[ERROR]"
SET YSDATA(2)="no tests"
QUIT
+6 SET Y=DT
XECUTE ^DD("DD")
SET YSDT(1)=Y
+7 DO ENBUL^YSUTL
+8 SET YSDATA(1)="[DATA]"
SET YSDATA(2)="OK"
+9 QUIT
CLERK(YSDATA,YS) ; get responses
+1 NEW YSITEM,YSQ,YSET,YSCODE
+2 ;-->out
SET YSCODE=$GET(YS("CODE"))
IF YSCODE=""
SET YSDATA(1)="[ERROR]"
SET YSDATA(2)="no code"
QUIT
+3 ;--> out
SET YSET=$ORDER(^YTT(601,"B",YSCODE,0))
IF YSET'>0
SET YSDATA(1)="[ERROR]"
SET YSDATA(2)="bad code"
QUIT
+4 SET YSQ=1
+5 SET YSITEM=0
+6 FOR
SET YSITEM=$ORDER(^YTT(601,YSET,"Q",YSITEM))
if YSITEM'>0
QUIT
DO RESP^YTAPI6
+7 MERGE YSDATA=^TMP($JOB,"YSDATA")
+8 SET YSDATA(1)="[DATA]"
+9 QUIT
SAVASI(YSDATA,YS) ;
+1 NEW RESULT,YSCK,G,YSF,YSV,N,YSIEN
+2 SET YSCK=0
+3 SET YSIEN=YS("YSIEN")
+4 SET N=0
FOR
SET N=$ORDER(YS(N))
if N'>0
QUIT
Begin DoDot:1
+5 SET G=YS(N)
+6 SET YSF=$PIECE(G,U)
SET YSV=$PIECE(G,U,2)
+7 IF YSF=".02"&YSV'?1N.N
SET YSCK=1
QUIT
+8 IF YSF=".09"&YSV'?1N.N
SET YSCK=1
QUIT
+9 ;ASF 1/30/02
IF YSF=".81"&YSV'?1N.N
SET YSCK=1
QUIT
+10 ;ASF 1/30/02
if (YSF'=".02")&(YSF'=".09")&(YSF'=".81")
DO CHK^DIE(604,YSF,"",YSV,.RESULT)
+11 IF $GET(RESULT)="^"
SET YSCK=1
QUIT
+12 ;ASF 1/30/02
SET ^TMP("YSASI",$JOB,604,YSIEN,YSF)=$SELECT(YSF=".02":YSV,YSF=".09":YSV,YSF=".81":YSV,1:RESULT)
+13 QUIT
End DoDot:1
if YSCK
QUIT
+14 ;-->out
IF YSCK
SET YSDATA(1)="[ERROR]"
SET YSDATA(2)="BAD FIELD "_YSF_": "_YSV
QUIT
+15 DO FILE^DIE("K","^TMP(""YSASI"",$J)","YSERR")
+16 SET YSDATA(1)="[DATA]"
SET YSDATA(2)="OK ASI SAVE "_YSIEN
+17 QUIT
ASIPN(YSDATA,YS) ;save narrative progress note
+1 NEW YSTIUT,YSTIUTS,YSAUTOSG,YSASDA
+2 SET YSTIUT=0
SET YSTIUTS=0
DO ASTIT^YSASPNT
+3 ;-->out
IF (YSTIUT'>0)!(YSTIUTS'?1"ACT".E)
SET YSDATA(1)="[ERROR]"
SET YSDATA(2)="ASI-TIU not fully ready"
QUIT
+4 SET YSASDA=$GET(YS("YSIEN"))
+5 ;-->out
IF YSASDA=""
SET YSDATA(1)="[ERROR]"
SET YSDATA(2)="BAD ASI IEN"
QUIT
+6 DO NARSET^YSASPNT
PUTPN ;create Pnote
+1 ;YSAUTOSG,TIUASKVS)
DO NEW^TIUPNAPI(.YSPIFN,DFN,YSASAUTH,YSNOW,YSTIUT,"","","","","")
+2 SET YSDATA(1)=$SELECT(+YSPIFN:"[DATA]",1:"[ERROR]")
+3 SET YSDATA(2)=$SELECT(+YSPIFN:"OK Progress Note created",1:"No Pnote entered")
+4 QUIT
BATT(YSDATA) ;get battery
+1 NEW I,J,N,YSN,G,T
+2 SET YSDATA(1)="[DATA]"
+3 SET J=1
+4 SET N=0
FOR
SET N=$ORDER(^YTT(601,N))
if N'>0
QUIT
Begin DoDot:1
+5 SET G=^YTT(601,N,0)
SET T=$PIECE(G,U,9)
+6 if T'="B"
QUIT
+7 SET A=$GET(^YTT(601,N,"A"))
SET A=$EXTRACT(A,14,$LENGTH(A)-2)
+8 if +A
Begin DoDot:2
+9 SET J=J+1
SET YSDATA(J)=$PIECE(G,U)
+10 FOR I=1:1
SET YSN=$PIECE(A,U,I)
if YSN=""
QUIT
SET YSDATA(J)=YSDATA(J)_U_$PIECE(^YTT(601,YSN,0),U)
End DoDot:2
End DoDot:1
+11 QUIT
