source: WorldVistAEHR/trunk/r/MENTAL_HEALTH-YS-RUCL-YI-YT/YTBPRS.m@ 1800

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

initial load of WorldVistAEHR

File size: 1.1 KB
Line 
1YTBPRS ;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
16WAIT ;
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
Note: See TracBrowser for help on using the repository browser.