1 | YSPRBR1 ;SLC/DKG-PROBLEM PRINT UTILITIES ;4/20/92 17:17 ;
|
---|
2 | ;;5.01;MENTAL HEALTH;**37**;Dec 30, 1994
|
---|
3 | ;
|
---|
4 | ENHD ; Called by routine YSPROBR
|
---|
5 | S YSFHDR=$S(YSAN=1:"Active",YSAN=3:"Historical",YSAN=2:"Complete",1:"")_" Problem List",YSFTR="VAF 10-1415"
|
---|
6 | S YSFHDR(1)="W:YST!(YSDXH="""") !! W ?2,""Problem"",?36,""Date of"",?48,""Date"",?59,""Status"",?72,""Date of"" X YSFHDR(2)"
|
---|
7 | S YSFHDR(2)="W !?4 W $S(YSAN=2:""Staff"",YSID:""Indicator(s)"",1:""""),?37,""Onset"",?46,""Recorded"",?72,""Status"" W:YSAN=2 !?6,""Indicator(s)"" W ! W:YSDXH]"""" !?2,YSDXH,!" Q
|
---|
8 | DOC ;
|
---|
9 | I $E(YSDO,6,7)["00" S Y=YSDO D ENDD^YSUTL S YSDO=YSDT(1)
|
---|
10 | E S YSDO=$$FMTE^XLFDT(YSDO,"5ZD")
|
---|
11 | Q
|
---|
12 | DC ; Called by routine YSPROBR1
|
---|
13 | S Z=$$FMTE^XLFDT(Z,"5ZD") S:$L(Z)<7 Z=" "_Z Q
|
---|
14 | DSM ; Called by routine YSPROBR
|
---|
15 | S YSCOM=1 D:$Y+YSSL+3>IOSL CK G:YSLFT END
|
---|
16 | I '$D(^YSD(627.8,"AE","D",YSDFN)) W !!,"NO DSM DIAGNOSES ON FILE" G PHDX
|
---|
17 | DX ;
|
---|
18 | S YSHDX="DSM DIAGNOSES:" W !!?2,YSHDX,! S L="D",L1=0 F S L1=$O(^YSD(627.8,"AE",L,YSDFN,L1)) Q:'L1 S L2="" F S L2=$O(^YSD(627.8,"AE",L,YSDFN,L1,L2)) Q:L2="" S L3=0 F S L3=$O(^YSD(627.8,"AE",L,YSDFN,L1,L2,L3)) Q:'L3 D VAR
|
---|
19 | PHDX ;
|
---|
20 | D:$Y+YSSL+1>IOSL CK G:YSLFT END I '$D(^YSD(627.8,"AE","I",YSDFN)) W !!,"NO ICD9 DIAGNOSES ON FILE" G FIN
|
---|
21 | S YSHDX="ICD9 DIAGNOSES:" W !!?2,YSHDX,!
|
---|
22 | PHDX1 ;
|
---|
23 | S L="I",L1=0 F S L1=$O(^YSD(627.8,"AE",L,YSDFN,L1)) Q:'L1 S L2="" F S L2=$O(^(L1,L2)) Q:L2="" S L3=0 F S L3=$O(^YSD(627.8,"AE",L,YSDFN,L1,L2,L3)) Q:'L3 D VAR
|
---|
24 | I $Y+YSSL>IOSL D WAIT G:YSLFT END
|
---|
25 | G FIN
|
---|
26 | VAR ;
|
---|
27 | D PDX I L="D" S DX=$P(L2,";",2),DX1=$P(L2,";"),DX2="^"_DX_DX1_","_0_")",YSDXNN=$P(@DX2,U,2),DX3="^"_DX_DX1_","_0_")",YSDXN=$P(@DX3,U,15)
|
---|
28 | I L="I" S DX=$P(L2,";",2),DX1=$P(L2,";"),DX2="^"_DX_DX1_","_0_")",YSDXN=$P(@DX2,U,3),YSDXNN=$P(@DX2,U)
|
---|
29 | S Z=$P(^YSD(627.8,L3,0),U,3) D DC S RDT=Z,ST=$P(^(1),U,4),ST1=$S(ST="A":"ACTIVE",ST="I":"INACTIVE",1:"UNKNOWN"),Z=$P(^(1),U,5) D DC S STDT=Z I YSAN=1&(ST'="A") Q
|
---|
30 | PLINE ;
|
---|
31 | D:$Y+YSSL+1>IOSL CK G:YSLFT END W !?2,$E(YSDXN,1,26),?30,YSPHDX,?45,$J(RDT,8),?57,$J(ST1,8),?71,STDT,! Q
|
---|
32 | PDX ;
|
---|
33 | S YSPHDX="" Q:'$D(^YSD(627.8,"AD",YSDFN)) S J=$O(^YSD(627.8,"AD",YSDFN,0)),J1=$O(^(J,0)) I J1=L3 S YSPHDX="*""P"" DIAGNOSIS*"
|
---|
34 | Q
|
---|
35 | DC1 ;
|
---|
36 | S Z=YSDS D DC S YSDS=Z S Z=YSDR D DC S YSDR=Z Q
|
---|
37 | G:YSLFT END W:$Y+YSSL'>IOSL ! G DX
|
---|
38 | FIN ;
|
---|
39 | S (YSNP,N1)=2 K DX,DXS S K=0
|
---|
40 | N1 ;
|
---|
41 | S N1=$O(^YS(615,YSDFN,P4,N1)) G:'N1 END S K=K+1 G:K>0 FIN1 G N1
|
---|
42 | FIN1 ;
|
---|
43 | I $Y+YSSL>IOSL S YSDXH="" D CK G:YSLFT END
|
---|
44 | S YSDXH="ADDITIONAL PROBLEM" S:K>1 YSDXH=YSDXH_"S" S YSDXH=YSDXH_":" W:N1>1 !?2,YSDXH S YSDXH=YSDXH_" (Continued)" G FP1^YSPROBR
|
---|
45 | G:YSLFT END W:$Y+YSSL'>IOSL ! G PHDX1
|
---|
46 | CK ;
|
---|
47 | S:YST YSCON=1 D ENFT^YSFORM:YST,WAIT:'YST Q:YSLFT D:YST ENHD^YSFORM X:'YST YSFHDR(1) Q
|
---|
48 | WAIT ;
|
---|
49 | F I0=1:1:IOSL-$Y-2 W !
|
---|
50 | W:$Y+1<IOSL !
|
---|
51 | N DTOUT,DUOUT,DIRUT
|
---|
52 | S DIR(0)="E" D ^DIR K DIR S YSTOUT=$D(DTOUT),YSUOUT=$D(DUOUT),YSLFT=$D(DIRUT) W @IOF Q
|
---|
53 | END ;
|
---|
54 | G FIN^YSPROBR1
|
---|