YTAPI4 ;ALB/ASF PSYCH TEST API PNOTES ;3/13/00 16:28
;;5.01;MENTAL HEALTH;**62**;Dec 30, 1994
Q
PNTEXT(YSDATA,YS) ;
Q
PREVIEW(YSDATA,YS) ;
N DA,DIK,DFN,YSNCODE,YSCODE,YSADATE
K ^TMP($J,"YTAPI4")
D PARSE^YTAPI(.YS)
I '$D(^DPT(DFN,0)) S YSDATA(1)="[ERROR]",YSDATA(2)="no such pt" Q
I '$D(^YTT(601,"B",YSCODE)) S YSDATA(1)="[ERROR]",YSDATA(2)="INCORRECT TEST CODE" Q ;---> bad code
S YSNCODE=$O(^YTT(601,"B",YSCODE,-1))
I YSADATE'=DT S YSDATA(1)="[ERROR]",YSDATA(2)="bad date needs DT" Q ;---> bad date
L +^YTD(601.2,DFN,1,YSNCODE,1,YSADATE):1 I '$T S YSDATA(1)="[ERROR]",YSDATA(2)="no lock" Q ;--->
D:$D(^YTD(601.2,DFN,1,YSNCODE,1,YSADATE)) INTMP ;save old testing for a day
;
D SAVEIT^YTAPI1(.YSDATA,.YS) ; save responses
I YSDATA(1)?1"[ERROR".E L -^YTD(601.2,DFN,1,YSNCODE,1,YSADATE) Q ;---> bad save
;
D SCOREIT^YTAPI2(.YSDATA,.YS)
DROP ;kill preview data
S DIK="^YTD(601.2,DFN,1,YSNCODE,1,",DA=YSADATE,DA(1)=YSNCODE,DA(2)=DFN D ^DIK
;
D:$D(^TMP($J,"YTAPI4")) OUTTMP ;place back old testing
S DIK="^YTD(601.2,",DA=DFN D IX^DIK ; reindex
L -^YTD(601.2,DFN,1,YSNCODE,1,YSADATE)
Q
INTMP ; SAVE OLD
M ^TMP($J,"YTAPI4")=^YTD(601.2,DFN,1,YSNCODE,1,YSADATE)
Q
OUTTMP ;replace old testing
M ^YTD(601.2,DFN,1,YSNCODE,1,YSADATE)=^TMP($J,"YTAPI4")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYTAPI4 1305 printed Oct 16, 2024@18:17:32 Page 2
YTAPI4 ;ALB/ASF PSYCH TEST API PNOTES ;3/13/00 16:28
+1 ;;5.01;MENTAL HEALTH;**62**;Dec 30, 1994
+2 QUIT
PNTEXT(YSDATA,YS) ;
+1 QUIT
PREVIEW(YSDATA,YS) ;
+1 NEW DA,DIK,DFN,YSNCODE,YSCODE,YSADATE
+2 KILL ^TMP($JOB,"YTAPI4")
+3 DO PARSE^YTAPI(.YS)
+4 IF '$DATA(^DPT(DFN,0))
SET YSDATA(1)="[ERROR]"
SET YSDATA(2)="no such pt"
QUIT
+5 ;---> bad code
IF '$DATA(^YTT(601,"B",YSCODE))
SET YSDATA(1)="[ERROR]"
SET YSDATA(2)="INCORRECT TEST CODE"
QUIT
+6 SET YSNCODE=$ORDER(^YTT(601,"B",YSCODE,-1))
+7 ;---> bad date
IF YSADATE'=DT
SET YSDATA(1)="[ERROR]"
SET YSDATA(2)="bad date needs DT"
QUIT
+8 ;--->
LOCK +^YTD(601.2,DFN,1,YSNCODE,1,YSADATE):1
IF '$TEST
SET YSDATA(1)="[ERROR]"
SET YSDATA(2)="no lock"
QUIT
+9 ;save old testing for a day
if $DATA(^YTD(601.2,DFN,1,YSNCODE,1,YSADATE))
DO INTMP
+10 ;
+11 ; save responses
DO SAVEIT^YTAPI1(.YSDATA,.YS)
+12 ;---> bad save
IF YSDATA(1)?1"[ERROR".E
LOCK -^YTD(601.2,DFN,1,YSNCODE,1,YSADATE)
QUIT
+13 ;
+14 DO SCOREIT^YTAPI2(.YSDATA,.YS)
DROP ;kill preview data
+1 SET DIK="^YTD(601.2,DFN,1,YSNCODE,1,"
SET DA=YSADATE
SET DA(1)=YSNCODE
SET DA(2)=DFN
DO ^DIK
+2 ;
+3 ;place back old testing
if $DATA(^TMP($JOB,"YTAPI4"))
DO OUTTMP
+4 ; reindex
SET DIK="^YTD(601.2,"
SET DA=DFN
DO IX^DIK
+5 LOCK -^YTD(601.2,DFN,1,YSNCODE,1,YSADATE)
+6 QUIT
INTMP ; SAVE OLD
+1 MERGE ^TMP($JOB,"YTAPI4")=^YTD(601.2,DFN,1,YSNCODE,1,YSADATE)
+2 QUIT
OUTTMP ;replace old testing
+1 MERGE ^YTD(601.2,DFN,1,YSNCODE,1,YSADATE)=^TMP($JOB,"YTAPI4")
+2 QUIT
