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

Last change on this file since 794 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 1.8 KB
Line 
1YSPROB5 ;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
7ENPRINT 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
8EN1 ; 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
13LS ;
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 ;
24FS ;
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 ;
34DX1 ;
35 ; Code originally stored here moved to DX1,PHDX,VAR,PLINE^YSDX0001
36 ; 11/17/93 LJA
37 D DX1^YSDX0001
38 QUIT
39 ;
40DC ; 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
43CK ;
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
46WAIT ;
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
52FIN ;
53 S:YST YSLFT=1 D:'$D(PROFILE) CK
54 QUIT
55 ;
56EOR ;YSPROB5 - PROBLEM LIST PRINT UTILITY ; 10/4/89 14:14
Note: See TracBrowser for help on using the repository browser.