1 | GMPLUTL1 ; 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
|
---|
27 | DIAGNOSI ; 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 | ;
|
---|
33 | LEXICON ; 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
|
---|
38 | DUPLICAT ; 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 | ;
|
---|
51 | LOCATION ; 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 | ;
|
---|
57 | PROVIDER ; 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 | ;
|
---|
63 | STATUS ; 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 | ;
|
---|
69 | ONSET ; 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 | ;
|
---|
77 | RESOLVED ; 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 | ;
|
---|
87 | RECORDED ; 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 | ;
|
---|
96 | SC ; 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 | ;
|
---|
102 | AO ; 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 | ;
|
---|
108 | IR ; 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 | ;
|
---|
114 | EC ; 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
|
---|
119 | HNC ; 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
|
---|
124 | MST ; 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
|
---|
129 | CV ; 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
|
---|
134 | SHD ; 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
|
---|