YTAR2 ;SLC/TGA-SAVE DISCONTINUED TESTS; ;03/10/94 15:05
;;5.01;MENTAL HEALTH;;Dec 30, 1994
;
S YSTIN=1 D:'$D(YSCLERK) EN40^YTFILE
S ^YTD(601.4,YSDFN,1,YSENT,0)=YSENT_"^"_YSHD_"^"_$G(YSDTA)_"^"_J_"^"_$G(C)_"^"_$G(YSCL)_"^"_YSORD_"^"_$G(YSBEGIN),^YTD(601.4,YSDFN,1,"B",YSENT,YSENT)=""
I $D(B) S ^YTD(601.4,YSDFN,1,YSENT,"B")=B
I '$D(YSCLERK) S YSXT(0)=$P(YSXT,U,YSXTP+1,99) S:YSXT(0)]"" ^YTD(601.4,YSDFN,1,YSENT,"R")=YSXT(0)
S:J>0 ^YTD(601.4,YSDFN,1,YSENT,J+199\200)=YSRP
I $D(YSCLERK) S ^YTD(601.4,YSDFN,1,"AC",YSCL,YSCLERK)=""
;
; 3/10/94 LJA Following line added...
I YSTESTN="MMPR" S ^YTD(601.4,+YSDFN,1,+YSENT,99)="MMPIR"
;
L W !!?2,"SESSION INTERRUPTED" S:'$D(YSCLERK) XMB(YSXTP+5)=$P(YSXT,U,YSXTP)_"*" S XMB(5)="(""*"" indicates not completed)"
I YSQ S YSXT="" I '$D(YSCLERK) F K=6:1 Q:'$D(XMB(K)) Q:(XMB(K)["*") S:$P(^YTT(601,XMB(K),0),U,9)'="B" YSXT=YSXT_YSHD_","_XMB(K)_"^"
I YSQ,YSXT]"" S YSXTP=1,ZTRTN="RP1^YTDP",ZTSAVE("YS*")="",ZTDTH=$H,ZTDESC="YS MH DISC INST" D ^%ZTLOAD W !,"REQUEST QUEUED!"
I DUZ'=YSORD,$D(YSCLERK) S XMB(6)="CLERK-"_YSCLN_"*"
E I DUZ'=YSORD F K=6:1 Q:'$D(XMB(K)) S XMB(K)=$P(^YTT(601,+XMB(K),0),U)_$S(XMB(K)["*":"*",1:"")
I DUZ'=YSORD D ENBUL^YSUTL
G KAR^YTS:$D(YSCL),H^XUS:'$D(YSM) Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYTAR2 1265 printed Nov 22, 2024@17:26:59 Page 2
YTAR2 ;SLC/TGA-SAVE DISCONTINUED TESTS; ;03/10/94 15:05
+1 ;;5.01;MENTAL HEALTH;;Dec 30, 1994
+2 ;
+3 SET YSTIN=1
if '$DATA(YSCLERK)
DO EN40^YTFILE
+4 SET ^YTD(601.4,YSDFN,1,YSENT,0)=YSENT_"^"_YSHD_"^"_$GET(YSDTA)_"^"_J_"^"_$GET(C)_"^"_$GET(YSCL)_"^"_YSORD_"^"_$GET(YSBEGIN)
SET ^YTD(601.4,YSDFN,1,"B",YSENT,YSENT)=""
+5 IF $DATA(B)
SET ^YTD(601.4,YSDFN,1,YSENT,"B")=B
+6 IF '$DATA(YSCLERK)
SET YSXT(0)=$PIECE(YSXT,U,YSXTP+1,99)
if YSXT(0)]""
SET ^YTD(601.4,YSDFN,1,YSENT,"R")=YSXT(0)
+7 if J>0
SET ^YTD(601.4,YSDFN,1,YSENT,J+199\200)=YSRP
+8 IF $DATA(YSCLERK)
SET ^YTD(601.4,YSDFN,1,"AC",YSCL,YSCLERK)=""
+9 ;
+10 ; 3/10/94 LJA Following line added...
+11 IF YSTESTN="MMPR"
SET ^YTD(601.4,+YSDFN,1,+YSENT,99)="MMPIR"
+12 ;
+13 LOCK
WRITE !!?2,"SESSION INTERRUPTED"
if '$DATA(YSCLERK)
SET XMB(YSXTP+5)=$PIECE(YSXT,U,YSXTP)_"*"
SET XMB(5)="(""*"" indicates not completed)"
+14 IF YSQ
SET YSXT=""
IF '$DATA(YSCLERK)
FOR K=6:1
if '$DATA(XMB(K))
QUIT
if (XMB(K)["*")
QUIT
if $PIECE(^YTT(601,XMB(K),0),U,9)'="B"
SET YSXT=YSXT_YSHD_","_XMB(K)_"^"
+15 IF YSQ
IF YSXT]""
SET YSXTP=1
SET ZTRTN="RP1^YTDP"
SET ZTSAVE("YS*")=""
SET ZTDTH=$HOROLOG
SET ZTDESC="YS MH DISC INST"
DO ^%ZTLOAD
WRITE !,"REQUEST QUEUED!"
+16 IF DUZ'=YSORD
IF $DATA(YSCLERK)
SET XMB(6)="CLERK-"_YSCLN_"*"
+17 IF '$TEST
IF DUZ'=YSORD
FOR K=6:1
if '$DATA(XMB(K))
QUIT
SET XMB(K)=$PIECE(^YTT(601,+XMB(K),0),U)_$SELECT(XMB(K)["*":"*",1:"")
+18 IF DUZ'=YSORD
DO ENBUL^YSUTL
+19 if $DATA(YSCL)
GOTO KAR^YTS
if '$DATA(YSM)
GOTO H^XUS
QUIT
