YSPROB5 ;SLC/DKG-PROBLEM LIST PRINT UTILITY ;10/4/89  14:14 ;
 ;;5.01;MENTAL HEALTH;**37**;Dec 30, 1994
 ;
 ; Called by routine YSPROBR
 K IOP S %ZIS="Q" D ^%ZIS G:POP FIN
 I $D(IO("Q")) K IO("Q") S ZTRTN="ENPRINT^YSPROB5",ZTSAVE("YS*")="",ZTDESC="YS PROB LIST PRINT" D ^%ZTLOAD S YSLFT=1 Q
ENPRINT U IO S YST=$S(IOST?1"C-".E:0,1:1),YSSL=$S(YST:8,1:3),P4="PL",YSFHDR="Short Problem List",YSFTR="     ",YSLFT=0 D:'$D(YSNOFORM) ENHD^YSFORM
EN1 ; Called by routine YSCEN3, YSPP9
 I '$D(^YS(615,YSDFN,P4)) W !!,"NO PROBLEMS ON FILE" G DX1
 I $P(^YS(615,YSDFN,P4,0),U,3)']"" W !!,"NO PROBLEMS ON FILE" G DX1
 W !!,"PROBLEM(S):"
 S N2=0
LS ;
 S N2=$O(^YS(615,YSDFN,P4,N2))
 G:'N2 DX1
 D:$Y+YSSL>IOSL CK
 G:YSLFT FIN
 W !,$P(^DIC(620,N2,0),U)
 D FS
 ;W:YSOK ?59,$J(S5,12),?72,L4 K YSOK
 W:YSOK ?55,$J(S5,12),?69,L4 K YSOK
 G LS
 ;
FS ;
 S YSOK=0
 S L2=+$P(^YS(615,YSDFN,P4,N2,2,0),U,3) QUIT:L2'>0  ;3rd piece of mult header
 S L3=$P(^YS(615,YSDFN,P4,N2,2,L2,0),U,2),Z=$P(^(0),U)
 D DC
 S L4=Z
 S S5=$S(L3="AC":"ACTIVE",L3="IN":"INACTIVE",L3="RA":"REACTIVATED",L3="RF":"REFORMULATED",L3="RS":"RESOLVED",1:"")
 S YSOK=1
 QUIT
 ;
DX1 ;
 ;  Code originally stored here moved to DX1,PHDX,VAR,PLINE^YSDX0001
 ;  11/17/93 LJA
 D DX1^YSDX0001
 QUIT
 ;
DC ;  DC code cloned into YSDX0001
 ;S Z=$E(Z,1,7) S:Z]"" Z=$E(Z,4,5)_"-"_$E(Z,6,7)_"-"_$E(Z,2,3) Q
 S Z=$E(Z,1,7) S:Z]"" Z=$$FMTE^XLFDT(Z,"5ZD") Q
CK ;
 I $D(YSNOFORM) D:'YST WAIT Q:YSLFT  W:YST @IOF Q
 S:YST&(YSLFT=0) 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
FIN ;
 S:YST YSLFT=1 D:'$D(PROFILE) CK
 QUIT
 ;
EOR ;YSPROB5 - PROBLEM LIST PRINT UTILITY ; 10/4/89 14:14