source: WorldVistAEHR/trunk/r/PROBLEM_LIST-GMPL/GMPLEDT2.m@ 1261

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

revised back to 6/30/08 version
File size: 4.8 KB
RevLine 
[623]1GMPLEDT2 ; SLC/MKB/KER -- Problem List edit actions ; 04/15/2002
2 ;;2.0;Problem List;**26**;Aug 25, 1994
3 ;
4 ; External References
5 ; DBIA 10060 ^VA(200
6 ; DBIA 10003 ^%DT
7 ; DBIA 10006 ^DIC
8 ; DBIA 10026 ^DIR
9 ; DBIA 10103 $$HTFM^XLFDT
10 ; DBIA 10104 $$UP^XLFSTR
11 ;
12EDITED() ; Returns 1 if problem has been altered
13 N FLD,NOTE,DIFFRENT S DIFFRENT=0
14 F FLD=0:0 S FLD=$O(GMPORIG(FLD)) Q:(FLD'>0)!(FLD'<10) I GMPORIG(FLD)'=GMPFLD(FLD) S DIFFRENT=1 Q
15 G:DIFFRENT EDQ
16 I $D(GMPFLD(10,"NEW"))>9 S DIFFRENT=1 G EDQ
17 F NOTE=0:0 S NOTE=$O(GMPORIG(10,NOTE)) Q:NOTE'>0 I $P(GMPORIG(10,NOTE),U,3)'=$P(GMPFLD(10,NOTE),U,3) S DIFFRENT=1 Q
18EDQ Q DIFFRENT
19 ;
20SUREDEL(NUM) ; -- sure you want to delete problems?
21 N DIR,X,Y
22 W !!,"CAUTION: "_$S(NUM=1:"This problem",1:"These "_NUM_" problems")_" will be completely removed",!," from this patient's list!!",!
23 S DIR(0)="YA",DIR("A")="Are you sure? ",DIR("B")="NO"
24 S DIR("?",1)="Enter YES to delete "_$S(NUM=1:"this problem",1:"these problems")_" from the current patient's list."
25 S DIR("?",2)="DO NOT use this option to remove problems from your currently"
26 S DIR("?")="displayed view of the Problem List!!"
27 W $C(7) D ^DIR
28 Q +Y
29 ;
30DELETE ; Remove current problem from patient's list
31 N CHNGE S VALMBCK=$S(VALMCC:"",1:"R") Q:'$$SUREDEL(1)
32 S CHNGE=GMPIFN_"^1.02^"_$$HTFM^XLFDT($H)_U_DUZ_"^P^H^Deleted^"_+$G(GMPROV) W "."
33 S $P(^AUPNPROB(GMPIFN,1),U,2)="H",GMPSAVED=1,VALMBCK="Q" W "."
34 D AUDIT^GMPLX(CHNGE,""),DTMOD^GMPLX(GMPIFN) W "."
35 W "... removed!",!!,"Returning to Problem List.",! H 1
36 Q
37 ;
38VERIFY ; Mark current problem as verified
39 I GMPFLD(1.02)'="T" W $C(7),!!,"This problem does not require verification.",! H 1 Q
40 S GMPFLD(1.02)="P" W !,"."
41 W "... verified!" H 1
42 Q
43 ;
44NPERSON ; look up into #200, given PROMPT,HELPMSG,DEFAULT (returns X, Y)
45 N DIC
46NP W !,PROMPT_$S(+DEFAULT:$P(DEFAULT,U,2)_"//",1:"")
47 R X:DTIME S:'$T DTOUT=1 I $D(DTOUT)!(X="^") S GMPQUIT=1 Q
48 I X?1"^".E D JUMP^GMPLEDT3(X) Q:$D(GMPQUIT)!($G(GMPLJUMP)) K:$G(GMPIFN) GMPLJUMP G NP
49 I X="" S Y=DEFAULT Q
50 I X="@" G:'$$SURE^GMPLX NP S Y="" Q
51 I X="?" W !!,HELPMSG,! G NP
52 I X["??" D NPHELP G NP
53 S DIC="^VA(200,",DIC(0)="EMQ" D ^DIC
54 I Y'>0 W !!,HELPMSG,!,$C(7) G NP
55 Q
56 ;
57NPHELP ; List names in New Person file
58 N NM,CNT,I,Y S CNT=0,(NM,Y)="" W !,"Choose from: "
59 F S NM=$O(^VA(200,"B",NM)) Q:NM="" D Q:Y'=""
60 . S CNT=CNT+1 I '(CNT#9) D Q:Y="^"
61 . . W " ... more, or ^ to stop: " R Y:DTIME S:'$T Y="^"
62 . S I=$O(^VA(200,"B",NM,0)) W !," "_$P($G(^VA(200,I,0)),U)
63 W !
64 Q
65 ;
66DATE ; Edit date fields given PROMPT,HELPMSG,DEFAULT (ret'ns X,Y)
67 N %DT S %DT="EP"
68D1 W !,PROMPT_$S(+DEFAULT:$P(DEFAULT,U,2)_"//",1:"")
69 R X:DTIME S:'$T DTOUT=1 I $D(DTOUT)!(X="^") S GMPQUIT=1 Q
70 I X?1"^".E D JUMP^GMPLEDT3(X) Q:$D(GMPQUIT)!($G(GMPLJUMP)) K:$G(GMPIFN) GMPLJUMP G D1
71 I X="" S Y=DEFAULT Q
72 I X="@" G:'$$SURE^GMPLX D1 S Y="" Q
73 I X="?" W !!,HELPMSG,! G D1
74 I X["??" D DTHELP G D1
75 D ^%DT I Y<1 W " INVALID DATE" D DTHELP W !,HELPMSG G D1
76 I Y>DT W !!,"Date cannot be in the future!",!,$C(7) G D1
77 Q
78 ;
79DTHELP ; Date help
80 W !!,"Examples of valid dates:"
81 W !," Jan 20 1957 or 20 Jan 57 or 1/20/57 or 012057"
82 W !," T (for TODAY), T-1 (for YESTERDAY), T-3W (for 3 WEEKS AGO), etc."
83 W !,"You may omit the precise day, such as Jan 1957, or"
84 W !,"If the year is omitted, a date in the PAST will be assumed.",!
85 Q
86 ;
87SPEXP ; Edit Fields 1.11, 1.12, 1.13, 1.15, 1.16
88 D:GMPAGTOR SP(1.11,"Agent Orange") Q:$D(GMPQUIT)!($G(GMPLJUMP))
89 S:$G(GMPFLD(1.11)) $P(GMPFLD(1.11),U,2)="AGENT ORANGE"
90 D:GMPION SP(1.12,"Radiation") Q:$D(GMPQUIT)!($G(GMPLJUMP))
91 S:$G(GMPFLD(1.12)) $P(GMPFLD(1.12),U,2)="RADIATION"
92 D:GMPGULF SP(1.13,"Environmental Contaminants") Q:$D(GMPQUIT)!($G(GMPLJUMP))
93 S:$G(GMPFLD(1.13)) $P(GMPFLD(1.13),U,2)="ENV CONTAMINANTS"
94 D:GMPHNC SP(1.15,"Head and/or Neck Cancer") Q:$D(GMPQUIT)!($G(GMPLJUMP))
95 S:$G(GMPFLD(1.15)) $P(GMPFLD(1.15),U,2)="HEAD/NECK CANCER"
96 D:GMPMST SP(1.16,"Military Sexual Trauma") Q:$D(GMPQUIT)!($G(GMPLJUMP))
97 S:$G(GMPFLD(1.16)) $P(GMPFLD(1.16),U,2)="MIL SEXUAL TRAUMA"
98 Q
99SP(FLD,NAME) ; edit exposure fields -- Requires FLD number & field NAME
100 N DIR,X,Y,GMPLN S DIR(0)="YAO",GMPLN=$$UP^XLFSTR(NAME)
101 S DIR("A")="Is this problem related to "_GMPLN
102 S:GMPLN'["SEXUAL"&(GMPLN'["CANCER") DIR("A")=DIR("A")_" EXPOSURE" S DIR("A")=DIR("A")_"? "
103 S DIR("?",1)="Enter YES if this problem is related in some way to the patient's"
104 S DIR("?")="diagnosed "_NAME_"." S:GMPLN["SEXUAL" DIR("?")="reported "_NAME_"." S:GMPLN'["SEXUAL"&(GMPLN'["CANCER") DIR("?")="exposure to "_NAME_"."
105 S:$L($G(GMPFLD(FLD))) DIR("B")=$S(+GMPFLD(FLD):"YES",1:"NO")
106SP1 D ^DIR I $D(DTOUT)!(Y="^") S GMPQUIT=1 Q
107 I Y?1"^".E D JUMP^GMPLEDT3(Y) Q:$D(GMPQUIT)!($G(GMPLJUMP)) K:$G(GMPIFN) GMPLJUMP G SP1
108 I X="@" G:'$$SURE^GMPLX SP1 S Y=""
109 S GMPFLD(FLD)=Y S:Y'="" GMPFLD(FLD)=GMPFLD(FLD)_U_$S(Y:"YES",1:"NO")
110 Q
Note: See TracBrowser for help on using the repository browser.