source: FOIAVistA/trunk/r/MENTAL_HEALTH-YS-RUCL-YI-YT/YSPRBR2.m@ 794

YSPRBR2 ;SLC/DKG-ADDITIONAL PRINT UTILITIES FOR PROBLEM LIST ; 7/10/89  19:09 ;
 ;;5.01;MENTAL HEALTH;**37**;Dec 30, 1994
 ;
FI ; Called by routine YSPROBR
 I '$D(^YS(615,YSDFN,P4,YSNP,1,N5,0)) S YSIN(N5)="" Q
 S YSIND=$P(^YS(615,YSDFN,P4,YSNP,1,N5,0),U) I YSAN=2 S YSINU=+$P(^(0),U,3),YSNDT=$P(^(0),U,4),YSINTN=$P(^(0),U,9),YSINTU=$P($G(^VA(200,YSINU,0)),U) S:YSINTN]"" YSINTL=$P(^DIC(3.1,YSINTN,0),U)
 S YSIN(N5)=$P(^DIC(625,YSIND,0),U) S:YSIND=217 YSIN(N5)=YSIN(N5)_": "_$P(^YS(615,YSDFN,P4,YSNP,1,N5,0),U,2) Q
WIS ; Called by routine YSPROBR
 I $Y+YSSL+4>IOSL D CK Q:YSLFT
 F I=3:1:8 I $L($P(YSIN(N5)," ",1,I))>52 Q
 W:YSIN(N5)]""&YSID !?6,$P(YSIN(N5)," ",1,I-1) I YSST(YSSN)]"" W:'YSID ! W:$X>56 ! W:YSAN'=1 ?56,YSST(YSSN),?71,DS(YSSN) D:YSST(YSSN)["REF" R Q:YSLFT
 I YSAN'=1 S YSSN=YSSN+1 D FS^YSPROBR
 I $L($P(YSIN(N5)," ",I,99)) W !?6,$P(YSIN(N5)," ",I,99) I YSST(YSSN)]"" W:'YSID ! W:$X>56 ! W:YSAN'=1 ?56,YSST(YSSN),?71,DS(YSSN) S YSSTW=1 D:YSST(YSSN)["REF" R Q:YSLFT
 I YSAN=2&(YSID) S Z=YSNDT
 I  D DC S YSNDT=Z W " on ",Z I YSST(YSSN)]"" W:'YSID ! W:$X>56 ! W:YSAN'=1 ?56,YSST(YSSN),?71,DS(YSSN) S YSSTW=1 D:YSST(YSSN)["REF" R Q:YSLFT
 I YSAN'=1,YSST(YSSN)]"",'$D(YSSTW) W:$X>56 ! W ?56,YSST(YSSN),?71,DS(YSSN) D:YSST(YSSN)["REF" R Q:YSLFT
 K YSSTW,YSINTL S YSSN=YSSN+1,N5=N5+1 D FS^YSPROBR,FI
 Q:YSIN(N5)=""&(YSST(YSSN)="")
 G WIS
R ; Called by routine YSPROBR
 I $Y+YSSL+3>IOSL D CK Q:YSLFT
 W !?10,"REFORMULATED TO: ",R F I=3:1:8 I $L($P(YSRTL," ",1,I))>60 Q
 W !?12,$P(YSRTL," ",1,I-1) I $L($P(YSRTL," ",I,99)) W !?12,$P(YSRTL," ",I,99)
 W ! K YSRF Q
DC ;
 S Z=$$FMTE^XLFDT(Z,"5ZD") S:$L(Z)<7 Z=" "_Z Q
FS ;
 I '$D(^YS(615,YSDFN,P4,YSNP,2,YSSN,0)) S (YSST(YSSN),DS(YSSN))="" Q
 S YSST(YSSN)=$P(^YS(615,YSDFN,P4,YSNP,2,YSSN,0),U,2),DS(YSSN)=$P(^(0),U) S:YSST(YSSN)="RF" YSRF=$P(^(0),U,3),N1=$P(^(0),U,4)
 I YSST(YSSN)]"" S YSST(YSSN)=$S(YSST(YSSN)="AC":"   ACTIVE",YSST(YSSN)="IN":"  INACTIVE",YSST(YSSN)="RA":"REACTIVATED",YSST(YSSN)="RF":"REFORMULATED",YSST(YSSN)="RS":"  RESOLVED",1:"  ??")
 I $D(YSRF) S R=$S(YSRF="EP":"EXISTING PROBLEM",YSRF="NP":"NEW PROBLEM",YSRF="OT":"OTHER PROBLEM",YSRF="DSM":"DSM DIAGNOSIS",YSRF="ICD":"ICD9 DIAGNOSIS",1:" ??")
 I $D(YSRF) S YSRTL=$S(YSRF="EP"!(YSRF="NP")!(YSRF="OT"):$P(^DIC(620,+N1,0),U),YSRF="DSM":$P(^DIC(627,+N1,0),U),YSRF="ICD":$P(^ICD9(+N1,0),U,3),1:" ??")
 I DS(YSSN)]"" S Z=DS(YSSN) D DC S DS(YSSN)=Z
 Q
CK ; Called by routine YSPROBR, YSPROBR1
 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