- YTAR1 ;SLC/TGA,DKG-RESUME TESTS; ;5/30/02 14:57
- ;;5.01;MENTAL HEALTH;**37,76**;Dec 30, 1994
- ;
- ; 3/11/94 LJA
- I $D(^YTD(601.4,YSDFN,1,"AC")) D
- . S (X,YSX)=$O(^YTD(601.4,+YSDFN,1,"AC",0))
- . W !?2,"("
- . I $G(^YTD(601.4,+YSDFN,1,14,99))'="MMPIR" W $P(^YTT(601,X,0),U)
- . I $G(^YTD(601.4,+YSDFN,1,14,99))="MMPIR" D
- . . W $S(YSX=60:"MMPIR",YSX=61:"MMPR",1:"??")
- . W " Test was discontinued in Clerical Entry mode)"
- ;
- S Z=0 F S Z=$O(^YTD(601.4,YSDFN,1,Z)) Q:'Z S Z1=$P(^YTT(601,Z,0),U) I Z1'="CLERK" S X2=$S($P(^YTD(601.4,YSDFN,1,Z,0),U,8):$P(^(0),U,8),1:$P(^(0),U,2)) D DAT I X S Z(Z1)=Z_"^"_$P(^YTD(601.4,YSDFN,1,Z,0),U,2)
- R11 ;
- I $D(Z)>10 W !!,"Interactive instruments to restart: " S Z1="" F S Z1=$O(Z(Z1)) Q:Z1="" W ?36,Z1 W:$P(Z(Z1),U,2)']"" ! I $P(Z(Z1),U,2)]"" S M=$P(Z(Z1),U,2) W ?44,$$FMTE^XLFDT(M,"5ZD") W !
- I $D(Z)<11 G A10^YTAR
- R2 ;
- R !!?2,"Restart Instrument: ",YSTEST:DTIME S YSTOUT='$T,YSUOUT=YSTEST["^" G:YSTOUT!YSUOUT KAR^YTS G:YSTEST["?" R11
- I YSTEST="",T1 D DEL G:"Nn^"[$E(A1) KAR^YTS
- I YSTEST="" G A10^YTAR
- I '$D(Z(YSTEST)) W " ??",$C(7,7) G R2
- S (YSENT,YSTEST)=$P(Z(YSTEST),U)
- S (B,C)="",J=+$P(^YTD(601.4,YSDFN,1,YSENT,0),U,4),C=$P(^(0),U,5),YSORD=$P(^(0),U,7) S:$P(^(0),U,8) YSBEGIN=$P(^(0),U,8)
- I $D(^YTD(601.4,YSDFN,1,YSENT,"B"))#2 S B=^("B")
- S YSRP=$S(J#200=1:"",1:^YTD(601.4,YSDFN,1,YSENT,J+198\200)) S:'J J=1
- MCMI2 ;
- I $P(^YTT(601,YSTEST,0),U)?1"MCMI"1N X ^YTT(601,YSTEST,"C") ;ASF 5/30/02
- S YSXT=YSTEST_"^" S:$D(^YTD(601.4,YSDFN,1,YSENT,"R")) YSXT=YSXT_^("R") S YSXTP=1,YSDEMO="N",YSRESTRT=1 G A3^YTAR
- DEL ;
- W !!?2,"Delete discontinued ",$P(^YTT(601,YSXT,0),U) R "? Y// ",A1:DTIME S YSTOUT='$T,YSUOUT=A1["^" Q:YSTOUT!YSUOUT S:A1="" A1="Y"
- I "Yy"[$E(A1) S YSTEST=YSXT,YSENT=$P(Z($P(^YTT(601,YSXT,0),U)),U) D ENKIL^YTFILE S YSTEST="" W !,"DELETED!" Q
- I "Yy"'[$E(A1) W !,$C(7),"You must either restart or delete this ",$P(^YTT(601,YSXT,0),U),"!"
- Q
- DAT ;
- N YTLM S YTLM=YSRSLMT
- I T1,YSXT'=Z S X=0 Q
- I $P($G(^YTT(601,Z,0)),U,16) S YTLM=$P(^(0),U,16)
- S X=$$FMDIFF^XLFDT(DT,X2,1) I X'>YTLM S X=1 K YTLM Q
- W !!?2,Z1,?9,"discontinued " I $D(%Y),%Y W X," days ago "
- W "- not restartable" S X=0 K YTLM Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYTAR1 2200 printed Feb 18, 2025@23:43:13 Page 2
- YTAR1 ;SLC/TGA,DKG-RESUME TESTS; ;5/30/02 14:57
- +1 ;;5.01;MENTAL HEALTH;**37,76**;Dec 30, 1994
- +2 ;
- +3 ; 3/11/94 LJA
- +4 IF $DATA(^YTD(601.4,YSDFN,1,"AC"))
- Begin DoDot:1
- +5 SET (X,YSX)=$ORDER(^YTD(601.4,+YSDFN,1,"AC",0))
- +6 WRITE !?2,"("
- +7 IF $GET(^YTD(601.4,+YSDFN,1,14,99))'="MMPIR"
- WRITE $PIECE(^YTT(601,X,0),U)
- +8 IF $GET(^YTD(601.4,+YSDFN,1,14,99))="MMPIR"
- Begin DoDot:2
- +9 WRITE $SELECT(YSX=60:"MMPIR",YSX=61:"MMPR",1:"??")
- End DoDot:2
- +10 WRITE " Test was discontinued in Clerical Entry mode)"
- End DoDot:1
- +11 ;
- +12 SET Z=0
- FOR
- SET Z=$ORDER(^YTD(601.4,YSDFN,1,Z))
- if 'Z
- QUIT
- SET Z1=$PIECE(^YTT(601,Z,0),U)
- IF Z1'="CLERK"
- SET X2=$SELECT($PIECE(^YTD(601.4,YSDFN,1,Z,0),U,8):$PIECE(^(0),U,8),1:$PIECE(^(0),U,2))
- DO DAT
- IF X
- SET Z(Z1)=Z_"^"_$PIECE(^YTD(601.4,YSDFN,1,Z,0),U,2)
- R11 ;
- +1 IF $DATA(Z)>10
- WRITE !!,"Interactive instruments to restart: "
- SET Z1=""
- FOR
- SET Z1=$ORDER(Z(Z1))
- if Z1=""
- QUIT
- WRITE ?36,Z1
- if $PIECE(Z(Z1),U,2)']""
- WRITE !
- IF $PIECE(Z(Z1),U,2)]""
- SET M=$PIECE(Z(Z1),U,2)
- WRITE ?44,$$FMTE^XLFDT(M,"5ZD")
- WRITE !
- +2 IF $DATA(Z)<11
- GOTO A10^YTAR
- R2 ;
- +1 READ !!?2,"Restart Instrument: ",YSTEST:DTIME
- SET YSTOUT='$TEST
- SET YSUOUT=YSTEST["^"
- if YSTOUT!YSUOUT
- GOTO KAR^YTS
- if YSTEST["?"
- GOTO R11
- +2 IF YSTEST=""
- IF T1
- DO DEL
- if "Nn^"[$EXTRACT(A1)
- GOTO KAR^YTS
- +3 IF YSTEST=""
- GOTO A10^YTAR
- +4 IF '$DATA(Z(YSTEST))
- WRITE " ??",$CHAR(7,7)
- GOTO R2
- +5 SET (YSENT,YSTEST)=$PIECE(Z(YSTEST),U)
- +6 SET (B,C)=""
- SET J=+$PIECE(^YTD(601.4,YSDFN,1,YSENT,0),U,4)
- SET C=$PIECE(^(0),U,5)
- SET YSORD=$PIECE(^(0),U,7)
- if $PIECE(^(0),U,8)
- SET YSBEGIN=$PIECE(^(0),U,8)
- +7 IF $DATA(^YTD(601.4,YSDFN,1,YSENT,"B"))#2
- SET B=^("B")
- +8 SET YSRP=$SELECT(J#200=1:"",1:^YTD(601.4,YSDFN,1,YSENT,J+198\200))
- if 'J
- SET J=1
- MCMI2 ;
- +1 ;ASF 5/30/02
- IF $PIECE(^YTT(601,YSTEST,0),U)?1"MCMI"1N
- XECUTE ^YTT(601,YSTEST,"C")
- +2 SET YSXT=YSTEST_"^"
- if $DATA(^YTD(601.4,YSDFN,1,YSENT,"R"))
- SET YSXT=YSXT_^("R")
- SET YSXTP=1
- SET YSDEMO="N"
- SET YSRESTRT=1
- GOTO A3^YTAR
- DEL ;
- +1 WRITE !!?2,"Delete discontinued ",$PIECE(^YTT(601,YSXT,0),U)
- READ "? Y// ",A1:DTIME
- SET YSTOUT='$TEST
- SET YSUOUT=A1["^"
- if YSTOUT!YSUOUT
- QUIT
- if A1=""
- SET A1="Y"
- +2 IF "Yy"[$EXTRACT(A1)
- SET YSTEST=YSXT
- SET YSENT=$PIECE(Z($PIECE(^YTT(601,YSXT,0),U)),U)
- DO ENKIL^YTFILE
- SET YSTEST=""
- WRITE !,"DELETED!"
- QUIT
- +3 IF "Yy"'[$EXTRACT(A1)
- WRITE !,$CHAR(7),"You must either restart or delete this ",$PIECE(^YTT(601,YSXT,0),U),"!"
- +4 QUIT
- DAT ;
- +1 NEW YTLM
- SET YTLM=YSRSLMT
- +2 IF T1
- IF YSXT'=Z
- SET X=0
- QUIT
- +3 IF $PIECE($GET(^YTT(601,Z,0)),U,16)
- SET YTLM=$PIECE(^(0),U,16)
- +4 SET X=$$FMDIFF^XLFDT(DT,X2,1)
- IF X'>YTLM
- SET X=1
- KILL YTLM
- QUIT
- +5 WRITE !!?2,Z1,?9,"discontinued "
- IF $DATA(%Y)
- IF %Y
- WRITE X," days ago "
- +6 WRITE "- not restartable"
- SET X=0
- KILL YTLM
- QUIT