source: WorldVistAEHR/trunk/r/MENTAL_HEALTH-YS-RUCL-YI-YT/YTTB.m@ 975

Last change on this file since 975 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 4.3 KB
Line 
1YTTB ;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.",!
7OP ;
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
10C ;
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
23NB ;
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
31NB1 ;
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!"
35FB ;
36 I $L(L1,U)<3 W !!?3,"No battery created",$C(7) G LB
37FB1 ;
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
54LB ;
55 K A,A1,DINUM,L,L1,N,X,YSDINUM,YSK,YSLK,YSTANO
56 G YTTB
57 ;
58D ;
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 ;
68STANO(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 ;
78P 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
79ENP ;
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)
82EP ;
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)
85END ;
86 K A,A1,DA,DIK,I,J,K,L,L1,N,T,T1,X,Y,YSK,YSORD,YSLK,Z,ZTSK Q
Note: See TracBrowser for help on using the repository browser.