source: FOIAVistA/trunk/r/MENTAL_HEALTH-YS-RUCL-YI-YT/YSPROB4.m@ 1166

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

initial load of FOIAVistA 6/30/08 version

File size: 3.2 KB
Line 
1YSPROB4 ;SLC/DKG-PROBLEM LIST CHANGE ROUTINES ;1/16/90 08:59 ;
2 ;;5.01;MENTAL HEALTH;;Dec 30, 1994
3 ;
4ENIN ; Called from MENU option YSIPROB
5 ;
6 D ^YSLRP G:YSDFN<1 FIN D H S M1="IN" G CS
7 ;
8ENRA ; Called from MENU option YSRAPROB
9 D ^YSLRP G:YSDFN<1 FIN D H S M1="RA" G CS
10 ;
11ENRS ; Called from MENU option YSRSPROB
12 D ^YSLRP G:YSDFN<1 FIN D H S M1="RS" G CS
13 ;
14ENRF ; Called from MENU option YSRFPROB
15 D ^YSLRP G:YSDFN<1 FIN D H
16 ;
17ENRF1 ;
18 S M1="RF" G CS
19H ;
20 K Y D ENDTM^YSUTL S P4="PL",YSTOUT=0 S YSEND=$O(^YS(615,YSDFN,P4,0)) K:'YSEND ^YS(615,YSDFN,P4)
21 Q
22CS ;
23 I '$D(^YS(615,YSDFN,P4)) W !!?3,"No 'Problem List' entries exist for this patient.",!,$C(7) G FIN
24 D A1 I YSTOUT!YSUOUT G FIN
25 K YSPTD,%DT,X,Y S DA(1)=YSDFN,DIC="^YS(615,YSDFN,P4,",DIC(0)="AEQMNZ" W ! D ^DIC G:Y'>0 FIN D CK G:A2 FIN
26 S DIC("NO^")=1,DA(1)=YSDFN,(DA,N5)=+Y,X=M1,DIE("NO^")=1,DIE="^YS(615,YSDFN,P4,",DR="8///"_YSDTM
27 S DR(2,615.03)=".01///"_YSDTM_";1///"_X_";I X]""RF"" S Y=4;2;S R=X;4///^S X=""`""_DUZ" L +^YS(615,YSDFN) D ^DIE L -^YS(615,YSDFN) S YSTOUT=$D(DTOUT)
28 K DIE("NO^") Q:YSTOUT D:$D(R) ^YSPROB3
29 S N6=$P(^DIC(620,N5,0),U),S6=$S(M1="IN":"INACTIVATED",M1="RA":"REACTIVATED",M1="RS":"RESOLVED",M1="RF":"REFORMULATED",1:"")
30 W !!?3,N6," has been ",S6,!
31FIN ;
32 D KVAR^VADPT G FIN^YSPROB1
33A1 ;
34 R !!?3,"Do you want to see problems already on the list? N// ",A4:DTIME S YSTOUT='$T,YSUOUT=A4["^" Q:YSTOUT!YSUOUT S:A4="" A4="N"
35 I "YyNn"'[$E(A4) W !?3,$C(7),"Type 'Y' or 'N'." G A1
36 Q:"Yy"'[A4 S N2=0 W !
37 ;
38LS ; Called by routine YSPROB, YSPROB3
39 F S N2=$O(^YS(615,YSDFN,P4,N2)) Q:'N2 W !?3,N2,?7,$P(^DIC(620,N2,0),U) D FS W ?50,S5 K L3,S5
40 Q
41 ;
42FS ;
43 S L3=$P(^($P(^YS(615,YSDFN,P4,N2,2,0),U,3),0),U,2),S5=$S(L3="AC":" ACTIVE",L3="IN":" INACTIVE",L3="RA":"REACTIVATED",L3="RF":"REFORMULATED",L3="RS":" RESOLVED",1:"")
44 Q
45CK ;
46 S N2=+Y,N3=$P(^DIC(620,N2,0),U),A2="" D FS
47 I L3=M1 W $C(7),!!?2,N3," is already ",$S(L3="IN":"INACTIVE! ",L3="RA":"REACTIVATED! ",L3="RS":"RESOLVED! ",L3="RF":"REFORMULATED! ",1:"CHANGED! ") S A2=1 Q
48 I L3="RF",M1="IN" W $C(7),!!?2,N3," has been REFORMULATED!",!!?2,"It is not necessary to INACTIVATE a REFORMULATED problem!" S A2=1 Q
49 I L3="RS",M1="IN" W $C(7),!!?2,N3," has been RESOLVED!",!!?2,"It is not necessary to INACTIVATE a RESOLVED problem! " S A2=1 Q
50 I L3="RF",M1'="RF" W $C(7),!!?2,N3," has been REFORMULATED!"
51CK1 ;
52 I L3="RF",M1'="RF" D MSG W $S(M1="RA":"REACTIVATE ",M1="RS":"RESOLVE ",1:"CHANGE "),"it? " R " NO// ",A:DTIME S YSTOUT='$T,YSUOUT=A["^" S:A="" A="N" S:YSTOUT!YSUOUT!("Nn^"[A) A2=1 Q:"Yy"[A!A2 W:A'["?" " ?",$C(7) G CK1
53 I M1="RA",L3="AC" W $C(7),!!?2,N3," is already active! " S A2=1 Q
54 I L3="RS",M1'="RS" W $C(7),!!?2,N3," has been RESOLVED!"
55CK2 ;
56 I L3="RS",M1'="RS" D MSG W $S(M1="RA":"REACTIVATE ",M1="RF":"REFORMULATE ",1:"CHANGE "),"it? " R "N// ",A:DTIME S YSTOUT='$T,YSUOUT=A["^" S:A="" A="N" S:YSTOUT!YSUOUT!("Nn^"[A) A2=1 Q:"Yy"[A!A2 W:A'["?" " ?",$C(7) G CK2
57 I L3="IN",M1="RS"!(M1="RF") W $C(7),!!?2,N3," is INACTIVE!"
58CK3 ;
59 I L3="IN",M1="RS"!(M1="RF") D MSG W $S(M1="RS":"RESOLVE ",M1="RF":"REFORMULATE ",1:"CHANGE "),"it? " R " N// ",A:DTIME S YSTOUT='$T,YSUOUT=A["^" S:A="" A="N" S:YSTOUT!YSUOUT!("Nn^"[A) A2=1 Q:"Yy"[A!A2 W:A'["?" " ?",$C(7) G CK3
60 Q
61MSG W !!?2,"Are you sure you want to "
62 Q
Note: See TracBrowser for help on using the repository browser.