57 lines
1.8 KiB
Mathematica
57 lines
1.8 KiB
Mathematica
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
|