source: WorldVistAEHR/trunk/r/MENTAL_HEALTH-YS-RUCL-YI-YT/YSPROBR.m@ 1005

YSPROBR ;SLC/DKG-PRINTS PROBLEM LIST ;11/16/90  08:57 ;08/12/93 14:06
 ;;5.01;MENTAL HEALTH;**37**;Dec 30, 1994
A ;
 R !!!?3,"(A)ctive, (H)istorical, (C)omplete, (S)hort or (Q)uit? A// ",A:DTIME S YSTOUT='$T,YSUOUT=A["^" G:YSTOUT!YSUOUT END S A=$TR($E(A_"A"),"ahcsq","AHCSQ") I A="Q" G END
 I A="S" D ^YSPROB5 G END:YSLFT,END^YSPROBR1
 I "AHC"'[A W:A'["?" $C(7)," ?" G A
 S YSAN=$S("A"[A:1,"C"[A:2,1:3)
IN ;
 I YSAN'=2 R !!,"Do you wish problem indicators? N// ",YSID:DTIME S YSTOUT='$T,YSUOUT=YSID["^" G:YSTOUT!YSUOUT END S YSID=$TR($E(YSID_"N"),"ny","NY") I "YN"'[YSID W:YSID'["?" " ?",$C(7) G IN
 S:YSAN=2 YSID=1 S:"Y"[YSID YSID=1
PR ;
 W ! S %ZIS="Q" K IOP D ^%ZIS G:POP END
 I $D(IO("Q")) K IO("Q") S ZTRTN="ENPRINT^YSPROBR",ZTSAVE("YS*")="",ZTDESC="YS PROB REPT" D ^%ZTLOAD G END
 ;
ENPRINT ;
 U IO S P4="PL",YSLFT=0,YST=$S(IOST?1"C-".E:0,1:1),YSSL=$S(YST:8,1:3),YSDXH="" D ENHD^YSPRBR1,ENHD^YSFORM
 I '$D(^YS(615,YSDFN,P4,0)) D MSG2^YSEMSG G END
 I $D(^YS(615,YSDFN,P4,1))!($D(^YS(615,YSDFN,P4,2))) S YSDXH="CRITICAL PROBLEM" S:$D(^YS(615,YSDFN,P4,1))&($D(^YS(615,YSDFN,P4,2))) YSDXH=YSDXH_"S" S YSDXH=YSDXH_":" W !!?2,YSDXH S YSDXH=YSDXH_" (Continued)"
FP ;
 S YSNP=0
FP1 ; Called by routine YSPRBR1
 S YSNP=$O(^YS(615,YSDFN,P4,YSNP))
 G:YSNP>2!('YSNP)&'$D(YSCOM) DSM^YSPRBR1
 I YSNP<1 G ^YSPROBR1
 I '$D(^YS(615,YSDFN,P4,+YSNP,2,0)) D MSG3^YSEMSG G END
 S YSLP=$P(^YS(615,YSDFN,P4,+YSNP,2,0),U,3)
 I '$D(^YS(615,YSDFN,P4,+YSNP,2,+YSLP,0)) D MSG4^YSEMSG G END
 S YSLPS=$P(^YS(615,YSDFN,P4,+YSNP,2,+YSLP,0),U,2)
 D RST I YSAN=1,YSLPS="IN"!(YSLPS="RS") G FP1
 S YSPRB=$P(^DIC(620,YSNP,0),U),YSPRD=^YS(615,YSDFN,P4,YSNP,0),YSDO=$P(YSPRD,U,4),YSDR=$P(YSPRD,U,5),YSUSER=$P(YSPRD,U,6) S:YSNP=27 YSPRB=YSPRB_": "_$P(YSPRD,U,2) D DOC S Z=YSDR D DC S YSDR=Z
 S (N5,YSSN)=1
PRB ;
 I $Y+YSSL+4>IOSL D CK^YSPRBR2 G:YSLFT END
 D:YSAN'=1 FS
 F I=3:1:5 I $L($P(YSPRB," ",1,I))>30 Q
 W !!?2,$P(YSPRB," ",1,I-1),?36,YSDO,?46,YSDR,?56,YSST(YSSN),?71,DS(YSSN) D:YSST(YSSN)["REF" R^YSPRBR2:YSAN'=1 G:YSLFT END I YSAN=1 S YSST(YSSN)=""
 I YSAN'=1 S YSSN=YSSN+1 D FS
 I $L($P(YSPRB," ",I,99)) W !?2,$P(YSPRB," ",I,99) G:YSAN=1&'YSID MIS1 I YSST(YSSN)]"" W:YSAN'=1 ?56,YSST(YSSN),?71,DS(YSSN) D:YSST(YSSN)["REF" R^YSPRBR2 G:YSLFT END S YSSN=YSSN+1 D FS
USER ;
 I YSAN=2 S YSUSER=$P(^VA(200,YSUSER,0),U),YSUTN=$P(^(0),U,9) S:YSUTN]"" YSUTL=$P(^DIC(3.1,YSUTN,0),U) W !?4,"By: ",YSUSER W:$D(YSUTL) "  ",YSUTL
 I YSAN=2&(YSST(YSSN)]"") W:$X>56 ! W ?56,YSST(YSSN),?71,DS(YSSN) D:YSST(YSSN)["REF" R^YSPRBR2 G:YSLFT END S YSSN=YSSN+1 D FS
 D FI^YSPRBR2,WIS^YSPRBR2 G:YSLFT END
MIS ;
 S YSSN=YSSN+1 D FS S N5=N5+1 D FI^YSPRBR2
MIS1 ;
 S:'$D(YSIN(N5)) YSIN(N5)="" I YSST(YSSN)=""&(YSIN(N5)="") K YSIN,YSST G FP1
 D WIS^YSPRBR2 G:YSLFT END G MIS
 ;
FS ; Called by routine YSPRBR2
 I '$D(^YS(615,YSDFN,P4,YSNP,2,YSSN,0)) S (YSST(YSSN),DS(YSSN))="" Q
 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)
 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:"  ??")
 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:" ??")
 I $D(YSRF),N1]"" 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:" ??")
 I $D(YSRF),N1="" S YSRTL="*** Alert: "_R_" not specified ***"
 I DS(YSSN)]"" S Z=DS(YSSN) D DC S DS(YSSN)=Z
 Q
RST ;
 S:'$D(YSRSD) YSRSD=$P(^YS(615,YSDFN,P4,YSNP,2,YSLP,0),U),YSRST=$P(^(0),U,5) S YSCSD=$P(^YS(615,YSDFN,P4,YSNP,2,YSLP,0),U),YSSTT=$P(^(0),U,2),YSCST=$P(^(0),U,5)
 I YSCSD>YSRSD S YSRSD=YSCSD,YSRST=YSCST
 Q:YSAN'=1  S YSST(1)=$S(YSSTT="AC":"   ACTIVE",YSSTT="RF":"REFORMULATED",YSSTT="RA":"REACTIVATED",1:"") S Z=YSCSD D DC S DS(1)=Z K YSSTT 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 ;
 S Z=$$FMTE^XLFDT(Z,"5ZD") S:$L(Z)<7 Z=" "_Z Q
 ;
ENP ; Called from MENU option YSPPROB
 D ^YSLRP I YSDFN>0,$O(^YS(615,YSDFN,"PL",0)) G YSPROBR
 I YSDFN>0 W !!?3,"No 'Problem List' entries exist for this patient.",!,$C(7)
 ;
END ;
 G FIN^YSPROBR1