| 1 | YSPRBR2 ;SLC/DKG-ADDITIONAL PRINT UTILITIES FOR PROBLEM LIST ; 7/10/89 19:09 ;
|
|---|
| 2 | ;;5.01;MENTAL HEALTH;**37**;Dec 30, 1994
|
|---|
| 3 | ;
|
|---|
| 4 | FI ; 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
|
|---|
| 8 | WIS ; 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
|
|---|
| 20 | R ; 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
|
|---|
| 25 | DC ;
|
|---|
| 26 | S Z=$$FMTE^XLFDT(Z,"5ZD") S:$L(Z)<7 Z=" "_Z Q
|
|---|
| 27 | FS ;
|
|---|
| 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
|
|---|
| 35 | CK ; 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
|
|---|
| 37 | WAIT ;
|
|---|
| 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
|
|---|
