YTAR2.m

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 ---YTAR2   1265     printed  Apr 09, 2024@21:20:39                                                                                                                                                                                                       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