YTCLERK1 ;SLC/DJP-CONTINUATION OF ^YTCLERK; ;5/30/02 15:06
;;5.01;MENTAL HEALTH;**10,19,76**;Dec 30, 1994
A31 ;
S YSQ=0,YSOK=1 R !!?3,"Queue to print when test(s)/interview(s) completed? Y// ",A:DTIME S YSTOUT='$T,YSUOUT=A["^" I YSTOUT!YSUOUT S YSOK=-1 Q
S A=$TR($E(A_"Y"),"yn","YN") I A="Y" S YSQ=1 G QUE
Q:A="N" W !!?3,"Queing will send tests results to the selected printer as soon as it",!?3,"is available." G A31
QUE ;
W ! K ION S IOP="Q" D ^%ZIS I POP S YSOK=-1 Q
I '$D(ION) W !,"IMPROPERLY DEFINED DEVICE!",$C(7) G QUE
I IO=IO(0),IOST'?1"P".E W !,"YOU MUST QUEUE TO A PRINTER!",$C(7) G QUE
Q
ZAP ;
W !!,"Do you want to delete ",YSTESTN," now" S %=2 D YN^DICN G:%=0 ZAP1 G:%'=1 KAR^YTS D ENKIL^YTFILE W !!,YSTESTN," DELETED!" D 1^YTCLERK Q
ZAP1 W !!,"By entering ""Y"", the test will be deleted from the patient's file.",! G ZAP
Q
REMMPR ;
R !,"SHORT FORM" S %=1 D YN^DICN
;
; Yes... Administer the MMRP-Short.
I %=1 K % Q
;
; No... Administer the MMPR-Long.
I %=2 D G REN ;->
. W !! F YSI=0:1:5 W !,$P($T(YSM+YSI),";;",2,99)
. W !!
. H 2
;
; Must've up-arrowed out...
I %=-1 S YSTIN=1 K % Q
;
; User asked for help...
I %=0 W !!,"If the short form (MMPR) is not used, the long form (MMPI) will be substituted.",! K % G REMMPR
;
;
YSM ;clerk entered long form message
;;Please clerk-enter all items in MMPR order. After the
;;test has been completely clerk entered, the computer will
;;re-order the items and save them in MMPI order. On the
;;test results printout, the items will appear in MMPI order.
;
REN ;
; Administering the MMPI... ien#60
S YSTEST=60,YSNQ=566,YSTF=1 Q
RESTART ;
; Called from RESTART and from YTCLERK
; 3/11/94 LJA
S YSTESTN=$P(^YTT(601,YSTEST,0),U)
I +YSTEST=60 D ;MMPI OR MMPR-LONG?
. I $G(^YTD(601.4,+YSDFN,1,14,99))="MMPIR" S YSTESTN="MMPIR"
W !,"Restart ",YSTESTN," now" S %=1 D YN^DICN G GOT:%=1,KAR^YTS:%<0
I %=0 W !,"Test will restart at question interrupted." G RESTART
W !!,YSTESTN," must be completed or deleted prior to administering another test." G ZAP
GOT ;
D A31 G KAR^YTS:YSOK<1
S YSXTP=1,YSXT=YSTEST,J=+$P(^YTD(601.4,YSDFN,1,YSENT,0),U,4),C=$P(^(0),U,5),YSDTA=$P(^(0),U,3),YSORD=$P(^(0),U,7) S:J<1 J=1
S B=$G(^YTD(601.4,YSDFN,1,YSENT,"B")),YSRP=$S(J#200=1:"",1:^(J+199\200)),B1=$S(B?1"W ".PN1"ANSWER".E:0,1:1)
I YSTESTN?1"MCMI"1N S YSNQ=$P(^YTT(601,YSTEST,"Q",0),U,3) ;ASF 5/30/02
E S YSNQ=$P(^YTT(601,YSTEST,0),U,11)
S YSCL=YSTEST,YSCLN=YSTESTN,R1=1 W !! G ENX^YTCLERK
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYTCLERK1 2544 printed Sep 23, 2025@19:53:14 Page 2
YTCLERK1 ;SLC/DJP-CONTINUATION OF ^YTCLERK; ;5/30/02 15:06
+1 ;;5.01;MENTAL HEALTH;**10,19,76**;Dec 30, 1994
A31 ;
+1 SET YSQ=0
SET YSOK=1
READ !!?3,"Queue to print when test(s)/interview(s) completed? Y// ",A:DTIME
SET YSTOUT='$TEST
SET YSUOUT=A["^"
IF YSTOUT!YSUOUT
SET YSOK=-1
QUIT
+2 SET A=$TRANSLATE($EXTRACT(A_"Y"),"yn","YN")
IF A="Y"
SET YSQ=1
GOTO QUE
+3 if A="N"
QUIT
WRITE !!?3,"Queing will send tests results to the selected printer as soon as it",!?3,"is available."
GOTO A31
QUE ;
+1 WRITE !
KILL ION
SET IOP="Q"
DO ^%ZIS
IF POP
SET YSOK=-1
QUIT
+2 IF '$DATA(ION)
WRITE !,"IMPROPERLY DEFINED DEVICE!",$CHAR(7)
GOTO QUE
+3 IF IO=IO(0)
IF IOST'?1"P".E
WRITE !,"YOU MUST QUEUE TO A PRINTER!",$CHAR(7)
GOTO QUE
+4 QUIT
ZAP ;
+1 WRITE !!,"Do you want to delete ",YSTESTN," now"
SET %=2
DO YN^DICN
if %=0
GOTO ZAP1
if %'=1
GOTO KAR^YTS
DO ENKIL^YTFILE
WRITE !!,YSTESTN," DELETED!"
DO 1^YTCLERK
QUIT
ZAP1 WRITE !!,"By entering ""Y"", the test will be deleted from the patient's file.",!
GOTO ZAP
+1 QUIT
REMMPR ;
+1 READ !,"SHORT FORM"
SET %=1
DO YN^DICN
+2 ;
+3 ; Yes... Administer the MMRP-Short.
+4 IF %=1
KILL %
QUIT
+5 ;
+6 ; No... Administer the MMPR-Long.
+7 ;->
IF %=2
Begin DoDot:1
+8 WRITE !!
FOR YSI=0:1:5
WRITE !,$PIECE($TEXT(YSM+YSI),";;",2,99)
+9 WRITE !!
+10 HANG 2
End DoDot:1
GOTO REN
+11 ;
+12 ; Must've up-arrowed out...
+13 IF %=-1
SET YSTIN=1
KILL %
QUIT
+14 ;
+15 ; User asked for help...
+16 IF %=0
WRITE !!,"If the short form (MMPR) is not used, the long form (MMPI) will be substituted.",!
KILL %
GOTO REMMPR
+17 ;
+18 ;
YSM ;clerk entered long form message
+1 ;;Please clerk-enter all items in MMPR order. After the
+2 ;;test has been completely clerk entered, the computer will
+3 ;;re-order the items and save them in MMPI order. On the
+4 ;;test results printout, the items will appear in MMPI order.
+5 ;
REN ;
+1 ; Administering the MMPI... ien#60
+2 SET YSTEST=60
SET YSNQ=566
SET YSTF=1
QUIT
RESTART ;
+1 ; Called from RESTART and from YTCLERK
+2 ; 3/11/94 LJA
+3 SET YSTESTN=$PIECE(^YTT(601,YSTEST,0),U)
+4 ;MMPI OR MMPR-LONG?
IF +YSTEST=60
Begin DoDot:1
+5 IF $GET(^YTD(601.4,+YSDFN,1,14,99))="MMPIR"
SET YSTESTN="MMPIR"
End DoDot:1
+6 WRITE !,"Restart ",YSTESTN," now"
SET %=1
DO YN^DICN
if %=1
GOTO GOT
if %<0
GOTO KAR^YTS
+7 IF %=0
WRITE !,"Test will restart at question interrupted."
GOTO RESTART
+8 WRITE !!,YSTESTN," must be completed or deleted prior to administering another test."
GOTO ZAP
GOT ;
+1 DO A31
if YSOK<1
GOTO KAR^YTS
+2 SET YSXTP=1
SET YSXT=YSTEST
SET J=+$PIECE(^YTD(601.4,YSDFN,1,YSENT,0),U,4)
SET C=$PIECE(^(0),U,5)
SET YSDTA=$PIECE(^(0),U,3)
SET YSORD=$PIECE(^(0),U,7)
if J<1
SET J=1
+3 SET B=$GET(^YTD(601.4,YSDFN,1,YSENT,"B"))
SET YSRP=$SELECT(J#200=1:"",1:^(J+199\200))
SET B1=$SELECT(B?1"W ".PN1"ANSWER".E:0,1:1)
+4 ;ASF 5/30/02
IF YSTESTN?1"MCMI"1N
SET YSNQ=$PIECE(^YTT(601,YSTEST,"Q",0),U,3)
+5 IF '$TEST
SET YSNQ=$PIECE(^YTT(601,YSTEST,0),U,11)
+6 SET YSCL=YSTEST
SET YSCLN=YSTESTN
SET R1=1
WRITE !!
GOTO ENX^YTCLERK
