- 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 Mar 13, 2025@21:21:48 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
