1 | PXCAPL1 ;ISL/dee & LEA/Chylton - Translates data from the PCE Device Interface into a call to update Problem List ;7/19/96
|
---|
2 | ;;1.0;PCE PATIENT CARE ENCOUNTER;**33,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 | PROBLIST ;Problem List
|
---|
12 | Q:'$D(^AUPNPROB)!($T(UPDATE^GMPLUTL)="")
|
---|
13 | N PXCAPRV,PXCAINDX,PXCANUMB
|
---|
14 | S PXCANUMB=0
|
---|
15 | S PXCAPRV=""
|
---|
16 | F S PXCAPRV=$O(PXCA("PROBLEM",PXCAPRV)) Q:PXCAPRV'>0 D
|
---|
17 | . S PXCAINDX=0
|
---|
18 | . F S PXCAINDX=$O(PXCA("PROBLEM",PXCAPRV,PXCAINDX)) Q:PXCAINDX']"" D
|
---|
19 | .. S PXCANUMB=PXCANUMB+1
|
---|
20 | .. Q:$D(PXCA("ERROR","PROBLEM",PXCAPRV,PXCAINDX))
|
---|
21 | .. N PXCAPROB,PXCAPL,PXCARES
|
---|
22 | .. S PXCAPROB=PXCA("PROBLEM",PXCAPRV,PXCAINDX)
|
---|
23 | .. S PXCAPL("PROBLEM")=$P(PXCAPROB,"^",10)
|
---|
24 | .. S PXCAPL("NARRATIVE")=$P(PXCAPROB,"^",1)
|
---|
25 | .. S PXCAPL("PATIENT")=PXCAPAT
|
---|
26 | .. S PXCAPL("STATUS")=$S($P(PXCAPROB,"^",3)="1":"A",$P(PXCAPROB,"^",3)="0":"I",1:"A")
|
---|
27 | .. S PXCAPL("PROVIDER")=PXCAPRV
|
---|
28 | .. S PXCAPL("LOCATION")=PXCAHLOC
|
---|
29 | .. S PXCAPL("SC")=$P(PXCAPROB,"^",5)
|
---|
30 | .. S PXCAPL("AO")=$P(PXCAPROB,"^",6)
|
---|
31 | .. S PXCAPL("IR")=$P(PXCAPROB,"^",7)
|
---|
32 | .. S PXCAPL("EC")=$P(PXCAPROB,"^",8)
|
---|
33 | .. ;PX*1*115 Add MST & HNC
|
---|
34 | .. S PXCAPL("MST")=$P(PXCAPROB,"^",13)
|
---|
35 | .. S PXCAPL("HNC")=$P(PXCAPROB,"^",14)
|
---|
36 | .. S PXCAPL("CV")=$P(PXCAPROB,"^",15)
|
---|
37 | .. S PXCAPL("DIAGNOSIS")=$P(PXCAPROB,"^",9)
|
---|
38 | .. S PXCAPL("RESOLVED")=$P(PXCAPROB,"^",4)
|
---|
39 | .. S PXCAPL("ONSET")=$P(PXCAPROB,"^",2)
|
---|
40 | .. S PXCAPL("COMMENT")=$P(PXCAPROB,"^",11)
|
---|
41 | .. S PXCAPL("LEXICON")=$P(PXCAPROB,"^",12)
|
---|
42 | .. D UPDATE^GMPLUTL(.PXCAPL,.PXCARES)
|
---|
43 | .. I $G(PXCARES)'>0 D
|
---|
44 | ... I PXCARES(0)'="Duplicate problem" S PXKERROR("PL",PXCANUMB,0,0)="Problem Not Stored = "_$G(PXCARES(0))_" For Provider = "_PXCAPRV_" and index = "_PXCAINDX
|
---|
45 | ... S PXCA("WARNING","PROBLEM",PXCAPRV,PXCAINDX,0)="PROBLEM Not Stored^"_$G(PXCARES(0))
|
---|
46 | Q
|
---|
47 | ;
|
---|