55 lines
2.8 KiB
Mathematica
55 lines
2.8 KiB
Mathematica
YSPRBR1 ;SLC/DKG-PROBLEM PRINT UTILITIES ;4/20/92 17:17 ;
|
|
;;5.01;MENTAL HEALTH;**37**;Dec 30, 1994
|
|
;
|
|
ENHD ; Called by routine YSPROBR
|
|
S YSFHDR=$S(YSAN=1:"Active",YSAN=3:"Historical",YSAN=2:"Complete",1:"")_" Problem List",YSFTR="VAF 10-1415"
|
|
S YSFHDR(1)="W:YST!(YSDXH="""") !! W ?2,""Problem"",?36,""Date of"",?48,""Date"",?59,""Status"",?72,""Date of"" X YSFHDR(2)"
|
|
S YSFHDR(2)="W !?4 W $S(YSAN=2:""Staff"",YSID:""Indicator(s)"",1:""""),?37,""Onset"",?46,""Recorded"",?72,""Status"" W:YSAN=2 !?6,""Indicator(s)"" W ! W:YSDXH]"""" !?2,YSDXH,!" Q
|
|
DOC ;
|
|
I $E(YSDO,6,7)["00" S Y=YSDO D ENDD^YSUTL S YSDO=YSDT(1)
|
|
E S YSDO=$$FMTE^XLFDT(YSDO,"5ZD")
|
|
Q
|
|
DC ; Called by routine YSPROBR1
|
|
S Z=$$FMTE^XLFDT(Z,"5ZD") S:$L(Z)<7 Z=" "_Z Q
|
|
DSM ; Called by routine YSPROBR
|
|
S YSCOM=1 D:$Y+YSSL+3>IOSL CK G:YSLFT END
|
|
I '$D(^YSD(627.8,"AE","D",YSDFN)) W !!,"NO DSM DIAGNOSES ON FILE" G PHDX
|
|
DX ;
|
|
S YSHDX="DSM DIAGNOSES:" W !!?2,YSHDX,! S L="D",L1=0 F S L1=$O(^YSD(627.8,"AE",L,YSDFN,L1)) Q:'L1 S L2="" F S L2=$O(^YSD(627.8,"AE",L,YSDFN,L1,L2)) Q:L2="" S L3=0 F S L3=$O(^YSD(627.8,"AE",L,YSDFN,L1,L2,L3)) Q:'L3 D VAR
|
|
PHDX ;
|
|
D:$Y+YSSL+1>IOSL CK G:YSLFT END I '$D(^YSD(627.8,"AE","I",YSDFN)) W !!,"NO ICD9 DIAGNOSES ON FILE" G FIN
|
|
S YSHDX="ICD9 DIAGNOSES:" W !!?2,YSHDX,!
|
|
PHDX1 ;
|
|
S L="I",L1=0 F S L1=$O(^YSD(627.8,"AE",L,YSDFN,L1)) Q:'L1 S L2="" F S L2=$O(^(L1,L2)) Q:L2="" S L3=0 F S L3=$O(^YSD(627.8,"AE",L,YSDFN,L1,L2,L3)) Q:'L3 D VAR
|
|
I $Y+YSSL>IOSL D WAIT G:YSLFT END
|
|
G FIN
|
|
VAR ;
|
|
D PDX I L="D" S DX=$P(L2,";",2),DX1=$P(L2,";"),DX2="^"_DX_DX1_","_0_")",YSDXNN=$P(@DX2,U,2),DX3="^"_DX_DX1_","_0_")",YSDXN=$P(@DX3,U,15)
|
|
I L="I" S DX=$P(L2,";",2),DX1=$P(L2,";"),DX2="^"_DX_DX1_","_0_")",YSDXN=$P(@DX2,U,3),YSDXNN=$P(@DX2,U)
|
|
S Z=$P(^YSD(627.8,L3,0),U,3) D DC S RDT=Z,ST=$P(^(1),U,4),ST1=$S(ST="A":"ACTIVE",ST="I":"INACTIVE",1:"UNKNOWN"),Z=$P(^(1),U,5) D DC S STDT=Z I YSAN=1&(ST'="A") Q
|
|
PLINE ;
|
|
D:$Y+YSSL+1>IOSL CK G:YSLFT END W !?2,$E(YSDXN,1,26),?30,YSPHDX,?45,$J(RDT,8),?57,$J(ST1,8),?71,STDT,! Q
|
|
PDX ;
|
|
S YSPHDX="" Q:'$D(^YSD(627.8,"AD",YSDFN)) S J=$O(^YSD(627.8,"AD",YSDFN,0)),J1=$O(^(J,0)) I J1=L3 S YSPHDX="*""P"" DIAGNOSIS*"
|
|
Q
|
|
DC1 ;
|
|
S Z=YSDS D DC S YSDS=Z S Z=YSDR D DC S YSDR=Z Q
|
|
G:YSLFT END W:$Y+YSSL'>IOSL ! G DX
|
|
FIN ;
|
|
S (YSNP,N1)=2 K DX,DXS S K=0
|
|
N1 ;
|
|
S N1=$O(^YS(615,YSDFN,P4,N1)) G:'N1 END S K=K+1 G:K>0 FIN1 G N1
|
|
FIN1 ;
|
|
I $Y+YSSL>IOSL S YSDXH="" D CK G:YSLFT END
|
|
S YSDXH="ADDITIONAL PROBLEM" S:K>1 YSDXH=YSDXH_"S" S YSDXH=YSDXH_":" W:N1>1 !?2,YSDXH S YSDXH=YSDXH_" (Continued)" G FP1^YSPROBR
|
|
G:YSLFT END W:$Y+YSSL'>IOSL ! G PHDX1
|
|
CK ;
|
|
S:YST 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
|
|
END ;
|
|
G FIN^YSPROBR1
|