source: WorldVistAEHR/trunk/r/MENTAL_HEALTH-YS-RUCL-YI-YT/YSPRBR1.m@ 1489

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

initial load of WorldVistAEHR

File size: 2.8 KB
Line 
1YSPRBR1 ;SLC/DKG-PROBLEM PRINT UTILITIES ;4/20/92 17:17 ;
2 ;;5.01;MENTAL HEALTH;**37**;Dec 30, 1994
3 ;
4ENHD ; Called by routine YSPROBR
5 S YSFHDR=$S(YSAN=1:"Active",YSAN=3:"Historical",YSAN=2:"Complete",1:"")_" Problem List",YSFTR="VAF 10-1415"
6 S YSFHDR(1)="W:YST!(YSDXH="""") !! W ?2,""Problem"",?36,""Date of"",?48,""Date"",?59,""Status"",?72,""Date of"" X YSFHDR(2)"
7 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
8DOC ;
9 I $E(YSDO,6,7)["00" S Y=YSDO D ENDD^YSUTL S YSDO=YSDT(1)
10 E S YSDO=$$FMTE^XLFDT(YSDO,"5ZD")
11 Q
12DC ; Called by routine YSPROBR1
13 S Z=$$FMTE^XLFDT(Z,"5ZD") S:$L(Z)<7 Z=" "_Z Q
14DSM ; Called by routine YSPROBR
15 S YSCOM=1 D:$Y+YSSL+3>IOSL CK G:YSLFT END
16 I '$D(^YSD(627.8,"AE","D",YSDFN)) W !!,"NO DSM DIAGNOSES ON FILE" G PHDX
17DX ;
18 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
19PHDX ;
20 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
21 S YSHDX="ICD9 DIAGNOSES:" W !!?2,YSHDX,!
22PHDX1 ;
23 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
24 I $Y+YSSL>IOSL D WAIT G:YSLFT END
25 G FIN
26VAR ;
27 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)
28 I L="I" S DX=$P(L2,";",2),DX1=$P(L2,";"),DX2="^"_DX_DX1_","_0_")",YSDXN=$P(@DX2,U,3),YSDXNN=$P(@DX2,U)
29 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
30PLINE ;
31 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
32PDX ;
33 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*"
34 Q
35DC1 ;
36 S Z=YSDS D DC S YSDS=Z S Z=YSDR D DC S YSDR=Z Q
37 G:YSLFT END W:$Y+YSSL'>IOSL ! G DX
38FIN ;
39 S (YSNP,N1)=2 K DX,DXS S K=0
40N1 ;
41 S N1=$O(^YS(615,YSDFN,P4,N1)) G:'N1 END S K=K+1 G:K>0 FIN1 G N1
42FIN1 ;
43 I $Y+YSSL>IOSL S YSDXH="" D CK G:YSLFT END
44 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
45 G:YSLFT END W:$Y+YSSL'>IOSL ! G PHDX1
46CK ;
47 S:YST YSCON=1 D ENFT^YSFORM:YST,WAIT:'YST Q:YSLFT D:YST ENHD^YSFORM X:'YST YSFHDR(1) Q
48WAIT ;
49 F I0=1:1:IOSL-$Y-2 W !
50 W:$Y+1<IOSL !
51 N DTOUT,DUOUT,DIRUT
52 S DIR(0)="E" D ^DIR K DIR S YSTOUT=$D(DTOUT),YSUOUT=$D(DUOUT),YSLFT=$D(DIRUT) W @IOF Q
53END ;
54 G FIN^YSPROBR1
Note: See TracBrowser for help on using the repository browser.