source: WorldVistAEHR/trunk/r/PCE_PATIENT_CARE_ENCOUNTER-AUTN-EFDP-PX-VSIT--PXRM/PXCAPL.m@ 724

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

initial load of WorldVistAEHR

File size: 4.8 KB
Line 
1PXCAPL ;ISL/dee & LEA/Chylton - Validates data from the PCE Device Interface into a call to update Problem List ;3/20/97
2 ;;1.0;PCE PATIENT CARE ENCOUNTER;**24,27,115,130**;Aug 12, 1996
3 Q
4 ; PXCAPROB Copy of a Problem node of the PXCA array
5 ; PXCAPRV Pointer to the provider (200)
6 ; PXCAINDX Count of the number of problems for one provider
7 ; PXCAPL The parameter array passed to Problem List
8 ; PXCARES The result back from Problem List
9 ; PXCANUMB Count of the total number of problems
10 ;
11 ;
12PROBLEM(PXCA,PXCABULD,PXCAERRS) ;
13 Q:'$D(PXCA("PROBLEM"))
14 I '$D(^AUPNPROB)!($T(UPDATE^GMPLUTL)="") S PXCA("WARNING","PROBLEM",0,0,0)="Problem List Package is not installed" Q
15 N PXCAPROB,PXCAPRV,PXCAINDX
16 N PXCAITEM,PXCAITM2
17 S PXCAPRV=""
18 F S PXCAPRV=$O(PXCA("PROBLEM",PXCAPRV)) Q:PXCAPRV']"" D
19 . I '$$ACTIVPRV^PXAPI(PXCAPRV,PXCADT) S PXCA("ERROR","PROBLEM",PXCAPRV,0,0)="Provider is not active or valid^"_PXCAPRV
20 . E I PXCABULD!PXCAERRS D ANOTHPRV^PXCAPRV(PXCAPRV)
21 . S PXCAINDX=0
22 . F S PXCAINDX=$O(PXCA("PROBLEM",PXCAPRV,PXCAINDX)) Q:PXCAINDX']"" D
23 .. S PXCAPROB=$G(PXCA("PROBLEM",PXCAPRV,PXCAINDX))
24 .. I PXCAPROB="" S PXCA("ERROR","PROBLEM",PXCAPRV,PXCAINDX,0)="PROBLEM data missing" Q
25 .. S PXCAITEM=$P(PXCAPROB,U,1),PXCAITM2=$L(PXCAITEM)
26 .. I PXCAITEM]"",PXCAITM2<2!(PXCAITM2>80) S PXCA("ERROR","PROBLEM",PXCAPRV,PXCAINDX,1)="Problem Name must be 2-80 Characters^"_PXCAITEM
27 .. S PXCAITEM=$P(PXCAPROB,U,2)
28 .. I PXCAITEM]"",PXCAITEM>DT!(PXCAITEM<1800000)!($P(+PXCAITEM,".")'=PXCAITEM)!(PXCAITEM>+$P($P(PXCA("ENCOUNTER"),"^"),".")) S PXCA("ERROR","PROBLEM",PXCAPRV,PXCAINDX,7)="Problem Onset Date is bad^"_PXCAITEM
29 .. S PXCAITEM=$P(PXCAPROB,U,3)
30 .. I '(PXCAITEM=1!(PXCAITEM=0)!(PXCAITEM="")) S PXCA("ERROR","PROBLEM",PXCAPRV,PXCAINDX,3)="Problem Active flag bad^"_PXCAITEM
31 .. E I PXCAITEM="" S $P(PXCA("PROBLEM",PXCAPRV,PXCAINDX),U,3)=1
32 .. S PXCAITEM=$P(PXCAPROB,U,4)
33 .. I PXCAITEM]"",PXCAITEM>DT!(PXCAITEM<1800000)!($P(+PXCAITEM,".")'=PXCAITEM)!(PXCAITEM>+$P($P(PXCA("ENCOUNTER"),"^"),".")) S PXCA("ERROR","PROBLEM",PXCAPRV,PXCAINDX,7)="Problem Resolved Date is bad^"_PXCAITEM
34 .. S PXCAITEM=$P(PXCAPROB,U,5)
35 .. I '(PXCAITEM=1!(PXCAITEM=0)!(PXCAITEM="")) S PXCA("ERROR","PROBLEM",PXCAPRV,PXCAINDX,5)="SC flag bad^"_PXCAITEM
36 .. S PXCAITEM=$P(PXCAPROB,U,6)
37 .. I '(PXCAITEM=1!(PXCAITEM=0)!(PXCAITEM="")) S PXCA("ERROR","PROBLEM",PXCAPRV,PXCAINDX,6)="AO flag bad^"_PXCAITEM
38 .. S PXCAITEM=$P(PXCAPROB,U,7)
39 .. I '(PXCAITEM=1!(PXCAITEM=0)!(PXCAITEM="")) S PXCA("ERROR","PROBLEM",PXCAPRV,PXCAINDX,7)="IR flag bad^"_PXCAITEM
40 .. S PXCAITEM=$P(PXCAPROB,U,8)
41 .. I '(PXCAITEM=1!(PXCAITEM=0)!(PXCAITEM="")) S PXCA("ERROR","PROBLEM",PXCAPRV,PXCAINDX,8)="EC flag bad^"_PXCAITEM
42 .. ;PX*1*115 - ADD MST & HNC
43 .. S PXCAITEM=$P(PXCAPROB,U,13)
44 .. I '(PXCAITEM=1!(PXCAITEM=0)!(PXCAITEM="")) S PXCA("ERROR","PROBLEM",PXCAPRV,PXCAINDX,13)="MST flag bad^"_PXCAITEM
45 .. S PXCAITEM=$P(PXCAPROB,U,14)
46 .. I '(PXCAITEM=1!(PXCAITEM=0)!(PXCAITEM="")) S PXCA("ERROR","PROBLEM",PXCAPRV,PXCAINDX,14)="HNC flag bad^"_PXCAITEM
47 .. S PXCAITEM=$P(PXCAPROB,U,15)
48 .. I '(PXCAITEM=1!(PXCAITEM=0)!(PXCAITEM="")) S PXCA("ERROR","PROBLEM",PXCAPRV,PXCAINDX,14)="CV flag bad^"_PXCAITEM
49 .. S PXCAITEM=$P(PXCAPROB,U,9)
50 .. I PXCAITEM>0 D
51 ... N DIC,DR,DA,DIQ,PXCADIQ1
52 ... S DIC=80
53 ... S DR=".01;102"
54 ... S DA=PXCAITEM
55 ... S DIQ="PXCADIQ1("
56 ... S DIQ(0)="I"
57 ... D EN^DIQ1
58 ... I $G(PXCADIQ1(80,DA,.01,"I"))="" S PXCA("ERROR","PROBLEM",PXCAPRV,PXCAINDX,9)="ICD9 Code not in file 80^"_PXCAITEM
59 ... E I $G(PXCADIQ1(80,DA,102,"I")),PXCADIQ1(80,DA,102,"I")'>+PXCADT S PXCA("ERROR","PROBLEM",PXCAPRV,PXCAINDX,9)="ICD9 Code is INACTIVE^"_PXCAITEM
60 .. S PXCAITEM=$P(PXCAPROB,U,10)
61 .. I PXCAITEM]"" D
62 ... I $G(^AUPNPROB(PXCAITEM,0))="" S PXCA("ERROR","PROBLEM",PXCAPRV,PXCAINDX,10)="Problem not in file 9000011^"_PXCAITEM
63 ... E I PXCAPAT'=$P($G(^AUPNPROB(PXCAITEM,0)),"^",2) S PXCA("ERROR","PROBLEM",PXCAPRV,PXCAINDX,10)="Problem in file 9000011 is for a different Patient^"_PXCAITEM
64 .. E S PXCAITEM=$P(PXCAPROB,U,1) I PXCAITEM']"" S PXCA("ERROR","PROBLEM",PXCAPRV,PXCAINDX,1)="Problem Name required for a new Problem List entry^"_PXCAITEM
65 .. S PXCAITEM=$P(PXCAPROB,U,11),PXCAITM2=$L(PXCAITEM)
66 .. I PXCAITM2>60 S PXCA("ERROR","PROBLEM",PXCAPRV,PXCAINDX,11)="PROBLEM comment must be 1-60 Characters^"_PXCAITEM
67 .. ;
68 .. ;Clinical Lexicon Term
69 .. S PXCAITEM=$P(PXCAPROB,"^",12)
70 .. I PXCAITEM]"" D
71 ... I $D(^LEX(757.01)) D
72 .... I $D(^LEX(757.01,PXCAITEM,0))#2'=1 S PXCA("ERROR","PROBLEM",PXCAPRV,PXCAINDX,12)="Lexicon Utility term is not in file 757.01^"_PXCAITEM
73 .... E S PXCACLEX=PXCAITEM
74 ... E I $D(^GMP(757.01)) D
75 .... I $D(^GMP(757.01,PXCAITEM,0))#2'=1 S PXCA("ERROR","PROBLEM",PXCAPRV,PXCAINDX,12)="Clinical Lexicon Utility term is not in file 757.01^"_PXCAITEM
76 .... E S PXCACLEX=PXCAITEM
77 ... E S PXCA("ERROR","PROBLEM",PXCAPRV,PXCAINDX,12)="Lexicon Utility is not installed^"_PXCAITEM
78 ;
79 Q
80 ;
Note: See TracBrowser for help on using the repository browser.