source: FOIAVistA/trunk/r/MENTAL_HEALTH-YS-RUCL-YI-YT/YSPDR1.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 
1YSPDR1 ;SLC/DKG,RWF-ICD9 DIAGNOSIS REPORT CONTINUED ;11/30/89 15:08 ;
2 ;;5.01;MENTAL HEALTH;;Dec 30, 1994
3 ;
4 ; Called by routine YSDXR1
5 I $D(^MR(YSDFN,"PHDX",1)) W !!,"ICD9 DIAGNOSES:",!
6 S (Y1,T1,T)=0 K W
7PRT ;
8 S T=$O(^MR(YSDFN,"PHDX","CH",T)) G PRT^YSPDXR:'T S Y1=0
9PRT1 ;
10 S Y1=$O(^MR(YSDFN,"PHDX","CH",T,Y1)) G PRT:'Y1 S T1=0
11PRT2 ;
12 S T1=$O(^MR(YSDFN,"PHDX","CH",T,Y1,T1)) G PRT1:'T1
13 S D2=^MR(YSDFN,"PHDX",Y1,0) G PRT:D2<1 S Y2=^ICD9(+D2,0)
14 I $D(A1),A1?1"Y".E G PRT1:$P(D2,U,2)="I"
15 IF $Y+7>IOSL D ENFT^YSFORM,WAIT Q:$D(W) D ENHD^YSFORM
16 W !!,$P(Y2,U),?8 S Y2=$P(Y2,U,3)
17 F I=3:1:8 IF $L($P(Y2," ",I))>70 Q
18 W $P(Y2," ",1,I-1) W:$L($P(Y2," ",I,99)) !?9,$P(Y2," ",I,99)
19 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
20PT1 ;
21 S S2=^MR(YSDFN,"PHDX",Y1,1,T1,0)
22 W !?8 S X=+S2,Z=$P(S2,U,2) D ENS^YSDXR
23 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)
24 S X=$P(S2,U,4) IF $L(X) F I=4:1:10 IF $L($P(X," ",I))>50 Q
25 IF $L(X) W !?20,"COMMENT: ",$P(X," ",1,I) W:$L($P(X," ",I+1,99)) !?21,$P(X," ",I+1,99)
26 G PRT2
27WAIT ;
28 I IOSL<30 K DIR S DIR(0)="E" D ^DIR K DIR S YSTOUT=$D(DTOUT),YSUOUT=$D(DUOUT) S:YSUOUT W=1 Q
29EN ;
30 S DIC="^MR(YSDFN,""PHDX"",",DIC(0)="AEMNQZ"
31 S DIC("W")="S C=$P(^(0),U,2) W ?70,$S(C=""A"":""ACTIVE"",C=""I"":""INACTIVE"",1:""UNKNOWN"")"
32 D ^DIC Q:X=""!(X?1P) G EN:Y'>0 S DIE=DIC,DR="2",DA=+Y L +^MR(YSDFN) D ^DIE L -^MR(YSDFN) S YSTOUT=$D(DTOUT) Q:YSTOUT G EN
Note: See TracBrowser for help on using the repository browser.