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

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

initial load of WorldVistAEHR
File size: 4.7 KB
Line 
1GMPLUTL1 ; SLC/MKB/KER -- PL Utilities (cont) ; 04/15/2002
2 ;;2.0;Problem List;**3,8,7,9,26,35**;Aug 25, 1994;Build 26
3 ;
4 ; External References
5 ; DBIA 446 ^AUTNPOV(
6 ; DBIA 10082 ^ICD9(
7 ; DBIA 1571 ^LEX(757.01
8 ; DBIA 10040 ^SC(
9 ; DBIA 10060 ^VA(200
10 ; DBIA 10003 ^%DT
11 ; DBIA 10104 $$UP^XLFSTR
12 ;
13 ; All entry points in this routine expect the
14 ; PL("data item") array from routine ^GMPLUTL.
15 ;
16 ; Entry Expected Variable
17 ; Point From VADPT^GMPLX1
18 ; AO GMPAGTOR
19 ; IR GMPION
20 ; EC GMPGULF
21 ; HNC GMPHNC
22 ; MST GMPMST
23 ; CV GMPCV
24 ; SHD GMPSHD
25 ;
26 Q
27DIAGNOSI ; ICD Diagnosis Pointer
28 S:'$L($G(PL("DIAGNOSIS"))) PL("DIAGNOSIS")=$$NOS^GMPLX
29 Q:$D(^ICD9(+PL("DIAGNOSIS"),0))
30 S GMPQUIT=1,PLY(0)="Invalid ICD Diagnosis"
31 Q
32 ;
33LEXICON ; Clinical Lexicon Pointer
34 S:'$L($G(PL("LEXICON"))) PL("LEXICON")=1
35 Q:$D(^LEX(757.01,+PL("LEXICON"),0))
36 S GMPQUIT=1,PLY(0)="Invalid Lexicon term"
37 Q
38DUPLICAT ; Problem Already on the List
39 N DUPL
40 Q:$P($G(^GMPL(125.99,1,0)),U,6)'=1
41 S:'$L($G(PL("DIAGNOSIS"))) PL("DIAGNOSIS")=$$NOS^GMPLX
42 I '$D(^AUPNPROB("B",+PL("DIAGNOSIS")))!('$D(^AUPNPROB("AC",GMPDFN))) Q
43 F IFN=0:0 S IFN=$O(^AUPNPROB("AC",GMPDFN,IFN)) Q:IFN'>0 D Q:$D(GMPQUIT)
44 . S (DUPL(1),DUPL(2))=0
45 . S NODE0=$G(^AUPNPROB(IFN,0)),NODE1=$G(^(1)) Q:$P(NODE1,U,2)="H"
46 . I +PL("DIAGNOSIS")=+NODE0 S DUPL(1)=IFN
47 . S:PL("NARRATIVE")=$$UP^XLFSTR($P(^AUTNPOV($P(NODE0,U,5),0),U)) DUPL(2)=IFN
48 . I DUPL(1)>0&DUPL(2)>0 S GMPQUIT=1,PLY(0)="Duplicate problem"
49 Q
50 ;
51LOCATION ; Hospital Location (Clinic) Pointer
52 S:'$D(PL("LOCATION")) PL("LOCATION")="" Q:'$L(PL("LOCATION"))
53 I $D(^SC(+PL("LOCATION"),0)),$P(^(0),U,3)="C" Q
54 S GMPQUIT=1,PLY(0)="Invalid hospital location"
55 Q
56 ;
57PROVIDER ; Responsible Provider
58 S:'$D(PL("PROVIDER")) PL("PROVIDER")=""
59 Q:'$L(PL("PROVIDER")) Q:$D(^VA(200,+PL("PROVIDER"),0))
60 S GMPQUIT=1,PLY(0)="Invalid provider"
61 Q
62 ;
63STATUS ; Problem Status
64 S:$G(PL("STATUS"))="" PL("STATUS")="A"
65 I "^A^I^a^i^"[(U_PL("STATUS")_U) S PL("STATUS")=$$UP^XLFSTR(PL("STATUS")) Q
66 S GMPQUIT=1,PLY(0)="Invalid problem status"
67 Q
68 ;
69ONSET ; Date of Onset
70 N %DT,Y,X
71 S:'$D(PL("ONSET")) PL("ONSET")="" Q:'$L(PL("ONSET"))
72 S %DT="P",%DT(0)="-NOW",X=PL("ONSET") D ^%DT
73 I Y>0 S PL("ONSET")=Y Q
74 S GMPQUIT=1,PLY(0)="Invalid Date of Onset"
75 Q
76 ;
77RESOLVED ; Date Resolved (Requires STATUS, ONSET)
78 N %DT,Y,X
79 S:'$D(PL("RESOLVED")) PL("RESOLVED")="" Q:'$L(PL("RESOLVED"))
80 S %DT="P",%DT(0)="-NOW",X=PL("RESOLVED") D ^%DT
81 I Y'>0 S GMPQUIT=1,PLY(0)="Invalid Date Resolved" Q
82 I PL("STATUS")="A" S GMPQUIT=1,PLY(0)="Active problems cannot have a Date Resolved" Q
83 I Y<PL("ONSET") S GMPQUIT=1,PLY(0)="Date Resolved cannot be prior to Date of Onset" Q
84 S PL("RESOLVED")=Y
85 Q
86 ;
87RECORDED ; Date Recorded (Requires ONSET)
88 N %DT,Y,X
89 S:'$D(PL("RECORDED")) PL("RECORDED")="" Q:'$L(PL("RECORDED"))
90 S %DT="P",%DT(0)="-NOW",X=PL("RECORDED") D ^%DT
91 I Y'>0 S GMPQUIT=1,PLY(0)="Invalid Date Recorded" Q
92 I PL("RECORDED")<PL("ONSET") S GMPQUIT=1,PLY(0)="Date Recorded cannot be prior to Date of Onset" Q
93 S PL("RECORDED")=Y
94 Q
95 ;
96SC ; SC condition flag
97 S:'$D(PL("SC")) PL("SC")=""
98 I "^^1^0^"'[(U_PL("SC")_U) S GMPQUIT=1,PLY(0)="Invalid SC flag" Q
99 I 'GMPSC,+PL("SC") S GMPQUIT=1,PLY(0)="Invalid SC flag"
100 Q
101 ;
102AO ; AO exposure flag (Requires GMPAGTOR)
103 S:'$D(PL("AO")) PL("AO")=""
104 I "^^1^0^"'[(U_PL("AO")_U) S GMPQUIT=1,PLY(0)="Invalid AO flag" Q
105 I 'GMPAGTOR,+PL("AO") S GMPQUIT=1,PLY(0)="Invalid AO flag"
106 Q
107 ;
108IR ; IR exposure flag (Requires GMPION)
109 S:'$D(PL("IR")) PL("IR")=""
110 I "^^1^0^"'[(U_PL("IR")_U) S GMPQUIT=1,PLY(0)="Invalid IR flag" Q
111 I 'GMPION,+PL("IR") S GMPQUIT=1,PLY(0)="Invalid IR flag"
112 Q
113 ;
114EC ; EC exposure flag (Requires GMPGULF)
115 S:'$D(PL("EC")) PL("EC")=""
116 I "^^1^0^"'[(U_PL("EC")_U) S GMPQUIT=1,PLY(0)="Invalid EC flag" Q
117 I 'GMPGULF,+PL("EC") S GMPQUIT=1,PLY(0)="Invalid EC flag"
118 Q
119HNC ; HNC/NTR exposure flag (Requires GMPHNC)
120 S:'$D(PL("HNC")) PL("HNC")=""
121 I "^^1^0^"'[(U_PL("HNC")_U) S GMPQUIT=1,PLY(0)="Invalid HNC flag" Q
122 I 'GMPHNC,+PL("HNC") S GMPQUIT=1,PLY(0)="Invalid HNC flag"
123 Q
124MST ; MST exposure flag (Requires GMPMST)
125 S:'$D(PL("MST")) PL("MST")=""
126 I "^^1^0^"'[(U_PL("MST")_U) S GMPQUIT=1,PLY(0)="Invalid MST flag" Q
127 I 'GMPMST,+PL("MST") S GMPQUIT=1,PLY(0)="Invalid MST flag"
128 Q
129CV ; CV exposure flag (Requires GMPCV)
130 S:'$D(PL("CV")) PL("CV")=""
131 I "^^1^0^"'[(U_PL("CV")_U) S GMPQUIT=1,PLY(0)="Invalid CV flag" Q
132 I 'GMPSHD,+PL("CV") S GMPQUIT=1,PLY(0)="Invalid CV flag"
133 Q
134SHD ; SHD exposure flag (Requires GMPSHD)
135 S:'$D(PL("SHD")) PL("SHD")=""
136 I "^^1^0^"'[(U_PL("SHD")_U) S GMPQUIT=1,PLY(0)="Invalid SHD flag" Q
137 I 'GMPSHD,+PL("SHD") S GMPQUIT=1,PLY(0)="Invalid SHD flag"
138 Q
Note: See TracBrowser for help on using the repository browser.