source: FOIAVistA/trunk/r/MENTAL_HEALTH-YS-RUCL-YI-YT/YSPDXR.m@ 1801

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

initial load of FOIAVistA 6/30/08 version

File size: 1.5 KB
Line 
1YSPDXR ;SLC/DKG,SLC/RWF-ICD9 DIAGNOSIS REPORT ; 4/24/89 11:28 ;
2 ;;5.01;MENTAL HEALTH;**37**;Dec 30, 1994
3 ;
4 ; Called by routine YSDXR
5 I $D(^MR(YSDFN,"PHDX",1)) D:$Y+YSSL+1>IOSL CK Q:YSLFT W !!,"ICD9 DIAGNOSES:"
6PRT ; Called by routine YSPDR1
7 S T=$O(^MR(YSDFN,"PHDX","B",T)) G END:'T S Y1=$O(^MR(YSDFN,"PHDX","B",T,0)) G END:'Y1
8 S D2=^MR(YSDFN,"PHDX",Y1,0),T1=0 G PRT:D2<1 S Y2=^ICD9(+D2,0)
9 I $D(A1),A1?1"Y".E G PRT:$P(D2,U,2)="I"
10 I $Y+YSSL+2>IOSL D CK Q:YSLFT
11 W !!,$P(Y2,U),?8 S Y2=$P(Y2,U,3)
12 F I=3:1:8 IF $L($P(Y2," ",I))>70 Q
13 W $P(Y2," ",1,I-1) W:$L($P(Y2," ",I,99)) !?9,$P(Y2," ",I,99)
14 S C=$P(^MR(YSDFN,"PHDX",Y1,0),U,2),C=$S(C="A":"A C T I V E",C="I":"** INACTIVE",1:"") W " ",C
15PT1 ;
16 I $Y+YSSL+2>IOSL D CK Q:YSLFT
17 S T1=$O(^MR(YSDFN,"PHDX",Y1,1,T1)) G PRT:'T1 S S2=^(T1,0)
18 W !?8 S X=+S2,Z=$P(S2,U,2) D DAT,SET
19 S X=$P(S2,U,3) IF X>0,$D(^VA(200,X,0)) W " ",$P(^VA(200,X,0),U) S X=$P(^(0),U,9) IF X>0,$D(^DIC(3.1,X,0)) W ", ",^(0)
20 S X=$P(S2,U,4) IF $L(X) F I=4:1:10 IF $L($P(X," ",I))>50 Q
21 IF $L(X) W !?20,"COMMENT: ",$P(X," ",1,I) W:$L($P(X," ",I+1,99)) !?21,$P(X," ",I+1,99)
22 G PT1
23END ;
24 Q:$D(YSNOFORM) D ENFT^YSFORM:YST D:'YSPP WAIT^YSUTL:'YST Q:YSPP D ^%ZISC,KILL^%ZTLOAD Q
25 ;
26DAT ;
27 W " ",$$FMTE^XLFDT(X,"5ZD") Q
28SET ;
29 S Y=";"_$P(^DD(90.05,1,0),U,3) F I=1:1:10 IF $P(Y,";",I)[(Z_":") Q
30 W:I<10 " ",$P($P(Y,";",I),":",2),":" Q
31CK ;
32 I $D(YSNOFORM) D:'YST WAIT^YSUTL Q:YSLFT W:YST @IOF Q
33 S:YSSL YSCON=1 D WAIT^YSUTL:'YST,ENFT^YSFORM:YST Q:YSLFT D:YST ENHD^YSFORM Q
Note: See TracBrowser for help on using the repository browser.