source: WorldVistAEHR/trunk/r/MENTAL_HEALTH-YS-RUCL-YI-YT/YSDXR1.m@ 949

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

initial load of WorldVistAEHR

File size: 1.9 KB
RevLine 
[613]1YSDXR1 ;SLC/DKG,SLC/RWF/LJA-(DSM-III) DIAGNOSIS REPORT CONTINUED ;12/14/93 12:59
2 ;;5.01;MENTAL HEALTH;;Dec 30, 1994
3 ;D RECORD^YSDX0001("^YSDXR1") ;Used for testing. Inactivated in YSDX0001...
4 ;
5 ; Called by routine YSDXR
6 S (Y1,T1,T)=0 K W
7PRT ;
8 ;D RECORD^YSDX0001("PRT^YSDXR1") ;Used for testing. Inactivated in YSDX0001...
9 S T=$O(^MR(YSDFN,"DX","CH",T))
10 G ^YSPDR1:'T ;->
11 S Y1=0
12PRT1 ;
13 ;D RECORD^YSDX0001("PRT1^YSDXR1") ;Used for testing. Inactivated in YSDX0001...
14 S Y1=$O(^MR(YSDFN,"DX","CH",T,Y1))
15 G PRT:'Y1 ;->
16 S T1=0
17PRT2 ;
18 ;D RECORD^YSDX0001("PRT2^YSDXR1") ;Used for testing. Inactivated in YSDX0001...
19 S T1=$O(^MR(YSDFN,"DX","CH",T,Y1,T1))
20 G PRT1:'T1 ;->
21 S D2=^MR(YSDFN,"DX",Y1,0)
22 G PRT:(D2<1) ;->
23 S Y2=^YSD(627.7,+D2,0)
24 I $D(A1),A1?1"Y".E G PRT1:$P(D2,U,2)="I" ;->
25 I ($Y+YSSL+5)>IOSL D CK^YSDXR
26 QUIT:YSLFT ;->
27 W !!,$P(Y2,U,2),?8
28 S Y2=$P(Y2,U)
29 F I=3:1:8 I $L($P(Y2," ",I))>70 QUIT
30 W $P(Y2," ",1,I-1) W:$L($P(Y2," ",I,99)) !?9,$P(Y2," ",I,99)
31 S C=$P(^MR(YSDFN,"DX",Y1,0),U,2)
32 S C=$S(C="A":"A C T I V E",C="I":"** INACTIVE",1:"")
33 W " ",C
34 S S2=^MR(YSDFN,"DX",Y1,1,T1,0)
35 W !?8 S X=+S2,Z=$P(S2,U,2)
36 D ENS^YSDXR
37 S X=$P(S2,U,3)
38 I X>0,$D(^VA(200,X,0)) D
39 . W " ",$P(^VA(200,X,0),U)
40 . S X=$P(^VA(200,X,0),U,9)
41 . I X>0,$D(^DIC(3.1,X,0)) W ", ",^(0)
42 S X=$P(S2,U,4)
43 I $L(X) F I=4:1:10 I $L($P(X," ",I))>50 QUIT
44 I $L(X) D
45 . W !?20,"COMMENT: ",$P(X," ",1,I)
46 . W:$L($P(X," ",I+1,99)) !?21,$P(X," ",I+1,99)
47 G PRT2 ;->
48EN ;
49 ;D RECORD^YSDX0001("EN^YSDXR1") ;Used for testing. Inactivated in YSDX0001...
50 S DIC="^MR(YSDFN,""DX"",",DIC(0)="AEMNQZ"
51 S DIC("W")="S CS=$P(^(0),U,2) W ?70,$S(CS=""A"":""ACTIVE"",CS=""I"":""INACTIVE"",1:""UNKNOWN"")"
52 D ^DIC
53 S YSTOUT=$D(DTOUT),YSUOUT=$D(DUOUT)
54 QUIT:YSTOUT!(YSUOUT) ;->
55 G EN:Y<1 ;->
56 S DIE=DIC,DR="2",DA=+Y
57 L +^MR(YSDFN)
58 D ^DIE
59 L -^MR(YSDFN)
60 S YSTOUT=$D(DTOUT)
61 QUIT:YSTOUT ;->
62 G EN ;->
63 ;
64EOR ;YSDXR1 - (DSM-III) DIAGNOSIS REPORT CONTINUED ; 10/6/88 15:13
Note: See TracBrowser for help on using the repository browser.