| [613] | 1 | YSPROB5 ;SLC/DKG-PROBLEM LIST PRINT UTILITY ;10/4/89 14:14 ;
|
|---|
| 2 | ;;5.01;MENTAL HEALTH;**37**;Dec 30, 1994
|
|---|
| 3 | ;
|
|---|
| 4 | ; Called by routine YSPROBR
|
|---|
| 5 | K IOP S %ZIS="Q" D ^%ZIS G:POP FIN
|
|---|
| 6 | I $D(IO("Q")) K IO("Q") S ZTRTN="ENPRINT^YSPROB5",ZTSAVE("YS*")="",ZTDESC="YS PROB LIST PRINT" D ^%ZTLOAD S YSLFT=1 Q
|
|---|
| 7 | 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
|
|---|
| 8 | EN1 ; Called by routine YSCEN3, YSPP9
|
|---|
| 9 | I '$D(^YS(615,YSDFN,P4)) W !!,"NO PROBLEMS ON FILE" G DX1
|
|---|
| 10 | I $P(^YS(615,YSDFN,P4,0),U,3)']"" W !!,"NO PROBLEMS ON FILE" G DX1
|
|---|
| 11 | W !!,"PROBLEM(S):"
|
|---|
| 12 | S N2=0
|
|---|
| 13 | LS ;
|
|---|
| 14 | S N2=$O(^YS(615,YSDFN,P4,N2))
|
|---|
| 15 | G:'N2 DX1
|
|---|
| 16 | D:$Y+YSSL>IOSL CK
|
|---|
| 17 | G:YSLFT FIN
|
|---|
| 18 | W !,$P(^DIC(620,N2,0),U)
|
|---|
| 19 | D FS
|
|---|
| 20 | ;W:YSOK ?59,$J(S5,12),?72,L4 K YSOK
|
|---|
| 21 | W:YSOK ?55,$J(S5,12),?69,L4 K YSOK
|
|---|
| 22 | G LS
|
|---|
| 23 | ;
|
|---|
| 24 | FS ;
|
|---|
| 25 | S YSOK=0
|
|---|
| 26 | S L2=+$P(^YS(615,YSDFN,P4,N2,2,0),U,3) QUIT:L2'>0 ;3rd piece of mult header
|
|---|
| 27 | S L3=$P(^YS(615,YSDFN,P4,N2,2,L2,0),U,2),Z=$P(^(0),U)
|
|---|
| 28 | D DC
|
|---|
| 29 | S L4=Z
|
|---|
| 30 | S S5=$S(L3="AC":"ACTIVE",L3="IN":"INACTIVE",L3="RA":"REACTIVATED",L3="RF":"REFORMULATED",L3="RS":"RESOLVED",1:"")
|
|---|
| 31 | S YSOK=1
|
|---|
| 32 | QUIT
|
|---|
| 33 | ;
|
|---|
| 34 | DX1 ;
|
|---|
| 35 | ; Code originally stored here moved to DX1,PHDX,VAR,PLINE^YSDX0001
|
|---|
| 36 | ; 11/17/93 LJA
|
|---|
| 37 | D DX1^YSDX0001
|
|---|
| 38 | QUIT
|
|---|
| 39 | ;
|
|---|
| 40 | DC ; DC code cloned into YSDX0001
|
|---|
| 41 | ;S Z=$E(Z,1,7) S:Z]"" Z=$E(Z,4,5)_"-"_$E(Z,6,7)_"-"_$E(Z,2,3) Q
|
|---|
| 42 | S Z=$E(Z,1,7) S:Z]"" Z=$$FMTE^XLFDT(Z,"5ZD") Q
|
|---|
| 43 | CK ;
|
|---|
| 44 | I $D(YSNOFORM) D:'YST WAIT Q:YSLFT W:YST @IOF Q
|
|---|
| 45 | S:YST&(YSLFT=0) YSCON=1 D ENFT^YSFORM:YST,WAIT:'YST Q:YSLFT D:YST ENHD^YSFORM X:'YST YSFHDR(1) Q
|
|---|
| 46 | WAIT ;
|
|---|
| 47 | F I0=1:1:IOSL-$Y-2 W !
|
|---|
| 48 | W:$Y+1<IOSL !
|
|---|
| 49 | N DTOUT,DUOUT,DIRUT
|
|---|
| 50 | S DIR(0)="E" D ^DIR K DIR S YSTOUT=$D(DTOUT),YSUOUT=$D(DUOUT),YSLFT=$D(DIRUT)
|
|---|
| 51 | W @IOF Q
|
|---|
| 52 | FIN ;
|
|---|
| 53 | S:YST YSLFT=1 D:'$D(PROFILE) CK
|
|---|
| 54 | QUIT
|
|---|
| 55 | ;
|
|---|
| 56 | EOR ;YSPROB5 - PROBLEM LIST PRINT UTILITY ; 10/4/89 14:14
|
|---|
