- 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 Feb 18, 2025@23:43:26 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