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

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

initial load of WorldVistAEHR
File size: 4.9 KB
Line 
1GMPL ; SLC/MKB/AJB -- Problem List Driver ;;9-5-95 11:47am
2 ;;2.0;Problem List;**3,11,28**;Aug 25, 1994
3EN ; -- main entry point for GMPL PROBLEM LIST
4 S GMPLUSER=1
5 D EN^VALM("GMPL PROBLEM LIST")
6 Q
7 ;
8DE ; -- main entry point for GMPL DATA ENTRY
9 K GMPLUSER
10 D EN^VALM("GMPL DATA ENTRY")
11 Q
12 ;
13ADD ; -- add a new problem
14 S VALMBCK="",GMPCLIN="" K GMPREBLD
15 I +$P(GMPDFN,U,4),'$$CKDEAD^GMPLX1($P(GMPDFN,U,4)) G ADDQ
16 S:$E(GMPLVIEW("VIEW"))'="S" GMPCLIN=$$CLINIC^GMPLX1("") G:GMPCLIN="^" ADDQ
17 S GMPLSLST=$P($G(^VA(200,DUZ,125)),U,2)
18 I 'GMPLSLST,GMPCLIN,$D(^GMPL(125,"C",+GMPCLIN)) S GMPLSLST=$O(^(+GMPCLIN,0)) ; if user has no list but clinic does, use clinic list
19 I GMPLSLST D G ADD1
20 . S $P(GMPLSLST,U,2)=$P($G(^GMPL(125,+GMPLSLST,0)),U)
21 . D EN^VALM("GMPL LIST MENU")
22 W @IOF D FULL^VALM1 F D ADD^GMPL1 Q:$D(GMPQUIT) S:$D(GMPSAVED) GMPREBLD=1 K DUOUT,DTOUT,GMPSAVED W !!!,">>> Please enter another problem, or press <return> to exit."
23 S VALMBCK="R"
24ADD1 I $D(GMPREBLD) D
25 . S VALMBCK="R",GMPRINT=1
26 . S VALMBG=$S(GMPARAM("REV"):1,VALMCNT<10:1,1:VALMCNT-9)
27 . D BUILD^GMPLMGR(.GMPLIST),HDR^GMPLMGR
28ADDQ D KILL^GMPLX S VALMSG=$$MSG^GMPLX S:'VALMCC VALMBCK="R"
29 Q
30 ;
31STATUS ; -- inactivate a problem
32 S VALMBCK="" G:+$G(GMPCOUNT)'>0 STQ
33 I GMPLVIEW("ACT")="I" W $C(7),!!,"Currently displayed problems are already inactive!",! G STQ
34 S GMPLSEL=$$SEL^GMPLX("inactivate") G:GMPLSEL="^" STQ
35 S GMPLNO=$L(GMPLSEL,",")
36 F GMPI=1:1:GMPLNO S GMPLNUM=$P(GMPLSEL,",",GMPI) I GMPLNUM D Q:$D(GMPQUIT)
37 . S GMPIFN=$P($G(^TMP("GMPLIDX",$J,+GMPLNUM)),U,2) Q:GMPIFN'>0
38 . I $P(^AUPNPROB(GMPIFN,0),U,12)="I" W !!,$$PROBTEXT^GMPLX(GMPIFN),!,"is already inactive!",! H 2 Q
39 . I $P($G(^AUPNPROB(GMPIFN,1)),U,2)="H" W !!,$$PROBTEXT^GMPLX(GMPIFN),!,"has been removed from this patient's problem list!",! H 2 Q
40 . L +^AUPNPROB(GMPIFN,0):1 I '$T W $C(7),!!,$$LOCKED^GMPLX,! H 2 Q
41 . D STATUS^GMPL1 L -^AUPNPROB(GMPIFN,0)
42 I $D(GMPSAVED) D
43 . S VALMBCK="R",GMPRINT=1
44 . D BUILD^GMPLMGR(.GMPLIST),HDR^GMPLMGR
45STQ D KILL^GMPLX S VALMSG=$$MSG^GMPLX S:'VALMCC VALMBCK="R"
46 Q
47 ;
48NOTES ; -- annotate a problem
49 S VALMBCK="" G:+$G(GMPCOUNT)'>0 NTQ
50 S GMPLNUM=$$SEL1^GMPLX("add comment(s) to") G:GMPLNUM="^" NTQ
51 S GMPIFN=$P($G(^TMP("GMPLIDX",$J,+GMPLNUM)),U,2) G:GMPIFN'>0 NTQ
52 I $P($G(^AUPNPROB(GMPIFN,1)),U,2)="H" W !!,$$PROBTEXT^GMPLX(GMPIFN),!,"has been removed from this patient's problem list!",! H 2 G NTQ
53 ; Code Set Versioning (CSV)
54 I '$$CODESTS^GMPLX(GMPIFN,DT) W !!,$$PROBTEXT^GMPLX(GMPIFN),!,"has an inactive ICD9 code. Edit the problem before adding comments.",! H 3 G NTQ
55 L +^AUPNPROB(GMPIFN,0):1 I '$T W $C(7),!!,$$LOCKED^GMPLX,! H 2 G NTQ
56 D NEWNOTE^GMPL1 I $D(GMPSAVED) D
57 . S VALMBCK="R",GMPRINT=1
58 . D BUILD^GMPLMGR(.GMPLIST)
59 L -^AUPNPROB(GMPIFN,0)
60NTQ D KILL^GMPLX S VALMSG=$$MSG^GMPLX S:'VALMCC VALMBCK="R"
61 Q
62 ;
63EDIT ; -- edit allowable fields of a problem
64 S VALMBCK="" G:+$G(GMPCOUNT)'>0 EDQ
65 S GMPLNUM=$$SEL1^GMPLX("edit") G:GMPLNUM="^" EDQ
66 S GMPIFN=$P($G(^TMP("GMPLIDX",$J,+GMPLNUM)),U,2) G:GMPIFN'>0 EDQ
67 ; Code Set Versioning (CSV)
68 ; I '$$CODESTS^GMPLX(GMPIFN,DT) W !!,$$PROBTEXT^GMPLX(GMPIFN),!,"has an inactive ICD code.",! H 3 G EDQ
69 I $P($G(^AUPNPROB(GMPIFN,1)),U,2)="H" W !!,$$PROBTEXT^GMPLX(GMPIFN),!,"has been removed from this patient's problem list!",! H 2 G EDQ
70 L +^AUPNPROB(GMPIFN,0):1 I '$T W $C(7),!!,$$LOCKED^GMPLX,! H 2 G EDQ
71 D EN^VALM("GMPL EDIT PROBLEM")
72 I $D(GMPSAVED) D BUILD^GMPLMGR(.GMPLIST),HDR^GMPLMGR S GMPRINT=1
73 S VALMBCK="R" L -^AUPNPROB(GMPIFN,0)
74EDQ D KILL^GMPLX S VALMSG=$$MSG^GMPLX S:'VALMCC VALMBCK="R"
75 Q
76 ;
77DELETE ; -- delete a problem
78 S VALMBCK="" G:+$G(GMPCOUNT)'>0 DELQ
79 S GMPLSEL=$$SEL^GMPLX("remove from the list") G:GMPLSEL="^" DELQ
80 S GMPLNO=$L(GMPLSEL,",") G:'$$SUREDEL^GMPLEDT2(GMPLNO-1) DELQ
81 F GMPI=1:1:GMPLNO S GMPLNUM=$P(GMPLSEL,",",GMPI) I GMPLNUM D Q:$D(GMPQUIT)
82 . S GMPIFN=$P($G(^TMP("GMPLIDX",$J,+GMPLNUM)),U,2) Q:GMPIFN'>0
83 . I $P($G(^AUPNPROB(GMPIFN,1)),U,2)="H" W !!,$$PROBTEXT^GMPLX(GMPIFN),!,"has already been removed from this patient's problem list!",! H 2 Q
84 . L +^AUPNPROB(GMPIFN,0):1 I '$T W $C(7),!!,$$LOCKED^GMPLX,! H 2 Q
85 . D DELETE^GMPL1 L -^AUPNPROB(GMPIFN,0)
86 I $D(GMPSAVED) D
87 . S VALMBCK="R",GMPRINT=1 D BUILD^GMPLMGR(.GMPLIST),HDR^GMPLMGR
88DELQ D KILL^GMPLX S VALMSG=$$MSG^GMPLX S:'VALMCC VALMBCK="R"
89 Q
90 ;
91VERIFY ; -- verify a problem
92 S VALMBCK="" Q:+$G(GMPCOUNT)'>0
93 W !!,"Select the problem(s) you wish to verify as correct."
94 S GMPLSEL=$$SEL^GMPLX("mark as verified") G:GMPLSEL="^" VERQ
95 S GMPLNO=$L(GMPLSEL,",")
96 F GMPI=1:1:GMPLNO S GMPLNUM=$P(GMPLSEL,",",GMPI) I GMPLNUM D
97 . S GMPIFN=$P($G(^TMP("GMPLIDX",$J,GMPLNUM)),U,2)
98 . D:GMPIFN VERIFY^GMPL1
99 I $D(GMPSAVED) D BUILD^GMPLMGR(.GMPLIST) S VALMBCK="R"
100VERQ D KILL^GMPLX S VALMSG=$$MSG^GMPLX S:'VALMCC VALMBCK="R"
101 Q
102 ;
103EXPAND ; -- detailed display of a problem
104 S VALMBCK="" Q:+$G(GMPCOUNT)'>0
105 S GMPLSEL=$$SEL^GMPLX("view") G:GMPLSEL="^" EXPQ
106 S GMPLNO=$L(GMPLSEL,",")-1,GMPI=0
107 D EN^VALM("GMPL DETAILED DISPLAY")
108 S VALMBCK="R"
109EXPQ D KILL^GMPLX S VALMSG=$$MSG^GMPLX S:'VALMCC VALMBCK="R"
110 Q
Note: See TracBrowser for help on using the repository browser.