[613] | 1 | PXCAPL2 ;ISL/dee & LEA/Chylton - Translates data from the PCE Device Interface for "DIAGNOSIS/PROBLEM" 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 | ; PXCADXPL 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("DIAGNOSIS/PROBLEM",PXCAPRV)) Q:PXCAPRV'>0 D
|
---|
| 17 | . S PXCAINDX=0
|
---|
| 18 | . F S PXCAINDX=$O(PXCA("DIAGNOSIS/PROBLEM",PXCAPRV,PXCAINDX)) Q:PXCAINDX']"" D
|
---|
| 19 | .. S PXCANUMB=PXCANUMB+1
|
---|
| 20 | .. ;Quit if there is an error in this node
|
---|
| 21 | .. Q:$D(PXCA("ERROR","DIAGNOSIS/PROBLEM",PXCAPRV,PXCAINDX))
|
---|
| 22 | .. N PXCADXPL,PXCAPL,PXCARES
|
---|
| 23 | .. S PXCADXPL=PXCA("DIAGNOSIS/PROBLEM",PXCAPRV,PXCAINDX)
|
---|
| 24 | .. S PXCAPL("COMMENT")=$P($G(PXCA("DIAGNOSIS/PROBLEM",PXCAPRV,PXCAINDX,"NOTE")),"^",1)
|
---|
| 25 | .. ;Quit if this is not a problem
|
---|
| 26 | .. Q:"^^^"[$P(PXCADXPL,"^",5,8)&(PXCAPL("COMMENT")="")
|
---|
| 27 | .. S PXCAPL("PATIENT")=PXCAPAT
|
---|
| 28 | .. S PXCAPL("PROVIDER")=PXCAPRV
|
---|
| 29 | .. S PXCAPL("LOCATION")=PXCAHLOC
|
---|
| 30 | .. S PXCAPL("DIAGNOSIS")=$P(PXCADXPL,"^",1)
|
---|
| 31 | .. S PXCAPL("LEXICON")=$P(PXCADXPL,"^",3)
|
---|
| 32 | .. S PXCAPL("PROBLEM")=$P(PXCADXPL,"^",4)
|
---|
| 33 | .. S PXCAPL("STATUS")=$P(PXCADXPL,"^",6)
|
---|
| 34 | .. S PXCAPL("ONSET")=$P(PXCADXPL,"^",7)
|
---|
| 35 | .. S PXCAPL("RESOLVED")=$P(PXCADXPL,"^",8)
|
---|
| 36 | .. S PXCAPL("SC")=$P(PXCADXPL,"^",9)
|
---|
| 37 | .. S PXCAPL("AO")=$P(PXCADXPL,"^",10)
|
---|
| 38 | .. S PXCAPL("IR")=$P(PXCADXPL,"^",11)
|
---|
| 39 | .. S PXCAPL("EC")=$P(PXCADXPL,"^",12)
|
---|
| 40 | .. ;Add MST & HNC
|
---|
| 41 | .. S PXCAPL("MST")=$P(PXCADXPL,"^",15)
|
---|
| 42 | .. S PXCAPL("HNC")=$P(PXCADXPL,"^",16)
|
---|
| 43 | .. S PXCAPL("CV")=$P(PXCADXPL,"^",17)
|
---|
| 44 | .. S PXCAPL("NARRATIVE")=$P(PXCADXPL,"^",13)
|
---|
| 45 | .. S:'PXCAPL("PROBLEM") PXCAPL("RECORDED")=$P($P(PXCA("ENCOUNTER"),"^"),".") ;Only if new problem
|
---|
| 46 | .. D UPDATE^GMPLUTL(.PXCAPL,.PXCARES)
|
---|
| 47 | .. I $G(PXCARES)'>0 D
|
---|
| 48 | ... I PXCARES(0)'="Duplicate problem" S PXKERROR("PL",PXCANUMB,0,0)="Problem Not Stored = "_$G(PXCARES(0))_" For Provider = "_PXCAPRV_" and index = "_PXCAINDX
|
---|
| 49 | ... S PXCA("WARNING","DIAGNOSIS/PROBLEM",PXCAPRV,PXCAINDX,0)="PROBLEM Not Stored^"_$G(PXCARES(0))
|
---|
| 50 | .. E I $D(^TMP("PXK",$J,"POV",PXCADNUM(PXCAPRV,PXCAINDX),0,"AFTER"))#2 S $P(^("AFTER"),"^",16)=PXCARES
|
---|
| 51 | Q
|
---|
| 52 | ;
|
---|