source: WorldVistAEHR/trunk/r/MENTAL_HEALTH-YS-RUCL-YI-YT/YSPRBR2.m@ 861

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

initial load of WorldVistAEHR

File size: 2.6 KB
RevLine 
[613]1YSPRBR2 ;SLC/DKG-ADDITIONAL PRINT UTILITIES FOR PROBLEM LIST ; 7/10/89 19:09 ;
2 ;;5.01;MENTAL HEALTH;**37**;Dec 30, 1994
3 ;
4FI ; Called by routine YSPROBR
5 I '$D(^YS(615,YSDFN,P4,YSNP,1,N5,0)) S YSIN(N5)="" Q
6 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)
7 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
8WIS ; Called by routine YSPROBR
9 I $Y+YSSL+4>IOSL D CK Q:YSLFT
10 F I=3:1:8 I $L($P(YSIN(N5)," ",1,I))>52 Q
11 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
12 I YSAN'=1 S YSSN=YSSN+1 D FS^YSPROBR
13 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
14 I YSAN=2&(YSID) S Z=YSNDT
15 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
16 I YSAN'=1,YSST(YSSN)]"",'$D(YSSTW) W:$X>56 ! W ?56,YSST(YSSN),?71,DS(YSSN) D:YSST(YSSN)["REF" R Q:YSLFT
17 K YSSTW,YSINTL S YSSN=YSSN+1,N5=N5+1 D FS^YSPROBR,FI
18 Q:YSIN(N5)=""&(YSST(YSSN)="")
19 G WIS
20R ; Called by routine YSPROBR
21 I $Y+YSSL+3>IOSL D CK Q:YSLFT
22 W !?10,"REFORMULATED TO: ",R F I=3:1:8 I $L($P(YSRTL," ",1,I))>60 Q
23 W !?12,$P(YSRTL," ",1,I-1) I $L($P(YSRTL," ",I,99)) W !?12,$P(YSRTL," ",I,99)
24 W ! K YSRF Q
25DC ;
26 S Z=$$FMTE^XLFDT(Z,"5ZD") S:$L(Z)<7 Z=" "_Z Q
27FS ;
28 I '$D(^YS(615,YSDFN,P4,YSNP,2,YSSN,0)) S (YSST(YSSN),DS(YSSN))="" Q
29 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)
30 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:" ??")
31 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:" ??")
32 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:" ??")
33 I DS(YSSN)]"" S Z=DS(YSSN) D DC S DS(YSSN)=Z
34 Q
35CK ; Called by routine YSPROBR, YSPROBR1
36 S:YST YSCON=1 D ENFT^YSFORM:YST,WAIT:'YST Q:YSLFT D:YST ENHD^YSFORM X:'YST YSFHDR(1) Q
37WAIT ;
38 F I0=1:1:IOSL-$Y-2 W !
39 W:$Y+1<IOSL !
40 N DTOUT,DUOUT,DIRUT
41 S DIR(0)="E" D ^DIR K DIR S YSTOUT=$D(DTOUT),YSUOUT=$D(DUOUT),YSLFT=$D(DIRUT)
42 W @IOF Q
Note: See TracBrowser for help on using the repository browser.