source: FOIAVistA/trunk/r/PCE_PATIENT_CARE_ENCOUNTER-AUTN-EFDP-PX-VSIT--PXRM/PXCAPL2.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: 2.4 KB
Line 
1PXCAPL2 ;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 ;
11PROBLIST ;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 ;
Note: See TracBrowser for help on using the repository browser.