| [613] | 1 | YTTB ;SLC/DKG-CREATE/DELETE TEST BATTERIES ; 7/10/89 11:34 ;
|
|---|
| 2 | ;;5.01;MENTAL HEALTH;;Dec 30, 1994
|
|---|
| 3 | ; Called from the top by MENU option YSTESTBAT
|
|---|
| 4 | ;
|
|---|
| 5 | W @IOF,?IOM-$L("Test/Interview Battery Utility")\2,"Test/Interview Battery Utility",!!
|
|---|
| 6 | W !?3,"A test battery (e.g., 'BATA') allows administration of a set",!?3,"of tests/interviews by entering just the battery code.",!
|
|---|
| 7 | OP ;
|
|---|
| 8 | R !!?3,"(C)reate battery, (D)elete battery, (P)rint list or (Q)uit: Q// ",A:DTIME S YSTOUT='$T,YSUOUT=A["^" G END:YSTOUT!YSUOUT S A=$TR($E(A_"Q"),"cdpq","CDPQ") G:"Q"=$E(A) END I "CDP"'[A W:A'["?" $C(7)," ?" G OP
|
|---|
| 9 | G C:"C"[A,D:"D"[A,P:"P"[A
|
|---|
| 10 | C ;
|
|---|
| 11 | S YSTANO=$$STANO($G(DUZ(2))) I YSTANO'>0 D QUIT ;->
|
|---|
| 12 | . W !!!!!,"Batteries cannot be entered because your DUZ(2) is not properly defined!!"
|
|---|
| 13 | . W !,"Please contact your IRM Service for assistance...",!!
|
|---|
| 14 | . N DIR
|
|---|
| 15 | . S DIR(0)="EA",DIR("A")="Hit RETURN to continue... "
|
|---|
| 16 | . D ^DIR
|
|---|
| 17 | ;
|
|---|
| 18 | S YSLK=$D(^XUSEC("YSP",DUZ))
|
|---|
| 19 | R !!?3,"Create battery NAME: ",A:DTIME S YSTOUT='$T,YSUOUT=A["^" G END:YSTOUT!YSUOUT,OP:A=""
|
|---|
| 20 | I $L(A)<3!($L(A)>5)!(A'?.UN) W $C(7),!!?3,"Enter 3 to 5 characters - upper case letters and numbers only",!?3,"(e.g., BATA or BAT1)" G C
|
|---|
| 21 | I $D(^YTT(601,"B",A)) W $C(7),!!?3,"There is already a test or test battery named ",A," in the package! " G C
|
|---|
| 22 | S YSK=0,L1="" K N
|
|---|
| 23 | NB ;
|
|---|
| 24 | S YSK=YSK+1 W !!?3,"TEST ",YSK,"> " R L:DTIME S YSTOUT='$T,YSUOUT=L["^" G END:YSTOUT!YSUOUT,FB:L=""
|
|---|
| 25 | I L["?" S YSXT="" D ENTB^YTLIST S YSK=YSK-1 G NB
|
|---|
| 26 | S L=$E(L,1,5) S N=$O(^YTT(601,"B",L,0)) I 'N W $C(7),!!?3,"No instrument ",L," in the package" S YSK=YSK-1 G NB
|
|---|
| 27 | S N(0)=$G(^YTT(601,N,0)) I $P(N(0),U,14)="N" W $C(7),!!?3,"Copy righted, non-licensed tests can not be in a test battery! " S YSK=YSK-1 G NB
|
|---|
| 28 | I $P(N(0),U,9)="B" W $C(7),!!?3,"Batteries may not be included in batteries!" S YSK=YSK-1 G NB
|
|---|
| 29 | I 'YSLK&($P(N(0),U,8)'["V") W $C(7),!!?3,"You do NOT have the proper security to put this test on a battery!" S YSK=YSK-1 G NB
|
|---|
| 30 | I $D(N(N)) W !!?3,"Duplicate ignored!",$C(7) S YSK=YSK-1 G NB
|
|---|
| 31 | NB1 ;
|
|---|
| 32 | I YSK>4 D G END:YSTOUT!YSUOUT S A1=$TR($E(A1),"yn","YN") G OP:"N"[A1 I "Y"'[A1 W:A1'["?" $C(7)," ?" G NB1
|
|---|
| 33 | .W $C(7),!!?3,"There are now ",YSK," tests in the battery",!!,"Are you sure you want ",YSK R " tests in one battery? N// ",A1:DTIME S YSTOUT='$T,YSUOUT=A1["^"
|
|---|
| 34 | S L1=L1_N_U,N(N)="" G NB:YSK<10 W !!,"10 instruments is max!"
|
|---|
| 35 | FB ;
|
|---|
| 36 | I $L(L1,U)<3 W !!?3,"No battery created",$C(7) G LB
|
|---|
| 37 | FB1 ;
|
|---|
| 38 | ; Get next 601 IEN in Station's number range...
|
|---|
| 39 | F YSDINUM=YSTANO_"000":1:YSTANO_999 Q:'$D(^YTT(601,+YSDINUM))
|
|---|
| 40 | I YSDINUM>(YSTANO_999) D G YTTB ;->
|
|---|
| 41 | . W !!,"No MH Instrument (#601) file internal entry numbers available!!"
|
|---|
| 42 | . W !,"Please contact IRM Service for assistance...",!!
|
|---|
| 43 | . N DIR
|
|---|
| 44 | . S DIR(0)="EA",DIR("A")="Hit return to continue... "
|
|---|
| 45 | . D ^DIR
|
|---|
| 46 | ;
|
|---|
| 47 | ; All OK. Enter test battery...
|
|---|
| 48 | S DINUM=+YSDINUM
|
|---|
| 49 | S X=A,DIC="^YTT(601,",DIC(0)="LX",DLAYGO=601,DIC("DR")="20///^S X=""B"";"
|
|---|
| 50 | D ^DIC
|
|---|
| 51 | S ^YTT(601,+Y,"A")="S YSXT=YSXT_"_""""_L1_""""
|
|---|
| 52 | W !!,"BATTERY ",A," created with ",YSK-1," instruments."
|
|---|
| 53 | H 3
|
|---|
| 54 | LB ;
|
|---|
| 55 | K A,A1,DINUM,L,L1,N,X,YSDINUM,YSK,YSLK,YSTANO
|
|---|
| 56 | G YTTB
|
|---|
| 57 | ;
|
|---|
| 58 | D ;
|
|---|
| 59 | R !!?3,"Delete battery: ",A:DTIME
|
|---|
| 60 | S YSTOUT='$T,YSUOUT=A["^" G END:YSTOUT!YSUOUT,OP:A=""
|
|---|
| 61 | I A["?" D ENP G D
|
|---|
| 62 | S X=$O(^YTT(601,"B",A,0))
|
|---|
| 63 | I 'X W $C(7),!!?3,"No battery with name ",A," on file. " G D
|
|---|
| 64 | I $P(^YTT(601,X,0),U,9)="B" S DIK="^YTT(601,",DA=X D ^DIK W !!?3,"Battery ",A," deleted! " G D
|
|---|
| 65 | W !!?3,$C(7),"There is an instrument by that name but it is not a battery!!"
|
|---|
| 66 | G D
|
|---|
| 67 | ;
|
|---|
| 68 | STANO(SIEN) ; Pass in station's IEN. Station number returned...
|
|---|
| 69 | ; SIEN = DUZ(2)
|
|---|
| 70 | N DA,DIC,DIQ,DR,YSDATA,YSTANO
|
|---|
| 71 | QUIT:$G(SIEN)'>0 "" ;->
|
|---|
| 72 | S DA=+SIEN,DIC=4,DR=99,DIQ="YSDATA",DIQ(0)="I"
|
|---|
| 73 | D EN^DIQ1
|
|---|
| 74 | S YSTANO=+$G(YSDATA(4,+SIEN,99,"I"))
|
|---|
| 75 | QUIT:YSTANO'>0 "" ;->
|
|---|
| 76 | QUIT YSTANO
|
|---|
| 77 | ;
|
|---|
| 78 | P W ! K IOP S %ZIS="Q" D ^%ZIS K %ZIS G:POP END I $D(IO("Q")) K IO("Q") S ZTRTN="ENP^YTTB",ZTDESC="YS PSYCH INST BAT" D ^%ZTLOAD G END
|
|---|
| 79 | ENP ;
|
|---|
| 80 | S:'$D(A) A=0 U IO W !! W:A'["?" @IOF W ?28,"CURRENT BATTERIES",!!,"NAME",?6,"INSTRUMENTS ON BATTERY"
|
|---|
| 81 | S I=0 F N=0:1 S I=$O(^YTT(601,"AI","B",I)) G:'I EP W !,$P(^YTT(601,I,0),U) S X=$P(^YTT(601,I,"A"),"""",2) F J=1:1 S Y=$P(X,U,J) Q:Y="" W ?(J*6),$P(^YTT(601,Y,0),U)
|
|---|
| 82 | EP ;
|
|---|
| 83 | I N=0 U IO(0) W $C(7),!!!?3,"No batteries on file!"
|
|---|
| 84 | Q:A["?" D:IOST?1"C-".E WAIT^YSUTL K A,I,J,N,X,Y D KILL^%ZTLOAD W ! D ^%ZISC G OP:'$G(ZTSK)
|
|---|
| 85 | END ;
|
|---|
| 86 | K A,A1,DA,DIK,I,J,K,L,L1,N,T,T1,X,Y,YSK,YSORD,YSLK,Z,ZTSK Q
|
|---|
