YSPRBR1 ;SLC/DKG-PROBLEM PRINT UTILITIES ;4/20/92  17:17 ;
 ;;5.01;MENTAL HEALTH;**37**;Dec 30, 1994
 ;
ENHD ; Called by routine YSPROBR
 S YSFHDR=$S(YSAN=1:"Active",YSAN=3:"Historical",YSAN=2:"Complete",1:"")_" Problem List",YSFTR="VAF 10-1415"
 S YSFHDR(1)="W:YST!(YSDXH="""") !! W ?2,""Problem"",?36,""Date of"",?48,""Date"",?59,""Status"",?72,""Date of"" X YSFHDR(2)"
 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
DOC ;
 I $E(YSDO,6,7)["00" S Y=YSDO D ENDD^YSUTL S YSDO=YSDT(1)
 E  S YSDO=$$FMTE^XLFDT(YSDO,"5ZD")
 Q
DC ; Called by routine YSPROBR1
 S Z=$$FMTE^XLFDT(Z,"5ZD") S:$L(Z)<7 Z=" "_Z Q
DSM ; Called by routine YSPROBR
 S YSCOM=1 D:$Y+YSSL+3>IOSL CK G:YSLFT END
 I '$D(^YSD(627.8,"AE","D",YSDFN)) W !!,"NO DSM DIAGNOSES ON FILE" G PHDX
DX ;
 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
PHDX ;
 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
 S YSHDX="ICD9 DIAGNOSES:" W !!?2,YSHDX,!
PHDX1 ;
 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
 I $Y+YSSL>IOSL D WAIT G:YSLFT END
 G FIN
VAR ;
 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)
 I L="I" S DX=$P(L2,";",2),DX1=$P(L2,";"),DX2="^"_DX_DX1_","_0_")",YSDXN=$P(@DX2,U,3),YSDXNN=$P(@DX2,U)
 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
PLINE ;
 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
PDX ;
 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*"
 Q
DC1 ;
 S Z=YSDS D DC S YSDS=Z S Z=YSDR D DC S YSDR=Z Q
 G:YSLFT END W:$Y+YSSL'>IOSL ! G DX
FIN ;
 S (YSNP,N1)=2 K DX,DXS S K=0
N1 ;
 S N1=$O(^YS(615,YSDFN,P4,N1)) G:'N1 END S K=K+1 G:K>0 FIN1 G N1
FIN1 ;
 I $Y+YSSL>IOSL S YSDXH="" D CK G:YSLFT END
 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
 G:YSLFT END W:$Y+YSSL'>IOSL ! G PHDX1
CK ;
 S:YST YSCON=1 D ENFT^YSFORM:YST,WAIT:'YST Q:YSLFT  D:YST ENHD^YSFORM X:'YST YSFHDR(1) Q
WAIT ;
 F I0=1:1:IOSL-$Y-2 W !
 W:$Y+1<IOSL !
 N DTOUT,DUOUT,DIRUT
 S DIR(0)="E" D ^DIR K DIR S YSTOUT=$D(DTOUT),YSUOUT=$D(DUOUT),YSLFT=$D(DIRUT) W @IOF Q
END ;
 G FIN^YSPROBR1