| 1 | YTBPRS ;SLC/DKG-TEST PKG: BPRS REPORT ; 10/19/88 17:18 ;
|
|---|
| 2 | ;;5.01;MENTAL HEALTH;;Dec 30, 1994
|
|---|
| 3 | ;
|
|---|
| 4 | S X=^YTD(601.2,YSDFN,1,YSET,1,YSED,1)
|
|---|
| 5 | S R="" F J=1:1:18 S R=R_$E(X,J)_"^"
|
|---|
| 6 | S R1=0 F J=4,12,15 S R1=R1+$E(X,J)
|
|---|
| 7 | S R=R_R1_"^",R1=0 F J=2,5,9 S R1=R1+$E(X,J)
|
|---|
| 8 | S R=R_R1_"^",R1=0 F J=10,11,14 S R1=R1+$E(X,J)
|
|---|
| 9 | S R=R_R1_"^",R1=0 F J=3,13,16 S R1=R1+$E(X,J)
|
|---|
| 10 | S R=R_R1_"^",R1=0 F J=1:1:16 S R1=R1+$E(X,J)
|
|---|
| 11 | S R=R_R1
|
|---|
| 12 | S Y=^YTT(601,YSTEST,"P"),X=$P(Y,U),A=$P(Y,U,2),B=$P(Y,U,3),L1=58-A\2,L2=L1+A+1 S:A<9 A=9
|
|---|
| 13 | D DTA^YTREPT W !!?(72-$L(X)\2),X,!!!?(A-9\2+L1),"S C A L E",?(L2+1),"RAW",!
|
|---|
| 14 | S YSLFT=0 F J=1:1 D:IOST?1"C-".E WAIT:$Y>(IOSL-4) Q:YSLFT S R1=$P(R,U,J) Q:R1="" W:J=19!(J=23) ! W !?L1,$P(^YTT(601,YSTEST,"S",J,0),U,2),?L2,$J(R1,4,0)
|
|---|
| 15 | W ! K A,B,J,L1,L2,R1,X,Y Q
|
|---|
| 16 | WAIT ;
|
|---|
| 17 | ; Added 5/6/94 LJA
|
|---|
| 18 | N A,B,B1,C,D,E,E1,F,F1,G,G1,H,I,J,J1,J2,J3,J4,K,L,L1,L2,M,N
|
|---|
| 19 | N N1,N2,N3,N4,P,P0,P1,P3,R,R1,S,S1,T,T1,T2,TT,V,V1,V2,V3
|
|---|
| 20 | N V4,V5,V6,W,X,X0,X1,X2,X3,X4,X7,X8,X9,Y,Y1,Y2,Z,Z1,Z3
|
|---|
| 21 | ;
|
|---|
| 22 | Q:IOST'?1"C-".E
|
|---|
| 23 | N DTOUT,DUOUT,DIRUT
|
|---|
| 24 | S DIR(0)="E" D ^DIR K DIR S YSTOUT=$D(DTOUT),YSUOUT=$D(DUOUT),YSLFT=$D(DIRUT)
|
|---|
| 25 | W @IOF
|
|---|
