source: FOIAVistA/trunk/r/PROBLEM_LIST-GMPL/GMPLUTL.m@ 1397

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

initial load of FOIAVistA 6/30/08 version
File size: 8.0 KB
Line 
1GMPLUTL ; SLC/MKB/KER -- PL Utilities ; 04/15/2002
2 ;;2.0;Problem List;**3,6,8,10,16,26**;Aug 25, 1994
3 ;
4 ; External References
5 ; DBIA 348 ^DPT(
6 ; DBIA 10082 ^ICD9(
7 ; DBIA 10006 ^VA(200
8 ;
9ACTIVE(GMPDFN,GMPL) ; Returns list of Active Problems for a Patient
10 ;
11 ; GMPDFN Pointer to Patient
12 ; GMPL Array in which the problems will be
13 ; returned, passed by reference
14 ;
15 ; GMPL(#,0) Problem file (#9000011) IEN
16 ; GMPL(#,1) Piece 1: Pointer to Problem (Lexicon file #757.01)
17 ; 2: Provider Narrative
18 ; NOTE: the provider narrative may be different
19 ; from the Lexicon term in file 757.01
20 ; GMPL(#,2) Piece 1: Pointer to ICD Diagnosis (file #80)
21 ; 2: ICD-9 Code
22 ; GMPL(#,3) Piece 1: Internal Date of Onset
23 ; 2: External Date of Onset 00/00/00
24 ; GMPL(#,4) Piece 1: Abbreviated Service Connection
25 ; SC^Service Connected
26 ; NSC^Not Service Connected
27 ; null
28 ; 2: Full text Service Connection
29 ; GMPL(#,5) Piece 1: Abbreviated Exposure
30 ; Full text Exposure
31 ; AO^Agent Orange
32 ; IR^Radiation
33 ; EC^Evn Contaminants
34 ; HNC^Head/Neck Cancer
35 ; MST^Mil Sexual Trauma
36 ; null
37 ;
38 N I,IFN,CNT,GMPL0,GMPL1,SP,NUM,ONSET,GMPLIST,GMPLVIEW,GMPARAM,GMPTOTAL
39 Q:$G(GMPDFN)'>0 S CNT=0,SP=""
40 S GMPARAM("QUIET")=1,GMPARAM("REV")=$P($G(^GMPL(125.99,1,0)),U,5)="R"
41 S GMPLVIEW("ACT")="A",GMPLVIEW("PROV")=0,GMPLVIEW("VIEW")=""
42 D GETPLIST^GMPLMGR1(.GMPLIST,.GMPTOTAL,.GMPLVIEW)
43 F NUM=0:0 S NUM=$O(GMPLIST(NUM)) Q:NUM'>0 D
44 . S IFN=+GMPLIST(NUM) Q:IFN'>0
45 . S GMPL0=$G(^AUPNPROB(IFN,0)),GMPL1=$G(^(1)),CNT=CNT+1,GMPL(CNT,0)=IFN
46 . S GMPL(CNT,1)=+GMPL1_U_$$PROBTEXT^GMPLX(IFN)
47 . S GMPL(CNT,2)=+GMPL0_U_$P($G(^ICD9(+GMPL0,0)),U),ONSET=$P(GMPL0,U,13)
48 . S GMPL(CNT,3)=$S(ONSET:ONSET_U_$$EXTDT^GMPLX(ONSET),1:"")
49 . S GMPL(CNT,4)=$S(+$P(GMPL1,U,10):"SC^SERVICE-CONNECTED",$P(GMPL1,U,10)=0:"NSC^NOT SERVICE-CONNECTED",1:"")
50 . F I=11,12,13,15,16 S:$P(GMPL1,U,I) SP=$S(I=11:"A",I=12:"I",I=13:"P",I=15:"H",1:"M")
51 . S GMPL(CNT,5)=$S(SP="A":"AO^AGENT ORANGE",SP="I":"IR^RADIATION",SP="P":"EC^ENV CONTAMINANTS",SP="H":"HNC^HEAD AND/OR NECK CANCER",SP="M":"MST^MILIARY SEXUAL TRAUMA",1:"")
52 S GMPL(0)=CNT
53 Q
54 ;
55CREATE(PL,PLY) ; Creates a new problem
56 ;
57 ; Input array, passed by reference
58 ; Required
59 ; PL("PATIENT") Pointer to Patient #2
60 ; PL("NARRATIVE") Text as entered by provider
61 ; PL("PROVIDER") Pointer to provider #200
62 ; Optional
63 ; PL("DIAGNOSIS") Pointer to ICD-9 #80
64 ; PL("LEXICON") Pointer to Lexicon #757.01
65 ; PL("STATUS") A = Active I = Inactive
66 ; PL("ONSET") Internal Date of Onset
67 ; PL("RECORDED") Internal Date Recorded
68 ; PL("RESOLVED") Internal Date Problem was Resolved
69 ; PL("COMMENT") Comment text, up to 60 characters
70 ; PL("LOCATION") Pointer to Hospital Location
71 ; PL("SC") Service Connected 1 = Yes 0 = No
72 ; PL("AO") Agent Orange 1 = Yes 0 = No
73 ; PL("IR") Radiation 1 = Yes 0 = No
74 ; PL("EC") Env Contamination 1 = Yes 0 = No
75 ; PL("HNC") Head/Neck Cancer 1 = Yes 0 = No
76 ; PL("MST") Mil Sexual Trauma 1 = Yes 0 = No
77 ;
78 ; Output, passed by reference
79 ; PLY Equivalent of Fileman Y, DA
80 ; PLY(0) Equivalent of Fileman Y(0)
81 ;
82 N GMPI,GMPQUIT,GMPVAMC,GMPVA,GMPFLD,GMPSC,GMPAGTOR,GMPION,GMPGULF
83 N GMPHNC,GMPMST,DA,GMPDFN,GMPROV
84 K PLY S PLY=-1,PLY(0)=""
85 S GMPVAMC=+$G(DUZ(2)),GMPVA=$S($G(DUZ("AG"))="V":1,1:0)
86 I '$L($G(PL("NARRATIVE"))) S PLY(0)="Missing problem narrative" Q
87 I '$D(^DPT(+$G(PL("PATIENT")),0)) S PLY(0)="Invalid patient" Q
88 I '$D(^VA(200,+$G(PL("PROVIDER")),0)) S PLY(0)="Invalid provider" Q
89 S GMPDFN=+PL("PATIENT"),(GMPSC,GMPAGTOR,GMPION,GMPGULF,GMPHNC,GMPMST)=0
90 D:GMPVA VADPT^GMPLX1(GMPDFN)
91 F GMPI="DIAGNOSI","LEXICON","DUPLICAT","LOCATION","STATUS" D @(GMPI_"^GMPLUTL1") Q:$D(GMPQUIT)
92 Q:$D(GMPQUIT)
93 F GMPI="ONSET","RESOLVED","RECORDED","SC","AO","IR","EC","HNC","MST" D @(GMPI_"^GMPLUTL1") Q:$D(GMPQUIT)
94 Q:$D(GMPQUIT)
95CR1 ; Ok to Create
96 S GMPFLD(.01)=PL("DIAGNOSIS"),GMPFLD(1.01)=PL("LEXICON")
97 S GMPFLD(.05)=U_$E(PL("NARRATIVE"),1,80)
98 S (GMPROV,GMPFLD(1.04),GMPFLD(1.05))=+PL("PROVIDER")
99 S GMPFLD(1.06)=$$SERVICE^GMPLX1(+PL("PROVIDER"))
100 S GMPFLD(.13)=PL("ONSET"),GMPFLD(1.09)=PL("RECORDED")
101 S GMPFLD(1.02)=$S('$P(^GMPL(125.99,1,0),U,2):"P",$G(GMPLUSER):"P",1:"T")
102 S GMPFLD(.12)=PL("STATUS"),GMPFLD(1.14)="",GMPFLD(1.07)=PL("RESOLVED")
103 S GMPFLD(10,0)=0,GMPFLD(1.03)=$G(DUZ),GMPFLD(1.08)=PL("LOCATION")
104 S:$L($G(PL("COMMENT"))) GMPFLD(10,"NEW",1)=$E(PL("COMMENT"),1,60)
105 S GMPFLD(1.1)=PL("SC"),GMPFLD(1.11)=PL("AO"),GMPFLD(1.12)=PL("IR")
106 S GMPFLD(1.13)=PL("EC"),GMPFLD(1.15)=$G(PL("HNC")),GMPFLD(1.16)=$G(PL("MST"))
107 D NEW^GMPLSAVE S PLY=DA
108CRQ ; Quit Create
109 Q
110 ;
111UPDATE(PL,PLY) ; Update a Problem/Create if Not Found
112 ;
113 ; Input array, passed by reference
114 ; Required
115 ; PL("PROBLEM") Pointer to Problem #9000011
116 ; PL("PROVIDER") Pointer to provider #200
117 ;
118 ; Optional
119 ; PL("NARRATIVE") Text as entered by provider
120 ; PL("DIAGNOSIS") Pointer to ICD-9 #80
121 ; PL("LEXICON") Pointer to Lexicon #757.01
122 ; PL("STATUS") A = Active I = Inactive
123 ; PL("ONSET") Internal Date of Onset
124 ; PL("RECORDED") Internal Date Recorded
125 ; PL("RESOLVED") Internal Date Problem was Resolved
126 ; PL("COMMENT") Comment text, up to 60 characters
127 ; PL("LOCATION") Pointer to Hospital Location
128 ; PL("SC") Service Connected 1 = Yes 0 = No
129 ; PL("AO") Agent Orange 1 = Yes 0 = No
130 ; PL("IR") Radiation 1 = Yes 0 = No
131 ; PL("EC") Env Contamination 1 = Yes 0 = No
132 ; PL("HNC") Head/Neck Cancer 1 = Yes 0 = No
133 ; PL("MST") Mil Sexual Trauma 1 = Yes 0 = No
134 ;
135 ; Output, passed by reference
136 ; PLY Equivalent of Fileman Y, DA
137 ; PLY(0) Equivalent of Fileman Y(0)
138 ;
139 N GMPORIG,GMPFLD,FLD,ITEMS,SUB,GMPI,DIFFRENT,GMPIFN,GMPVAMC,GMPVA,GMPROV,GMPQUIT,GMPDFN
140 S GMPVAMC=+$G(DUZ(2)),GMPVA=$S($G(DUZ("AG"))="V":1,1:0),PLY=-1,PLY(0)=""
141 S GMPIFN=$G(PL("PROBLEM")) I GMPIFN="" D CREATE(.PL,.PLY) Q
142 I '$D(^AUPNPROB(GMPIFN,0)) S PLY(0)="Invalid problem" Q
143 I '$D(^VA(200,+$G(PL("PROVIDER")),0)) S PLY(0)="Invalid provider" Q
144 S GMPROV=+$G(PL("PROVIDER")),GMPDFN=+$P(^AUPNPROB(GMPIFN,0),U,2)
145 D GETFLDS^GMPLEDT3(GMPIFN) I '$D(GMPFLD) S PLY(0)="Invalid problem" Q
146 I +$G(PL("PATIENT")),+PL("PATIENT")'=GMPDFN S PLY(0)="Patient does not match for this problem" Q
147 I $L($G(PL("RECORDED"))) S PLY(0)="Date Recorded is not editable" Q
148 S (GMPSC,GMPAGTOR,GMPION,GMPGULF)=0 D:GMPVA VADPT^GMPLX1(GMPDFN)
149 S ITEMS="LEXICON^DIAGNOSIS^LOCATION^STATUS^ONSET^RESOLVED^SC^AO^IR^EC^HNC^MST^",FLD="1.01^.01^1.08^.12^.13^1.07^1.1^1.11^1.12^1.13^1.15^1.16"
150 F GMPI=1:1 S SUB=$P(ITEMS,U,GMPI) Q:SUB="" D Q:$D(GMPQUIT)
151 . I '$L($G(PL(SUB))) S PL(SUB)=$P(GMPFLD($P(FLD,U,GMPI)),U) Q
152 . I SUB="STATUS",PL(SUB)="@" S GMPQUIT=1,PLY(0)="Cannot delete problem status" Q
153 . I PL(SUB)'="@" D @($E(SUB,1,8)_"^GMPLUTL1") Q:$D(GMPQUIT)
154 . S GMPFLD($P(FLD,U,GMPI))=$S(PL(SUB)="@":"",1:PL(SUB)),DIFFRENT=1
155 Q:$D(GMPQUIT)
156 I +GMPFLD(1.07),GMPFLD(1.07)<GMPFLD(.13) S PLY(0)="Date Resolved cannot be prior to Date of Onset" Q
157 I +GMPFLD(1.09),GMPFLD(1.09)<GMPFLD(.13) S PLY(0)="Date Recorded cannot be prior to Date of Onset" Q
158 S:$L($G(PL("NARRATIVE"))) GMPFLD(.05)=U_PL("NARRATIVE"),DIFFRENT=1
159 S:$L($G(PL("COMMENT"))) GMPFLD(10,"NEW",1)=$E(PL("COMMENT"),1,60),DIFFRENT=1
160 D:$D(DIFFRENT) EN^GMPLSAVE S PLY=GMPIFN,PLY(0)=""
161 Q
Note: See TracBrowser for help on using the repository browser.