source: WorldVistAEHR/trunk/r/MENTAL_HEALTH-YS-RUCL-YI-YT/YTAR2.m@ 1800

Last change on this file since 1800 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.2 KB
Line 
1YTAR2 ;SLC/TGA-SAVE DISCONTINUED TESTS; ;03/10/94 15:05
2 ;;5.01;MENTAL HEALTH;;Dec 30, 1994
3 ;
4 S YSTIN=1 D:'$D(YSCLERK) EN40^YTFILE
5 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)=""
6 I $D(B) S ^YTD(601.4,YSDFN,1,YSENT,"B")=B
7 I '$D(YSCLERK) S YSXT(0)=$P(YSXT,U,YSXTP+1,99) S:YSXT(0)]"" ^YTD(601.4,YSDFN,1,YSENT,"R")=YSXT(0)
8 S:J>0 ^YTD(601.4,YSDFN,1,YSENT,J+199\200)=YSRP
9 I $D(YSCLERK) S ^YTD(601.4,YSDFN,1,"AC",YSCL,YSCLERK)=""
10 ;
11 ; 3/10/94 LJA Following line added...
12 I YSTESTN="MMPR" S ^YTD(601.4,+YSDFN,1,+YSENT,99)="MMPIR"
13 ;
14 L W !!?2,"SESSION INTERRUPTED" S:'$D(YSCLERK) XMB(YSXTP+5)=$P(YSXT,U,YSXTP)_"*" S XMB(5)="(""*"" indicates not completed)"
15 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)_"^"
16 I YSQ,YSXT]"" S YSXTP=1,ZTRTN="RP1^YTDP",ZTSAVE("YS*")="",ZTDTH=$H,ZTDESC="YS MH DISC INST" D ^%ZTLOAD W !,"REQUEST QUEUED!"
17 I DUZ'=YSORD,$D(YSCLERK) S XMB(6)="CLERK-"_YSCLN_"*"
18 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:"")
19 I DUZ'=YSORD D ENBUL^YSUTL
20 G KAR^YTS:$D(YSCL),H^XUS:'$D(YSM) Q
Note: See TracBrowser for help on using the repository browser.