source: WorldVistAEHR/trunk/r/MENTAL_HEALTH-YS-RUCL-YI-YT/YSPP8.m@ 841

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

initial load of WorldVistAEHR

File size: 1.5 KB
Line 
1YSPP8 ;ALB/ASF-PP PSYCH TESTS ;12/4/91 13:57 ;
2 ;;5.01;MENTAL HEALTH;**37**;Dec 30, 1994
3 ;
4 S YSFHDR="Problem List, Psychological Tests and Interviews <<section 9>>" D ENHD^YSFORM
5 ;
6ENCE ; Called indirectly from YSCEN31
7 ;
8 I '$D(^PTX(YSDFN,"HX")) W !,"HISTORY 1: ** NONE ON FILE **"
9 I $D(^MR(YSDFN,"PE"))>1 W !,"PHYSICAL: " S M="PE",YSDOT=0 D DT0
10 I '$D(^MR(YSDFN,"PE")) W !,"PHYSICAL: ** NONE ON FILE **"
11 W !,"PROBLEM LIST : ",$S('$D(^YS(615,YSDFN,"PL")):"** NOT ON FILE **",1:"ON FILE")
12 I $D(^GMR(121,"AC",YSDFN)) W !,"PROGRESS NOTES: LAST " S YSDOT="",YSDOT=$O(^GMR(121,"AC",YSDFN,YSDOT)) S YSDOT=9999999-YSDOT D YSDOT
13 I '$D(^GMR(121,"AC",YSDFN)) W !,"PROGRESS NOTES: ** NONE ON FILE **"
14 I '$D(^YTD(601.2,YSDFN,1,"B")) W !,"NO PSYCHOLOGICAL TESTS OR INTERVIEWS HAVE BEEN COMPLETED",! G END
15 E D TLST
16END ;
17 K M,N,YSDOT Q:$D(YSNOFORM) D ENFT^YSFORM:YST,WAIT1^YSUTL:'YST Q
18TLST ;
19 W !!,"Psychological Tests/Interviews:",! K AI,N
20 S N=0 F S N=$O(^YTD(601.2,YSDFN,1,N)) Q:'N!('$D(^YTT(601,N))) S N(2)=0 F S N(2)=$O(^YTD(601.2,YSDFN,1,N,1,N(2))) Q:'N(2) S X=^YTT(601,N,0),N(4)=$P(X,U) S AI(N(4),N(2))=""
21 S N(3)=0,N="" F S N=$O(AI(N)) Q:N="" S N(2)=0 F S N(2)=$O(AI(N,N(2))) Q:'N(2) W ?(N(3)*16),N,$E(" ",1,6-$L(N)),$$FMTE^XLFDT(N(2),"5ZD") S N(3)=N(3)+1 I '(N(3)#5) W ! S N(3)=0
22 Q
23 ;
24YSDOT ;
25 W $$FMTE^XLFDT(YSDOT,"5ZD")," "
26 Q
27 ;
28DTS S YSDOT=0
29DT0 S YSDOT=$O(^MR(YSDFN,M,"B",YSDOT)) I YSDOT D YSDOT G DT0
30 Q
31 ;
32DT1 S YSDOT=$O(^PTX(YSDFN,M,YSDOT)) I YSDOT D YSDOT G DT1
33 Q
34 ;
35DT2 S YSDOT=$O(^YS(615,YSDFN,M,"B",YSDOT)) I YSDOT D YSDOT G DT1
36 Q
Note: See TracBrowser for help on using the repository browser.