- 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 Feb 18, 2025@23:43:12 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