source: FOIAVistA/tag/r/PCE_PATIENT_CARE_ENCOUNTER-AUTN-EFDP-PX-VSIT--PXRM/PXCADXP1.m@ 628

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

initial load of FOIAVistA 6/30/08 version
File size: 3.4 KB
Line 
1PXCADXP1 ;ISL/dee & LEA/Chylton - Validates & Translates data from the PCE Device Interface into a call to V POV & update Problem List ;3/20/97
2 ;;1.0;PCE PATIENT CARE ENCOUNTER;**24,33**;Aug 12, 1996
3 Q
4 ;
5PART1 ;
6 N PXCACLEX
7 S (PXCADIAG,PXCAPROB)=0
8 I "^^^"'[$P(PXCADXPL,"^",5,8) S PXCAPROB=1
9 ;Note
10 S PXCAITEM=$P($G(PXCA("DIAGNOSIS/PROBLEM",PXCAPRV,PXCAINDX,"NOTE")),"^",1),PXCAITM2=$L(PXCAITEM)
11 I PXCAITEM]"" D
12 . I PXCAITM2<3!(PXCAITM2>60) S PXCA("ERROR","DIAGNOSIS/PROBLEM",PXCAPRV,PXCAINDX,"NOTE",1)="PROBLEM Note must be 1-60 Characters^"_PXCAITEM
13 . S PXCAPROB=1
14 ;
15 ;Diagnosis Code
16 S PXCAITEM=$P(PXCADXPL,"^",1)
17 I PXCAITEM>0 D
18 . N DIC,DR,DA,DIQ,PXCADIQ1
19 . S DIC=80
20 . S DR=".01;102"
21 . S DA=PXCAITEM
22 . S DIQ="PXCADIQ1("
23 . S DIQ(0)="I"
24 . D EN^DIQ1
25 . I $G(PXCADIQ1(80,DA,.01,"I"))="" S PXCA("ERROR","DIAGNOSIS/PROBLEM",PXCAPRV,PXCAINDX,1)="ICD9 Code not in file 80^"_PXCAITEM
26 . E I $G(PXCADIQ1(80,DA,102,"I")),PXCADIQ1(80,DA,102,"I")'>+PXCADT S PXCA("ERROR","DIAGNOSIS/PROBLEM",PXCAPRV,PXCAINDX,1)="ICD9 Code is INACTIVE^"_PXCAITEM
27 ;
28 ;Diagnosis Specification Code
29 S PXCAITM2=$P(PXCADXPL,"^",2)
30 I PXCAITM2'="" D
31 . S PXCADIAG=1
32 . I '((PXCAITM2="P")!(PXCAITM2="S")!(PXCAITM2="PS")!(PXCAITM2="SP")) S PXCA("ERROR","DIAGNOSIS/PROBLEM",PXCAPRV,PXCAINDX,2)="Diagnosis specification code must be P|S^"_PXCAITM2
33 . E I PXCAITM2["P",PXCAITEM>0 D
34 .. I 'PXCAPDX S PXCAPDX=PXCAITEM
35 .. E I $P($G(^PX(815,1,"DI")),"^",2) S PXCA("ERROR","DIAGNOSIS/PROBLEM",PXCAPRV,PXCAINDX,2)="There is already a Primary Diagnosis for this encounter^"_PXCAITM2
36 .. E D
37 ... S PXCA("WARNING","DIAGNOSIS/PROBLEM",PXCAPRV,PXCAINDX,2)="There is already a Primary Diagnosis. This one is changed to Secondary^"_PXCAITM2
38 ... S $P(PXCADXPL,"^",2)="S"
39 . I PXCAITEM'>0 S PXCA("ERROR","DIAGNOSIS/PROBLEM",PXCAPRV,PXCAINDX,1)="ICD9 Code is required for DIAGNOSIS^"_PXCAITEM
40 ;
41 ;Clinical Lexicon Term
42 S PXCAITEM=$P(PXCADXPL,"^",3)
43 I PXCAITEM]"" D
44 . I $D(^LEX(757.01)) D
45 .. I $D(^LEX(757.01,PXCAITEM,0))#2'=1 S PXCA("ERROR","DIAGNOSIS/PROBLEM",PXCAPRV,PXCAINDX,3)="Lexicon Utility term is not in file 757.01^"_PXCAITEM
46 .. E S PXCACLEX=PXCAITEM
47 . E I $D(^GMP(757.01)) D
48 .. I $D(^GMP(757.01,PXCAITEM,0))#2'=1 S PXCA("ERROR","DIAGNOSIS/PROBLEM",PXCAPRV,PXCAINDX,3)="Clinical Lexicon Utility term is not in file 757.01^"_PXCAITEM
49 .. E S PXCACLEX=PXCAITEM
50 . E S PXCA("ERROR","DIAGNOSIS/PROBLEM",PXCAPRV,PXCAINDX,3)="Lexicon Utility is not installed^"_PXCAITEM
51 ;
52 ;Problem List IEN
53 S PXCAITEM=$P(PXCADXPL,"^",4)
54 ;Add to Problem List
55 S PXCAITM2=$P(PXCADXPL,"^",5)
56 I PXCAITEM]"" D
57 . I $G(^AUPNPROB(PXCAITEM,0))="" S PXCA("ERROR","DIAGNOSIS/PROBLEM",PXCAPRV,PXCAINDX,4)="Problem not in file 9000011^"_PXCAITEM
58 . E I PXCAPAT'=$P($G(^AUPNPROB(PXCAITEM,0)),"^",2) S PXCA("ERROR","DIAGNOSIS/PROBLEM",PXCAPRV,PXCAINDX,4)="Problem in file 9000011 is for a different Patient^"_PXCAITEM
59 . I PXCAITM2=1 S PXCA("ERROR","DIAGNOSIS/PROBLEM",PXCAPRV,PXCAINDX,5)="Cannot ADD existing Problem to file 9000011^"_PXCAITM2
60 E I PXCAPROB,PXCAITM2'=1 S PXCA("ERROR","DIAGNOSIS/PROBLEM",PXCAPRV,PXCAINDX,4)="Cannot update an existing Problem with out an IEN to file 9000011^"_PXCAITEM
61 I '(PXCAITM2=1!(PXCAITM2=0)!(PXCAITM2="")) S PXCA("ERROR","DIAGNOSIS/PROBLEM",PXCAPRV,PXCAINDX,5)="Add to Problem List flag bad^"_PXCAITM2
62 I PXCAITM2=1,PXCAPRV'>0 S PXCA("ERROR","DIAGNOSIS/PROBLEM",PXCAPRV,PXCAINDX,0)="Provider is required to add a new Problem^"_PXCAPRV
63 ;
64 Q
65 ;
Note: See TracBrowser for help on using the repository browser.